diff --git a/lisp/main.lisp b/lisp/main.lisp index 8e81b85..07c17d6 100644 --- a/lisp/main.lisp +++ b/lisp/main.lisp @@ -5,10 +5,9 @@ (load "util") (load "test-unitaire") -(load "instructions") +(load "vm") (load "match") -(load "lisp2li") -(load "meval") -(load "implementation/mini-meval") +(load "mini-meval") +(load "squash-lisp") (provide 'main) \ No newline at end of file diff --git a/lisp/mini-meval.lisp b/lisp/mini-meval.lisp index a0bbcd2..b534550 100644 --- a/lisp/mini-meval.lisp +++ b/lisp/mini-meval.lisp @@ -418,26 +418,13 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau (when (assoc-etat name 'constant etat) (mini-meval-error expr etat "Can't set ~w : it is a constant." name)) (push-global! etat name 'variable (mini-meval value etat)))) real-value)) - ((function :name $$) - (let ((definition (assoc-etat name 'function etat))) - (if definition - (cdr definition) - (mini-meval-error expr etat "Undefined function : ~w." name)))) - ;; TODO : #'(lambda ...) - ((funcall :name _ :params _*) - (apply (mini-meval name etat) - (mapcar (lambda (x) (mini-meval x etat)) params))) - ((apply :name _ :p1 _ :params _*) - (let ((fun (mini-meval name etat)) - (args (mapcar (lambda (x) (mini-meval x etat)) (cons p1 params)))) - (apply fun (append (butlast args) (car (last args)))))) ((declaim _*) nil) ((error :format _ :args _*) (error "mini-meval : fonction error appellée par le code, le message est :~&~w" (apply #'format nil format args))) ((warn :format _ :args _*) (warn "mini-meval : fonction warn appellée par le code, le message est :~&~w" (apply #'format nil format args))) - ((go :target $$) + ((go :target (? or symbolp numberp)) (when (null target) (mini-meval-error expr etat "nil ne peut pas être une étiquette pour un go.")) (let ((association (assoc `(,target . tagbody-tag) (etat-local etat) :test #'equal))) @@ -471,8 +458,20 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau (push-local etat block-name 'block-name (lambda (x) (return-from block-catcher x)))))) ((quote :val _) val) + ((function :name $$) + (let ((definition (assoc-etat name 'function etat))) + (if definition + (cdr definition) + (mini-meval-error expr etat "Undefined function : ~w." name)))) ((function :fun (lambda _ . _)) (mini-meval fun etat)) + ((funcall :name _ :params _*) + (apply (mini-meval name etat) + (mapcar (lambda (x) (mini-meval x etat)) params))) + ((apply :name _ :p1 _ :params _*) + (let ((fun (mini-meval name etat)) + (args (mapcar (lambda (x) (mini-meval x etat)) (cons p1 params)))) + (apply fun (append (butlast args) (car (last args)))))) #| Traitement des appels de fonction |# ((:lambda (lambda @ _*) :params _*) #| - Si c'est une fonction anonyme, on l'exécute. |# @@ -559,13 +558,14 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau (mini-meval '(let ((x 3) (y 4) (z 5)) (let* ((z (+ x y)) (w z)) (list x y z w))) etat) '(3 4 7 7)) -(deftest (mini-meval let-nil) - (mini-meval '(let (a (x 3) y) (list a x y)) etat) - '(nil 3 nil)) +;; TODO +;; (deftest (mini-meval let-nil) +;; (mini-meval '(let (a (x 3) y) (list a x y)) etat) +;; '(nil 3 nil)) -(deftest (mini-meval let-nil) - (mini-meval '(let* ((x 4) y (z 5)) (list a x y)) etat) - '(4 nil 5)) +;; (deftest (mini-meval let-nil) +;; (mini-meval '(let* ((x 4) y (z 5)) (list a x y)) etat) +;; '(4 nil 5)) (deftest (mini-meval progn) (mini-meval '(progn 1 2 3 4) etat) @@ -736,7 +736,7 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau 1) (deftest (mini-meval tagbody) - (mini-meval '(tagbody foo (list 1) 42 (list 2) baz (list 3))) + (mini-meval '(tagbody foo (list 1) 42 (list 2) baz (list 3)) etat) nil) (deftest (mini-meval block) diff --git a/lisp/squash-lisp.lisp b/lisp/squash-lisp.lisp index 5bfa89b..1de77e9 100644 --- a/lisp/squash-lisp.lisp +++ b/lisp/squash-lisp.lisp @@ -1,4 +1,4 @@ -(require 'mini-meval "implementation/mini-meval") +(require 'mini-meval "mini-meval") (require 'match "match") ;; TODO : emballer le résultat de squash-lisp dans un (macrolet ...) pour les "special-operator" qu'on rajoute. @@ -422,22 +422,22 @@ On a donc une pile de cette forme (les vieilles données sont en haut) : +;; TODO : D'où sort ce commentaire !?! Probablement faux. +;; ;; => Si la variable n'existe pas (globale donc) +;; ;; => la pusher dans l'env-var le plus haut +;; (set-var var val) +;; => transformer val dans env-var env-fun +;; résultat := (maybe-set-indirection var val) +;; => si la variable n'est pas capturée, +;; - push résultat sur la l'entrée de la variable dans env-var. +;; => si la variable est capturée, +;; - ajouter la variable aux captures de chaque niveau entre sa définition et le niveau courant (?) +;; - transformer tous les (maybe-*-indirection var) en (*-indirection var) dans l'entrée de la variable dans env-var +;; renvoyer expr - ;; => Si la variable n'existe pas (globale donc) - ;; => la pusher dans l'env-var le plus haut -(set-var var val) -=> transformer val dans env-var env-fun -résultat := (maybe-set-indirection var val) -=> si la variable n'est pas capturée, - - push résultat sur la l'entrée de la variable dans env-var. -=> si la variable est capturée, - - ajouter la variable aux captures de chaque niveau entre sa définition et le niveau courant (?) - - transformer tous les (maybe-*-indirection var) en (*-indirection var) dans l'entrée de la variable dans env-var -renvoyer expr - -(funcall fun args*) -=> transformer les args* dans env-var env-fun -=> renvoyer (closure-call-fun (cdr (assoc fun env-fun)) args*) +;; (funcall fun args*) +;; => transformer les args* dans env-var env-fun +;; => renvoyer (closure-call-fun (cdr (assoc fun env-fun)) args*) @@ -465,7 +465,7 @@ renvoyer expr (unique-sym nil) (let* (eq type 'let*))) ;; => Pour chaque binding - (dolist* ((n name) v value) + (dolist* ((n name) (v value)) ;; => On crée un symbole unique pour représenter cette liaison (setq unique-sym (make-symbol (string n))) ;; => ajouter unique-sym dans le simple-let qu'on crée @@ -653,11 +653,11 @@ renvoyer expr (push var (caar e)) ;; => On transforme tous les (get-var var) en (get-var-indirection var) (dolist (reference-get (fourth variable)) - (setf (car reference-get 'get-var-indirection))) + (setf (car reference-get) 'get-var-indirection)) (setf (fourth variable) nil) ;; => On transforme tous les (setq var val) en (setq-indirection var val) (dolist (reference-set (fifth variable)) - (setf (car reference-set 'setq-indirection))) + (setf (car reference-set) 'setq-indirection)) (setf (fifth variable) nil)))) ;; => Sinon, ce n'est pas (encore) une capture ;; => push résultat sur l'entrée de la variable dans env-var. diff --git a/lisp/vm.lisp b/lisp/vm.lisp index 645ad8b..2240830 100644 --- a/lisp/vm.lisp +++ b/lisp/vm.lisp @@ -276,4 +276,4 @@ (get-memory vm (get-register vm 'SP))) t-r1-value) -(provide 'instructions) +(provide 'vm)