--- /dev/null
+This document is about the design and architecture of the Parenscript compiler.
+
+Compilation Pipeline:
+
+ user --> [parenscript text]
+-- reader --> [parenscript sexp forms]
+-- parser --> [special forms]
+-- optimizer --> [(javascript) special forms]
+-- translater --> [javascript text]
+-> user
+
+==reader==
+Parenscript can use either the Lisp reader or the Parenscript reader to read objects from source
+text. Generally, Parenscript embedded in Lisp will use the Lisp reader, and Parenscript in
+Parenscript files will use the Parenscript reader. There are only a few differences between
+the readers:
+# The Parenscript reader will not obey defined read macros in the Lisp reader
+# The Parenscript reader understands Parenscript package names as package prefixes and
+does NOT understand Lisp package names as package prefixes.
+# The Lisp reader does not understand Parenscript package names but does understand
+Lisp package names as symbol prefixes.
+
+==parser==
+Once the source text has been transformed into SEXPs, the parser transforms the SEXPs into
+primitive special-form objects. This is the stage during which macroexpansion takes place
+and an AST is generated for the program.
+
+==optimizer==
+The compiler then performs optional optimizations on the AST produced by the parser. The
+result is an AST that produces faster/better code.
+
+==transformer==
+Given an AST, the transformer produces Javascript source text.
+
+*************************************************************************************
--- /dev/null
+Programming languages were at one point a flourishing research area. In some areanas, they still are.
+It is difficult to get a programming language "right." Parenscript is fortunate in that it is
+modelled after a language to which many people have contributed a great deal over many decades.
+
+Most of the links and notes below refer to ideas about Common Lisp. Some are about Javascript,
+the target programming language and environment for Parenscript.
+
+
+Strange Javascript Semantics
+===========================================================================
+var x = 1;
+function foo() {
+ if (x == ONE_OR_NOT_ONE) { var x = 3; }
+ return "bleck: " + x;
+};
+foo();
+
+This code returns "bleck: undefined" when ONE_OR_NOT_ONE is 1 or 2. See
+http://www.ecma-international.org/publications/files/ecma-st/ECMA-262.pdf
+page 37 for an explanation of the semantics of variable scope.
+
+
+var x = 1; function foo(a) { return foo; var foo=5; } foo(3);
+
+=> 'undefined'
+
+var x = 1; function foo(a) { return foo; } foo(3);
+
+=> thee function foo
+
+
+
+
+Reference material
+===========================================================================
+Macro Expansion in Lisp:
+ Common Lisp the Language, 2nd Edition.
+ http://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node99.html
+
+File Compilation:
+ http://www.lispworks.com/documentation/HyperSpec/Body/03_bca.htm
+
+Special forms in Lisp:
+ CLHS
+ http://www.lisp.org/HyperSpec/Body/sec_3-1-2-1-2-1.html
+
+block let* return-from
+catch load-time-value setq
+eval-when locally symbol-macrolet
+flet macrolet tagbody
+function multiple-value-call the
+go multiple-value-prog1 throw
+if progn unwind-protect
+labels progv
+let quote
(:module :src
:components ((:file "package")
(:file "utils" :depends-on ("package"))
- (:file "source-model" :depends-on ("package" "utils"))
- (:file "parser" :depends-on ("source-model"))
+ (:file "js-source-model" :depends-on ("package" "utils"))
+ (:file "ps-source-model" :depends-on ("js-source-model"))
+ (:file "parser" :depends-on ("js-source-model" "ps-source-model"))
(:file "deprecated-interface" :depends-on ("parser"))
- (:file "macrology" :depends-on ("deprecated-interface"))
- (:file "js-translation" :depends-on ("macrology"))
- (:file "compilation-interface" :depends-on ("package" "js-translation"))
+ (:file "js-macrology" :depends-on ("deprecated-interface"))
+ (:file "ps-macrology" :depends-on ("js-macrology"))
+ (:file "js-translation" :depends-on ("ps-macrology"))
+; (:file "js-ugly-translation" :depends-on ("js-translation"))
+ (:file "reader" :depends-on ("parser"))
+ (:file "compilation-interface" :depends-on ("package" "reader" "js-translation")); "js-ugly-translation"))
;; standard library
(:module :lib
:components ((:static-file "functional.lisp")
by OUTPUT-SPEC, pretty printing if PRETTY-PRINT is non-null.
OUTPUT-SPEC must be :javascript at the moment."
- (declare (ignore pretty-print) (ignore comp-env))
+ (declare (ignore comp-env))
(when (not (eql :javascript output-spec))
(error "Unsupported output-spec for translation: ~A" output-spec))
(when (eql :javascript output-spec)
- (write-string (string-join
- (js-to-statement-strings compiled-expr 0)
- (string #\Newline))
- output-stream)))
+; (if (not pretty-print)
+; (js-translate compiled-expr :statement output-stream)
+ (write-string (string-join
+ (ps-js::js-to-statement-strings compiled-expr 0)
+ (string #\Newline))
+ output-stream)))
(defun compile-script (script-form
&key
to the given output stream."
(setf (comp-env-compiling-toplevel-p comp-env) t)
(error "NOT IMPLEMENTED."))
-
-
-
;(defun compile-script-file (script-src-file
; &key
"Define a ParenScript macro, and store it in the toplevel ParenScript macro environment.
DEPRECATED"
- `(defscriptmacro ,name ,args ,@body))
\ No newline at end of file
+ `(defscriptmacro ,name ,args ,@body))
+
+;;; dual lisp/parenscript macro balderdash
+;;; TODO: should probably move elsewhere ;;;
+#+nil
+(progn
+(defmacro defmacro/js (name args &body body)
+ "Define a Lisp macro and import it into the ParenScript macro environment."
+ `(progn (defmacro ,name ,args ,@body)
+ (js:import-macros-from-lisp ',name)))
+
+(defmacro defmacro+js (name args &body body)
+ "Define a Lisp macro and a ParenScript macro in their respective
+macro environments. This function should be used when you want to use
+the same macro in both Lisp and ParenScript, but the 'macroexpand' of
+that macro in Lisp makes the Lisp macro unsuitable to be imported into
+the ParenScript macro environment."
+ `(progn (defmacro ,name ,args ,@body)
+ (defscriptmacro ,name ,args ,@body)))
+
+(defun import-macros-from-lisp (&rest names)
+ "Import the named Lisp macros into the ParenScript macro environment."
+ (dolist (name names)
+ (let ((name name))
+ (undefine-js-special-form name)
+ (setf (get-macro-spec name *script-macro-toplevel*)
+ (cons nil (lambda (&rest args)
+ (macroexpand `(,name ,@args))))))))
+
+(defmacro js-file (&rest body)
+ `(html
+ (:princ
+ (js ,@body))))
+
+(defmacro js-script (&rest body)
+ `((:script :type "text/javascript")
+ (:princ (format nil "~%// <![CDATA[~%"))
+ (:princ (js ,@body))
+ (:princ (format nil "~%// ]]>~%"))))
+
+(defmacro js-inline (&rest body)
+ `(js-inline* '(progn ,@body)))
+
+(defmacro js-inline* (&rest body)
+ "Just like JS-INLINE except that BODY is evaluated before being
+converted to javascript."
+ `(concatenate 'string "javascript:"
+ (string-join (js-to-statement-strings (compile-script-form (list 'progn ,@body)) 0) " ")))
+)
\ No newline at end of file
--- /dev/null
+(in-package :parenscript.javascript)
+
+;;;; The macrology of the basic Javascript-in-SEXPs language. Special forms and macros.
+
+;;; literals
+(defmacro defscriptliteral (name string)
+ "Define a Javascript literal that will expand to STRING."
+ `(define-script-special-form ,name () (make-instance 'expression :value ,string)))
+
+(defscriptliteral this "this")
+(defscriptliteral t "true")
+(defscriptliteral nil "null")
+(defscriptliteral false "false")
+(defscriptliteral undefined "undefined")
+
+(defmacro defscriptkeyword (name string)
+ "Define a Javascript keyword that will expand to STRING."
+ `(define-script-special-form ,name () (make-instance 'statement :value ,string)))
+
+(defscriptkeyword break "break")
+(defscriptkeyword continue "continue")
+
+;;; array literals
+(define-script-special-form array (&rest values)
+ (make-instance 'array-literal
+ :values (mapcar #'compile-to-expression values)))
+
+(define-script-special-form aref (array &rest coords)
+ (make-instance 'js-aref
+ :array (compile-to-expression array)
+ :index (mapcar #'compile-to-expression coords)))
+
+
+;;; object literals (maps and hash-tables)
+(define-script-special-form {} (&rest values)
+ (make-instance 'object-literal
+ :values (loop
+ for (key value) on values by #'cddr
+ collect (cons key (compile-to-expression value)))))
+
+;;; operators
+(define-script-special-form ++ (x)
+ (make-instance 'one-op :pre-p nil :op "++"
+ :value (compile-to-expression x)))
+
+(define-script-special-form -- (x)
+ (make-instance 'one-op :pre-p nil :op "--"
+ :value (compile-to-expression x)))
+
+(define-script-special-form incf (x &optional (delta 1))
+ (if (eql delta 1)
+ (make-instance 'one-op :pre-p t :op "++"
+ :value (compile-to-expression x))
+ (make-instance 'op-form
+ :operator '+=
+ :args (mapcar #'compile-to-expression
+ (list x delta )))))
+
+(define-script-special-form decf (x &optional (delta 1))
+ (if (eql delta 1)
+ (make-instance 'one-op :pre-p t :op "--"
+ :value (compile-to-expression x))
+ (make-instance 'op-form
+ :operator '-=
+ :args (mapcar #'compile-to-expression
+ (list x delta )))))
+
+(define-script-special-form - (first &rest rest)
+ (if (null rest)
+ (make-instance 'one-op
+ :pre-p t
+ :op "-"
+ :value (compile-to-expression first))
+ (make-instance 'op-form
+ :operator '-
+ :args (mapcar #'compile-to-expression
+ (cons first rest)))))
+
+(define-script-special-form not (x)
+ (let ((value (compile-to-expression x)))
+ (if (and (typep value 'op-form)
+ (= (length (op-args value)) 2))
+ (let ((new-op (case (operator value)
+ (== '!=)
+ (< '>=)
+ (> '<=)
+ (<= '>)
+ (>= '<)
+ (!= '==)
+ (=== '!==)
+ (!== '===)
+ (t nil))))
+ (if new-op
+ (make-instance 'op-form :operator new-op
+ :args (op-args value))
+ (make-instance 'one-op :pre-p t :op "!"
+ :value value)))
+ (make-instance 'one-op :pre-p t :op "!"
+ :value value))))
+
+(define-script-special-form ~ (x)
+ (let ((expr (compile-to-expression x)))
+ (make-instance 'one-op :pre-p t :op "~" :value expr)))
+
+;;; progn
+(define-script-special-form progn (&rest body)
+ (make-instance 'js-block
+ :statements (mapcar #'compile-to-statement body)))
+
+(defmethod expression-precedence ((body js-block))
+ (if (= (length (block-statements body)) 1)
+ (expression-precedence (first (block-statements body)))
+ (op-precedence 'comma)))
+
+;;; function definition
+(define-script-special-form lambda (args &rest body)
+ (make-instance 'js-lambda
+ :args (mapcar #'compile-to-symbol args)
+ :body (make-instance 'js-block
+ :indent " "
+ :statements (mapcar #'compile-to-statement body))))
+
+(define-script-special-form defun (name args &rest body)
+ (make-instance 'js-defun
+ :name (compile-to-symbol name)
+ :args (mapcar #'compile-to-symbol args)
+ :body (make-instance 'js-block
+ :indent " "
+ :statements (mapcar #'compile-to-statement body))))
+
+;;; object creation
+(define-script-special-form create (&rest args)
+ (make-instance 'js-object
+ :slots (loop for (name val) on args by #'cddr
+ collect (let ((name-expr (compile-to-expression name)))
+ (assert (or (typep name-expr 'js-variable)
+ (typep name-expr 'string-literal)
+ (typep name-expr 'number-literal)))
+ (list name-expr (compile-to-expression val))))))
+
+
+(define-script-special-form slot-value (obj slot)
+ (make-instance 'js-slot-value :object (compile-to-expression obj)
+ :slot (compile-script-form slot)))
+
+;;; cond
+(define-script-special-form cond (&rest clauses)
+ (make-instance 'js-cond
+ :tests (mapcar (lambda (clause) (compile-to-expression (car clause)))
+ clauses)
+ :bodies (mapcar (lambda (clause) (compile-to-block (cons 'progn (cdr clause)) :indent " "))
+ clauses)))
+
+;;; if
+(define-script-special-form if (test then &optional else)
+ (make-instance 'js-if :test (compile-to-expression test)
+ :then (compile-to-block then :indent " ")
+ :else (when else
+ (compile-to-block else :indent " "))))
+
+(defmethod expression-precedence ((if js-if))
+ (op-precedence 'if))
+
+;;; switch
+(define-script-special-form switch (value &rest clauses)
+ (let ((clauses (mapcar #'(lambda (clause)
+ (let ((val (first clause))
+ (body (cdr clause)))
+ (list (if (eql val 'default)
+ 'default
+ (compile-to-expression val))
+ (compile-to-block (cons 'progn body) :indent " "))))
+ clauses))
+ (check (compile-to-expression value)))
+ (make-instance 'js-switch :value check
+ :clauses clauses)))
+
+
+;;; assignment
+(defun assignment-op (op)
+ (case op
+ (+ '+=)
+ (~ '~=)
+ (\& '\&=)
+ (\| '\|=)
+ (- '-=)
+ (* '*=)
+ (% '%=)
+ (>> '>>=)
+ (^ '^=)
+ (<< '<<=)
+ (>>> '>>>=)
+ (/ '/=)
+ (t nil)))
+
+(defun make-js-test (lhs rhs)
+ (if (and (typep rhs 'op-form)
+ (member lhs (op-args rhs) :test #'js-equal))
+ (let ((args-without (remove lhs (op-args rhs)
+ :count 1 :test #'js-equal))
+ (args-without-first (remove lhs (op-args rhs)
+ :count 1 :end 1
+ :test #'js-equal))
+ (one (list (make-instance 'number-literal :value 1))))
+ #+nil
+ (format t "OPERATOR: ~S, ARGS-WITHOUT: ~S, ARGS-WITHOUT-FIRST ~S~%"
+ (operator rhs)
+ args-without
+ args-without-first)
+ (cond ((and (js-equal args-without one)
+ (eql (operator rhs) '+))
+ (make-instance 'one-op :pre-p nil :op "++"
+ :value lhs))
+ ((and (js-equal args-without-first one)
+ (eql (operator rhs) '-))
+ (make-instance 'one-op :pre-p nil :op "--"
+ :value lhs))
+ ((and (assignment-op (operator rhs))
+ (member (operator rhs)
+ '(+ *))
+ (js-equal lhs (first (op-args rhs))))
+ (make-instance 'op-form
+ :operator (assignment-op (operator rhs))
+ :args (list lhs (make-instance 'op-form
+ :operator (operator rhs)
+ :args args-without-first))))
+ ((and (assignment-op (operator rhs))
+ (js-equal (first (op-args rhs)) lhs))
+ (make-instance 'op-form
+ :operator (assignment-op (operator rhs))
+ :args (list lhs (make-instance 'op-form
+ :operator (operator rhs)
+ :args (cdr (op-args rhs))))))
+ (t (make-instance 'js-setf :lhs lhs :rhsides (list rhs)))))
+ (make-instance 'js-setf :lhs lhs :rhsides (list rhs))))
+
+(define-script-special-form setf (&rest args)
+ (let ((assignments (loop for (lhs rhs) on args by #'cddr
+ for rexpr = (compile-to-expression rhs)
+ for lexpr = (compile-to-expression lhs)
+ collect (make-js-test lexpr rexpr))))
+ (if (= (length assignments) 1)
+ (first assignments)
+ (make-instance 'js-block :indent "" :statements assignments))))
+
+(defmethod expression-precedence ((setf js-setf))
+ (op-precedence '=))
+
+;;; defvar
+(define-script-special-form defvar (name &optional value)
+ (make-instance 'js-defvar :names (list (compile-to-symbol name))
+ :value (when value (compile-to-expression value))))
+
+;;; iteration
+(defun make-for-vars (decls)
+ (loop for decl in decls
+ for var = (if (atom decl) decl (first decl))
+ for init = (if (atom decl) nil (second decl))
+ collect (make-instance 'js-defvar :names (list (compile-to-symbol var))
+ :value (compile-to-expression init))))
+
+(defun make-for-steps (decls)
+ (loop for decl in decls
+ when (= (length decl) 3)
+ collect (compile-to-expression (third decl))))
+
+(define-script-special-form do (decls termination &rest body)
+ (let ((vars (make-for-vars decls))
+ (steps (make-for-steps decls))
+ (check (compile-to-expression (list 'not (first termination))))
+ (body (compile-to-block (cons 'progn body) :indent " ")))
+ (make-instance 'js-for
+ :vars vars
+ :steps steps
+ :check check
+ :body body)))
+
+(define-script-special-form doeach (decl &rest body)
+ (make-instance 'for-each :name (compile-to-symbol (first decl))
+ :value (compile-to-expression (second decl))
+ :body (compile-to-block (cons 'progn body) :indent " ")))
+
+(define-script-special-form while (check &rest body)
+ (make-instance 'js-while
+ :check (compile-to-expression check)
+ :body (compile-to-block (cons 'progn body) :indent " ")))
+
+;;; with
+(define-script-special-form with (statement &rest body)
+ (make-instance 'js-with
+ :obj (compile-to-expression statement)
+ :body (compile-to-block (cons 'progn body) :indent " ")))
+
+
+;;; try-catch
+(define-script-special-form try (body &rest clauses)
+ (let ((body (compile-to-block body :indent " "))
+ (catch (cdr (assoc :catch clauses)))
+ (finally (cdr (assoc :finally clauses))))
+ (assert (not (cdar catch)) nil "Sorry, currently only simple catch forms are supported.")
+ (make-instance 'js-try
+ :body body
+ :catch (when catch (list (compile-to-symbol (caar catch))
+ (compile-to-block (cons 'progn (cdr catch))
+ :indent " ")))
+ :finally (when finally (compile-to-block (cons 'progn finally)
+ :indent " ")))))
+;;; regex
+(define-script-special-form regex (regex)
+ (make-instance 'regex :value (string regex)))
+
+;;; TODO instanceof
+(define-script-special-form instanceof (value type)
+ (make-instance 'js-instanceof
+ :value (compile-to-expression value)
+ :type (compile-to-expression type)))
+
+;;; single operations
+(defmacro define-parse-script-single-op (name &optional (superclass 'expression))
+ (let ((script-name (intern (concatenate 'string "JS-" (symbol-name name)) #.*package*)))
+ `(define-script-special-form ,name (value)
+ (make-instance ',script-name :value (compile-to-expression value)))
+ ))
+
+(define-parse-script-single-op return statement)
+(define-parse-script-single-op throw statement)
+(define-parse-script-single-op delete)
+(define-parse-script-single-op void)
+(define-parse-script-single-op typeof)
+(define-parse-script-single-op new)
+
+;;; conditional compilation
+(define-script-special-form cc-if (test &rest body)
+ (make-instance 'cc-if :test test
+ :body (mapcar #'compile-script-form body)))
+
+;;; standard macros
+(defscriptmacro with-slots (slots object &rest body)
+ `(symbol-macrolet ,(mapcar #'(lambda (slot)
+ `(,slot '(slot-value ,object ',slot)))
+ slots)
+ ,@body))
+
+(defscriptmacro when (test &rest body)
+ `(if ,test (progn ,@body)))
+
+(defscriptmacro unless (test &rest body)
+ `(if (not ,test) (progn ,@body)))
+
+(defscriptmacro 1- (form)
+ `(- ,form 1))
+
+(defscriptmacro 1+ (form)
+ `(+ ,form 1))
+
+;;; Math library
+(defscriptmacro floor (expr)
+ `(*Math.floor ,expr))
+
+(defscriptmacro random ()
+ `(*Math.random))
+
+(defscriptmacro evenp (num)
+ `(= (% ,num 2) 0))
+
+(defscriptmacro oddp (num)
+ `(= (% ,num 2) 1))
+
+;;; helper macros
+(define-script-special-form js (&rest body)
+ (make-instance 'string-literal
+ :value (string-join (js-to-statement-strings
+ (compile-script-form (cons 'progn body)) 0) " ")))
+
+(define-script-special-form script-inline (&rest body)
+ (make-instance 'string-literal
+ :value (concatenate
+ 'string
+ "javascript:"
+ (string-join (js-to-statement-strings
+ (compile-script-form (cons 'progn body)) 0) " "))))
+(defscriptmacro js-inline (&rest body)
+ `(script-inline ,@body))
(defgeneric script-equal (compiled-ast-node1 compiled-ast-node2)
(:documentation "Determines if the AST nodes are equal."))
-(defgeneric expression-precedence (expression)
- (:documentation "Returns the precedence of an enscript-javascript expression"))
-
;;; AST node equality
(defmethod script-equal ((obj1 list) (obj2 list))
(and (= (length obj1) (length obj2))
(slot-value obj2 slot)))
',slot-names)))))
-;;; js language types
+(in-package :parenscript.javascript)
+
+(defgeneric expression-precedence (expression)
+ (:documentation "Returns the precedence of an enscript-javascript expression"))
+
+;;;; define Javascript language types
(defclass statement ()
((value :initarg :value :accessor value :initform nil))
(:documentation "A Javascript entity without a value."))
(defscriptclass array-literal (expression)
((values :initarg :values :accessor array-values)))
-(defscriptclass script-aref (expression)
+(defscriptclass js-aref (expression)
((array :initarg :array
:accessor aref-array)
(index :initarg :index
(value))
;;; variables
-(defscriptclass script-variable (expression)
+(defscriptclass js-variable (expression)
(value))
-;;; quote
-(defscriptclass script-quote (expression)
- ())
-
;;; operators
(defscriptclass op-form (expression)
((operator :initarg :operator :accessor operator)
(args :initarg :args :accessor op-args)))
(eval-when (:compile-toplevel :load-toplevel :execute)
-
(defparameter *op-precedence-hash* (make-hash-table :test #'equal))
;;; generate the operator precedences from *OP-PRECEDENCES*
(args :initarg :args :accessor m-args)))
;;; body forms
-(defscriptclass script-body (expression)
- ((statements :initarg :statements :accessor b-statements)
- (indent :initarg :indent :initform "" :accessor b-indent)))
+(defscriptclass js-block (expression)
+ ((statements :initarg :statements :accessor block-statements)
+ (indent :initarg :indent :initform "" :accessor block-indent)))
-(defmethod initialize-instance :after ((body script-body) &rest initargs)
+(defmethod initialize-instance :after ((block js-block) &rest initargs)
(declare (ignore initargs))
- (let* ((statements (b-statements body))
+ (let* ((statements (block-statements block))
(last (last statements))
(last-stmt (car last)))
- (when (typep last-stmt 'script-body)
- (setf (b-statements body)
+ (when (typep last-stmt 'js-block)
+ (setf (block-statements block)
(nconc (butlast statements)
- (b-statements last-stmt))))))
+ (block-statements last-stmt))))))
-(defscriptclass script-sub-body (script-body)
+(defscriptclass js-sub-block (js-block)
(statements indent))
;;; function definition
-(defscriptclass script-lambda (expression)
+(defscriptclass js-lambda (expression)
((args :initarg :args :accessor lambda-args)
(body :initarg :body :accessor lambda-body)))
-(defscriptclass script-defun (script-lambda)
+(defscriptclass js-defun (js-lambda)
((name :initarg :name :accessor defun-name)))
;;; object creation
-(defscriptclass script-object (expression)
+(defscriptclass js-object (expression)
((slots :initarg :slots
:accessor o-slots)))
-(defscriptclass script-slot-value (expression)
+(defscriptclass js-slot-value (expression)
((object :initarg :object
:accessor sv-object)
(slot :initarg :slot
:accessor sv-slot)))
;;; cond
-(defscriptclass script-cond (expression)
+(defscriptclass js-cond (expression)
((tests :initarg :tests
:accessor cond-tests)
(bodies :initarg :bodies
:accessor cond-bodies)))
-(defscriptclass script-if (expression)
+(defscriptclass js-if (expression)
((test :initarg :test
:accessor if-test)
(then :initarg :then
(else :initarg :else
:accessor if-else)))
-(defmethod initialize-instance :after ((if script-if) &rest initargs)
+(defmethod initialize-instance :after ((if js-if) &rest initargs)
(declare (ignore initargs))
(when (and (if-then if)
- (typep (if-then if) 'script-sub-body))
- (change-class (if-then if) 'script-body))
+ (typep (if-then if) 'js-sub-block))
+ (change-class (if-then if) 'js-block))
(when (and (if-else if)
- (typep (if-else if) 'script-sub-body))
- (change-class (if-else if) 'script-body)))
+ (typep (if-else if) 'js-sub-block))
+ (change-class (if-else if) 'js-block)))
;;; switch
-(defscriptclass script-switch (statement)
+(defscriptclass js-switch (statement)
((value :initarg :value :accessor case-value)
(clauses :initarg :clauses :accessor case-clauses)))
;;; assignment
-(defscriptclass script-setf (expression)
+(defscriptclass js-setf (expression)
((lhs :initarg :lhs :accessor setf-lhs)
(rhsides :initarg :rhsides :accessor setf-rhsides)))
;;; defvar
-(defscriptclass script-defvar (statement)
+(defscriptclass js-defvar (statement)
((names :initarg :names :accessor var-names)
(value :initarg :value :accessor var-value)))
;;; iteration
-(defscriptclass script-for (statement)
+(defscriptclass js-for (statement)
((vars :initarg :vars :accessor for-vars)
(steps :initarg :steps :accessor for-steps)
(check :initarg :check :accessor for-check)
(value :initarg :value :accessor fe-value)
(body :initarg :body :accessor fe-body)))
-(defscriptclass script-while (statement)
+(defscriptclass js-while (statement)
((check :initarg :check :accessor while-check)
(body :initarg :body :accessor while-body)))
;;; with
-(defscriptclass script-with (statement)
+(defscriptclass js-with (statement)
((obj :initarg :obj :accessor with-obj)
(body :initarg :body :accessor with-body)))
;;; try-catch
-(defscriptclass script-try (statement)
+(defscriptclass js-try (statement)
((body :initarg :body :accessor try-body)
(catch :initarg :catch :accessor try-catch)
(finally :initarg :finally :accessor try-finally)))
;; TODO this may not be the best integrated implementation of
;; instanceof into the rest of the code
-(defscriptclass script-instanceof (expression)
+(defscriptclass js-instanceof (expression)
((value)
(type :initarg :type)))
-(defmacro define-script-single-op (name &optional (superclass 'expression))
- (let ((script-name (intern (concatenate 'string "SCRIPT-" (symbol-name name)) #.*package*)))
+(defmacro define-js-single-op (name &optional (superclass 'expression))
+ (let ((js-name (intern (concatenate 'string "JS-" (symbol-name name)) #.*package*)))
`(progn
- (defscriptclass ,script-name (,superclass)
+ (defscriptclass ,js-name (,superclass)
(value)))))
-(define-script-single-op return statement)
-(define-script-single-op throw statement)
-(define-script-single-op delete)
-(define-script-single-op void)
-(define-script-single-op typeof)
-(define-script-single-op new)
-
-;;; for script-package stuff
-(defscriptclass blank-statement (statement)
- ()
- (:documentation "An empty statement that does nothing."))
\ No newline at end of file
+(define-js-single-op return statement)
+(define-js-single-op throw statement)
+(define-js-single-op delete)
+(define-js-single-op void)
+(define-js-single-op typeof)
+(define-js-single-op new)
\ No newline at end of file
-(in-package :parenscript)
-
+(in-package :parenscript.javascript)
(defgeneric js-to-strings (expression start-pos)
(:documentation "Transform an enscript-javascript expression to a string"))
:start "[ " :end " ]"
:join-after ",")))
-(defmethod js-to-strings ((aref script-aref) start-pos)
+(defmethod js-to-strings ((aref js-aref) start-pos)
(dwim-join (cons (js-to-strings (aref-array aref) start-pos)
(mapcar #'(lambda (x) (dwim-join (list (js-to-strings x (+ start-pos 2)))
(- 80 start-pos 2)
;;; object literals (maps and hash-tables)
(defmethod js-to-strings ((obj object-literal) start-pos)
- (dwim-join (loop
- for (key . value) in (object-values obj)
- append (list
- (dwim-join (list (list (format nil "~A:" (symbol-to-js key)))
- (js-to-strings value (+ start-pos 2)))
- (- 80 start-pos 2)
- :start "" :end "" :join-after "")))
- (- 80 start-pos 2)
- :start "{ " :end " }"
- :join-after ","))
+ (dwim-join
+ (loop
+ for (key . value) in (object-values obj)
+ append (list
+ (dwim-join (list (list (format nil "~A:" (js-translate-symbol key)))
+ (js-to-strings value (+ start-pos 2)))
+ (- 80 start-pos 2)
+ :start "" :end "" :join-after "")))
+ (- 80 start-pos 2)
+ :start "{ " :end " }"
+ :join-after ","))
;;; string literals
(#\r . #\Return)
(#\t . #\Tab)))
-(defun lisp-special-char-to-js(lisp-char)
+(defun lisp-special-char-to-js (lisp-char)
(car (rassoc lisp-char *js-lisp-escaped-chars*)))
(defmethod js-to-strings ((string string-literal) start-pos)
finally (write-char *js-quote-char* escaped)))))
;;; variables
-(defmethod js-to-strings ((v script-variable) start-form)
+(defgeneric js-translate-symbol (var)
+ (:documentation "Given a JS-VARIABLE returns an output
+JavaScript version of it as a string."))
+
+(defmethod js-translate-symbol ((var js-variable))
+ (js-translate-symbol (value var)))
+
+(defmethod js-translate-symbol ((var-name symbol))
+ (if parenscript::*enable-package-system*
+ (case *package-prefix-style*
+ (:prefix
+ (cond
+ ((or (eql (symbol-package var-name) (find-package :keyword))
+ (eql (symbol-package var-name) (find-package :parenscript.global)))
+ (symbol-to-js var-name))
+ (t
+ (let ((script-package (symbol-script-package var-name)))
+ (format nil "~A_~A"
+ (symbol-to-js (script-package-name script-package))
+ (symbol-to-js var-name))))))
+ (t
+ (symbol-to-js (value var-name))))
+ (symbol-to-js var-name)))
+
+(defmethod js-to-strings ((v js-variable) start-form)
(declare (ignore start-form))
- (list (symbol-to-js (value v))))
+ (list (js-translate-symbol v)))
;;; arithmetic operators
(defun script-convert-op-name (op)
(args (dwim-join value-string-lists max-length
:start "(" :end ")" :join-after ",")))
(etypecase (f-function form)
- (script-lambda
+ (js-lambda
(dwim-join (list (append (dwim-join (list (js-to-strings (f-function form) (+ start-pos 2)))
max-length
:start "(" :end ")" :separator "")
args))
max-length
:separator ""))
- ((or script-variable script-aref script-slot-value)
+ ((or js-variable js-aref js-slot-value)
(dwim-join (list (js-to-strings (f-function form) (+ start-pos 2))
args)
max-length
;; TODO: this may not be the best way to add ()'s around lambdas
;; probably there is or should be a more general solution working
;; in other situations involving lambda's
- (when (member (m-object form) (list 'script-lambda 'number-literal 'script-object 'op-form) :test #'typep)
+ (when (member (m-object form) (list 'js-lambda 'number-literal 'js-object 'op-form)
+ :test #'typep)
(push "(" object)
(nconc object (list ")")))
(let* ((fname (dwim-join (list object
- (list (symbol-to-js (m-method form))))
+ (list (js-translate-symbol (m-method form))))
(- 80 start-pos 2)
:end "("
:separator ""))
(list ensure-no-newline-before-dot)
(rest method-and-args)))))
-(defmethod js-to-statement-strings ((body script-body) start-pos)
+;;; optimization that gets rid of nested blocks, which have no meaningful effect
+;;; in javascript
+(defgeneric expanded-subblocks (block)
+ (:method (block)
+ (list block))
+ (:method ((block js-block))
+ (mapcan #'expanded-subblocks (block-statements block))))
+
+(defun consolidate-subblocks (block)
+ (setf (block-statements block) (expanded-subblocks block))
+ block)
+
+
+(defmethod js-to-statement-strings ((body js-block) start-pos)
+ (consolidate-subblocks body)
(dwim-join (mapcar #'(lambda (x) (js-to-statement-strings x (+ start-pos 2)))
- (b-statements body))
+ (block-statements body))
(- 80 start-pos 2)
:join-after ";"
:append-to-last #'special-append-to-last
- :start (b-indent body) :collect nil
+ :start (block-indent body) :collect nil
:end ";"))
-(defmethod js-to-strings ((body script-body) start-pos)
+(defmethod js-to-strings ((body js-block) start-pos)
(dwim-join (mapcar #'(lambda (x) (js-to-strings x (+ start-pos 2)))
- (b-statements body))
+ (block-statements body))
(- 80 start-pos 2)
:append-to-last #'special-append-to-last
:join-after ","
- :start (b-indent body)))
+ :start (block-indent body)))
-(defmethod js-to-statement-strings ((body script-sub-body) start-pos)
+(defmethod js-to-statement-strings ((body js-sub-block) start-pos)
(declare (ignore start-pos))
(nconc (list "{") (call-next-method) (list "}")))
;;; function definition
-(defmethod js-to-strings ((lambda script-lambda) start-pos)
+(defmethod js-to-strings ((lambda js-lambda) start-pos)
(let ((fun-header (dwim-join (mapcar #'(lambda (x)
- (list (symbol-to-js x)))
+ (list (js-translate-symbol x)))
(lambda-args lambda))
(- 80 start-pos 2)
:start (function-start-string lambda)
(:documentation "Returns the string that starts the function - this varies according to whether
this is a lambda or a defun"))
-(defmethod function-start-string ((lambda script-lambda))
+(defmethod function-start-string ((lambda js-lambda))
"function (")
-(defmethod js-to-statement-strings ((lambda script-lambda) start-pos)
+(defmethod js-to-statement-strings ((lambda js-lambda) start-pos)
(js-to-strings lambda start-pos))
-(defmethod function-start-string ((defun script-defun))
- (format nil "function ~A(" (symbol-to-js (defun-name defun))))
+(defmethod function-start-string ((defun js-defun))
+ (format nil "function ~A(" (js-translate-symbol (defun-name defun))))
;;; object creation
-(defmethod js-to-strings ((object script-object) start-pos)
+(defmethod js-to-strings ((object js-object) start-pos)
(let ((value-string-lists
(mapcar #'(lambda (slot)
(dwim-join (list (js-to-strings (second slot) (+ start-pos 4)))
:white-space " "
:collect nil)))
-(defmethod js-to-strings ((sv script-slot-value) start-pos)
+(defmethod js-to-strings ((sv js-slot-value) start-pos)
(append-to-last (js-to-strings (sv-object sv) start-pos)
(if (typep (sv-slot sv) 'script-quote)
(if (symbolp (value (sv-slot sv)))
- (format nil ".~A" (symbol-to-js (value (sv-slot sv))))
+ (format nil ".~A" (js-translate-symbol (value (sv-slot sv))))
(format nil ".~A" (first (js-to-strings (sv-slot sv) 0))))
(format nil "[~A]" (first (js-to-strings (sv-slot sv) 0))))))
;;; cond
-(defmethod js-to-statement-strings ((cond script-cond) start-pos)
+(defmethod js-to-statement-strings ((cond js-cond) start-pos)
(loop :for body :on (cond-bodies cond)
:for first = (eq body (cond-bodies cond))
:for last = (not (cdr body))
:append (js-to-statement-strings (car body) (+ start-pos 2))
:collect "}"))
-(defmethod js-to-statement-strings ((if script-if) start-pos)
+(defmethod js-to-statement-strings ((if js-if) start-pos)
(let ((if-strings (dwim-join (list (js-to-strings (if-test if) 0))
(- 80 start-pos 2)
:start "if ("
(nconc (list "} else {") else-strings (list "}"))
(list "}")))))
-(defmethod js-to-strings ((if script-if) start-pos)
+(defmethod js-to-strings ((if js-if) start-pos)
(assert (typep (if-then if) 'expression))
(when (if-else if)
(assert (typep (if-else if) 'expression)))
(dwim-join (list (append-to-last (js-to-strings (if-test if) start-pos) " ?")
- (let* ((new-then (make-instance 'script-body
- :statements (b-statements (if-then if))
+ (let* ((new-then (make-instance 'js-block
+ :statements (block-statements (if-then if))
:indent ""))
(res (js-to-strings new-then start-pos)))
(if (>= (expression-precedence (if-then if))
res))
(list ":")
(if (if-else if)
- (let* ((new-else (make-instance 'script-body
- :statements (b-statements (if-else if))
+ (let* ((new-else (make-instance 'js-block
+ :statements (block-statements (if-else if))
:indent ""))
(res (js-to-strings new-else start-pos)))
(if (>= (expression-precedence (if-else if))
:white-space " "))
;;; setf
-(defmethod js-to-strings ((setf script-setf) start-pos)
+(defmethod js-to-strings ((setf js-setf) start-pos)
(dwim-join (cons (js-to-strings (setf-lhs setf) start-pos)
(mapcar #'(lambda (x) (js-to-strings x start-pos)) (setf-rhsides setf)))
(- 80 start-pos 2)
:join-after " ="))
;;; defvar
-(defmethod js-to-statement-strings ((defvar script-defvar) start-pos)
- (dwim-join (nconc (mapcar #'(lambda (x) (list (symbol-to-js x))) (var-names defvar))
+(defmethod js-to-statement-strings ((defvar js-defvar) start-pos)
+ (dwim-join (nconc (mapcar #'(lambda (x) (list (js-translate-symbol x))) (var-names defvar))
(when (var-value defvar)
(list (js-to-strings (var-value defvar) start-pos))))
(- 80 start-pos 2)
:start "var " :end ";"))
;;; iteration
-(defmethod js-to-statement-strings ((for script-for) start-pos)
+(defmethod js-to-statement-strings ((for js-for) start-pos)
(let* ((init (dwim-join (mapcar #'(lambda (x)
- (dwim-join (list (list (symbol-to-js (first (var-names x))))
+ (dwim-join (list (list (js-translate-symbol (first (var-names x))))
(js-to-strings (var-value x)
(+ start-pos 2)))
(- 80 start-pos 2)
(check (js-to-strings (for-check for) (+ start-pos 2)))
(steps (dwim-join (mapcar #'(lambda (x var)
(dwim-join
- (list (list (symbol-to-js (first (var-names var))))
+ (list (list (js-translate-symbol (first (var-names var))))
(js-to-strings x (- start-pos 2)))
(- 80 start-pos 2)
:join-after " ="))
(defmethod js-to-statement-strings ((fe for-each) start-pos)
- (let ((header (dwim-join (list (list (symbol-to-js (fe-name fe)))
+ (let ((header (dwim-join (list (list (js-translate-symbol (fe-name fe)))
(list "in")
(js-to-strings (fe-value fe) (+ start-pos 2)))
(- 80 start-pos 2)
(body (js-to-statement-strings (fe-body fe) (+ start-pos 2))))
(nconc header body (list "}"))))
-(defmethod js-to-statement-strings ((while script-while) start-pos)
+(defmethod js-to-statement-strings ((while js-while) start-pos)
(let ((header (dwim-join (list (js-to-strings (while-check while) (+ start-pos 2)))
(- 80 start-pos 2)
:start "while ("
(nconc header body (list "}"))))
;;; with
-(defmethod js-to-statement-strings ((with script-with) start-pos)
+(defmethod js-to-statement-strings ((with js-with) start-pos)
(nconc (dwim-join (list (js-to-strings (with-obj with) (+ start-pos 2)))
(- 80 start-pos 2)
:start "with (" :end ") {")
(list "}")))
;;; switch
-(defmethod js-to-statement-strings ((case script-switch) start-pos)
+(defmethod js-to-statement-strings ((case js-switch) start-pos)
(let ((body (mapcan #'(lambda (clause)
(let ((val (car clause))
(body (second clause)))
(list "}"))))
;;; try-catch
-(defmethod js-to-statement-strings ((try script-try) start-pos)
+(defmethod js-to-statement-strings ((try js-try) start-pos)
(let* ((catch (try-catch try))
(finally (try-finally try))
(catch-list (when catch
(nconc
- (dwim-join (list (list (symbol-to-js (first catch))))
+ (dwim-join (list (list (js-translate-symbol (first catch))))
(- 80 start-pos 2)
:start "} catch ("
:end ") {")
;;; TODO instanceof
-(defmethod js-to-strings ((instanceof script-instanceof) start-pos)
+(defmethod js-to-strings ((instanceof js-instanceof) start-pos)
(dwim-join
(list (js-to-strings (value instanceof) (+ start-pos 2))
(list "instanceof")
;;; single operations
(defmacro define-translate-js-single-op (name &optional (superclass 'expression))
- (let ((script-name (intern (concatenate 'string "SCRIPT-" (symbol-name name)) #.*package*)))
+ (let ((script-name (intern (concatenate 'string "JS-" (symbol-name name)) #.*package*)))
`(defmethod ,(if (eql superclass 'expression)
'js-to-strings
'js-to-statement-strings)
(define-translate-js-single-op delete)
(define-translate-js-single-op void)
(define-translate-js-single-op typeof)
-(define-translate-js-single-op new)
-
-(defmethod js-to-statement-strings ((blank-statement blank-statement) start-pos)
- (declare (ignore blank-statement) (ignore start-pos))
- '(";"))
\ No newline at end of file
+(define-translate-js-single-op new)
\ No newline at end of file
--- /dev/null
+(in-package :parenscript)
+
+(defparameter *js-lisp-escaped-chars*
+ '((#\' . #\')
+ (#\\ . #\\)
+ (#\b . #\Backspace)
+ (#\f . #.(code-char 12))
+ (#\n . #\Newline)
+ (#\r . #\Return)
+ (#\t . #\Tab)))
+
+(defparameter *char-escape-table*
+ (let ((hash (make-hash-table)))
+ (dolist (escape-pair *js-lisp-escaped-chars* hash)
+ (setf (gethash (cdr escape-pair) hash) (car escape-pair)))))
+
+(declaim (inline lisp-special-char-to-js-2))
+(defun lisp-special-char-to-js-2 (lisp-char)
+ "Gets the escaped version "
+ (gethash lisp-char *char-escape-table*))
+
+(defgeneric js-translate (ast-node expression-or-statement stream)
+ (:documentation "Translates the given AST node to Javascript.
+expression-or-statement is either the keyword :statement or :expression"))
+
+(defmacro defjstrans (script-class type-spec (node-var stream-var) &body body)
+ "Generates a translate-to-js definition for the special-form class SCRIPT-CLASS
+where type-spec is either :expression or :statement. STREAM is the output stream
+where we should place the Javascript."
+ (when (not (or (eql :expression type-spec) (eql :statement type-spec)))
+ (error "Invalid type-spec fo DEFJSTRANS form."))
+ `(defmethod js-translate ((,node-var ,script-class) (spec (eql ,type-spec)) ,stream-var)
+ ,@body))
+
+(defjstrans expression :expression (expr stream)
+ (princ (value expr) stream))
+
+(defjstrans expression :statement (expr stream)
+ (princ (value expr) stream))
+
+(defjstrans statement :statement (statement stream)
+ (princ (value statement) stream))
+
+(defmacro dolist+ ((car-var list &key result-form lastp-var) &body body)
+ "Iterates over a list, giving other information in bindings designated
+by the keyword arguments."
+ (let ((sublist-var (gensym)))
+ `(progn
+ (mapl
+ #'(lambda (,sublist-var)
+ (let ((,car-var (car ,sublist-var))
+ ,@(when lastp-var
+ (list `(,lastp-var (not (cdr ,sublist-var))))))
+ ,@body))
+ ,list)
+ ,result-form)))
+
+
+(defjstrans array-literal :expression (array stream)
+ (write-char #\[ stream)
+ (dolist+ (array-item (array-values array) :lastp-var last?)
+ (js-translate array-item :expression stream)
+ (when (not last?) (princ ",")))
+ (write-char #\] stream))
+
+(defjstrans script-aref :expression (aref stream)
+ (js-translate (aref-array aref) :expression stream)
+ (princ "[")
+ (js-translate (aref-index aref) :expression stream)
+ (princ "]"))
+
+(defjstrans object-literal :expression (obj stream)
+ (princ "{")
+ (dolist+ (obj-pair (object-values obj) :lastp-var last?)
+ (js-translate (car obj-pair) :expression stream)
+ (princ ":")
+ (js-translate (cdr obj-pair) :expression stream)
+ (when (not last?) (princ ",")))
+ (princ "}"))
+
+(defjstrans string-literal :expression (string stream)
+ (declare (inline lisp-special-char-to-js-2))
+ (write-char *js-quote-char* stream)
+ (loop
+ for char across (value string)
+ for code = (char-code char)
+ for special = (lisp-special-char-to-js-2 char)
+ do
+ (cond
+ (special
+ (write-char #\\ stream)
+ (write-char special stream))
+ ((or (<= code #x1f) (>= code #x80))
+ (format stream "\\u~4,'0x" code))
+ (t (write-char char stream)))
+ finally (write-char *js-quote-char* stream)))
+
+(defjstrans script-variable :expression (var stream)
+ (princ (symbol-to-js (value var)) stream))
+
+(defjstrans op-form :expression (op-form stream)
+ (let ((precedence (expression-precedence op-form)))
+ (flet ((output-op-arg (op-arg)
+ (let ((parens? (>= (expression-precedence op-arg) precedence)))
+ (when parens? (write-char #\())
+ (js-translate op-arg :expression stream)
+ (when parens? (write-char #\))))))
+ (output-op-arg (first (op-args op-form)))
+ (format stream "~A " (operator op-form))
+ (output-op-arg (second (op-args op-form))))))
+
+(defjstrans one-op :expression (one-op stream)
+ (let ((pre? (one-op-pre-p one-op)))
+ (when pre?
+ (princ (one-op one-op) stream))
+ (js-translate (value one-op) :expression stream)
+ (when (not pre?)
+ (princ (one-op one-op) stream))))
\ No newline at end of file
+++ /dev/null
-(in-package :parenscript)
-
-;;;; The macrology of the basic Parenscript language. Special forms and macros in the
-;;;; Parenscript language.
-
-;;; parenscript gensyms
-(defvar *gen-script-name-counter* 0)
-
-(defun gen-script-name-string (&key (prefix "_ps_"))
- "Generates a unique valid javascript identifier ()"
- (concatenate 'string
- prefix (princ-to-string (incf *gen-script-name-counter*))))
-
-(defun gen-script-name (&key (prefix "_ps_"))
- "Generate a new javascript identifier."
- (intern (gen-script-name-string :prefix prefix)
- (find-package :js)))
-
-(defmacro with-unique-js-names (symbols &body body)
- "Evaluate BODY with the variables on SYMBOLS bound to new javascript identifiers.
-
-Each element of SYMBOLS is either a symbol or a list of (symbol
-prefix)."
- `(let* ,(mapcar (lambda (symbol)
- (destructuring-bind (symbol &optional prefix)
- (if (consp symbol)
- symbol
- (list symbol))
- (if prefix
- `(,symbol (gen-script-name :prefix ,prefix))
- `(,symbol (gen-script-name)))))
- symbols)
- ,@body))
-
-(defvar *var-counter* 0)
-
-(defun script-gensym (&optional (name "js"))
- (intern (format nil "tmp-~A-~A" name (incf *var-counter*)) #.*package*))
-
-;;; literals
-(defmacro defscriptliteral (name string)
- "Define a Javascript literal that will expand to STRING."
- `(define-script-special-form ,name () (make-instance 'expression :value ,string)))
-
-(defscriptliteral this "this")
-(defscriptliteral t "true")
-(defscriptliteral nil "null")
-(defscriptliteral false "false")
-(defscriptliteral undefined "undefined")
-
-(defmacro defscriptkeyword (name string)
- "Define a Javascript keyword that will expand to STRING."
- `(define-script-special-form ,name () (make-instance 'statement :value ,string)))
-
-(defscriptkeyword break "break")
-(defscriptkeyword continue "continue")
-
-;;; array literals
-(define-script-special-form array (&rest values)
- (make-instance 'array-literal
- :values (mapcar #'compile-to-expression values)))
-
-(defscriptmacro list (&rest values)
- `(array ,@values))
-
-(define-script-special-form aref (array &rest coords)
- (make-instance 'script-aref
- :array (compile-to-expression array)
- :index (mapcar #'compile-to-expression coords)))
-
-
-(defscriptmacro make-array (&rest inits)
- `(new (*array ,@inits)))
-
-;;; object literals (maps and hash-tables)
-(define-script-special-form {} (&rest values)
- (make-instance 'object-literal
- :values (loop
- for (key value) on values by #'cddr
- collect (cons key (compile-to-expression value)))))
-
-;;; operators
-(define-script-special-form ++ (x)
- (make-instance 'one-op :pre-p nil :op "++"
- :value (compile-to-expression x)))
-
-(define-script-special-form -- (x)
- (make-instance 'one-op :pre-p nil :op "--"
- :value (compile-to-expression x)))
-
-(define-script-special-form incf (x &optional (delta 1))
- (if (eql delta 1)
- (make-instance 'one-op :pre-p t :op "++"
- :value (compile-to-expression x))
- (make-instance 'op-form
- :operator '+=
- :args (mapcar #'compile-to-expression
- (list x delta )))))
-
-(define-script-special-form decf (x &optional (delta 1))
- (if (eql delta 1)
- (make-instance 'one-op :pre-p t :op "--"
- :value (compile-to-expression x))
- (make-instance 'op-form
- :operator '-=
- :args (mapcar #'compile-to-expression
- (list x delta )))))
-
-(define-script-special-form - (first &rest rest)
- (if (null rest)
- (make-instance 'one-op
- :pre-p t
- :op "-"
- :value (compile-to-expression first))
- (make-instance 'op-form
- :operator '-
- :args (mapcar #'compile-to-expression
- (cons first rest)))))
-
-(define-script-special-form not (x)
- (let ((value (compile-to-expression x)))
- (if (and (typep value 'op-form)
- (= (length (op-args value)) 2))
- (let ((new-op (case (operator value)
- (== '!=)
- (< '>=)
- (> '<=)
- (<= '>)
- (>= '<)
- (!= '==)
- (=== '!==)
- (!== '===)
- (t nil))))
- (if new-op
- (make-instance 'op-form :operator new-op
- :args (op-args value))
- (make-instance 'one-op :pre-p t :op "!"
- :value value)))
- (make-instance 'one-op :pre-p t :op "!"
- :value value))))
-
-(define-script-special-form ~ (x)
- (let ((expr (compile-to-expression x)))
- (make-instance 'one-op :pre-p t :op "~" :value expr)))
-
-;;; progn
-(define-script-special-form progn (&rest body)
- (make-instance 'script-body
- :statements (mapcar #'compile-to-statement body)))
-
-(defmethod expression-precedence ((body script-body))
- (if (= (length (b-statements body)) 1)
- (expression-precedence (first (b-statements body)))
- (op-precedence 'comma)))
-
-;;; function definition
-(define-script-special-form lambda (args &rest body)
- (make-instance 'script-lambda
- :args (mapcar #'compile-to-symbol args)
- :body (make-instance 'script-body
- :indent " "
- :statements (mapcar #'compile-to-statement body))))
-
-(define-script-special-form defun (name args &rest body)
- (make-instance 'script-defun
- :name (compile-to-symbol name)
- :args (mapcar #'compile-to-symbol args)
- :body (make-instance 'script-body
- :indent " "
- :statements (mapcar #'compile-to-statement body))))
-
-;;; object creation
-(define-script-special-form create (&rest args)
- (make-instance 'script-object
- :slots (loop for (name val) on args by #'cddr
- collect (let ((name-expr (compile-to-expression name)))
- (assert (or (typep name-expr 'script-variable)
- (typep name-expr 'string-literal)
- (typep name-expr 'number-literal)))
- (list name-expr (compile-to-expression val))))))
-
-
-(define-script-special-form slot-value (obj slot)
- (make-instance 'script-slot-value :object (compile-to-expression obj)
- :slot (compile-script-form slot)))
-
-;;; cond
-(define-script-special-form cond (&rest clauses)
- (make-instance 'script-cond
- :tests (mapcar (lambda (clause) (compile-to-expression (car clause)))
- clauses)
- :bodies (mapcar (lambda (clause) (compile-to-body (cons 'progn (cdr clause)) :indent " "))
- clauses)))
-
-;;; if
-(define-script-special-form if (test then &optional else)
- (make-instance 'script-if :test (compile-to-expression test)
- :then (compile-to-body then :indent " ")
- :else (when else
- (compile-to-body else :indent " "))))
-
-(defmethod expression-precedence ((if script-if))
- (op-precedence 'if))
-
-;;; switch
-(define-script-special-form switch (value &rest clauses)
- (let ((clauses (mapcar #'(lambda (clause)
- (let ((val (first clause))
- (body (cdr clause)))
- (list (if (eql val 'default)
- 'default
- (compile-to-expression val))
- (compile-to-body (cons 'progn body) :indent " "))))
- clauses))
- (check (compile-to-expression value)))
- (make-instance 'script-switch :value check
- :clauses clauses)))
-
-
-(defscriptmacro case (value &rest clauses)
- (labels ((make-clause (val body more)
- (cond ((listp val)
- (append (mapcar #'list (butlast val))
- (make-clause (first (last val)) body more)))
- ((member val '(t otherwise))
- (make-clause 'default body more))
- (more `((,val ,@body break)))
- (t `((,val ,@body))))))
- `(switch ,value ,@(mapcon #'(lambda (x)
- (make-clause (car (first x))
- (cdr (first x))
- (rest x)))
- clauses))))
-
-;;; assignment
-(defun assignment-op (op)
- (case op
- (+ '+=)
- (~ '~=)
- (\& '\&=)
- (\| '\|=)
- (- '-=)
- (* '*=)
- (% '%=)
- (>> '>>=)
- (^ '^=)
- (<< '<<=)
- (>>> '>>>=)
- (/ '/=)
- (t nil)))
-
-(defun make-js-test (lhs rhs)
- (if (and (typep rhs 'op-form)
- (member lhs (op-args rhs) :test #'js-equal))
- (let ((args-without (remove lhs (op-args rhs)
- :count 1 :test #'js-equal))
- (args-without-first (remove lhs (op-args rhs)
- :count 1 :end 1
- :test #'js-equal))
- (one (list (make-instance 'number-literal :value 1))))
- #+nil
- (format t "OPERATOR: ~S, ARGS-WITHOUT: ~S, ARGS-WITHOUT-FIRST ~S~%"
- (operator rhs)
- args-without
- args-without-first)
- (cond ((and (js-equal args-without one)
- (eql (operator rhs) '+))
- (make-instance 'one-op :pre-p nil :op "++"
- :value lhs))
- ((and (js-equal args-without-first one)
- (eql (operator rhs) '-))
- (make-instance 'one-op :pre-p nil :op "--"
- :value lhs))
- ((and (assignment-op (operator rhs))
- (member (operator rhs)
- '(+ *))
- (js-equal lhs (first (op-args rhs))))
- (make-instance 'op-form
- :operator (assignment-op (operator rhs))
- :args (list lhs (make-instance 'op-form
- :operator (operator rhs)
- :args args-without-first))))
- ((and (assignment-op (operator rhs))
- (js-equal (first (op-args rhs)) lhs))
- (make-instance 'op-form
- :operator (assignment-op (operator rhs))
- :args (list lhs (make-instance 'op-form
- :operator (operator rhs)
- :args (cdr (op-args rhs))))))
- (t (make-instance 'script-setf :lhs lhs :rhsides (list rhs)))))
- (make-instance 'script-setf :lhs lhs :rhsides (list rhs))))
-
-(define-script-special-form setf (&rest args)
- (let ((assignments (loop for (lhs rhs) on args by #'cddr
- for rexpr = (compile-to-expression rhs)
- for lexpr = (compile-to-expression lhs)
- collect (make-js-test lexpr rexpr))))
- (if (= (length assignments) 1)
- (first assignments)
- (make-instance 'script-body :indent "" :statements assignments))))
-
-(defmethod expression-precedence ((setf script-setf))
- (op-precedence '=))
-
-;;; defvar
-(define-script-special-form defvar (name &optional value)
- (make-instance 'script-defvar :names (list (compile-to-symbol name))
- :value (when value (compile-to-expression value))))
-
-;;; let
-(define-script-special-form let (decls &rest body)
- (let ((defvars (mapcar #'(lambda (decl)
- (if (atom decl)
- (make-instance 'script-defvar
- :names (list (compile-to-symbol decl))
- :value nil)
- (let ((name (first decl))
- (value (second decl)))
- (make-instance 'script-defvar
- :names (list (compile-to-symbol name))
- :value (compile-to-expression value)))))
- decls)))
- (make-instance 'script-sub-body
- :indent " "
- :statements (nconc defvars
- (mapcar #'compile-to-statement body)))))
-
-;;; iteration
-(defun make-for-vars (decls)
- (loop for decl in decls
- for var = (if (atom decl) decl (first decl))
- for init = (if (atom decl) nil (second decl))
- collect (make-instance 'script-defvar :names (list (compile-to-symbol var))
- :value (compile-to-expression init))))
-
-(defun make-for-steps (decls)
- (loop for decl in decls
- when (= (length decl) 3)
- collect (compile-to-expression (third decl))))
-
-(define-script-special-form do (decls termination &rest body)
- (let ((vars (make-for-vars decls))
- (steps (make-for-steps decls))
- (check (compile-to-expression (list 'not (first termination))))
- (body (compile-to-body (cons 'progn body) :indent " ")))
- (make-instance 'script-for
- :vars vars
- :steps steps
- :check check
- :body body)))
-
-(defscriptmacro dotimes (iter &rest body)
- (let ((var (first iter))
- (times (second iter)))
- `(do ((,var 0 (1+ ,var)))
- ((>= ,var ,times))
- ,@body)))
-
-(defscriptmacro dolist (i-array &rest body)
- (let ((var (first i-array))
- (array (second i-array))
- (arrvar (script-gensym "arr"))
- (idx (script-gensym "i")))
- `(let ((,arrvar ,array))
- (do ((,idx 0 (1+ ,idx)))
- ((>= ,idx (slot-value ,arrvar 'length)))
- (let ((,var (aref ,arrvar ,idx)))
- ,@body)))))
-
-(define-script-special-form doeach (decl &rest body)
- (make-instance 'for-each :name (compile-to-symbol (first decl))
- :value (compile-to-expression (second decl))
- :body (compile-to-body (cons 'progn body) :indent " ")))
-
-(define-script-special-form while (check &rest body)
- (make-instance 'script-while
- :check (compile-to-expression check)
- :body (compile-to-body (cons 'progn body) :indent " ")))
-
-;;; with
-(define-script-special-form with (statement &rest body)
- (make-instance 'script-with
- :obj (compile-to-expression statement)
- :body (compile-to-body (cons 'progn body) :indent " ")))
-
-
-;;; try-catch
-(define-script-special-form try (body &rest clauses)
- (let ((body (compile-to-body body :indent " "))
- (catch (cdr (assoc :catch clauses)))
- (finally (cdr (assoc :finally clauses))))
- (assert (not (cdar catch)) nil "Sorry, currently only simple catch forms are supported.")
- (make-instance 'script-try
- :body body
- :catch (when catch (list (compile-to-symbol (caar catch))
- (compile-to-body (cons 'progn (cdr catch))
- :indent " ")))
- :finally (when finally (compile-to-body (cons 'progn finally)
- :indent " ")))))
-;;; regex
-(define-script-special-form regex (regex)
- (make-instance 'regex :value (string regex)))
-
-;;; TODO instanceof
-(define-script-special-form instanceof (value type)
- (make-instance 'script-instanceof
- :value (compile-to-expression value)
- :type (compile-to-expression type)))
-
-;;; eval-when
-(define-script-special-form eval-when (&rest args)
- "(eval-when form-language? (situation*) form*)
-
-The given forms are evaluated only during the given SITUATION in the specified
-FORM-LANGUAGE (either :lisp or :parenscript, def, defaulting to :lisp during
--toplevel and :parenscript during :execute). The accepted SITUATIONS are :execute,
-:scan-toplevel. :scan-toplevel is the phase of compilation when function definitions
-and the like are being added to the compilation environment. :execute is the phase when
-the code is being evaluated by a Javascript engine."
- (multiple-value-bind (body-language situations subforms)
- (process-eval-when-args args)
- (format t "~A~%~A~%"
- (and (compiler-in-situation-p *compilation-environment* :compile-toplevel)
- (find :compile-toplevel situations))
- (compiler-in-situation-p *compilation-environment* :execute)
- (find :execute situations))
- (cond
- ((and (compiler-in-situation-p *compilation-environment* :compile-toplevel)
- (find :compile-toplevel situations))
- (error "Should never be processing eval-when :COMPILE-TOPLEVEL forms from here."))
-
- ((and (compiler-in-situation-p *compilation-environment* :execute)
- (find :execute situations))
- (when (eql body-language :parenscript)
- (let ((form `(progn ,@subforms)))
- (format t "Form: ~A~%" form)
- (compile-to-statement form)))))))
-
-;;; script packages
-(define-script-special-form blank-statement ()
- (make-instance 'blank-statement))
-
-(defscriptmacro defpackage (name &rest options)
- "Defines a Parenscript package."
- (labels ((opt-name (opt) (if (listp opt) (car opt) opt)))
- (let ((nicknames nil) (lisp-package nil) (secondary-lisp-packages nil)
- (exports nil) (used-packages nil) (documentation nil))
- (dolist (opt options)
- (case (opt-name opt)
- (:nicknames (setf nicknames (rest opt)))
- (:secondary-lisp-packages secondary-lisp-packages t)
- (:export (setf exports (rest opt)))
- (:use (setf used-packages (rest opt)))
- (:documentation (setf documentation (second opt)))))
- (create-script-package
- *compilation-environment*
- :name name
- :nicknames nicknames
- :secondary-lisp-packages secondary-lisp-packages
- :used-packages used-packages
- :lisp-package lisp-package
- :exports exports
- :documentation documentation)))
- `(progn))
-
-(defscriptmacro in-package (package-designator)
- "Changes the current script package in the parenscript compilation environment. This mostly
-affects the reader and how it interns non-prefixed symbols"
- (setf (comp-env-current-package
- *compilation-environment*)
- (comp-env-find-package *compilation-environment* package-designator))
- `(progn))
-
-;;; single operations
-(defmacro define-parse-script-single-op (name &optional (superclass 'expression))
- (let ((script-name (intern (concatenate 'string "SCRIPT-" (symbol-name name)) #.*package*)))
- `(define-script-special-form ,name (value)
- (make-instance ',script-name :value (compile-to-expression value)))
- ))
-
-(define-parse-script-single-op return statement)
-(define-parse-script-single-op throw statement)
-(define-parse-script-single-op delete)
-(define-parse-script-single-op void)
-(define-parse-script-single-op typeof)
-(define-parse-script-single-op new)
-
-;;; conditional compilation
-(define-script-special-form cc-if (test &rest body)
- (make-instance 'cc-if :test test
- :body (mapcar #'compile-script-form body)))
-
-;;; standard macros
-(defscriptmacro with-slots (slots object &rest body)
- `(symbol-macrolet ,(mapcar #'(lambda (slot)
- `(,slot '(slot-value ,object ',slot)))
- slots)
- ,@body))
-
-(defscriptmacro when (test &rest body)
- `(if ,test (progn ,@body)))
-
-(defscriptmacro unless (test &rest body)
- `(if (not ,test) (progn ,@body)))
-
-(defscriptmacro 1- (form)
- `(- ,form 1))
-
-(defscriptmacro 1+ (form)
- `(+ ,form 1))
-
-;;; macros
-(defmacro with-temp-macro-environment ((var) &body body)
- `(let* ((,var (make-macro-env-dictionary))
- (*script-macro-env* (cons ,var *script-macro-env*)))
- ,@body))
-
-(define-script-special-form macrolet (macros &body body)
- (with-temp-macro-environment (macro-env-dict)
- (dolist (macro macros)
- (destructuring-bind (name arglist &body body)
- macro
- (setf (get-macro-spec name macro-env-dict)
- (cons nil (let ((args (gensym "ps-macrolet-args-")))
- (compile nil `(lambda (&rest ,args)
- (destructuring-bind ,arglist
- ,args
- ,@body))))))))
- (compile-script-form `(progn ,@body))))
-
-(define-script-special-form symbol-macrolet (symbol-macros &body body)
- (with-temp-macro-environment (macro-env-dict)
- (dolist (macro symbol-macros)
- (destructuring-bind (name &body expansion)
- macro
- (setf (get-macro-spec name macro-env-dict)
- (cons t (compile nil `(lambda () ,@expansion))))))
- (compile-script-form `(progn ,@body))))
-
-(defscriptmacro defmacro (name args &body body)
- `(lisp (defscriptmacro ,name ,args ,@body) nil))
-
-(defscriptmacro lisp (&body forms)
- "Evaluates the given forms in Common Lisp at ParenScript
-macro-expansion time. The value of the last form is treated as a
-ParenScript expression and is inserted into the generated Javascript
-(use nil for no-op)."
- (eval (cons 'progn forms)))
-
-
-(defscriptmacro rebind (variables expression)
- "Creates a new js lexical environment and copies the given
- variable(s) there. Executes the body in the new environment. This
- has the same effect as a new (let () ...) form in lisp but works on
- the js side for js closures."
- (unless (listp variables)
- (setf variables (list variables)))
- `((lambda ()
- (let ((new-context (new *object)))
- ,@(loop for variable in variables
- do (setf variable (symbol-to-js variable))
- collect `(setf (slot-value new-context ,variable) (slot-value this ,variable)))
- (with new-context
- (return ,expression))))))
-
-;;; Math library
-(defscriptmacro floor (expr)
- `(*Math.floor ,expr))
-
-(defscriptmacro random ()
- `(*Math.random))
-
-(defscriptmacro evenp (num)
- `(= (% ,num 2) 0))
-
-(defscriptmacro oddp (num)
- `(= (% ,num 2) 1))
-
-;;; helper macros
-(define-script-special-form js (&rest body)
- (make-instance 'string-literal
- :value (string-join (js-to-statement-strings
- (compile-script-form (cons 'progn body)) 0) " ")))
-
-(define-script-special-form script-inline (&rest body)
- (make-instance 'string-literal
- :value (concatenate
- 'string
- "javascript:"
- (string-join (js-to-statement-strings
- (compile-script-form (cons 'progn body)) 0) " "))))
-(defscriptmacro js-inline (&rest body)
- `(script-inline ,@body))
-
-;;; dual lisp/parenscript macro balderdash
-;;; TODO: should probably move elsewhere ;;;
-(defmacro defmacro/js (name args &body body)
- "Define a Lisp macro and import it into the ParenScript macro environment."
- `(progn (defmacro ,name ,args ,@body)
- (js:import-macros-from-lisp ',name)))
-
-(defmacro defmacro+js (name args &body body)
- "Define a Lisp macro and a ParenScript macro in their respective
-macro environments. This function should be used when you want to use
-the same macro in both Lisp and ParenScript, but the 'macroexpand' of
-that macro in Lisp makes the Lisp macro unsuitable to be imported into
-the ParenScript macro environment."
- `(progn (defmacro ,name ,args ,@body)
- (defscriptmacro ,name ,args ,@body)))
-
-(defun import-macros-from-lisp (&rest names)
- "Import the named Lisp macros into the ParenScript macro environment."
- (dolist (name names)
- (let ((name name))
- (undefine-js-special-form name)
- (setf (get-macro-spec name *script-macro-toplevel*)
- (cons nil (lambda (&rest args)
- (macroexpand `(,name ,@args))))))))
-
-(defmacro js-file (&rest body)
- `(html
- (:princ
- (js ,@body))))
-
-(defmacro js-script (&rest body)
- `((:script :type "text/javascript")
- (:princ (format nil "~%// <![CDATA[~%"))
- (:princ (js ,@body))
- (:princ (format nil "~%// ]]>~%"))))
-
-(defmacro js-inline (&rest body)
- `(js-inline* '(progn ,@body)))
-
-(defmacro js-inline* (&rest body)
- "Just like JS-INLINE except that BODY is evaluated before being
-converted to javascript."
- `(concatenate 'string "javascript:"
- (string-join (js-to-statement-strings (compile-script-form (list 'progn ,@body)) 0) " ")))
(in-package :cl-user)
-(defpackage :parenscript
+(defpackage parenscript.javascript
(:use :common-lisp)
+ (:nicknames javascript ps-js)
+ (:export
+
+ #:new
+ ;; literals
+ #:t
+ #:nil
+ #:this
+ #:false
+ #:undefined
+
+ ;; keywords
+ #:break
+ #:continue
+
+ ;; array literals
+ #:array
+ #:list
+ #:aref
+ #:make-array
+
+ ;; operators
+ #:! #:not #:~
+ #:* #:/ #:%
+ #:+ #:-
+ #:<< #:>>
+ #:>>>
+ #:< #:> #:<= #:>=
+ #:in
+ #:eql #:== #:!= #:=
+ #:=== #:!==
+ #:&
+ #:^
+ #:\|
+ #:\&\& #:and
+ #:\|\| #:or
+ #:>>= #:<<=
+ #:*= #:/= #:%= #:+= #:\&= #:^= #:\|= #:~=
+ #:++ #:--
+ #:1+ #:1-
+ #:incf #:decf
+
+ ;; body forms
+ #:progn
+
+ ;; function definition
+ #:defun
+ #:lambda
+
+ ;; object literals
+ #:create
+ #:slot-value
+ #:with-slots
+
+ ;; macros
+ #:macrolet
+ #:symbol-macrolet
+
+ ;; if
+ #:if
+ #:when
+ #:unless
+
+ ;; single argument statements
+ #:return
+ #:throw
+
+ ;; single argument expressions
+ #:delete
+ #:void
+ #:typeof
+ #:instanceof
+ #:new
+
+ ;; assignment
+ #:setf
+
+ ;; variables
+ #:defvar
+
+ ;; iteration
+ #:for
+ #:doeach
+ #:while
+
+ ;; with
+ #:with
+
+ ;; case
+ #:switch
+ #:case
+ #:default
+
+ ;; try throw catch
+ #:try
+
+ ;; regex literals
+ #:regex
+
+ ;; conditional compilation (IE)
+ #:cc-if
+
+ ;; translate
+ #:js-to-strings
+ #:js-to-statement-strings
+ )
+ (:documentation "The package used to define Javascript special forms. Most of Parenscript
+is defined as macros on top of Javascript special forms"))
+
+(defpackage :parenscript
+ (:use :common-lisp :parenscript.javascript)
(:nicknames :js :ps)
(:export
;; addition js symbols
;; compiler
#:compile-script
+ #:compile-parenscript-file
+ #:compile-parenscript-file-to-string
#:script
#:with-new-compilation-environment ; tentative
#:with-compilation-environment ; tentative
+ #:*compilation-environment*
+
+ ;; package system
+ #:find-script-package
+ #:script-intern
+ #:script-export
+ #:find-script-symbol
+ #:comp-env-current-package
+ #:symbol-script-package
+ #:script-package-name
;; for parenscript macro definition within lisp
#:defscriptmacro #:defpsmacro ; should we use one or the other of these?
#:css-inline
#:css-file
- #:compile-parenscript-file
- #:compile-parenscript-file-to-string
-
;; deprecated interface
#:defjsmacro
#:js-compile
#:js-to-statement-strings
#:js-to-string
#:js-to-line
- ))
+ )
+ (:intern
+ #:define-script-special-form
+ #:defscriptclass
+ #:symbol-to-js
+ #:script-quote
+ #:*package-prefix-style*
+ #:*script-macro-env*
+ #:compile-to-statement
+ #:compile-to-block
+ #:compile-to-symbol
+ #:compile-to-expression
+ #:list-join
+ #:list-to-string
+ #:append-to-last
+ #:prepend-to-first
+ #:string-join
+ #:val-to-string
+ #:string-split
+ #:script-special-form-p
+ #:make-macro-env-dictionary
+ #:compile-script-form
+ )
+ )
+
+(in-package :parenscript)
+
+(import
+ '(defscriptclass
+ define-script-special-form
+ defscriptmacro
+ symbol-to-js
+ script-quote
+ *package-prefix-style*
+ *script-macro-env*
+ compile-to-statement
+ compile-to-block
+ compile-to-symbol
+ compile-to-expression
+ symbol-script-package
+ script-package-name
+ list-join
+ list-to-string
+ append-to-last
+ prepend-to-first
+ string-join
+ val-to-string
+ string-split
+ script-special-form-p
+ make-macro-env-dictionary
+ js-equal
+ compile-script-form
+ )
+ :parenscript.javascript)
+
+(defpackage parenscript.reader
+ (:nicknames parenscript-reader)
+ (:use :common-lisp :parenscript)
+ (:shadow readtablep
+ readtable-case
+ copy-readtable
+ get-macro-character
+ get-dispatch-macro-character
+ set-macro-character
+ set-dispatch-macro-character
+ make-dispatch-macro-character
+ set-syntax-from-char
+ read-preserving-whitespace
+ read
+ read-from-string
+ read-delimited-list
+ backquote-comma-dot
+ backquote
+ backquote-comma
+ backquote-comma-at
+
+ *read-eval*
+ *read-base*
+ *read-default-float-format*
+ *read-suppress*
+ *readtable*
+ *read-suppress*
+ *reader-error*
+ *read-suppress*
+
+ readtable
+ backquote
+ reader-error)
+ (:export
+ read
+ read-from-string
+ read-delimited-list))
+
+(defpackage parenscript.global
+ (:nicknames global)
+ (:documentation "Symbols interned in the global package are serialized in Javascript
+as non-prefixed identifiers."))
+
+(defpackage parenscript.user
+ (:nicknames ps-user paren-user parenscript-user)
+ (:documentation "The default package a user is inside of when compiling code."))
\ No newline at end of file
;;;; The mechanisms for defining macros & parsing Parenscript.
-(defclass identifier ()
- ((symbol :accessor id-symbol :initform nil :type symbol))
- (:documentation ""))
-
(defclass script-package ()
;; configuration slots
((name :accessor script-package-name :initform nil :initarg :name :type string
(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)
- (exports :accessor script-package-exports :initform nil :initarg :exports
+ (exports :accessor script-package-exports :initarg :exports
+ :initform nil;(make-hash-table :test #'equal)
:documentation "List of exported identifiers.")
(used-packages :accessor script-package-used-packages :initform nil :initarg :used-packages
:documentation "")
(defgeneric compiler-in-situation-p (comp-env situation)
(:documentation "Returns true when the compiler is considered 'in' the situation
-given by SITUATION, which is one of :compile-toplevel.")
+given by SITUATION, which is one of :compile-toplevel :execute.")
(:method ((comp-env compilation-environment) situation)
(cond
((eql situation :compile-toplevel) (processing-toplevel-p comp-env))
))
(defvar *compilation-environment* nil
- "The active compilation environment.
+ "The active compilation environment."
+;; Right now all code assumes that *compilation-environment* is accurately bound to the
+;; current compilation environment--even some functions that take the compilation environment
+;; as arguments.
+ )
+
+(defvar *enable-package-system* t
+ "When NIL, all symbols will function as global symbols.")
-Right now all code assumes that *compilation-environment* is accurately bound to the
-current compilation environment--even some functions that take the compilation environment
-as arguments.")
+(defvar *package-prefix-style* :prefix
+ "Determines how package symbols are serialized to JavaScript identifiers. NIL for
+no prefixes. :prefix to prefix variables with something like packagename_identifier.")
;;; parenscript packages
(defun lisp-to-script-package (lisp-package &optional (comp-env *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."
- (find (string name) (comp-env-script-packages comp-env) :test #'equal))
-
+ (typecase name
+ ((or symbol string)
+ (find (string name) (comp-env-script-packages comp-env)
+ :test #'equal :key #'script-package-name))
+ (script-package name)
+ (t (error "~A has unknown type" name))))
+
(defun destroy-script-package (script-package)
"Disposes of relevant resources when the script package is no longer relevant."
(when (script-package-exclusive-lisp-package-p script-package)
(delete-package (script-package-lisp-package script-package))))
+(defun script-intern (name script-package)
+ "Returns a Parenscript symbol with the string value STRING interned for the
+given SCRIPT-PACKAGE."
+ (setf script-package (find-script-package script-package))
+ (intern name (script-package-lisp-package script-package)))
+
+(defun script-export (symbols &optional (script-package (comp-env-current-package *compilation-environment*)))
+ "Exports the given symbols in the given script package."
+ (when (symbolp symbols)
+ (setf symbols (list symbols)))
+ ;; TODO check to make sure symbols are each interned under SCRIPT-PACKAGE
+ (mapc #'(lambda (sym)
+ (pushnew sym (script-package-exports script-package)))
+ symbols)
+ t)
+
+(defun find-script-symbol (name script-package)
+ "Finds the symbol with name NAME in the script package SCRIPT-PACKAGE. NAME is a
+string and SCRIPT-PACKAGE is a package designator. If NAME does not specify a symbol of
+script-package, returns nil. Otherwise returns 2 values:
+1. the symbol
+2. :external if the symbol is external. :internal if the symbol is internal"
+ (setf script-package (find-script-package script-package))
+ (let* ((symbol (find-symbol name (script-package-lisp-package script-package)))
+ (exported? (find symbol (script-package-exports script-package))))
+ (values symbol (if exported? :external (when symbol :internal)))))
+
;; environmental considerations
+(defgeneric install-standard-script-packages (comp-env)
+ (:documentation "Creates standard script packages and installs them in the current compilation
+environment.")
+ (:method ((comp-env compilation-environment))
+ (list
+ (create-script-package
+ comp-env
+ :name "GLOBAL" :lisp-package :parenscript.global
+ :secondary-lisp-packages '(:keyword))
+ (create-script-package
+ comp-env
+ :name "JAVASCRIPT" :nicknames (list "JS") :lisp-package :parenscript.javascript
+ :secondary-lisp-packages '(:common-lisp))
+ (create-script-package
+ comp-env
+ :name "PARENSCRIPT" :lisp-package :parenscript
+ :used-packages '(:javascript)
+ )
+ (create-script-package
+ comp-env
+ :name "PARENSCRIPT-USER" :lisp-package :parenscript-user
+ :secondary-lisp-packages (list :cl-user)
+ :nicknames '("PS-USER" "PAREN-USER")))))
+
+(defgeneric setup-compilation-environment (comp-env)
+ (:documentation "Sets up a basic compilation environment prepared for a language user.
+This should do things like define packages and set the current package.
+
+Returns the compilation-environment.")
+ (:method ((comp-env compilation-environment))
+ (install-standard-script-packages comp-env)
+ (setf (comp-env-current-package comp-env)
+ (find-script-package :parenscript-user comp-env))
+ comp-env))
+
(defun make-basic-compilation-environment ()
"Creates a compilation environment object from scratch. Fills it in with the default
script packages (parenscript, global, and parenscript-user)."
- (let ((comp-env (make-instance 'compilation-environment)))
- comp-env))
+ (setup-compilation-environment (make-instance 'compilation-environment)))
(defun create-script-package (comp-env
&key name nicknames secondary-lisp-packages used-packages
(defun funcall-form-p (form)
(and (listp form)
- (not (op-form-p form))
+ (not (ps-js::op-form-p form))
(not (script-special-form-p form))))
(defun method-call-p (form)
(compile-parenscript-form comp-env subform :toplevel-p t))
(rest form))))
;; TODO process macrolets, symbol-macrolets, and file inclusions
+
;; process eval-when. evaluates in :COMPILE-TOPLEVEL situation and returns
;; the resultant form. for :EXECUTE situation it returns
((eql 'eval-when (car form))
(multiple-value-bind (function warnings-p failure-p)
(compile nil `(lambda () ,@body))
(declare (ignore warnings-p) (ignore failure-p))
- `(progn
- ,(funcall function)
- ,@(when other-situations
- (list `(eval-when ,other-situations ,@body))))))))
+ (compile-parenscript-form
+ comp-env
+ `(progn
+ ,(funcall function)
+ ,@(when other-situations
+ (list `(eval-when ,other-situations ,@body))))
+ :toplevel-p t)))))
;; if :compile-toplevel is not in the situation list, return the form
(t form))))
(t form))
(cond ((stringp form)
- (make-instance 'string-literal :value form))
+ (make-instance 'ps-js::string-literal :value form))
((characterp form)
- (make-instance 'string-literal :value (string form)))
+ (make-instance 'ps-js::string-literal :value (string form)))
((numberp form)
- (make-instance 'number-literal :value form))
- ((symbolp form) ;; is this the correct behavior?
+ (make-instance 'ps-js::number-literal :value form))
+ ((symbolp form)
+ ;; is this the correct behavior?
(let ((c-macro (get-script-special-form form)))
(if c-macro
(funcall c-macro)
- (make-instance 'script-variable :value form))))
+ (make-instance 'ps-js::js-variable :value form))))
((and (consp form)
(eql (first form) 'quote))
(make-instance 'script-quote :value (second form)))
(cond (script-form
(apply script-form args))
- ((op-form-p form)
- (make-instance 'op-form
- :operator (script-convert-op-name (compile-to-symbol (first form)))
+ ((ps-js::op-form-p form)
+ (make-instance 'ps-js::op-form
+ :operator (ps-js::script-convert-op-name (compile-to-symbol (first form)))
:args (mapcar #'compile-to-expression (rest form))))
((method-call-p form)
- (make-instance 'method-call
+ (make-instance 'ps-js::method-call
:method (compile-to-symbol (first form))
:object (compile-to-expression (second form))
:args (mapcar #'compile-to-expression (cddr form))))
((funcall-form-p form)
- (make-instance 'function-call
+ (make-instance 'ps-js::function-call
:function (compile-to-expression (first form))
:args (mapcar #'compile-to-expression (rest form))))
(defun compile-to-expression (form)
"Compiles the given Parenscript form and guarantees the result is an expression."
(let ((res (compile-script-form form)))
- (assert (typep res 'expression))
+ (assert (typep res 'ps-js::expression))
res))
(defun compile-to-symbol (form)
- "Compiles the given Parenscript form and guarantees a symbolic result."
+ "Compiles the given Parenscript form and guarantees a symbolic result. This
+also guarantees that the symbol has an associated script-package."
(let ((res (compile-script-form form)))
- (when (typep res 'script-variable)
- (setf res (value res)))
+ (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. This could be due to ~a being a special form." form res form)
+ (when *enable-package-system*
+ (assert (symbol-script-package res) ()
+ "The symbol ~A::~A has no associated script package."
+ (package-name (symbol-package res))
+ res))
res))
(defun compile-to-statement (form)
"Compiles the given Parenscript form and guarantees the result is a statement."
(let ((res (compile-script-form form)))
- (assert (typep res 'statement))
+ (assert (typep res 'ps-js::statement))
res))
-(defun compile-to-body (form &key (indent ""))
+(defun compile-to-block (form &key (indent ""))
"Compiles the given Parenscript form and guarantees the result is of type SCRIPT-BODY"
(let ((res (compile-to-statement form)))
- (if (typep res 'script-body)
- (progn (setf (b-indent res) indent)
+ (if (typep res 'ps-js::js-block)
+ (progn (setf (ps-js::block-indent res) indent)
res)
- (make-instance 'script-body
+ (make-instance 'ps-js::js-block
:indent indent
:statements (list res)))))
\ No newline at end of file
--- /dev/null
+(in-package :parenscript)
+
+;;;; The macrology of the Parenscript language. Special forms and macros.
+
+;;; parenscript gensyms
+(defvar *gen-script-name-counter* 0)
+
+(defun gen-script-name-string (&key (prefix "_js_"))
+ "Generates a unique valid javascript identifier ()"
+ (concatenate 'string
+ prefix (princ-to-string (incf *gen-script-name-counter*))))
+
+(defun gen-script-name (&key (prefix "_ps_"))
+ "Generate a new javascript identifier."
+ (intern (gen-script-name-string :prefix prefix)
+ (find-package :js)))
+
+(defmacro with-unique-js-names (symbols &body body)
+ "Evaluate BODY with the variables on SYMBOLS bound to new javascript identifiers.
+
+Each element of SYMBOLS is either a symbol or a list of (symbol
+prefix)."
+ `(let* ,(mapcar (lambda (symbol)
+ (destructuring-bind (symbol &optional prefix)
+ (if (consp symbol)
+ symbol
+ (list symbol))
+ (if prefix
+ `(,symbol (gen-script-name :prefix ,prefix))
+ `(,symbol (gen-script-name)))))
+ symbols)
+ ,@body))
+
+(defvar *var-counter* 0)
+
+(defun script-gensym (&optional (name "js"))
+ (intern (format nil "tmp-~A-~A" name (incf *var-counter*)) #.*package*))
+
+;;; array literals
+(defscriptmacro list (&rest values)
+ `(array ,@values))
+
+(defscriptmacro make-array (&rest inits)
+ `(new (*array ,@inits)))
+
+;;; eval-when
+(define-script-special-form eval-when (&rest args)
+ "(eval-when form-language? (situation*) form*)
+
+The given forms are evaluated only during the given SITUATION in the specified
+FORM-LANGUAGE (either :lisp or :parenscript, def, defaulting to :lisp during
+-toplevel and :parenscript during :execute). The accepted SITUATIONS are :execute,
+:scan-toplevel. :scan-toplevel is the phase of compilation when function definitions
+and the like are being added to the compilation environment. :execute is the phase when
+the code is being evaluated by a Javascript engine."
+ (multiple-value-bind (body-language situations subforms)
+ (process-eval-when-args args)
+; (format t "~A~%~A~%"
+; (and (compiler-in-situation-p *compilation-environment* :compile-toplevel)
+; (find :compile-toplevel situations))
+; (compiler-in-situation-p *compilation-environment* :execute)
+; (find :execute situations))
+ (cond
+ ((and (compiler-in-situation-p *compilation-environment* :compile-toplevel)
+ (find :compile-toplevel situations))
+ (error "Should never be processing eval-when :COMPILE-TOPLEVEL forms from here."))
+
+ ((and (compiler-in-situation-p *compilation-environment* :execute)
+ (find :execute situations))
+ (when (eql body-language :parenscript)
+ (let ((form `(progn ,@subforms)))
+ (format t "Form: ~A~%" form)
+ (compile-to-statement form)))))))
+
+;;; script packages
+(defscriptmacro defpackage (name &rest options)
+ "Defines a Parenscript package."
+ (labels ((opt-name (opt) (if (listp opt) (car opt) opt)))
+ (let ((nicknames nil) (lisp-package nil) (secondary-lisp-packages nil)
+ (exports nil) (used-packages nil) (documentation nil))
+ (dolist (opt options)
+ (case (opt-name opt)
+ (:lisp-package (setf lisp-package (second opt)))
+ (:nicknames (setf nicknames (rest opt)))
+ (:secondary-lisp-packages secondary-lisp-packages t)
+ (:export (setf exports (rest opt)))
+ (:use (setf used-packages (rest opt)))
+ (:documentation (setf documentation (second opt)))
+ (t (error "Unknown option in DEFPACKAGE: ~A" (opt-name opt)))))
+ (create-script-package
+ *compilation-environment*
+ :name name
+ :nicknames nicknames
+ :secondary-lisp-packages secondary-lisp-packages
+ :used-packages used-packages
+ :lisp-package lisp-package
+ :exports exports
+ :documentation documentation)))
+ `(progn))
+
+(defscriptmacro in-package (package-designator)
+ "Changes the current script package in the parenscript compilation environment. This mostly
+affects the reader and how it interns non-prefixed symbols"
+ (setf (comp-env-current-package *compilation-environment*)
+ (find-script-package package-designator *compilation-environment*))
+ `(progn))
+
+(defscriptmacro case (value &rest clauses)
+ (labels ((make-clause (val body more)
+ (cond ((listp val)
+ (append (mapcar #'list (butlast val))
+ (make-clause (first (last val)) body more)))
+ ((member val '(t otherwise))
+ (make-clause 'default body more))
+ (more `((,val ,@body break)))
+ (t `((,val ,@body))))))
+ `(switch ,value ,@(mapcon #'(lambda (x)
+ (make-clause (car (first x))
+ (cdr (first x))
+ (rest x)))
+ clauses))))
+
+;;; let
+(define-script-special-form let (decls &rest body)
+ (let ((defvars (mapcar #'(lambda (decl)
+ (if (atom decl)
+ (make-instance 'ps-js::js-defvar
+ :names (list (compile-to-symbol decl))
+ :value nil)
+ (let ((name (first decl))
+ (value (second decl)))
+ (make-instance 'ps-js::js-defvar
+ :names (list (compile-to-symbol name))
+ :value (compile-to-expression value)))))
+ decls)))
+ (make-instance 'ps-js::js-sub-block
+ :indent " "
+ :statements (nconc defvars
+ (mapcar #'compile-to-statement body)))))
+
+;;; iteration
+(defscriptmacro dotimes (iter &rest body)
+ (let ((var (first iter))
+ (times (second iter)))
+ `(do ((,var 0 (1+ ,var)))
+ ((>= ,var ,times))
+ ,@body)))
+
+(defscriptmacro dolist (i-array &rest body)
+ (let ((var (first i-array))
+ (array (second i-array))
+ (arrvar (script-gensym "arr"))
+ (idx (script-gensym "i")))
+ `(let ((,arrvar ,array))
+ (do ((,idx 0 (1+ ,idx)))
+ ((>= ,idx (slot-value ,arrvar 'length)))
+ (let ((,var (aref ,arrvar ,idx)))
+ ,@body)))))
+
+;;; macros
+(defmacro with-temp-macro-environment ((var) &body body)
+ `(let* ((,var (make-macro-env-dictionary))
+ (*script-macro-env* (cons ,var *script-macro-env*)))
+ ,@body))
+
+(define-script-special-form macrolet (macros &body body)
+ (with-temp-macro-environment (macro-env-dict)
+ (dolist (macro macros)
+ (destructuring-bind (name arglist &body body)
+ macro
+ (setf (get-macro-spec name macro-env-dict)
+ (cons nil (let ((args (gensym "ps-macrolet-args-")))
+ (compile nil `(lambda (&rest ,args)
+ (destructuring-bind ,arglist
+ ,args
+ ,@body))))))))
+ (compile-script-form `(progn ,@body))))
+
+(define-script-special-form symbol-macrolet (symbol-macros &body body)
+ (with-temp-macro-environment (macro-env-dict)
+ (dolist (macro symbol-macros)
+ (destructuring-bind (name &body expansion)
+ macro
+ (setf (get-macro-spec name macro-env-dict)
+ (cons t (compile nil `(lambda () ,@expansion))))))
+ (compile-script-form `(progn ,@body))))
+
+(defscriptmacro defmacro (name args &body body)
+ `(lisp (defscriptmacro ,name ,args ,@body) nil))
+
+(defscriptmacro lisp (&body forms)
+ "Evaluates the given forms in Common Lisp at ParenScript
+macro-expansion time. The value of the last form is treated as a
+ParenScript expression and is inserted into the generated Javascript
+(use nil for no-op)."
+ (eval (cons 'progn forms)))
+
+
+(defscriptmacro rebind (variables expression)
+ "Creates a new js lexical environment and copies the given
+ variable(s) there. Executes the body in the new environment. This
+ has the same effect as a new (let () ...) form in lisp but works on
+ the js side for js closures."
+ (unless (listp variables)
+ (setf variables (list variables)))
+ `((lambda ()
+ (let ((new-context (new *object)))
+ ,@(loop for variable in variables
+ do (setf variable (symbol-to-js variable))
+ collect `(setf (slot-value new-context ,variable) (slot-value this ,variable)))
+ (with new-context
+ (return ,expression))))))
\ No newline at end of file
--- /dev/null
+(in-package :parenscript)
+
+;;; quote
+(defscriptclass script-quote (ps-js::expression)
+ ())
+
-c;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
;; ALL RIGHTS RESERVED.
;;
;; $Id: reader.lisp,v 1.10 2004/02/20 07:23:42 yuji Exp $
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-(in-package parenscript-reader)
+;;;; The ParenScript reader, used for reading Parenscript files and other
+;;;; forms during the Parenscript compilation process. The main difference
+;;;; between this reader and the standard Lisp reader is that package
+;;;; prefixes are SCRIPT package names rather than Lisp package names.
+
+;;; The main function, READ, will not work unless *compilation-environement*
+;;; is bound to a valid Parenscript COMPILATION-ENVIRONMENT.
+(in-package parenscript.reader)
(defstruct (readtable (:predicate readtablep) (:copier nil))
(syntax (make-hash-table) :type hash-table)
(float? sign))))))
(defun ensure-external-symbol (name package)
- (multiple-value-bind (symbol status) (find-script-symbol name package)
+ "Ensures that the symbol with name NAME is external for the given script package PACKAGE.
+Raises a continuable error if NAME is not external in PACKAGE. Otherwise interns NAME
+in PACKAGE and returns the symbol."
+ (multiple-value-bind (symbol status)
+ (find-script-symbol name package)
(unless (eq status :external)
(cerror (if (null status)
"Intern and export script symbol ~S in package ~S."
(script-export (setq symbol (script-intern name package)) package))
symbol))
-(defvar *intern-package-prefixes* t)
-
(defun construct-symbol (lexemes &key uninterned-symbol-wanted)
(labels ((up (x) (if (listp x) (copy-list x) (list (char-upcase x))))
(down (x) (if (listp x) (copy-list x) (list (char-downcase x))))
(let* ((pos (position #\: lexemes))
(external-p (and pos (not (eql (nth (1+ pos) lexemes) #\:))))
(package (when pos (name (subseq lexemes 0 pos))))
- (script-package (find-script-package *compilation-environment* package))
+ (script-package (find-script-package package))
(name (name (subseq lexemes (if pos (+ pos (if external-p 1 2)) 0)))))
(values (cond
- (*intern-package-prefixes*
- (let ((str (if package
- (concatenate 'string package ":" name)
- name)))
-
- (if uninterned-symbol-wanted
- str
- (intern str))))
(uninterned-symbol-wanted
(if package
(reader-error)
- (make-symbol name)))
+ (make-symbol name)))
(external-p
- (ensure-external-symbol name package))
+ (ensure-external-symbol name script-package))
(t (script-intern name
- (or package
- (current-package *compilation-environment*)))))))))
+ (or script-package
+ (parenscript::comp-env-current-package
+ *compilation-environment*)))))))))
(defun read-number-or-symbol (stream c)
(let ((lexemes (collect-lexemes c stream)))
--- /dev/null
+(in-package :parenscript-test)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (def-suite package-system-tests))
+
+(in-suite package-system-tests)
+
+(defpstest simple-variable-prefix ()
+ (progn
+ (defpackage test (:lisp-package :parenscript-test))
+ (defvar the-var))
+ "var test_theVar;")
+
+(defpstest no-global-variable-prefix ()
+ (progn
+ (defvar global::the-var)
+ (defvar global::global))
+ "var theVar; var global;")
+
+(defpstest eval-when-returns-paren-form ()
+ (progn
+ (eval-when (:compile-toplevel)
+ `(global::sort-of-macro-like))
+ global::treat-me-right)
+ "sortOfMacroLike(); treatMeRight;")
+
+(defpstest javascript-operations ()
+ (progn
+ (+ 1 2 3 4)
+ (- 1 2 3 4)
+ nil t this false undefined)
+ "1 + 2 + 3 + 4; 1 - 2 - 3 - 4; null; true; this; false; undefined;")
+
+(defpstest def-keywords ()
+ (progn
+ (defun global::hello-world () (return 5)))
+ "function helloWorld() { return 5; };")
+
+(defpstest ps-js-reserved ()
+ (eval-when (:compile-toplevel)
+ (format nil "~A" (script-package-name (symbol-script-package 'defclass))))
+ "'JAVASCRIPT';")
+
"(function (x) { return x; }) (10).toString()")
(test no-whitespace-before-dot
- (let* ((str (js:js* '(.to-string ((lambda (x) (return x)) 10))))
+ (let* ((parenscript::*enable-package-system* nil)
+ (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 #\)))
}")
(test escape-sequences-in-string
- (let ((escapes `((#\\ . #\\)
+ (let ((parenscript::*enable-package-system* nil)
+ (escapes `((#\\ . #\\)
(#\b . #\Backspace)
(#\f . ,(code-char 12))
("u000B" . ,(code-char #x000b));;Vertical tab, too uncommon to bother with
(normalize-whitespace str))))))
(defmacro test-ps-js (testname parenscript javascript)
+ (let (
+ ;; (parenscript
+ ;; `(progn
+ ;; (defpackage parenscript-test
+ ;; (:lisp-package :parenscript-test))
+ ;; ,parenscript)))
+ )
`(test ,testname ()
(setf js::*var-counter* 0)
+
;; is-macro expands its argument again when reporting failures, so
;; the reported temporary js-variables get wrong if we don't evalute first.
- (let ((generated-code (compile-script ',parenscript))
+ (let* ((parenscript::*enable-package-system* nil)
+ (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)
+ `(test ,testname
+ (setf parenscript::*var-counter* 0)
+ (let* ((parenscript::*enable-package-system* ,enable-package-system)
+ (generated-code (compile-script ',parenscript))
(js-code ,javascript))
(is (string= (normalize-js-code generated-code)
(normalize-js-code js-code))))))
(format t "Running reference tests:~&")
(run! 'ref-tests)
(format t "Running other tests:~&")
- (run! 'ps-tests))
+ (run! 'ps-tests)
+ (format t "Running Package System tests:~&")
+ (run! 'package-system-tests))
HCoop / clinton / parenscript.git / commitdiff