Commit 905f534e authored by Vladimir Sedach's avatar Vladimir Sedach
Browse files

Changed package system so that symbols in parenscript, javascript and...

Changed package system so that symbols in parenscript, javascript and parenscript-user are non-prefixed. Made symbols in unknown packages be treated as though they were in parenscript-user by default. Added a prefix string preference to PS packages. Removed all *enable-package-system* stuff.
parent 72332f2a
......@@ -26,20 +26,24 @@
(create-script-package
comp-env
:name "GLOBAL" :lisp-package :parenscript.global)
;; symbols in the parenscript, javascript and parenscript-user packages are non-prefixed
(create-script-package
comp-env
:name "JAVASCRIPT" :nicknames (list "JS") :lisp-package :parenscript.javascript
:name "JAVASCRIPT" :prefix "" :nicknames (list "JS") :lisp-package :parenscript.javascript
:exports *javascript-exports*
:secondary-lisp-packages '(:common-lisp))
(create-script-package
comp-env
:name "PARENSCRIPT" :lisp-package :parenscript
:name "PARENSCRIPT" :prefix "" :lisp-package :parenscript
:exports *parenscript-exports*
:used-packages '(:javascript)
)
(create-script-package
comp-env
:name "PARENSCRIPT-USER" :lisp-package :parenscript-user
:name "PARENSCRIPT-USER" :prefix "" :lisp-package :parenscript-user
:secondary-lisp-packages (list :cl-user)
:used-packages '("PARENSCRIPT")
:nicknames '("PS-USER" "PAREN-USER"))))
\ No newline at end of file
:nicknames '("PS-USER" "PAREN-USER"))
(create-script-package
comp-env
:name "PS_GS" :lisp-package :parenscript.ps-gensyms)))
\ No newline at end of file
......@@ -8,10 +8,6 @@
:format-control "~:@(~a~) is deprecated~:[.~;, use ~:@(~a~) instead~]"
:format-arguments (list old-name new-name new-name)))
(defmacro without-packages (&body body)
`(let ((ps:*enable-package-system* nil))
,@body))
(defmacro defun-js (old-name new-name args &body body)
`(defun ,old-name ,args
,(when (and (stringp (car body)) (< 1 (length body))) ;; docstring
......
......@@ -357,5 +357,5 @@
"javascript:"
(string-join (js-to-statement-strings
(compile-script-form (cons 'progn body)) 0) " "))))
(defscriptmacro js-inline (&rest body)
(defscriptmacro parenscript::js-inline (&rest body)
`(script-inline ,@body))
......@@ -221,9 +221,8 @@ and for the given symbol."))
(t
(case *package-prefix-style*
(:prefix
; (when (first
(format nil "~A_~A"
(symbol-to-js (script-package-name package))
(format nil "~A~A"
(or (ps::script-package-prefix package) (concatenate 'string (ps::script-package-name package) "_"))
(symbol-to-js symbol)))
(t
(symbol-to-js (value symbol)))))))
......@@ -236,12 +235,7 @@ JavaScript version of it as a string."))
(js-translate-symbol (value var)))
(defmethod js-translate-symbol ((var-name symbol))
(if parenscript::*enable-package-system*
(js-translate-symbol-contextually
var-name
(ps::symbol-script-package var-name)
ps::*compilation-environment*)
(symbol-to-js var-name)))
(js-translate-symbol-contextually var-name (ps::symbol-script-package var-name) ps::*compilation-environment*))
(defmethod js-to-strings ((v js-variable) start-form)
(declare (ignore start-form))
......
......@@ -207,7 +207,6 @@ both the Lisp package and the script package for Parenscript."))
#:*compilation-environment*
;; package system
#:*enable-package-system*
#:find-script-package
#:script-intern
#:script-export
......@@ -323,4 +322,7 @@ as non-prefixed identifiers."))
(defpackage parenscript.asdf
(:use :parenscript :asdf :common-lisp)
(:documentation "ASDF extensions that help compile and use Parenscript systems."))
\ No newline at end of file
(:documentation "ASDF extensions that help compile and use Parenscript systems."))
(defpackage parenscript.non-prefixed (:nicknames ps.non-prefixed))
(defpackage parenscript.ps-gensyms)
......@@ -2,27 +2,9 @@
;;;; The mechanisms for defining macros & parsing Parenscript.
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *enable-package-system* t
"When NIL, all symbols will function as global symbols."))
(eval-when (:compile-toplevel :load-toplevel)
(defun macro-name-hash-function ()
(if *enable-package-system* #'eql #'equal)))
;(defclass script-symbol ()
; ((lisp-symbol :initarg :lisp-symbol :initform nil :accessor lisp-symbol)
; (script-package :initarg :script-package :initform nil :writer symbol-script-package))
; (:documentation "The same thing as a lisp symbol but with an associated script package rather than
;just a lisp package."))
;(defmethod script-symbol-name ((symbol symbol)) (symbol-name symbol))
;(defmethod script-symbol-name ((symbol script-symbol)) (script-symbol-name (lisp-symbol symbol)))
;(defmethod symbol-script-package ((symbol script-symbol))
; (if (script-package symbol)
; (script-package symbol)
; (symbol-script-package (lisp-symbol symbol))))
#'eql))
(defclass script-package ()
;; configuration slots
......@@ -30,6 +12,8 @@
:documentation "Canonical name of the package (a String).")
(nicknames :accessor script-package-nicknames :initform nil :initarg :nicknames
:documentation "List of nicknames for the package (as strings).")
(prefix :accessor script-package-prefix :initform nil :initarg :prefix :type string
:documentation "The prefix string that will be used when translating the symbols in the current package to Javascript.")
(lisp-package :accessor script-package-lisp-package :initform nil :initarg :lisp-package)
(secondary-lisp-packages :accessor script-package-secondary-lisp-packages :initform nil
:initarg :secondary-lisp-packages)
......@@ -97,6 +81,10 @@ http://www.lispworks.com/documentation/HyperSpec/Body/03_bca.htm")
"Determines how package symbols are serialized to JavaScript identifiers. NIL for
no prefixes. :prefix to prefix variables with something like packagename_identifier.")
(defvar *warn-ps-package* nil
"If true, warns when ParenScript attempts to compile symbols that
don't have an associated ParenScript package.")
;;; parenscript packages
(defun lisp-to-script-package (lisp-package &optional (comp-env *compilation-environment*))
"Gets a script package corresponding to the given Lisp package."
......@@ -110,9 +98,14 @@ no prefixes. :prefix to prefix variables with something like packagename_identi
(defmethod symbol-script-package ((symbol symbol))
(if (symbol-package symbol)
(lisp-to-script-package (symbol-package symbol))
(or (lisp-to-script-package (symbol-package symbol) *compilation-environment*)
(progn (when *warn-ps-package*
(warn 'simple-style-warning
:format-control "~s is a symbol with lisp package ~s, which has no corresponding ParenScript package.
Defaulting to :parenscript-user."
:format-arguments (list symbol (symbol-package symbol))))
(find-script-package "PARENSCRIPT-USER" (make-basic-compilation-environment))))
(gethash symbol (symbol-to-script-package *compilation-environment*))))
(defun find-script-package (name &optional (comp-env *compilation-environment*))
"Find the script package with the name NAME in the given compilation environment."
......@@ -124,36 +117,36 @@ no prefixes. :prefix to prefix variables with something like packagename_identi
(script-package-nicknames script-package))
:test #'equal))
(comp-env-script-packages comp-env)))
(script-package name)
(script-package name)
(t (error "~A has unknown type" name))))
(defun script-intern (name script-package)
(defun script-intern (name script-package-name)
"Returns a Parenscript symbol with the string value STRING interned for the
given SCRIPT-PACKAGE."
(declare (type string name))
(setf script-package (find-script-package script-package))
(flet ((find-exported-symbol (name script-package)
(let ((res
(find name (script-package-exports script-package)
:key #'(lambda (exported-symbol) (string exported-symbol))
:test #'equal)))
res)))
(let ((res
(or
(some #'(lambda (used-package)
(find-exported-symbol name used-package))
(script-package-used-packages script-package))
(if (script-package-lisp-package script-package)
(intern name (script-package-lisp-package script-package))
(progn
(let ((sym (intern-without-package name)))
(setf (gethash name (script-package-symbol-table script-package))
sym)
(setf (gethash sym (symbol-to-script-package (script-package-comp-env script-package)))
script-package)
sym))))))
(declare (type symbol res))
res)))
(let ((script-package (find-script-package script-package-name)))
(flet ((find-exported-symbol (name script-package)
(let ((res
(find name (script-package-exports script-package)
:key #'(lambda (exported-symbol) (string exported-symbol))
:test #'equal)))
res)))
(let ((res
(or
(some #'(lambda (used-package)
(find-exported-symbol name used-package))
(script-package-used-packages script-package))
(if (script-package-lisp-package script-package)
(intern name (script-package-lisp-package script-package))
(progn
(let ((sym (intern-without-package name)))
(setf (gethash name (script-package-symbol-table script-package))
sym)
(setf (gethash sym (symbol-to-script-package (script-package-comp-env script-package)))
script-package)
sym))))))
(declare (type symbol res))
res))))
(defun find-script-symbol (name script-package)
......@@ -241,7 +234,7 @@ script packages (parenscript, global, and parenscript-user)."
(defun create-script-package (comp-env
&key name nicknames secondary-lisp-packages used-packages
&key name nicknames prefix secondary-lisp-packages used-packages
lisp-package exports documentation)
"Creates a script package in the given compilation environment"
(when (and lisp-package (not (find-package lisp-package)))
......@@ -250,6 +243,7 @@ script packages (parenscript, global, and parenscript-user)."
(make-instance 'script-package
:name (string name)
:comp-env comp-env
:prefix prefix
:nicknames (mapcar #'string nicknames)
:lisp-package (when lisp-package (find-package lisp-package))
:secondary-lisp-packages (mapcar #'find-package secondary-lisp-packages)
......@@ -334,17 +328,8 @@ ongoing javascript compilation."
(defun get-script-special-form (name)
"Returns the special form function corresponding to the given name."
; (declare (type symbol name))
(cond
(*enable-package-system*
(when (symbolp name)
(gethash name *toplevel-special-forms*)))
(t
(when (symbolp name)
(maphash #'(lambda (macro-name value)
(when (equal (string macro-name) (string name))
(return-from get-script-special-form value)))
*toplevel-special-forms*)))))
(when (symbolp name)
(gethash name *toplevel-special-forms*)))
;;; sexp form predicates
(defun script-special-form-p (form)
......@@ -381,16 +366,7 @@ arguments of the access functions as a first value and the form to be
stored as the second value.")
(defun find-macro-spec (name env-dict)
(if *enable-package-system*
(gethash name env-dict)
(with-hash-table-iterator (next-entry env-dict)
(loop
(multiple-value-bind (exists? macro-name spec)
(next-entry)
(if exists?
(when (equal (string macro-name) (string name))
(return spec))
(return nil)))))))
(gethash name env-dict))
(defsetf find-macro-spec (name env-dict)
(spec)
`(setf (gethash ,name ,env-dict) ,spec)))
......@@ -403,7 +379,7 @@ SPEC is of the form (symbol-macro-p . expansion-function)."
(defun lookup-macro-spec (name &optional (environment *script-macro-env*))
"Looks up the macro spec associated with NAME in the given environment. A
macro spec is of the form (symbol-macro-p function). Returns two values:
macro spec is of the form (symbol-macro-p . function). Returns two values:
the SPEC and the parent macro environment.
NAME must be a symbol."
......@@ -686,12 +662,11 @@ also guarantees that the symbol has an associated script-package."
(when (typep res 'ps-js::js-variable)
(setf res (ps-js::value res)))
(assert (symbolp res) ()
"~a is expected to be a symbol, but compiles to ~a (the ParenScript output for ~a alone is \"~a\"). This could be due to ~a being a special form." form res form (let ((*enable-package-system* nil)) (ps::ps* form)) form)
(when *enable-package-system*
(assert (symbol-script-package res) ()
"The symbol ~A::~A has no associated script package."
(if (symbol-package res) (package-name (symbol-package res)) "ANONYMOUS-PACKAGE")
res))
"~a is expected to be a symbol, but compiles to ~a (the ParenScript output for ~a alone is \"~a\"). This could be due to ~a being a special form." form res form (ps::ps* form) form)
(assert (symbol-script-package res) ()
"The symbol ~A::~A has no associated script package."
(if (symbol-package res) (package-name (symbol-package res)) "ANONYMOUS-PACKAGE")
res)
res))
(defun compile-to-statement (form)
......
......@@ -10,10 +10,10 @@
(concatenate 'string
prefix (princ-to-string (incf *gen-script-name-counter*))))
(defun gen-script-name (&key (prefix "_ps_"))
(defun gen-script-name (&key (prefix ""))
"Generate a new javascript identifier."
(intern (gen-script-name-string :prefix prefix)
(find-package :js)))
(find-package :parenscript.ps-gensyms)))
(defmacro gen-ps-name (&rest args)
`(gen-script-name ,@args))
......
......@@ -9,7 +9,7 @@
(progn
(defpackage test (:lisp-package :parenscript-test))
(defvar the-var))
"var test_theVar;")
"var TEST_theVar;")
(defpstest no-global-variable-prefix ()
(progn
......
......@@ -68,8 +68,7 @@ x = 2 + sideEffect() + x + 5;")
"(function (x) { return x; }) (10).toString()")
(test no-whitespace-before-dot
(let* ((parenscript::*enable-package-system* nil)
(str (compile-script '(.to-string ((lambda (x) (return x)) 10))))
(let* ((str (compile-script '(.to-string ((lambda (x) (return x)) 10))))
(dot-pos (position #\. str :test #'char=))
(char-before (elt str (1- dot-pos)))
(a-parenthesis #\)))
......@@ -173,8 +172,7 @@ x = 2 + sideEffect() + x + 5;")
}")
(test escape-sequences-in-string
(let ((parenscript::*enable-package-system* nil)
(escapes `((#\\ . #\\)
(let ((escapes `((#\\ . #\\)
(#\b . #\Backspace)
(#\f . ,(code-char 12))
("u000B" . ,(code-char #x000b));;Vertical tab, too uncommon to bother with
......@@ -186,7 +184,7 @@ x = 2 + sideEffect() + x + 5;")
("u0080" . ,(code-char 128)) ;;Character over 127. Actually valid, parenscript escapes them to be sure.
("uABCD" . ,(code-char #xabcd)))));; Really above ascii.
(loop for (js-escape . lisp-char) in escapes
for generated = (compile-script `(let ((x , (format nil "hello~ahi" lisp-char)))))
for generated = (compile-script `(let ((x ,(format nil "hello~ahi" lisp-char)))))
for wanted = (format nil "{
var x = 'hello\\~ahi';
}" js-escape)
......@@ -213,10 +211,10 @@ x = 2 + sideEffect() + x + 5;")
"(!zoo ? foo : bar).x")
(test script-star-eval1
(is (string= "x = 1; y = 2;" (normalize-js-code (let ((*enable-package-system* nil)) (script* '(setf x 1) '(setf y 2)))))))
(is (string= "x = 1; y = 2;" (normalize-js-code (script* '(setf x 1) '(setf y 2))))))
(test script-star-eval2
(is (string= "x = 1;" (normalize-js-code (let ((*enable-package-system* nil)) (script* '(setf x 1)))))))
(is (string= "x = 1;" (normalize-js-code (script* '(setf x 1))))))
(test-ps-js slot-value-null1
(slot-value foo nil)
......@@ -240,7 +238,6 @@ x = 2 + sideEffect() + x + 5;")
(test defsetf1
(ps (defsetf baz (x y) (newval) `(set-baz ,x ,y ,newval)))
(is (string= "var _ps_1 = 3; var _ps_2 = 2; var _ps_3 = 1; setBaz(_ps_3, _ps_2, _ps_1);"
(normalize-js-code (let ((*enable-package-system* nil)
(ps::*gen-script-name-counter* 0))
(is (string= "var PS_GS_1 = 3; var PS_GS_2 = 2; var PS_GS_3 = 1; setBaz(PS_GS_3, PS_GS_2, PS_GS_1);"
(normalize-js-code (let ((ps::*gen-script-name-counter* 0))
(ps (setf (baz 1 2) 3)))))))
......@@ -43,17 +43,15 @@
;; is-macro expands its argument again when reporting failures, so
;; the reported temporary js-variables get wrong if we don't evalute first.
(let* ((parenscript::*enable-package-system* nil)
(generated-code (compile-script ',parenscript))
(let* ((generated-code (compile-script ',parenscript))
(js-code ,javascript))
(is (string= (normalize-js-code generated-code)
(normalize-js-code js-code)))))))
(defmacro defpstest (testname (&key (optimize t) (enable-package-system t)) parenscript javascript)
(defmacro defpstest (testname (&key (optimize t)) parenscript javascript)
`(test ,testname
(setf parenscript::*var-counter* 0)
(let* ((parenscript::*enable-package-system* ,enable-package-system)
(generated-code (compile-script ',parenscript))
(let* ((generated-code (compile-script ',parenscript))
(js-code ,javascript))
(is (string= (normalize-js-code generated-code)
(normalize-js-code js-code))))))
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment