X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=jscl.lisp;h=5628e87108bd7ad46952bd6f5fb63c19ddbf9d92;hb=f8e5f4e8ae9b7bdc7efc7382a26aa6e28f6c4652;hp=e0074eb5bd339cf97f4c1de693e4eb4f56b90093;hpb=208c73a2f0efe2a798ac6ea959687c613dc7d5e8;p=jscl.git
diff --git a/jscl.lisp b/jscl.lisp
index e0074eb..5628e87 100644
--- a/jscl.lisp
+++ b/jscl.lisp
@@ -3,26 +3,35 @@
;; Copyright (C) 2012, 2013 David Vazquez
;; Copyright (C) 2012 Raimon Grau
-;; This program is free software: you can redistribute it and/or
+;; JSCL is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
-;; This program is distributed in the hope that it will be useful, but
+;; JSCL is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see .
+;; 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)
+ ("string" :target)
("print" :target)
("package" :target)
+ ("ffi" :target)
+ ("char" :target)
("read" :both)
("compiler" :both)
("toplevel" :target)))
@@ -49,7 +58,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,34 +73,60 @@
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)
+ (write-string (ls-compile-toplevel form) stream)))
+ ;; We assume that environments have a friendly list representation
+ ;; 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))))
+ (late-compile `(setq *environment* ',*environment*))
+ ;; Set some counter variable properly, so user compiled code will
+ ;; 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))
+ (setq *literal-table* ',*literal-table*)
+ (setq *variable-counter* ,*variable-counter*)
+ (setq *gensym-counter* ,*gensym-counter*)))
+ (late-compile `(setq *literal-counter* ,*literal-counter*))))
+
(defun bootstrap ()
- (setq *environment* (make-lexenv))
- (setq *literal-table* nil)
- (setq *variable-counter* 0
- *gensym-counter* 0
- *literal-counter* 0
- *block-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))))
- ;; 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 ((*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 ()
- (dolist (input (append (directory "tests.lisp")
- (directory "tests/*.lisp")
- (directory "tests-report.lisp")))
- (load input)))
+ (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")))