commit ae51cc671ad7d277668a526be3c05466242fee88
parent 5b323b2c46c57884ae2634bda901b3489c636658
Author: Bertrand BRUN <bertrand.brun@me.com>
Date: Sat, 6 Nov 2010 13:22:28 +0100
Ajout de la gestion des call, if et progn dans meval
Diffstat:
| M | meval.lisp | | | 66 | +++++++++++++++++++++++++++++++++++++++++++----------------------- |
1 file changed, 43 insertions(+), 23 deletions(-)
diff --git a/meval.lisp b/meval.lisp
@@ -9,6 +9,15 @@
)))
(get-env-num-t num env 0))
+(defun map-meval (list env)
+ (mapcar (lambda (x) (meval x env)) list))
+
+(defun meval-progn (list env)
+ (loop
+ for expr in list
+ do (meval expr env)
+ ))
+
(defun meval (expr &optional env)
"Interprète le langage intermédiaire passé en paramètre."
(cond ((match :const (first expr))
@@ -17,27 +26,17 @@
(let ((sub-env (get-env-num (second expr) env)))
(if sub-env
(aref sub-env (third expr))
- (error "The variable ~S is unbound" (cdr expr)))))
+ (error "The variable ~S is unbound" expr))))
+ ((match :if (first expr))
+ (if (meval (second expr) env)
+ (meval (third expr) env)
+ (meval (fourth expr) env)))
+ ((match :call (first expr))
+ (apply (symbol-function (cadr expr)) (map-meval (cddr expr) env)))
+ ((match :progn (first expr))
+ (map-meval ())
(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))
+ (error "form special ~S not yet implemented" (car expr)))))
;; Test unitaire
(load "test-unitaire")
@@ -69,8 +68,30 @@
(deftest (meval :call)
(meval '(:call + (:const . 3) (:cvar 0 1)) #(() 4 5 6))
- 8)
+ 7)
+
+(deftest (meval :call)
+ (meval '(:call list (:const . 3) (:const . 2)))
+ '(3 2))
+
+(deftest (meval :if)
+ (meval '(:if (:const . T)
+ (:const . T)
+ (:const . nil)))
+ T)
+
+(deftest (meval :if)
+ (meval '(:if (:call eq (:const . 1)
+ (:cvar 0 1))
+ (:const . T)
+ (:const . nil)) #(() 1 2 3))
+ T)
(deftest (meval defun)
(meval '(defun foo (x) x))
- foo)
-\ No newline at end of file
+ foo)
+
+(deftest (meval defun)
+ (meval '(defun foo (x y z) (list x y z)))
+ foo)
+
