3 ;; Copyright (C) 2012, 2013 David Vazquez
4 ;; Copyright (C) 2012 Raimon Grau
6 ;; This program 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 ;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
26 ("toplevel" :target)))
28 (defun source-pathname
29 (filename &key (directory '(:relative "src")) (type nil) (defaults filename))
31 (make-pathname :type type :directory directory :defaults defaults)
32 (make-pathname :directory directory :defaults defaults)))
34 ;;; Compile jscl into the host
35 (with-compilation-unit ()
36 (dolist (input *source*)
37 (when (member (cadr input) '(:host :both))
38 (compile-file (source-pathname (car input))))))
40 ;;; Load jscl into the host
41 (dolist (input *source*)
42 (when (member (cadr input) '(:host :both))
43 (load (source-pathname (car input)))))
45 (defun read-whole-file (filename)
46 (with-open-file (in filename)
47 (let ((seq (make-array (file-length in) :element-type 'character)))
48 (read-sequence seq in)
51 (defun ls-compile-file (filename out &key print)
52 (let ((*compiling-file* t)
53 (*compile-print-toplevels* print))
54 (let* ((source (read-whole-file filename))
55 (in (make-string-stream source)))
56 (format t "Compiling ~a...~%" filename)
58 with eof-mark = (gensym)
59 for x = (ls-read in nil eof-mark)
61 for compilation = (ls-compile-toplevel x)
62 when (plusp (length compilation))
63 do (write-string compilation out)))))
66 (setq *environment* (make-lexenv))
67 (setq *literal-table* nil)
68 (setq *variable-counter* 0
72 (with-open-file (out "jscl.js" :direction :output :if-exists :supersede)
73 (write-string (read-whole-file (source-pathname "prelude.js")) out)
74 (dolist (input *source*)
75 (when (member (cadr input) '(:target :both))
76 (ls-compile-file (source-pathname (car input) :type "lisp") out))))
78 (with-open-file (out "tests.js" :direction :output :if-exists :supersede)
79 (dolist (input (append (directory "tests.lisp")
80 (directory "tests/*.lisp")
81 (directory "tests-report.lisp")))
82 (ls-compile-file input out))))
85 ;;; Run the tests in the host Lisp implementation. It is a quick way
86 ;;; to improve the level of trust of the tests.
87 (defun run-tests-in-host ()
88 (dolist (input (append (directory "tests.lisp")
89 (directory "tests/*.lisp")
90 (directory "tests-report.lisp")))