Merge branch 'master' into mutable-strings

[jscl.git] / jscl.lisp

diff --git a/jscl.lisp b/jscl.lisp
index 792461f..ebf6f0d 100644 (file)
--- a/jscl.lisp
+++ b/jscl.lisp
@@ -21,6 +21,7 @@
     ("compat"    :host)
     ("utils"     :both)
     ("list"      :target)
+    ("string"    :target)
     ("print"     :target)
     ("package"   :target)
     ("read"      :both)
@@ -68,30 +69,53 @@
          when (plusp (length compilation))
          do (write-string compilation out)))))
 
+
+(defun dump-global-environment (stream)
+  (flet ((late-compile (form)
+           (write-string (ls-compile-toplevel form) stream)))
+    ;; We assume that environments have a friendly list representation
+    ;; for the compiler and it can be dumped.
+    (dolist (b (lexenv-function *environment*))
+      (when (eq (binding-type b) 'macro)
+        (push *magic-unquote-marker* (binding-value b))))
+    (late-compile `(setq *environment* ',*environment*))
+    ;; Set some counter variable properly, so user compiled code will
+    ;; not collide with the compiler itself.
+    (late-compile
+     `(progn
+        ,@(mapcar (lambda (s) `(%intern-symbol (%js-vref ,(cdr s)))) *literal-table*)
+        (setq *literal-table* ',*literal-table*)
+        (setq *variable-counter* ,*variable-counter*)
+        (setq *gensym-counter* ,*gensym-counter*)))
+    (late-compile `(setq *literal-counter* ,*literal-counter*))))
+
+
 (defun bootstrap ()
   (setq *environment* (make-lexenv))
   (setq *literal-table* nil)
   (setq *variable-counter* 0
         *gensym-counter* 0
-        *literal-counter* 0
-        *block-counter* 0)
+        *literal-counter* 0)
   (with-open-file (out "jscl.js" :direction :output :if-exists :supersede)
     (write-string (read-whole-file (source-pathname "prelude.js")) out)
     (dolist (input *source*)
       (when (member (cadr input) '(:target :both))
-        (ls-compile-file (source-pathname (car input) :type "lisp") out))))
+        (ls-compile-file (source-pathname (car input) :type "lisp") out)))
+    (dump-global-environment out))
   ;; Tests
   (with-open-file (out "tests.js" :direction :output :if-exists :supersede)
     (dolist (input (append (directory "tests.lisp")
                            (directory "tests/*.lisp")
-                           (directory "tests-report.lisp"))) 
+                           (directory "tests-report.lisp")))
       (ls-compile-file input out))))
 
 
 ;;; Run the tests in the host Lisp implementation. It is a quick way
 ;;; to improve the level of trust of the tests.
 (defun run-tests-in-host ()
-  (dolist (input (append (directory "tests.lisp")
-                         (directory "tests/*.lisp")
-                         (directory "tests-report.lisp")))
-    (load input)))
+  (load "tests.lisp")
+  (let ((*use-html-output-p* nil))
+    (declare (special *use-html-output-p*))
+    (dolist (input (directory "tests/*.lisp"))
+      (load input)))
+  (load "tests-report.lisp"))