Ajout de la gestion des call, if et progn dans meval
This commit is contained in:
parent
5b323b2c46
commit
ae51cc671a
65
meval.lisp
65
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)
|
||||
foo)
|
||||
|
||||
(deftest (meval defun)
|
||||
(meval '(defun foo (x y z) (list x y z)))
|
||||
foo)
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user