From 6de39415127640d8647b6ef8a5dc6ecb49407194 Mon Sep 17 00:00:00 2001 From: =?utf8?q?David=20V=C3=A1zquez?= Date: Sat, 4 May 2013 23:46:35 +0100 Subject: [PATCH] Create JSCL package to keep the symbols in the host implementation We can manage what symbols are accesible from JSCL and avoid collisions. In particular, this fixes the compilation in GNU/clisp, which failed because it exports a with-collect macro in the EXT package, visible from CL-USER. --- .gitignore | 2 ++ jscl.lisp | 62 ++++++++++++++++++++++++++++++++------------------------- src/read.lisp | 2 +- 3 files changed, 38 insertions(+), 28 deletions(-) diff --git a/.gitignore b/.gitignore index 3073aaa..1743f91 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,6 @@ *~ *.fasl +*.fas +*.lib jscl.js tests.js diff --git a/jscl.lisp b/jscl.lisp index 9a89a5d..76d2c84 100644 --- a/jscl.lisp +++ b/jscl.lisp @@ -16,6 +16,12 @@ ;; 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) @@ -51,7 +57,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))) @@ -66,9 +72,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) @@ -93,31 +99,33 @@ (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 ((*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"))) diff --git a/src/read.lisp b/src/read.lisp index 9d0ec46..3c352b3 100644 --- a/src/read.lisp +++ b/src/read.lisp @@ -324,7 +324,7 @@ (unless (= index size) (return)) ;; Everything went ok, we have a float ;; XXX: Use FLOAT when implemented. - (/ (* sign (expt 10.0 (* exponent-sign exponent)) number) divisor)))) + (/ (* sign (expt 10.0 (* exponent-sign exponent)) number) divisor 1.0)))) (defun !parse-integer (string junk-allow) (block nil -- 1.7.10.4