diff --git a/lisp2li.lisp b/lisp2li.lisp index 56cd0fb..92470d9 100644 --- a/lisp2li.lisp +++ b/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)) ()) diff --git a/meval.lisp b/meval.lisp index c0a107f..7c975ba 100644 --- a/meval.lisp +++ b/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) \ No newline at end of file diff --git a/util.lisp b/util.lisp index e1c79b9..4abcb5f 100644 --- a/util.lisp +++ b/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)) \ No newline at end of file