commit 989d5b15245cf828f419150ac823f9102017ac32
parent 72578b6e9ea2a9ab558d2a488006f657b439f16e
Author: Bertrand BRUN <bertrand.brun@me.com>
Date: Tue, 26 Oct 2010 13:33:31 +0200
Ajout de la fonction lisp2li et de ces tests unitaire. Manque quelques cas a gerer (voir git grep TODO -- lisp2li.lisp)
Diffstat:
4 files changed, 96 insertions(+), 12 deletions(-)
diff --git a/instructions.lisp b/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)
diff --git a/lisp2li.lisp b/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)
+\ No newline at end of file
diff --git a/main.lisp b/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)
diff --git a/test-unitaire.lisp b/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))
