Correction de la fonction print-env-stack pour quel puisse afficher correctement l'environnement, lisp2li gere maintenant correctement les lambda-expressions et les defuns

This commit is contained in:
Bertrand BRUN 2010-10-31 02:45:19 +02:00
parent e80b555d9c
commit b154264f1a
2 changed files with 34 additions and 19 deletions

View File

@ -93,12 +93,21 @@ l'environnement top-level."
env-stack)
(defun print-env-stack (env-stack)
(if (atom env-stack)
nil
(progn (format t "~&~a: " (caar env-stack))
(mapcar (lambda (b) (format t "~& ~w = ~w" (car b) (cdr b)))
(cdar env-stack))
(print-env-stack (cdr env-stack)))))
(let ((*print-circle* t))
(if (atom env-stack)
nil
(progn (format t "~&~a: " (caar env-stack))
(mapcar (lambda (b) (format t "~& ~w = ~w" (car b) (cdr b)))
(cdar env-stack))
(print-env-stack (cdr env-stack))))))
;(defun print-env-stack (env-stack)
; (if (atom env-stack)
; nil
; (progn (format t "~&~a: " (caar env-stack))
; (mapcar (lambda (b) (format t "~& ~w = ~w" (car b) (cdr b)))
; (cdar env-stack))
; (print-env-stack (cdr env-stack)))))
;;Test Unitaire
(deftest environnement

View File

@ -1,4 +1,4 @@
;; TODO : reste a gerer les defuns, les let, les lambda expression, les setf, les progn, ...
(load "environnement")
(defun lisp2li (expr env)
"Convertit le code LISP en un code intermédiaire reconnu
par le compilateur et par linterpréteur"
@ -10,16 +10,20 @@ par le compilateur et par linterpréteur"
(if cell
(cons :var (car cell))
(warn "Variable ~S unknown" expr))))
((eq 'lambda (car expr))
(let ((env-bis (make-stat-env (push-new-env env "LAMBDA") (second expr))))
`(:lclosure ,env-bis
,(lisp2li (third expr)
env-bis))))
((and (consp (car expr))
(eq 'lambda (caar expr)))
;; λ-expressions
;; => recursion sur arguments
;; => construction environnement
;; => recursion sur corps de la λ-fonction
(error "Lambda expression NYI"))
`(:call ,(lisp2li (car expr) env)
,@(mapcar (lambda (param)
(lisp2li param env))
(cdr expr))))
((not (symbolp (car expr)))
(warn "~S isn't a symbol" (car expr)))
((get-binding env (car expr))
((and (not (fboundp (car expr))) (not (get-binding env (car expr))))
(list :unknown expr env))
((eq 'if (car expr)) ; if
(list :if
@ -29,12 +33,12 @@ par le compilateur et par linterpréteur"
((eq 'quote (car expr)) ;; quotes
(cons :lit (second expr)))
((eq 'defun (car expr)) ;; TODO : a verifier que le cas de defun est bien gerer comme on le veux
(add-top-level-binding env
(second expr)
(cons :lclosure (list (length (third expr))
(lisp2li (fourth expr)
(make-stat-env (push-new-env env "DEFUN")
(third expr))))))
(let ((env-bis (make-stat-env (push-new-env env "DEFUN") (third expr))))
(add-top-level-binding env
(second expr)
(cons :lclosure (cons env-bis
(lisp2li (fourth expr)
env-bis)))))
(cons :lit (second expr)))
((eq 'setq (car expr))
(cons :call (cons 'set-binding (list `(:lit . ,env)
@ -134,4 +138,6 @@ par le compilateur et par linterpréteur"
(lisp2li '(setq x 2) env)
'(:call set-binding (:lit . (("TOP-LEVEL" (x . 1)))) (:lit . x) (:lit . 2)))
;; Test sur le defun
;(run-tests t)