Ajout de la fonction lisp2li et de ces tests unitaire. Manque quelques cas a gerer (voir git grep TODO -- lisp2li.lisp)

instructions.lisp

@@ -156,7 +156,7 @@ et termine par la liste APPEND."
 (defun ISN-JMP (vm dst)
   (set-register vm 'PC (- dst 1)))
 
-(defun JSR (vm dst)
+(defun ISN-JSR (vm dst)
   (ISN-PUSH vm 'PC)
   (ISN-JMP vm dst))
 
@@ -273,5 +273,4 @@ et termine par la liste APPEND."
   42)
 
 
-
 (dump-vm vm)

lisp2li.lisp

@@ -0,0 +1,83 @@
+
+;; TODO : reste a gere les variables, les macros predefinies, les defuns.
+(defun lisp2li (expr env)
+  (cond ((and (atom expr) (constantp expr))
+         (cons :lit expr))
+        ((eq 'if (car expr))
+         (list :if
+               (lisp2li (second expr) env)
+               (lisp2li (third expr) env)
+               (lisp2li (fourth expr) env)))
+        ((eq 'quote (car expr))
+         (cons :lit (second expr)))
+        ((fboundp (car expr))
+         (cons :call (cons (first expr) (map-lisp2li (cdr expr) env))))
+        (T (list :unknown expr env))
+        ))
+
+(defun map-lisp2li (expr env)
+  (mapcar (lambda (x) (lisp2li x env)) expr))
+
+;; Test unitaire
+(load "test-unitaire")
+;(erase-tests)
+;; test des litteraux
+(deftest lisp2li
+  (lisp2li 1 ())
+  '(:lit . 1))
+
+(deftest lisp2li
+  (lisp2li 2.3 ())
+  '(:lit . 2.3))
+
+(deftest lisp2li
+  (lisp2li "abc" ())
+  '(:lit . "abc"))
+
+(deftest lisp2li
+  (lisp2li T ())
+  '(:lit . T))
+
+(deftest lisp2li
+  (lisp2li nil ())
+  '(:lit . nil))
+
+;; test des if
+(deftest lisp2li
+  (lisp2li '(if T T nil) ())
+  '(:if (:lit . T) (:lit . T) (:lit . nil)))
+
+(deftest lisp2li
+  (lisp2li '(if T nil T) ())
+  '(:if (:lit . T) (:lit . nil) (:lit . T)))
+
+;; test des fonctions predefinies
+(deftest lisp2li
+  (lisp2li '(eq 1 1) ())
+  '(:call eq (:lit . 1) (:lit . 1)))
+
+(deftest lisp2li
+  (lisp2li '(and 1 1) ())
+  '(:call and (:lit . 1) (:lit . 1)))
+
+;; Test avec des expression plus complexe
+(deftest lisp2li
+  (lisp2li '(if (eq 1 1) 2 2) ())
+  '(:if (:call eq (:lit . 1) (:lit . 1)) (:lit . 2) (:lit . 2)))
+
+(deftest lisp2li
+  (lisp2li '(if (eq "abc" 1) "abc" 2) ())
+  '(:IF (:CALL EQ (:LIT . "abc") (:LIT . 1)) (:LIT . "abc") (:LIT . 2)))
+
+(deftest lisp2li
+  (lisp2li '(if (and (eq 1 1) (= 2 2)) (or 1 2) (and 1 2)) ())
+  '(:if (:call and (:call eq (:lit . 1) (:lit . 1))
+               (:call = (:lit . 2) (:lit . 2)))
+        (:call or (:lit . 1) (:lit . 2))
+        (:call and (:lit . 1) (:lit . 2))))
+
+(deftest lisp2li
+  (lisp2li '(foo 1 1) ())
+  '(:unknown (foo 1 1) ()))
+
+(run-tests t)

main.lisp

@@ -6,6 +6,7 @@
           (copytree (cdr l)))))
 (load "environnement")
 (load "instructions")
+(load "lisp2li")
 ;; ...
-(run-test t)
+(run-tests t)
 ;(print-env-stack exemple-env-stack)

test-unitaire.lisp

@@ -69,12 +69,12 @@
 (defun erase-tests ()
   (setf all-tests nil))
 
-(deftest moda nil nil)
-(deftest moda (eq 42 42) t)
-(deftest modb (eq 'a 'a) t)
-(deftest modb (eq 'a 'b) nil)
-(deftest modb (eq 'a 'c) t)
-(deftest modb 1 1)
-(deftest modc (+ 1 2) (+ 2 1))
-(deftestvar modc x 1)
-(deftest modc (+ x 2) (+ 2 1))
+;(deftest moda nil nil)
+;(deftest moda (eq 42 42) t)
+;(deftest modb (eq 'a 'a) t)
+;(deftest modb (eq 'a 'b) nil)
+;(deftest modb (eq 'a 'c) t)
+;(deftest modb 1 1)
+;(deftest modc (+ 1 2) (+ 2 1))
+;(deftestvar modc x 1)
+;(deftest modc (+ x 2) (+ 2 1))