3 ;; Copyright (C) 2012, 2013 David Vazquez
4 ;; Copyright (C) 2012 Raimon Grau
6 ;; JSCL is free software: you can redistribute it and/or
7 ;; modify it under the terms of the GNU General Public License as
8 ;; published by the Free Software Foundation, either version 3 of the
9 ;; License, or (at your option) any later version.
11 ;; JSCL is distributed in the hope that it will be useful, but
12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;; General Public License for more details.
16 ;; You should have received a copy of the GNU General Public License
17 ;; along with JSCL. If not, see <http://www.gnu.org/licenses/>.
28 ("toplevel" :target)))
30 (defun source-pathname
31 (filename &key (directory '(:relative "src")) (type nil) (defaults filename))
33 (make-pathname :type type :directory directory :defaults defaults)
34 (make-pathname :directory directory :defaults defaults)))
36 ;;; Compile jscl into the host
37 (with-compilation-unit ()
38 (dolist (input *source*)
39 (when (member (cadr input) '(:host :both))
40 (let ((fname (source-pathname (car input))))
41 (multiple-value-bind (fasl warn fail) (compile-file fname)
42 (declare (ignore fasl warn))
44 (error "Compilation of ~A failed." fname)))))))
46 ;;; Load jscl into the host
47 (dolist (input *source*)
48 (when (member (cadr input) '(:host :both))
49 (load (source-pathname (car input)))))
51 (defun read-whole-file (filename)
52 (with-open-file (in filename :external-format :latin-1)
53 (let ((seq (make-array (file-length in) :element-type 'character)))
54 (read-sequence seq in)
57 (defun ls-compile-file (filename out &key print)
58 (let ((*compiling-file* t)
59 (*compile-print-toplevels* print))
60 (let* ((source (read-whole-file filename))
61 (in (make-string-stream source)))
62 (format t "Compiling ~a...~%" filename)
64 with eof-mark = (gensym)
65 for x = (ls-read in nil eof-mark)
67 for compilation = (ls-compile-toplevel x)
68 when (plusp (length compilation))
69 do (write-string compilation out)))))
71 (defun dump-global-environment (stream)
72 (flet ((late-compile (form)
73 (write-string (ls-compile-toplevel form) stream)))
74 ;; Set the initial global environment to be equal to the host global
75 ;; environment at this point of the compilation.
76 (late-compile `(setq *environment* ',*environment*))
77 ;; Set some counter variable properly, so user compiled code will
78 ;; not collide with the compiler itself.
81 ,@(mapcar (lambda (s) `(%intern-symbol (%js-vref ,(cdr s)))) *literal-table*)
82 (setq *literal-table* ',*literal-table*)
83 (setq *variable-counter* ,*variable-counter*)
84 (setq *gensym-counter* ,*gensym-counter*)))
85 (late-compile `(setq *literal-counter* ,*literal-counter*))))
88 (setq *environment* (make-lexenv))
89 (setq *literal-table* nil)
90 (setq *variable-counter* 0
93 (with-open-file (out "jscl.js" :direction :output :if-exists :supersede)
94 (write-string (read-whole-file (source-pathname "prelude.js")) out)
95 (dolist (input *source*)
96 (when (member (cadr input) '(:target :both))
97 (ls-compile-file (source-pathname (car input) :type "lisp") out)))
98 (dump-global-environment out))
100 (with-open-file (out "tests.js" :direction :output :if-exists :supersede)
101 (dolist (input (append (directory "tests.lisp")
102 (directory "tests/*.lisp")
103 (directory "tests-report.lisp")))
104 (ls-compile-file input out))))
107 ;;; Run the tests in the host Lisp implementation. It is a quick way
108 ;;; to improve the level of trust of the tests.
109 (defun run-tests-in-host ()
111 (let ((*use-html-output-p* nil))
112 (declare (special *use-html-output-p*))
113 (dolist (input (directory "tests/*.lisp"))
115 (load "tests-report.lisp"))