X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=jscl.lisp;h=5e393d6f3273dd6ba6a9c2db484da2f4e735bc8a;hb=064ea3b5dfb0d44a71025990d91d54726cb42415;hp=6d907a3e872846366fb7ec60cfbfb0c50bac7ea0;hpb=13b34bf604807174b4ed9a18d5e82678557b7c4e;p=jscl.git

diff --git a/jscl.lisp b/jscl.lisp
index 6d907a3..5e393d6 100644
--- a/jscl.lisp
+++ b/jscl.lisp
@@ -16,16 +16,28 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
 
+(defpackage :jscl
+  (:use :cl)
+  (:export #:bootstrap #:run-tests-in-host))
+
+(in-package :jscl)
+
 (defvar *source*
-  '(("boot"      :target)
-    ("compat"    :host)
-    ("utils"     :both)
-    ("list"      :target)
-    ("print"     :target)
-    ("package"   :target)
-    ("read"      :both)
-    ("compiler"  :both)
-    ("toplevel"  :target)))
+  '(("boot"             :target)
+    ("compat"           :host)
+    ("utils"            :both)
+    ("list"             :target)
+    ("string"           :target)
+    ("sequence"         :target)
+    ("print"            :target)
+    ("package"          :target)
+    ("ffi"              :target)
+    ("misc"             :target)
+    ("read"             :both)
+    ("defstruct"        :both)
+    ("lambda-list"      :both)
+    ("compiler"         :both)
+    ("toplevel"         :target)))
 
 (defun source-pathname
     (filename &key (directory '(:relative "src")) (type nil) (defaults filename))
@@ -49,7 +61,7 @@
     (load (source-pathname (car input)))))
 
 (defun read-whole-file (filename)
-  (with-open-file (in filename :external-format :latin-1)
+  (with-open-file (in filename)
     (let ((seq (make-array (file-length in) :element-type 'character)))
       (read-sequence seq in)
       seq)))
@@ -64,35 +76,60 @@
          with eof-mark = (gensym)
          for x = (ls-read in nil eof-mark)
          until (eq x eof-mark)
-         for compilation = (ls-compile-toplevel x)
-         when (plusp (length compilation))
-         do (write-string compilation out)))))
+         do (let ((compilation (ls-compile-toplevel x)))
+              (when (plusp (length compilation))
+                (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)
+        (setf (binding-value b) `(,*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))))
+                  (remove-if-not #'symbolp *literal-table* :key #'car))
+        (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)
-  (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))))
-  ;; 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")))
-      (ls-compile-file input out))))
+  (let ((*features* (cons :jscl *features*))
+        (*package* (find-package "JSCL")))
+    (setq *environment* (make-lexenv))
+    (setq *literal-table* nil)
+    (setq *variable-counter* 0
+          *gensym-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)))
+      (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")))
+        (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 ()
-  (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"))
+  (let ((*package* (find-package "JSCL")))
+    (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")))