'(("boot" :target)
("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
;;; 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)
(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))
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*))
;; 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*)))
*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