Ajout de la parti test unitaire

environnement.lisp

@@ -14,8 +14,8 @@
 ;;    répercute sur la valeur accédée par l'autre.
 ;;  - Lorsqu'on définit une fonction, il faut mettre juste après la
 ;;    liste des paramètres une chaîne de caractères qui documente la
-;;    fonction (une docstring). http://en.wikipedia.org/wiki/Docstring
-
+;;    fonction (une docstring).
+;;  - L'environnement top-level est partage par tous le monde
 
 ;; Exemple de la structure env-stack après création de deux
 ;; environnements en plus du top-level et ajout de plusieurs laisons.
@@ -94,4 +94,3 @@ l'environnement top-level."
 	(3 (add-binding (add-binding (push-new-env (empty-env-stack)) 'x 42) 'y 56))
 	))
 
-(test-env 0)

meval.lisp

@@ -0,0 +1,37 @@
+;; meval donnee en cours
+
+(defun meval (expr env)
+  (cond ((and (atom expr) (constantp expr)) expr) ;; Literal
+        ((atom expr) ;; symboles
+         (let ((cell (assoc expr env)))
+           (if cell (cdr cell)
+             (error ""))))
+        ;; .
+        ;; .
+        ;; .
+        ((eq 'quote (car expr)) (cadr expr)) ;;Quote (' ou quote)
+        ((and (consp (car expr)) (eq 'lambda (caar expr)))
+         (meval-lambda (car expr) (cdr expr) env env)) ;; TODO : a remplir
+        ((eq 'defun (car expr))
+         (set-defun (cadr expr) (cons 'lambda (cddr expr))) ;; TODO : sera remplacer par add-top-level-binding
+         (get-defun (car expr))
+         (meval-lambda (get-defun (car expr)) (cdr expr) env ()))
+        ((eq 'if (car expr))
+         (if (meval (second expr) env)
+             (meval (third expr) env)
+           (meval (fourth expr) env)))
+        ;;cas des marcros/forme speciale deja traiter
+        ((fboundp (car expr)) ;;denier cas vrais fonctin globale predefinie
+         (apply (car expr) (map-meval (cdr expr) env))
+        )
+  ))
+
+(defun map-meval (list env)
+  (mapcar (lambda (x) (meval x env)) list))
+
+(defun meval-lambda (lbd args env-args old-env)
+ (meval (third (car lbd))
+        (make-env (second (car lbd))
+                  (map-meval args env-args)
+                  old-env))
+)

test-unitaire.lisp

@@ -0,0 +1,19 @@
+(let ((tests nil))
+  (defmacro deftest (module expected test)
+    (setf tests (cons (list module expected test) tests))
+     nil)
+  (defmacro run-test (module)
+    (mapcar (lambda (test)
+              (let ((res (eval (third test))))
+                (if (equal (second test) res)
+                    (print "[SUCCESS] ~a" (third test))
+                  (print  "[FAILURE] ~a\n           got ~a\n           expected ~a" (third test) res (second test)))))
+              tests) nil)
+  (defun show-test ()
+    tests))
+
+;; Test de debugage du test unitaire
+(deftest environnement nil nil)
+(show-test)
+(run-test environnement)
+