X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=jscl.lisp;h=c9754226897d26309906040f3192a1b71831035d;hb=6ec52a68fd2a26e18593f189b35722a3ca1011d8;hp=fb2045f8a84a7b8c9296a9a144e4138819aec075;hpb=ab354f654ea66e732d3617265ab004f4537c4062;p=jscl.git diff --git a/jscl.lisp b/jscl.lisp index fb2045f..c975422 100644 --- a/jscl.lisp +++ b/jscl.lisp @@ -16,16 +16,31 @@ ;; You should have received a copy of the GNU General Public License ;; along with JSCL. If not, see . +(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) + ("numbers" :target) + ("char" :target) + ("read" :both) + ("defstruct" :both) + ("lambda-list" :both) + ("backquote" :both) + ("compiler" :both) + ("toplevel" :target))) (defun source-pathname (filename &key (directory '(:relative "src")) (type nil) (defaults filename)) @@ -49,7 +64,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,10 +79,9 @@ 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) @@ -76,7 +90,7 @@ ;; 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)))) + (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. @@ -91,31 +105,34 @@ (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))) - (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)))) + (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")))