Commencement de la fonction meval. Pour l'instant elle n'evalue que les contantes :D

lisp2li.lisp

@@ -89,7 +89,7 @@ par le compilateur et par l’interpréteur"
    ((eq 'lambda (car expr)) ;; TODO : ameliorer le cas du lambda
     (if (member '&rest (second expr))
       `(:lclosure . (,(get-nb-params (second expr))
-                           ,(+ 1 (position '&rest (second expr)))
+                           ,(+ 1 (mposition '&rest (second expr)))
                            ,(lisp2li (caddr expr)
                                     (make-stat-env (second expr)))))
       `(:lclosure . ,(cons (get-nb-params (second expr))
@@ -204,8 +204,8 @@ par le compilateur et par l’interpréteur"
   '(:if (:const . T) (:const . T) (:const . nil)))
 
 (deftest (lisp2li defun)
-  (lisp2li '(defun foo (x) x) ())
-  '(:mcall set-defun (:const . foo) (:lclosure 1 :cvar 0 1)))
+  (lisp2li '(defun bar (x) x) ())
+  '(:mcall set-defun (:const . bar) (:lclosure 1 :cvar 0 1)))
 
 (deftest (lisp2li defun)
   (lisp2li '(defun foo (x y z) (list x y z)) ())

meval.lisp

@@ -1,39 +1,65 @@
-(defun meval (expr env)
+(load "match")
+(defun meval (expr &optional env)
   "Interprète le langage intermédiaire passé en paramètre."
-  (cond ((eq ':lit (first expr))
+  (cond ((match :const (first expr))
          (cdr expr))
-        ((eq ':var (first expr))
-         (let ((cell (get-binding env (cdr expr))))
-           (if cell
-                (cdr cell)
-               (error "The variable ~S is unbound" (cdr expr)))))
-        ((eq ':if (car expr))
-         (if (meval (second expr) env)
-             (meval (third expr) env)
-           (meval (fourth expr) env)))
-        ((eq ':call (first expr))
-         (apply (second expr) (map-meval (cddr expr) env)))
-        ))
+        ((match :cvar (first expr))
+         )
+        ((match :lclosure (first expr))
+         )
+        (T
+         (error "form special ~S not yet implemented" expr))))
+
+;;   (cond ((eq ':const (first expr))
+;;          (cdr expr))
+;;         ((eq ':var (first expr))
+;;          (let ((cell (get-binding env (cdr expr))))
+;;            (if cell
+;;                 (cdr cell)
+;;                (error "The variable ~S is unbound" (cdr expr)))))
+;;         ((eq ':if (car expr))
+;;          (if (meval (second expr) env)
+;;              (meval (third expr) env)
+;;            (meval (fourth expr) env)))
+;;         ((eq ':call (first expr))
+;;          (apply (second expr) (map-meval (cddr expr) env)))
+;;         ))
 
 (defun map-meval (list env)
   (mapcar (lambda (x) (meval x env)) list))
 
 ;; Test unitaire
 (load "test-unitaire")
+(load "lisp2li")
 (erase-tests meval)
-(deftest meval
-  (meval '(:lit . 3) ())
+(deftest (meval :const)
+  (meval (lisp2li 3 ()))
   3)
 
-(deftest meval
-  (meval '(:var . x) '(("TEST" (s . ()) (z . 4) (x . 5) (u . 6))))
+(deftest (meval quote)
+  (meval (lisp2li '3 ()))
+  3)
+
+(deftest (meval quote)
+  (meval (lisp2li ''3 ()))
+  3)
+
+(deftest (meval quote)
+  (meval (lisp2li '''3 ()))
+  '3)
+
+(deftest (meval :cvar)
+  (meval (lisp2li 'x '((x 0 2))) #(() 4 5 6))
   5)
 
-(deftest meval
-  (meval '(:var . s2) '(("TEST" (s . ()) (s1 . 7) (s2 . 8))
-                       ("TOP-LEVEL" (x . 4) (x1 . 5) (x2 . 6))))
+(deftest (meval :cvar)
+  (meval '(:cvar 1 2) #(#(() 7 8) 4 5 6)) 
   8)
 
-(deftest meval
-  (meval '(:call + (:lit . 3) (:var . x)) '(("TOP-LEVEL" (x1 . 4) (x . 5) (z . 6))))
+(deftest (meval :call)
+  (meval '(:call + (:const . 3) (:cvar 0 1)) #(() 4 5 6))
   8)
+
+(deftest (meval defun)
+  (meval '(defun foo (x) x))
+  foo)

util.lisp

@@ -84,3 +84,13 @@
   (setf (get-defmacro (cdaddr li))
         (cdddr li)))
 
+(defun mposition (symb list)
+  (defun mposition-t (symb list counter)
+    (cond ((endp list) nil)
+          ((eq symb (car list)) counter)
+          ((or (eq (car list) '&optional)
+              (eq (car list) '&rest))
+          (mposition-t symb (cdr list) counter))
+          (T
+           (mposition-t symb (cdr list) (+ 1 counter)))))
+  (mposition-t symb list 0))