Commit 5955c9f8 authored by Vladimir Sedach's avatar Vladimir Sedach
Browse files

Renamed package JS to PS-JS to avoid possible future conflicts (I know...

Renamed package JS to PS-JS to avoid possible future conflicts (I know CL-JavaScript at one point wanted to use JS)
parent c76f5ad2
......@@ -197,7 +197,7 @@ form, FORM, returns the new value for *compilation-level*."
(let ((*compilation-level* (adjust-compilation-level form *compilation-level*)))
(if (special-form? form)
(compile-special-form form)
`(js:funcall ,(if (symbolp (car form))
`(ps-js:funcall ,(if (symbolp (car form))
(maybe-rename-local-function (car form))
(compile-expression (car form)))
,@(mapcar #'compile-expression (cdr form)))))))))
......
......@@ -103,7 +103,7 @@ is output to the OUTPUT-STREAM stream."
(define-statement-operator with (expression &rest body)
(warn-deprecated 'with '|LET or WITH-SLOTS|)
`(js:with ,(compile-expression expression)
`(ps-js:with ,(compile-expression expression)
,(compile-statement `(progn ,@body))))
(defpsmacro label (&rest args)
......
(in-package #:cl)
(defpackage #:js
(defpackage #:ps-js
(:shadowing-import-from #:cl
#:+
#:-
......
......@@ -4,31 +4,37 @@
;;; standard but exported by Parenscript, and their Common Lisp
;;; equivalent definitions
(defmacro define-trivial-special-ops (&rest mappings)
`(progn ,@(loop for (form-name js-primitive) on mappings by #'cddr collect
`(define-expression-operator ,form-name (&rest args)
(cons ',js-primitive (mapcar #'compile-expression args))))))
(define-trivial-special-ops
array js:array
instanceof js:instanceof
typeof js:typeof
new js:new
delete js:delete
in js:in ;; maybe rename to slot-boundp?
break js:break
array ps-js:array
instanceof ps-js:instanceof
typeof ps-js:typeof
new ps-js:new
delete ps-js:delete
in ps-js:in ;; maybe rename to slot-boundp?
break ps-js:break
)
(defun array (&rest initial-contents)
(make-array (length initial-contents) :initial-contents initial-contents))
;; Common Lisp Hyperspec, 11.1.2.1.2
;; (defun array (&rest initial-contents)
;; (make-array (length initial-contents) :initial-contents initial-contents))
(define-statement-operator continue (&optional label)
`(js:continue ,label))
`(ps-js:continue ,label))
(define-statement-operator switch (test-expr &rest clauses)
`(js:switch ,(compile-expression test-expr)
`(ps-js:switch ,(compile-expression test-expr)
,@(loop for (val . body) in clauses collect
(cons (if (eq val 'default)
'js:default
'ps-js:default
(compile-expression val))
(mapcan (lambda (x)
(let ((exp (compile-statement x)))
(if (and (listp exp) (eq 'js:block (car exp)))
(if (and (listp exp) (eq 'ps-js:block (car exp)))
(cdr exp)
(list exp))))
body)))))
......@@ -37,7 +43,7 @@
;;; objects
(define-expression-operator create (&rest arrows)
`(js:object
`(ps-js:object
,@(loop for (key val-expr) on arrows by #'cddr collecting
(progn
(assert (or (stringp key) (numberp key) (symbolp key))
......@@ -54,9 +60,9 @@
(eq 'quote (car expanded-slot)))
(aif (or (reserved-symbol? (second expanded-slot))
(and (keywordp (second expanded-slot)) (second expanded-slot)))
`(js:aref ,obj ,it)
`(js:getprop ,obj ,(second expanded-slot)))
`(js:aref ,obj ,(compile-expression slot)))))
`(ps-js:aref ,obj ,it)
`(ps-js:getprop ,obj ,(second expanded-slot)))
`(ps-js:aref ,obj ,(compile-expression slot)))))
(defpsmacro getprop (obj &rest slots)
(if (null (rest slots))
......@@ -89,7 +95,7 @@
(when value? (compile-expression `(setf ,name ,value))))
(define-statement-operator var (name &optional (value (values) value?) docstr)
`(js:var ,(ps-macroexpand name) ,@(when value? (list (compile-expression value) docstr))))
`(ps-js:var ,(ps-macroexpand name) ,@(when value? (list (compile-expression value) docstr))))
(defmacro var (name &optional value docstr)
`(defparameter ,name ,@(when value (list value)) ,@(when docstr (list docstr))))
......@@ -98,18 +104,18 @@
(define-statement-operator for (init-forms cond-forms step-forms &body body)
(let ((init-forms (make-for-vars/inits init-forms)))
`(js:for ,init-forms
`(ps-js:for ,init-forms
,(mapcar #'compile-expression cond-forms)
,(mapcar #'compile-expression step-forms)
,(compile-loop-body (mapcar #'car init-forms) body))))
(define-statement-operator for-in ((var object) &rest body)
`(js:for-in ,(compile-expression var)
`(ps-js:for-in ,(compile-expression var)
,(compile-expression object)
,(compile-loop-body (list var) body)))
(define-statement-operator while (test &rest body)
`(js:while ,(compile-expression test)
`(ps-js:while ,(compile-expression test)
,(compile-loop-body () body)))
(defmacro while (test &body body)
......@@ -122,18 +128,18 @@
(finally (cdr (assoc :finally clauses))))
(assert (not (cdar catch)) () "Sorry, currently only simple catch forms are supported.")
(assert (or catch finally) () "Try form should have either a catch or a finally clause or both.")
`(js:try ,(compile-statement `(progn ,form))
`(ps-js:try ,(compile-statement `(progn ,form))
:catch ,(when catch (list (caar catch) (compile-statement `(progn ,@(cdr catch)))))
:finally ,(when finally (compile-statement `(progn ,@finally))))))
(define-expression-operator regex (regex)
`(js:regex ,(string regex)))
`(ps-js:regex ,(string regex)))
(define-expression-operator lisp (lisp-form)
;; (ps (foo (lisp bar))) is like (ps* `(foo ,bar))
;; When called from inside of ps*, lisp-form has access to the
;; dynamic environment only, analogous to eval.
`(js:escape
`(ps-js:escape
(with-output-to-string (*psw-stream*)
(let ((compile-expression? ,compile-expression?))
(parenscript-print (ps-compile ,lisp-form) t)))))
......@@ -166,8 +172,8 @@
"Like concatenate but prints all of its arguments."
(format nil "~{~A~}" things))
(define-ps-symbol-macro f js:f)
(define-ps-symbol-macro f ps-js:f)
(defvar f nil)
(define-ps-symbol-macro false js:f)
(define-ps-symbol-macro false ps-js:f)
(defvar false nil)
......@@ -22,7 +22,7 @@ vice-versa.")
(%psw-accumulator ()))
(declare (special %psw-accumulator))
(with-standard-io-syntax
(if (and (listp form) (eq 'js:block (car form))) ; ignore top-level block
(if (and (listp form) (eq 'ps-js:block (car form))) ; ignore top-level block
(loop for (statement . remaining) on (cdr form) do
(ps-print statement) (psw #\;) (when remaining (psw #\Newline)))
(ps-print form)))
......@@ -67,7 +67,7 @@ vice-versa.")
(defmethod ps-print ((x (eql t)))
(psw "true"))
(defmethod ps-print ((x (eql 'js:f)))
(defmethod ps-print ((x (eql 'ps-js:f)))
(psw "false"))
(defmethod ps-print ((s symbol))
......@@ -122,25 +122,25 @@ vice-versa.")
(format *psw-stream* (if (integerp number) "~S" "~F") number))
(let ((precedence-table (make-hash-table :test 'eq)))
(loop for level in '((js:getprop js:aref js:new js:funcall)
(js:lambda) ;; you won't find this in JS books
(js:++ js:-- js:post++ js:post--)
(js:! js:~ js:negate js:typeof js:delete)
(js:* js:/ js:%)
(js:-)
(js:+)
(js:<< js:>> js:>>>)
(js:< js:> js:<= js:>= js:instanceof js:in)
(js:== js:!= js:=== js:!==)
(js:&)
(js:^)
(js:\|)
(js:&&)
(js:\|\|)
(js:?)
(js:= js:*= js:/= js:%= js:+= js:-= js:<<= js:>>= js:>>>= js:&= js:^= js:\|=)
(js:return js:throw)
(js:|,|))
(loop for level in '((ps-js:getprop ps-js:aref ps-js:new ps-js:funcall)
(ps-js:lambda) ;; you won't find this in JS books
(ps-js:++ ps-js:-- ps-js:post++ ps-js:post--)
(ps-js:! ps-js:~ ps-js:negate ps-js:typeof ps-js:delete)
(ps-js:* ps-js:/ ps-js:%)
(ps-js:-)
(ps-js:+)
(ps-js:<< ps-js:>> ps-js:>>>)
(ps-js:< ps-js:> ps-js:<= ps-js:>= ps-js:instanceof ps-js:in)
(ps-js:== ps-js:!= ps-js:=== ps-js:!==)
(ps-js:&)
(ps-js:^)
(ps-js:\|)
(ps-js:&&)
(ps-js:\|\|)
(ps-js:?)
(ps-js:= ps-js:*= ps-js:/= ps-js:%= ps-js:+= ps-js:-= ps-js:<<= ps-js:>>= ps-js:>>>= ps-js:&= ps-js:^= ps-js:\|=)
(ps-js:return ps-js:throw)
(ps-js:|,|))
for i from 0
do (mapc (lambda (symbol)
(setf (gethash symbol precedence-table) i))
......@@ -149,8 +149,8 @@ vice-versa.")
(gethash op precedence-table -1)))
(defun associative? (op)
(member op '(js:+ js:* js:& js:&& js:\| js:\|\|
js:funcall js:aref js:getprop))) ;; these aren't really associative, but RPN
(member op '(ps-js:+ ps-js:* ps-js:& ps-js:&& ps-js:\| ps-js:\|\|
ps-js:funcall ps-js:aref ps-js:getprop))) ;; these aren't really associative, but RPN
(defun parenthesize-print (ps-form)
(psw #\() (ps-print ps-form) (psw #\)))
......@@ -165,57 +165,57 @@ vice-versa.")
(defun print-op (op)
(psw (string-downcase op)))
(defprinter (js:! js:~ js:++ js:--) (x)
(defprinter (ps-js:! ps-js:~ ps-js:++ ps-js:--) (x)
(print-op op) (print-op-argument op x))
(defprinter js:negate (x)
(defprinter ps-js:negate (x)
"-"(print-op-argument op x))
(defprinter (js:delete js:typeof js:new js:throw js:return) (x)
(defprinter (ps-js:delete ps-js:typeof ps-js:new ps-js:throw ps-js:return) (x)
(print-op op)" "(print-op-argument op x))
(defprinter js:post++ (x)
(defprinter ps-js:post++ (x)
(ps-print x)"++")
(defprinter js:post-- (x)
(defprinter ps-js:post-- (x)
(ps-print x)"--")
(defprinter (js:+ js:- js:* js:/ js:% js:&& js:\|\| js:& js:\| js:-= js:+= js:*= js:/= js:%= js:^ js:&= js:^= js:\|= js:= js:== js:=== js:!== js:in js:!= js:> js:>= js:< js:<=)
(defprinter (ps-js:+ ps-js:- ps-js:* ps-js:/ ps-js:% ps-js:&& ps-js:\|\| ps-js:& ps-js:\| ps-js:-= ps-js:+= ps-js:*= ps-js:/= ps-js:%= ps-js:^ ps-js:&= ps-js:^= ps-js:\|= ps-js:= ps-js:== ps-js:=== ps-js:!== ps-js:in ps-js:!= ps-js:> ps-js:>= ps-js:< ps-js:<=)
(&rest args)
(loop for (arg . remaining) on args do
(print-op-argument op arg)
(when remaining (format *psw-stream* " ~(~A~) " op))))
(defprinter js:aref (array &rest indices)
(print-op-argument 'js:aref array)
(defprinter ps-js:aref (array &rest indices)
(print-op-argument 'ps-js:aref array)
(dolist (idx indices)
(psw #\[) (ps-print idx) (psw #\])))
(defun print-comma-delimited-list (ps-forms)
(loop for (form . remaining) on ps-forms do
(print-op-argument 'js:|,| form)
(print-op-argument 'ps-js:|,| form)
(when remaining (psw ", "))))
(defprinter js:array (&rest initial-contents)
(defprinter ps-js:array (&rest initial-contents)
"["(print-comma-delimited-list initial-contents)"]")
(defprinter (js:|,|) (&rest expressions)
(defprinter (ps-js:|,|) (&rest expressions)
(print-comma-delimited-list expressions))
(defprinter js:funcall (fun-designator &rest args)
(defprinter ps-js:funcall (fun-designator &rest args)
(print-op-argument op fun-designator)"("(print-comma-delimited-list args)")")
(defprinter js:block (&rest statements)
(defprinter ps-js:block (&rest statements)
"{" (incf *indent-level*)
(dolist (statement statements)
(newline-and-indent) (ps-print statement) (psw #\;))
(decf *indent-level*) (newline-and-indent)
"}")
(defprinter js:lambda (args body)
(defprinter ps-js:lambda (args body)
(print-fun-def nil args body))
(defprinter js:defun (name args docstring body)
(defprinter ps-js:defun (name args docstring body)
(when docstring (print-comment docstring))
(print-fun-def name args body))
......@@ -226,15 +226,15 @@ vice-versa.")
(psw ") ")
(ps-print body-block))
(defprinter js:object (&rest slot-defs)
(defprinter ps-js:object (&rest slot-defs)
"{ "(loop for ((slot-name . slot-value) . remaining) on slot-defs do
(ps-print slot-name) (psw " : ") (ps-print slot-value)
(when remaining (psw ", ")))" }")
(defprinter js:getprop (obj slot)
(defprinter ps-js:getprop (obj slot)
(print-op-argument op obj)"."(psw (symbol-to-js-string slot)))
(defprinter js:if (test consequent &rest clauses)
(defprinter ps-js:if (test consequent &rest clauses)
"if ("(ps-print test)") "
(ps-print consequent)
(loop while clauses do
......@@ -246,25 +246,25 @@ vice-versa.")
(ps-print (cadr clauses))
(return)))))
(defprinter js:? (test then else)
(defprinter ps-js:? (test then else)
(print-op-argument op test) " ? "
(print-op-argument op then) " : "
(print-op-argument op else))
(defprinter js:var (var-name &optional (value (values) value?) docstring)
(defprinter ps-js:var (var-name &optional (value (values) value?) docstring)
(when docstring (print-comment docstring))
"var "(psw (symbol-to-js-string var-name))
(when value? (psw " = ") (print-op-argument 'js:= value)))
(when value? (psw " = ") (print-op-argument 'ps-js:= value)))
(defprinter js:label (label statement)
(defprinter ps-js:label (label statement)
(psw (symbol-to-js-string label))": "(ps-print statement))
(defprinter (js:continue js:break) (&optional label)
(defprinter (ps-js:continue ps-js:break) (&optional label)
(print-op op) (when label
(psw " " (symbol-to-js-string label))))
;;; iteration
(defprinter js:for (vars tests steps body-block)
(defprinter ps-js:for (vars tests steps body-block)
(psw "for (")
(loop for ((var-name . var-init) . remaining) on vars
for decl = "var " then "" do
......@@ -278,15 +278,15 @@ vice-versa.")
") "
(ps-print body-block))
(defprinter js:for-in (var object body-block)
(defprinter ps-js:for-in (var object body-block)
"for (var "(ps-print var)" in "(ps-print object)") "
(ps-print body-block))
(defprinter (js:with js:while) (expression body-block)
(defprinter (ps-js:with ps-js:while) (expression body-block)
(print-op op)" ("(ps-print expression)") "
(ps-print body-block))
(defprinter js:switch (test &rest clauses)
(defprinter ps-js:switch (test &rest clauses)
"switch ("(ps-print test)") {"
(flet ((print-body-statements (body-statements)
(incf *indent-level*)
......@@ -297,7 +297,7 @@ vice-versa.")
(decf *indent-level*)))
(loop for (val . statements) in clauses
do (progn (newline-and-indent)
(if (eq val 'js:default)
(if (eq val 'ps-js:default)
(progn (psw "default:")
(print-body-statements statements))
(progn (psw "case ") (ps-print val) (psw #\:)
......@@ -305,7 +305,7 @@ vice-versa.")
(newline-and-indent)
"}")
(defprinter js:try (body-block &key catch finally)
(defprinter ps-js:try (body-block &key catch finally)
"try "(ps-print body-block)
(when catch
(psw " catch ("(symbol-to-js-string (first catch))") ")
......@@ -313,14 +313,14 @@ vice-versa.")
(when finally
(psw " finally ") (ps-print finally)))
(defprinter js:regex (regex)
(defprinter ps-js:regex (regex)
(let ((slash (unless (and (> (length regex) 0) (char= (char regex 0) #\/)) "/")))
(psw (concatenate 'string slash regex slash))))
(defprinter js:instanceof (value type)
(defprinter ps-js:instanceof (value type)
"("(print-op-argument op value)" instanceof "(print-op-argument op type)")")
(defprinter js:escape (literal-js)
(defprinter ps-js:escape (literal-js)
;; literal-js should be a form that evaluates to a string containing
;; valid JavaScript
(psw literal-js))
......@@ -3,35 +3,30 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; arithmetic and logic
(defmacro define-trivial-special-ops (&rest mappings)
`(progn ,@(loop for (form-name js-primitive) on mappings by #'cddr collect
`(define-expression-operator ,form-name (&rest args)
(cons ',js-primitive (mapcar #'compile-expression args))))))
(define-trivial-special-ops
+ js:+
- js:-
* js:*
/ js:/
rem js:%
and js:&&
or js:\|\|
logand js:&
logior js:\|
logxor js:^
lognot js:~
+ ps-js:+
- ps-js:-
* ps-js:*
/ ps-js:/
rem ps-js:%
and ps-js:&&
or ps-js:\|\|
logand ps-js:&
logior ps-js:\|
logxor ps-js:^
lognot ps-js:~
;; todo: ash for shifts
throw js:throw
aref js:aref
throw ps-js:throw
aref ps-js:aref
funcall js:funcall
funcall ps-js:funcall
)
(define-expression-operator - (&rest args)
(let ((args (mapcar #'compile-expression args)))
(cons (if (cdr args) 'js:- 'js:negate) args)))
(cons (if (cdr args) 'ps-js:- 'ps-js:negate) args)))
(defun fix-nary-comparison (operator objects)
(let* ((tmp-var-forms (butlast (cdr objects)))
......@@ -55,43 +50,43 @@
(cons ',js-primitive
(mapcar #'compile-expression objects))))))))
(define-nary-comparison-forms
< js:<
> js:>
<= js:<=
>= js:>=
eql js:===
equal js:==))
< ps-js:<
> ps-js:>
<= ps-js:<=
>= ps-js:>=
eql ps-js:===
equal ps-js:==))
(define-expression-operator /= (a b)
;; for n>2, /= is finding duplicates in an array of numbers (ie -
;; nontrivial runtime algorithm), so we restrict it to binary in PS
`(js:!== ,(compile-expression a) ,(compile-expression b)))
`(ps-js:!== ,(compile-expression a) ,(compile-expression b)))
(define-expression-operator incf (x &optional (delta 1))
(let ((delta (ps-macroexpand delta)))
(if (eql delta 1)
`(js:++ ,(compile-expression x))
`(js:+= ,(compile-expression x) ,(compile-expression delta)))))
`(ps-js:++ ,(compile-expression x))
`(ps-js:+= ,(compile-expression x) ,(compile-expression delta)))))
(define-expression-operator decf (x &optional (delta 1))
(let ((delta (ps-macroexpand delta)))
(if (eql delta 1)
`(js:-- ,(compile-expression x))
`(js:-= ,(compile-expression x) ,(compile-expression delta)))))
`(ps-js:-- ,(compile-expression x))
`(ps-js:-= ,(compile-expression x) ,(compile-expression delta)))))
(let ((inverses (mapcan (lambda (x)
(list x (reverse x)))
'((js:=== js:!==)
(js:== js:!=)
(js:< js:>=)
(js:> js:<=)))))
'((ps-js:=== ps-js:!==)
(ps-js:== ps-js:!=)
(ps-js:< ps-js:>=)
(ps-js:> ps-js:<=)))))
(define-expression-operator not (x)
(let ((form (compile-expression x)))
(acond ((and (listp form) (eq (car form) 'js:!))
(acond ((and (listp form) (eq (car form) 'ps-js:!))
(second form))
((and (listp form) (cadr (assoc (car form) inverses)))
`(,it ,@(cdr form)))
(t `(js:! ,form))))))
(t `(ps-js:! ,form))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; blocks and control flow
......@@ -99,7 +94,7 @@
(defun compile-progn (body)
(labels ((flatten-blocks (body)
(when body
(if (and (listp (car body)) (eq 'js:block (caar body)))
(if (and (listp (car body)) (eq 'ps-js:block (caar body)))
(append (cdr (car body)) (flatten-blocks (cdr body)))
(cons (car body) (flatten-blocks (cdr body)))))))
(let ((block (flatten-blocks (remove nil (mapcar #'ps-compile body)))))
......@@ -110,16 +105,16 @@
(define-expression-operator progn (&rest body)
(if (cdr body)
`(js:|,| ,@(compile-progn body))
`(ps-js:|,| ,@(compile-progn body))
(compile-expression (car body))))
(define-statement-operator progn (&rest body)
`(js:block ,@(compile-progn body)))
`(ps-js:block ,@(compile-progn body)))
(defun wrap-block-for-dynamic-return (tag body)
(if (member tag *tags-that-return-throws-to*)
`(js:block
(js:try ,body
`(ps-js:block
(ps-js:try ,body
:catch (err ,(compile-statement `(progn (if (and err (eql ',tag (getprop err :ps-block-tag)))
;; FIXME make this a multiple-value return
(getprop err :ps-return-value)
......@@ -131,7 +126,7 @@
(let* ((name (or name 'nilBlock))
(*lexical-extent-return-tags* (cons name *lexical-extent-return-tags*))
(*tags-that-return-throws-to* ()))
`(js:label ,name ,(wrap-block-for-dynamic-return name (compile-statement `(progn ,@body))))))
`(ps-js:label ,name ,(wrap-block-for-dynamic-return name (compile-statement `(progn ,@body))))))
(defun nesting-depth (form)
(if (consp form)
......@@ -144,22 +139,22 @@
(progn
(when result
(warn "Trying to (RETURN ~A) from inside a loop with an implicit nil block (DO, DOLIST, DOTIMES, etc.). Parenscript doesn't support returning values this way from inside a loop yet!" result))
'(js:break))
'(ps-js:break))
(ps-compile `(return-from nilBlock ,result)))
(let ((form (ps-macroexpand result)))
(flet ((return-exp (value) ;; this stuff needs to be fixed to handle multiple-value returns, too
(let ((value (compile-expression value)))
(cond ((or (eql '%function-body tag) (eql *function-block-name* tag))
`(js:return ,value))
`(ps-js:return ,value))
((member tag *lexical-extent-return-tags*)
(when result
(warn "Trying to (RETURN-FROM ~A ~A) a value from a block. Parenscript doesn't support returning values this way from blocks yet!" tag result))
`(js:break ,tag))
`(ps-js:break ,tag))
((member tag *dynamic-extent-return-tags*)
(push tag *tags-that-return-throws-to*)
(ps-compile `(throw (create :ps-block-tag ',tag :ps-return-value ,value))))
(t (warn "Returning from unknown block ~A" tag)
`(js:return ,value)))))) ;; for backwards-compatibility
`(ps-js:return ,value)))))) ;; for backwards-compatibility
(if (listp form)
(block expressionize
(ps-compile
......@@ -207,7 +202,7 @@
form)
(if
(aif (and (<= (nesting-depth form) 3) (handler-case (compile-expression form) (compile-expression-error () nil)))
(return-from expressionize `(js:return ,it))
(return-from expressionize `(ps-js:return ,it))
`(if ,(second form)
(return-from ,tag ,(third form))
,@(when (fourth form) `((return-from ,tag ,(fourth form)))))))
......@@ -221,10 +216,10 @@
;;; conditionals
(define-expression-operator if (test then &optional else)
`(js:? ,(compile-expression test) ,(compile-expression then) ,(compile-expression else)))
`(ps-js:? ,(compile-expression test) ,(compile-expression then) ,(compile-expression else)))
(define-statement-operator if (test then &optional else)
`(js:if ,(compile-expression test