Ajout du curry pour manger

lisp2li.lisp

@@ -40,7 +40,7 @@ par le compilateur et par l’interpréteur"
                (lisp2li (third expr) env-var env-fun)
                (lisp2li (fourth expr) env-var env-fun)))
 	;; quotes
-        ((eq 'quote (car expr)) 
+        ((eq 'quote (car expr))
          (cons :lit (second expr)))
         ;; defun
 	((eq 'defun (car expr)) 
@@ -62,8 +62,8 @@ par le compilateur et par l’interpréteur"
                (body (cddr expr)))
            (lisp2li `((lambda ,(mapcar #'car bindings)
                ,@body)
-               ,@(mapcar #'cadr bindings)) env-var env-fun)))
-	;; let*
+                      ,@(mapcar #'cadr bindings)) env-var env-fun)))
+        ;; let*
         ((eq 'let* (car expr))
          (let ((bindings (cadr expr))
                (body (caddr expr)))
@@ -72,6 +72,16 @@ par le compilateur et par l’interpréteur"
                       `(let (,(car bindings))
                          (let* ,(cdr bindings)
                            ,body))) env-var env-fun)))
+        ;; labels
+        ((eq 'labels (car expr))
+         (let ((bindings (cadr expr))
+               (body (cddr expr)))
+           (lisp2li `((lambda ,(mapcar #'car bindings)
+                        ,@body)
+                      ,@(mapcar #'cadr bindings)) env-var env-fun)))
+        ;; `
+        ((eq '` (car expr))
+         (print "Ca marche"))
 	;; progn
 	((eq 'progn (car expr))
 	 (cons :progn (map-lisp2li (cdr expr) env-var env-fun)))
@@ -86,7 +96,7 @@ par le compilateur et par l’interpréteur"
         ))
 
 (defun map-lisp2li (expr env-var env-fun)
-  (mapcar (lambda (x) (lisp2li x env-var env-fun)) expr))
+  (mapcar (curry #'lisp2li :skip env-var env-fun) expr))
 
 (defun map-lisp2li-let (expr env)
   (mapcar (lambda (x) (add-binding env (car x) (lisp2li (cadr x) env))) (cadr expr)))

meval.lisp

@@ -17,7 +17,6 @@
 
 (defun map-meval (list env)
   (mapcar (lambda (x) (meval x env)) list))
-
 (defun foo (x) x)
 
 ;; Test unitaire

util.lisp

@@ -34,3 +34,31 @@
       t
       (and (consp l)
            (n-consp (- n 1) (cdr l)))))
+
+(defun range (a &optional b)
+  (cond ((null b) (range 0 a))
+        ((> a b) (loop for i from a above (- b 1) collect i))
+        (T (loop for i from a to b collect i))))
+
+(defun shift (n l)
+  (if (<= n 0)
+      l
+    (shift (- n 1) (cdr l))))
+
+(defmacro curry (fun &rest params)
+  `(lambda (&rest actual-params)
+     (apply ,fun
+            ,@(mapcar (lambda (x n)
+                        (if (eq :skip x)
+                            `(nth ,(- n 1) actual-params)
+                          x))
+                      params
+                      (range (length params)))
+            (shift ,(count-if (lambda (x) (eq x :skip)) params)
+                   actual-params))))
+
+(defun foo (x y z) (list x y z))
+(defvar cfoo nil)
+(setq cfoo (curry #'foo 1 2))
+(defvar cfoo2 nil)
+(setq cfoo2 (curry #'foo :skip 2))