Ajout de la gestion des call, if et progn dans meval

This commit is contained in:
Bertrand BRUN 2010-11-06 13:22:28 +01:00
parent 5b323b2c46
commit ae51cc671a

View File

@ -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)
foo)
(deftest (meval defun)
(meval '(defun foo (x y z) (list x y z)))
foo)