Création du dossier lisp à côté de scheme (partie 2)

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)

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)

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.

lisp/vm.lisp

@@ -276,4 +276,4 @@
          (get-memory vm (get-register vm 'SP)))
   t-r1-value)
 
-(provide 'instructions)
+(provide 'vm)