suzanne.soy/2010-m1s1-compilation
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' of github:dumbs/2010-m1s1-compilation

Browse Source
This commit is contained in:
Georges Dupéron 2010-10-31 02:19:56 +01:00
commit b7d2da9a3a
2 changed files with 40 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
environnement.lisp
View File

@ -52,8 +52,8 @@ Le paramètre ENV-STACK est toute la pile d'environnements."
(defun add-binding (env-stack name value)
"Ajoute une liaison au dernier environnement (le plus bas)."
(setf (cdar env-stack)
(cons (cons name value)
(cdar env-stack)))
(cons (cons name value)
(cdar env-stack)))
env-stack)
(defun get-binding (env-stack name)
@ -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

39
lisp2li.lisp
View File

@ -1,24 +1,29 @@
;; 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 l’interpréteur"
(cond ((and (atom expr) (constantp expr)) ; literaux
(cond ((null env) (lisp2li expr (empty-env-stack)))
((and (atom expr) (constantp expr)) ; literaux
(cons :lit expr))
((symbolp expr) ; symboles
(let ((cell (get-binding env expr)))
(if cell
(cons :var (car cell))
(warn "Variable ~S unknown" (car expr)))))
(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)))
((not (fboundp (car expr)))
((and (not (fboundp (car expr))) (not (get-binding env (car expr))))
(list :unknown expr env))
((eq 'if (car expr)) ; if
(list :if
@ -28,12 +33,12 @@ par le compilateur et par l’interpré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)
@ -131,6 +136,8 @@ par le compilateur et par l’interpréteur"
(deftestvar lisp2li env (add-binding (empty-env-stack) 'x 1))
(deftest lisp2li
(lisp2li '(setq x 2) env)
'(:call set-binding (:lit (("TOP-LEVEL" (x . 1)))) (:lit . x) (:lit . 2)))
'(:call set-binding (:lit . (("TOP-LEVEL" (x . 1)))) (:lit . x) (:lit . 2)))
;; Test sur le defun
;(run-tests t)