Add DO-SOURCE macro for iterating over source files

[jscl.git] / jscl.lisp

diff --git a/jscl.lisp b/jscl.lisp
index 8cc5f71..04b9450 100644 (file)
--- a/jscl.lisp
+++ b/jscl.lisp
@@ -27,21 +27,33 @@
     ("compat"           :host)
     ("utils"            :both)
     ("numbers"          :target)
+    ("char"             :target)
     ("list"             :target)
     ("array"            :target)
     ("string"           :target)
     ("sequence"         :target)
+    ("stream"           :target)
     ("print"            :target)
     ("package"          :target)
-    ("ffi"              :target)
     ("misc"             :target)
+    ("ffi"              :both)
     ("read"             :both)
     ("defstruct"        :both)
     ("lambda-list"      :both)
     ("backquote"        :both)
+    ("compiler-codegen" :both)
     ("compiler"         :both)
     ("toplevel"         :target)))
 
+(defmacro do-source (name type &body body)
+  (unless (member type '(:host :target))
+    (error "TYPE should be one of :HOST or :TARGET"))
+  (let ((file (gensym)))
+    `(dolist (,file *source*)
+       (when (member (cadr ,file) (list :both ,type))
+         (let ((,name (source-pathname (car ,file) :type "lisp")))
+           ,@body)))))
+
 (defun source-pathname
     (filename &key (directory '(:relative "src")) (type nil) (defaults filename))
   (if type
@@ -50,18 +62,15 @@
 
 ;;; Compile jscl into the host
 (with-compilation-unit ()
-  (dolist (input *source*)
-    (when (member (cadr input) '(:host :both))
-      (let ((fname (source-pathname (car input))))
-        (multiple-value-bind (fasl warn fail) (compile-file fname)
-          (declare (ignore fasl warn))
-          (when fail
-            (error "Compilation of ~A failed." fname)))))))
+  (do-source input :host
+    (multiple-value-bind (fasl warn fail) (compile-file input)
+      (declare (ignore fasl warn))
+      (when fail
+        (error "Compilation of ~A failed." input)))))
 
 ;;; Load jscl into the host
-(dolist (input *source*)
-  (when (member (cadr input) '(:host :both))
-    (load (source-pathname (car input)))))
+(do-source input :host
+  (load input))
 
 (defun read-whole-file (filename)
   (with-open-file (in filename)
@@ -69,7 +78,7 @@
       (read-sequence seq in)
       seq)))
 
-(defun ls-compile-file (filename out &key print)
+(defun !compile-file (filename out &key print)
   (let ((*compiling-file* t)
         (*compile-print-toplevels* print))
     (let* ((source (read-whole-file filename))
@@ -79,13 +88,14 @@
          with eof-mark = (gensym)
          for x = (ls-read in nil eof-mark)
          until (eq x eof-mark)
-         do (let ((compilation (ls-compile-toplevel x)))
+         do (let ((compilation (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)))
+           (let ((*standard-output* stream))
+             (write-string (compile-toplevel form)))))
     ;; We assume that environments have a friendly list representation
     ;; for the compiler and it can be dumped.
     (dolist (b (lexenv-function *environment*))
@@ -96,8 +106,8 @@
     ;; 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))
+        (progn ,@(mapcar (lambda (s) `(%intern-symbol (%js-vref ,(string (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*)))
@@ -114,16 +124,15 @@
           *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)))
+      (do-source input :target
+        (!compile-file input 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)))))
+        (!compile-file input out)))))
 
 
 ;;; Run the tests in the host Lisp implementation. It is a quick way