Merge branch 'master' of https://github.com/dumbs/2010-m1s1-compilation

Conflicts:
	implementation/mini-meval.lisp
	test-unitaire.lisp

environnement.lisp

@@ -19,7 +19,7 @@
 
 ;; Exemple de la structure env-stack après création de deux
 ;; environnements en plus du top-level et ajout de plusieurs laisons.
-(load "test-unitaire")
+(require 'test-unitaire "test-unitaire")
 (erase-tests environnement)
 (deftestvar environnement exemple-env-stack 
   '(;; Environnement le plus bas (dernières définitions par ordre
@@ -148,3 +148,5 @@ l'environnement top-level."
   (set-top-level-binding (copy-tree '(("LEVEL2" (X . 42)) ("TOP-LEVEL" (Y . 56))))
                          'Y "42")
   '(("LEVEL2" (X . 42)) ("TOP-LEVEL" (Y . "42"))))
+
+(provide 'environnement)

implementation/compilation.lisp

@@ -1,6 +1,6 @@
-(load "match")
-(load "util")
-(load "implementation/lisp2cli")
+(require 'match "match")
+(require 'util "util")
+(require 'lisp2cli "implementation/lisp2cli")
 
 (defvar asm-fixnum-size 32)
 (defvar asm-max-fixnum (expt 2 asm-fixnum-size))
@@ -136,3 +136,5 @@
 ;;   pop r0
 ;;   add r1 r0
 ;;   retn
+
+(provide 'compilation)

implementation/lisp2cli.lisp

@@ -371,4 +371,6 @@ Est transformé en :
 [get-global-cell-value x]
 [set-global-cell-value x [pop]]
 
-|#
+|#
+
+(provide 'lisp2cli)

implementation/mini-meval.lisp

@@ -1,5 +1,5 @@
-(load "match")
-(load "util")
+(require 'match "match")
+(require 'util "util")
 
 ;; TODO (dans mini-meval et/ou compilateur) :
 ;; - match-automaton(tagbody+block)
@@ -554,3 +554,5 @@ Mini-meval sera appellé sur des morceaux spécifiques du fichier source. Il fau
 (deftest (mini-meval block)
   (mini-meval '(block foo 1 2))
   2)
+
+(provide 'mini-meval)

instructions.lisp

@@ -214,18 +214,19 @@
 ;;Test Unitaire
 ;; TODO : Faire deftestvar
 ;; TODO : Finir le test unitaire
-(load "test-unitaire")
+(require 'test-unitaire "test-unitaire")
 (erase-tests virtual-machine)
-(deftestvar virtual-machine t-r0-value (+ 1 (random 42))) ;; r0 > 0 pour la division.
-(deftestvar virtual-machine t-r1-value (random 42))
-(deftestvar virtual-machine t-m-value (random 42))
-(deftestvar virtual-machine t-vm-size (+ 10 (random 10)))
-(deftestvar virtual-machine t-adress (random t-vm-size))
+(deftestvar virtual-machine t-r0-value (+ 1 (random-test 42))) ;; r0 > 0 pour la division.
+(deftestvar virtual-machine t-r1-value (random-test 42))
+(deftestvar virtual-machine t-m-value (random-test 42))
+(deftestvar virtual-machine t-vm-size (+ 10 (random-test 10)))
+(deftestvar virtual-machine t-address (random-test t-vm-size))
 (deftestvar virtual-machine vm
-  (progn
-	(make-vm t-vm-size)
+  (let ((vm (make-vm t-vm-size)))
 	(set-register vm 'R0 t-r0-value)
-	(set-memory vm t-adress t-m-value)))
+	(set-register vm 'R1 t-r1-value)
+	(set-memory vm t-address t-m-value)
+    vm))
 
 (deftest virtual-machine
   (progn (ISN-LOAD vm t-address 'R0)
@@ -259,7 +260,7 @@
 	(set-register vm 'R0 2)
 	(ISN-MULT vm 'R0 'R1)
 	(get-register vm 'R1))
-  (* 2 t-r0-value))
+  (* 2 t-r1-value))
 
 (deftest virtual-machine
   (progn (ISN-DIV vm 'R0 'R1) ;; R0 > 0 (voir t-r0-value ci-dessus).
@@ -279,5 +280,6 @@
 (deftest virtual-machine
   (progn (ISN-PUSH vm 'R1)
          (get-memory vm (get-register vm 'SP)))
-  (t-r1-value))
+  t-r1-value)
 
+(provide 'instructions)

lisp2li.lisp

@@ -1,14 +1,14 @@
-(load "util.lisp")
-(load "match.lisp")
+(require 'util "util.lisp")
+(require 'match "match.lisp")
 
 ;; `
-(defvar my-quasiquote (car '`(,a)))
+(defvar my-quasiquote nil);(car '`(,a)))
 
 ;; ,
-(defvar my-unquote (caaadr '`(,a)))
+(defvar my-unquote nil);(caaadr '`(,a)))
 
 ;; ,@
-(defvar my-unquote-unsplice (caaadr '`(,@a)))
+(defvar my-unquote-unsplice nil);(caaadr '`(,@a)))
 
 (defun map-lisp2li (expr env)
   (mapcar (lambda (x) (lisp2li x env)) expr))
@@ -258,7 +258,7 @@ par le compilateur et par l’interpréteur"
 ;; TODO : demander au prof comment corriger (or (= n 0) (= n 1)) qui rend nil car il fait 2 macroexpand 1: (COND ((= N 0)) (T (= N 1))) 2: (LET (#1=#:RESULT-7048) (IF (SETQ #1# (= N 0)) #1# (= N 1))) et 2 vaux nil car n != 0
 
 ;; Test unitaire
-(load "test-unitaire")
+(require 'test-unitaire "test-unitaire")
 (erase-tests lisp2li)
 
 (deftest (lisp2li make-stat-env)
@@ -552,3 +552,4 @@ par le compilateur et par l’interpréteur"
   '(:let 1 (:set-var (0 1) (:const . 2))
          (:call cons (:cvar 0 1) (:cvar 1 1))))
 
+(provide 'lisp2li)

main.lisp

@@ -1,8 +1,14 @@
-;(setq *print-circle* t)
-(load "environnement")
+;; Main
+
+;; Chargement de tous les fichiers, dans l'ordre du tri topologique
+;; pour tous les re-charger, sans les charger deux fois.
+
+(load "util")
+(load "test-unitaire")
 (load "instructions")
+(load "match")
 (load "lisp2li")
 (load "meval")
-;; ...
-;(run-tests t)
-;(print-env-stack exemple-env-stack)
+(load "implementation/mini-meval")
+
+(provide 'main)

match.lisp

@@ -1,4 +1,4 @@
-(load "util") ;; n-consp
+(require 'util "util") ;; n-consp
 
 ;; Syntaxe : (match <motif> expression)
 ;;       ex: (match (:a ? :c) '(a b c)) => t
@@ -660,7 +660,7 @@ donc seule la valeur de la dernière expression de la dernière clause est renvo
                                                                       (go ,to)))
                                                    (_ (go reject))))))))))
 
-(load "test-unitaire")
+(require 'test-unitaire "test-unitaire")
 (erase-tests match)
 
 ;;;; Tests de matching (vrai / faux)
@@ -1429,3 +1429,5 @@ donc seule la valeur de la dernière expression de la dernière clause est renvo
 (deftest (match defmatch)
     (test-match-bar 42)
   'i-m-else)
+
+(provide 'match)

meval.lisp

@@ -1,4 +1,4 @@
-(load "match")
+(require 'match "match")
 
 (defun env-size (env)
   (if (or (equalp env #()) (eq env nil))
@@ -168,8 +168,8 @@ d’arguments dans un certain environnement."
                (error "form special ~S not yet implemented" expr))))
 
 ;; Test unitaire
-(load "test-unitaire")
-(load "lisp2li")
+(require 'test-unitaire "test-unitaire")
+(require 'lisp2li "lisp2li")
 (erase-tests meval)
 (deftest (meval :const)
   (meval (lisp2li 3 ()))
@@ -288,3 +288,5 @@ d’arguments dans un certain environnement."
     env)
   #(() 42)
   #'equalp)
+
+(provide 'meval)

test-unitaire.lisp

@@ -59,33 +59,26 @@
   (if a b (not b)))
 
 (defmacro deftest (module test expected &optional (compare #'equal))
-  `(test-add-test
-    ',module
-    (lambda ()
-      (let* ((vars (test-get-variables-and-above ',module))
-             (_test ',test)
-             (_expected ',expected)
-             (_compare ,compare)
-             ;; Les "eval" ci-dessous exécutent :
-             ;; (let ((var1 val1) (var2 val2) ...) ;; On définit les
-             ;;                                    ;; variables de deftestvar.
-             ;;   var1 var2 ... ;; On "utilise" les variables pour
-             ;;                 ;; éviter le unused variable warning
-             ;;   corps-du-test) ;; On évalue le corps du test dans 
-             ;;                  ;; un environement où les deftestvar
-             ;;                  ;; sont accessibles.
-             (res (eval `(let* ,vars ,@(mapcar #'car vars) ,_test)))
-             (exp (eval `(let* ,vars ,@(mapcar #'car vars) ,_expected))))
-        (if (funcall _compare res exp)
-            (progn
-              (format t "~&    [SUCCESS] ~w~&" ',test)
-              t)
-            (progn
-              (format t "~&    [FAILURE] Test       : ~w~&" ',test)
-              (format t "~&              got        : ~w~&" res)
-              (format t "~&              expected   : ~w~&" exp)
-              (format t "~&              comparison : ~w~&" _compare)
-              nil))))))
+  (let ((vars (test-get-variables-and-above module)))
+    `(test-add-test
+      ',module
+      (lambda ()
+        (let* ((state-1 (make-random-state))
+               (state-2 (make-random-state state-1))
+               (res (labels ((random-test (n) (random n state-1)))
+                      (let* ,vars ,@(mapcar #'car vars) ,test)))
+               (exp (labels ((random-test (n) (random n state-2)))
+                      (let* ,vars ,@(mapcar #'car vars) ,expected))))
+          (if (funcall ,compare res exp)
+              (progn
+                (format t "~&    [SUCCESS] ~w~&" ',test)
+                t)
+              (progn
+                (format t "~&    [FAILURE] Test       : ~w~&" ',test)
+                (format t "~&              got        : ~w~&" res)
+                (format t "~&              expected   : ~w~&" exp)
+                (format t "~&              comparison : ~w~&" ,compare)
+                nil)))))))
 
 (defvar b '(x x))
 (defmacro generates-error-p (code)
@@ -98,7 +91,7 @@
 
 (defmacro deftestvar (module name value)
   `(test-add-variable ',module
-                      (list ',name (list 'copy-all ',value))))
+                      (list ',name ',value)))
 
 (defvar run-tests-counter 0)
 
@@ -167,7 +160,7 @@
   (let* ((foo #(a b (1 #(2 4 6) 3) c))
            (copy-of-foo (copy-all foo)))
       copy-of-foo
-      (setf (aref (cadr (aref copy-of-foo 2)) 1) (cons 'MODIFIED (random 42)))
+      (setf (aref (cadr (aref copy-of-foo 2)) 1) (cons 'MODIFIED (random-test 42)))
       (equalp foo #(a b (1 #(2 4 6) 3) c)))
   t #'booleq)
 
@@ -194,3 +187,5 @@
 ;; (run-tests ())
 ;; (run-tests t)
 ;; (run-tests)
+
+(provide 'test-unitaire)

util.lisp

@@ -170,7 +170,9 @@
       (apply #'append (if (symbolp (car expr))
                           (list (car expr))
                           nil)
-             (mapcar #'find-what-is-used (cdr expr)))))
+             (mapcar #'find-what-is-used-1 (cdr expr)))))
 
 (defun find-what-is-used (expr)
   (remove-duplicates (find-what-is-used-1 expr)))
+
+(provide 'util)