(gethash name *ps-special-forms*))
(defmacro define-ps-special-form (name lambda-list &rest body)
- "Define a special form NAME. The first argument (an anaphor called
-'expecting' automatically added to the arglist) to the special form is
-a keyword indicating whether the form is expected to produce
-an :expression or a :statement."
- (let ((args (gensym "ps-arglist-")))
- `(setf (gethash ',name *ps-special-forms*)
- (lambda (&rest ,args)
- (destructuring-bind ,(cons 'expecting lambda-list)
- ,args
- (declare (ignorable expecting))
- ,@body)))))
+ `(setf (gethash ',name *ps-special-forms*)
+ (lambda (&rest whole)
+ (destructuring-bind ,lambda-list
+ whole
+ ,@body))))
(defun undefine-ps-special-form (name)
(remhash name *ps-special-forms*))
(defparameter *ps-compilation-level* :toplevel
"This value takes on the following values:
:toplevel indicates that we are traversing toplevel forms.
-:inside-toplevel-form indicates that we are inside a call to compile-parenscript-form
+:inside-toplevel-form indicates that we are inside a call to ps-compile-*
nil indicates we are no longer toplevel-related."))
(defun lookup-macro-def (name env)
fun-name))
;;;; compiler interface
-(defgeneric compile-parenscript-form (form &key expecting)
- (:documentation "Compiles a ParenScript form to the intermediate
-ParenScript representation. :expecting determines whether the form is
-compiled to an :expression (the default), a :statement, or a
-:symbol."))
-
(defun adjust-ps-compilation-level (form level)
"Given the current *ps-compilation-level*, LEVEL, and the fully macroexpanded
form, FORM, returns the new value for *ps-compilation-level*."
((eq :toplevel level) :inside-toplevel-form)))
-(defmethod compile-parenscript-form :around (form &key expecting)
- (assert (if expecting (member expecting '(:expression :statement)) t))
- (call-next-method))
-
(defun ps-compile-symbol (form)
"Compiles the given Parenscript form and guarantees that the
resultant symbol has an associated script-package. Raises an error if
the form cannot be compiled to a symbol."
- (let ((exp (compile-parenscript-form form :expecting :expression)))
+ (let ((exp (ps-compile-expression form)))
(when (eq (first exp) 'js:variable)
(setf exp (second exp)))
(assert (symbolp exp) ()
"~a is expected to be a symbol, but compiles to ~a (the ParenScript output for ~a alone is \"~a\"). This could be due to ~a being a special form." form exp form (ps* form) form)
exp))
-(defmethod compile-parenscript-form (form &key expecting)
- (declare (ignore expecting))
+(defmethod ps-compile (form)
(error "The object ~S cannot be compiled by ParenScript." form))
-(defmethod compile-parenscript-form ((form number) &key expecting)
- (declare (ignore expecting))
+(defmethod ps-compile ((form number))
form)
-(defmethod compile-parenscript-form ((form string) &key expecting)
- (declare (ignore expecting))
+(defmethod ps-compile ((form string))
form)
-(defmethod compile-parenscript-form ((form character) &key expecting)
- (declare (ignore expecting))
- (compile-parenscript-form (string form)))
+(defmethod ps-compile ((form character))
+ (ps-compile (string form)))
-(defmethod compile-parenscript-form ((symbol symbol) &key expecting)
+(defmethod ps-compile ((symbol symbol))
(when (eq *ps-compilation-level* :toplevel)
(multiple-value-bind (expansion expanded-p)
(ps-macroexpand symbol)
(when expanded-p
- (return-from compile-parenscript-form (compile-parenscript-form expansion :expecting expecting)))))
+ (return-from ps-compile (ps-compile expansion)))))
(cond ((keywordp symbol) symbol)
((ps-special-form-p (list symbol))
(if (ps-reserved-symbol-p symbol)
- (funcall (get-ps-special-form symbol) :symbol)
+ (funcall (get-ps-special-form symbol))
(error "Attempting to use Parenscript special form ~a as variable" symbol)))
(t `(js:variable ,symbol))))
(not '!)
(eql '\=\=)
(= '\=\=)
- (t op)))
+ (t op)))
(defun maybe-fix-nary-comparison-form (form)
(if (< 2 (length (cdr form)))
(defun compile-op-form (form)
`(js:operator ,(ps-convert-op-name (ps-compile-symbol (car form)))
,@(mapcar (lambda (form)
- (compile-parenscript-form (ps-macroexpand form) :expecting :expression))
+ (ps-compile-expression (ps-macroexpand form)))
(cdr form))))
(defun compile-funcall-form (form)
`(js:funcall
- ,(compile-parenscript-form (if (symbolp (car form))
- (maybe-rename-local-function (car form))
- (ps-macroexpand (car form)))
- :expecting :expression)
- ,@(mapcar (lambda (arg)
- (compile-parenscript-form (ps-macroexpand arg) :expecting :expression))
- (cdr form))))
-
-(defmethod compile-parenscript-form ((form cons) &key (expecting :statement))
+ ,(ps-compile-expression (if (symbolp (car form))
+ (maybe-rename-local-function (car form))
+ (ps-macroexpand (car form))))
+ ,@(mapcar #'ps-compile-expression (cdr form))))
+
+(defvar compile-expression?)
+
+(defmethod ps-compile ((form cons))
(multiple-value-bind (form expanded-p)
(ps-macroexpand form)
(let ((*ps-compilation-level*
*ps-compilation-level*
(adjust-ps-compilation-level form *ps-compilation-level*))))
(cond (expanded-p
- (compile-parenscript-form form :expecting expecting))
+ (ps-compile form))
((ps-special-form-p form)
- (apply (get-ps-special-form (car form)) (cons expecting (cdr form))))
+ (apply (get-ps-special-form (car form)) (cdr form)))
((comparison-form-p form)
(multiple-value-bind (form fixed?)
(maybe-fix-nary-comparison-form form)
(if fixed?
- (compile-parenscript-form form :expecting expecting)
+ (ps-compile form)
(compile-op-form form))))
- ((op-form-p form) (compile-op-form form))
- ((funcall-form-p form) (compile-funcall-form form))
+ ((op-form-p form)
+ (compile-op-form form))
+ ((funcall-form-p form)
+ (compile-funcall-form form))
(t (error "Cannot compile ~S to a ParenScript form." form))))))
+(defun ps-compile-statement (form)
+ (let ((compile-expression? nil))
+ (ps-compile form)))
+
+(defun ps-compile-expression (form)
+ (let ((compile-expression? t))
+ (ps-compile form)))
+
(defvar *ps-gensym-counter* 0)
(defun ps-gensym (&optional (prefix "_js"))
(def-for-literal continue js:continue))
(define-ps-special-form quote (x)
- (compile-parenscript-form
+ (ps-compile-expression
(typecase x
(cons `(array ,@(mapcar (lambda (x) (when x `',x)) x)))
(null '(array))
(keyword x)
(symbol (symbol-to-js-string x))
(number x)
- (string x))
- :expecting expecting))
+ (string x))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; unary operators
(spacep (if (listp op) (second op) nil)))
`(define-ps-special-form ,op (x)
(list 'js:unary-operator ',op
- (compile-parenscript-form (ps-macroexpand x) :expecting :expression)
+ (ps-compile-expression (ps-macroexpand x))
:prefix t :space ,spacep))))
ops))))
(def-unary-ops ~ ! (new t) (delete t) (void t) (typeof t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; statements
(define-ps-special-form return (&optional value)
- `(js:return ,(compile-parenscript-form (ps-macroexpand value) :expecting :expression)))
+ `(js:return ,(ps-compile-expression (ps-macroexpand value))))
(define-ps-special-form throw (value)
- `(js:throw ,(compile-parenscript-form (ps-macroexpand value) :expecting :expression)))
+ `(js:throw ,(ps-compile-expression (ps-macroexpand value))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; arrays
(define-ps-special-form array (&rest values)
- `(js:array ,@(mapcar (lambda (form) (compile-parenscript-form (ps-macroexpand form) :expecting :expression))
- values)))
+ `(js:array ,@(mapcar (lambda (form) (ps-compile-expression (ps-macroexpand form)))
+ values)))
(define-ps-special-form aref (array &rest coords)
- `(js:aref ,(compile-parenscript-form (ps-macroexpand array) :expecting :expression)
+ `(js:aref ,(ps-compile-expression (ps-macroexpand array))
,(mapcar (lambda (form)
- (compile-parenscript-form (ps-macroexpand form) :expecting :expression))
+ (ps-compile-expression (ps-macroexpand form)))
coords)))
(defpsmacro list (&rest values)
(let ((x (ps-macroexpand x))
(delta (ps-macroexpand delta)))
(if (eql delta 1)
- `(js:unary-operator js:++ ,(compile-parenscript-form x :expecting :expression) :prefix t)
- `(js:operator js:+= ,(compile-parenscript-form x :expecting :expression)
- ,(compile-parenscript-form delta :expecting :expression)))))
+ `(js:unary-operator js:++ ,(ps-compile-expression x) :prefix t)
+ `(js:operator js:+= ,(ps-compile-expression x)
+ ,(ps-compile-expression delta)))))
(define-ps-special-form decf (x &optional (delta 1))
(let ((x (ps-macroexpand x))
(delta (ps-macroexpand delta)))
(if (eql delta 1)
- `(js:unary-operator js:-- ,(compile-parenscript-form x :expecting :expression) :prefix t)
- `(js:operator js:-= ,(compile-parenscript-form x :expecting :expression)
- ,(compile-parenscript-form delta :expecting :expression)))))
+ `(js:unary-operator js:-- ,(ps-compile-expression x) :prefix t)
+ `(js:operator js:-= ,(ps-compile-expression x)
+ ,(ps-compile-expression delta)))))
(define-ps-special-form - (first &rest rest)
(let ((first (ps-macroexpand first))
(rest (mapcar #'ps-macroexpand rest)))
(if rest
- `(js:operator js:- ,@(mapcar (lambda (val) (compile-parenscript-form val :expecting :expression))
+ `(js:operator js:- ,@(mapcar (lambda (val) (ps-compile-expression val))
(cons first rest)))
- `(js:unary-operator js:- ,(compile-parenscript-form first :expecting :expression) :prefix t))))
+ `(js:unary-operator js:- ,(ps-compile-expression first) :prefix t))))
(define-ps-special-form not (x)
- (let ((form (compile-parenscript-form (ps-macroexpand x) :expecting :expression))
+ (let ((form (ps-compile-expression (ps-macroexpand x)))
inverse-op)
(if (and (eq (car form) 'js:operator)
(= (length (cddr form)) 2)
(define-ps-special-form progn (&rest body)
(let ((body (mapcar #'ps-macroexpand body)))
- (if (and (eq expecting :expression) (= 1 (length body)))
- (compile-parenscript-form (car body) :expecting :expression)
- `(,(if (eq expecting :expression) 'js:|,| 'js:block)
- ,@(let* ((block (flatten-blocks (remove nil (mapcar (lambda (form)
- (compile-parenscript-form form :expecting expecting))
- body)))))
+ (if (and compile-expression? (= 1 (length body)))
+ (ps-compile-expression (car body))
+ `(,(if compile-expression? 'js:|,| 'js:block)
+ ,@(let* ((block (flatten-blocks (remove nil (mapcar #'ps-compile body)))))
(append (remove-if #'constant-literal-form-p (butlast block)) (last block)))))))
(define-ps-special-form cond (&rest clauses)
- (ecase expecting
- (:statement `(js:if ,(compile-parenscript-form (caar clauses) :expecting :expression)
- ,(compile-parenscript-form `(progn ,@(cdar clauses)))
- ,@(loop for (test . body) in (cdr clauses) appending
- (if (eq t test)
- `(:else ,(compile-parenscript-form `(progn ,@body) :expecting :statement))
- `(:else-if ,(compile-parenscript-form test :expecting :expression)
- ,(compile-parenscript-form `(progn ,@body) :expecting :statement))))))
- (:expression (make-cond-clauses-into-nested-ifs clauses))))
+ (if compile-expression?
+ (make-cond-clauses-into-nested-ifs clauses)
+ `(js:if ,(ps-compile-expression (caar clauses))
+ ,(ps-compile-statement `(progn ,@(cdar clauses)))
+ ,@(loop for (test . body) in (cdr clauses) appending
+ (if (eq t test)
+ `(:else ,(ps-compile-statement `(progn ,@body)))
+ `(:else-if ,(ps-compile-expression test)
+ ,(ps-compile-statement `(progn ,@body))))))))
(defun make-cond-clauses-into-nested-ifs (clauses)
(if clauses
(destructuring-bind (test &rest body)
(car clauses)
(if (eq t test)
- (compile-parenscript-form `(progn ,@body) :expecting :expression)
- `(js:? ,(compile-parenscript-form test :expecting :expression)
- ,(compile-parenscript-form `(progn ,@body) :expecting :expression)
+ (ps-compile-expression `(progn ,@body))
+ `(js:? ,(ps-compile-expression test)
+ ,(ps-compile-expression `(progn ,@body))
,(make-cond-clauses-into-nested-ifs (cdr clauses)))))
- (compile-parenscript-form nil :expecting :expression))) ;; js:null
+ (ps-compile-expression nil)))
(define-ps-special-form if (test then &optional else)
- (ecase expecting
- (:statement `(js:if ,(compile-parenscript-form (ps-macroexpand test) :expecting :expression)
- ,(compile-parenscript-form `(progn ,then))
- ,@(when else `(:else ,(compile-parenscript-form `(progn ,else))))))
- (:expression `(js:? ,(compile-parenscript-form (ps-macroexpand test) :expecting :expression)
- ,(compile-parenscript-form (ps-macroexpand then) :expecting :expression)
- ,(compile-parenscript-form (ps-macroexpand else) :expecting :expression)))))
+ (if compile-expression?
+ `(js:? ,(ps-compile-expression (ps-macroexpand test))
+ ,(ps-compile-expression (ps-macroexpand then))
+ ,(ps-compile-expression (ps-macroexpand else)))
+ `(js:if ,(ps-compile-expression (ps-macroexpand test))
+ ,(ps-compile-statement `(progn ,then))
+ ,@(when else `(:else ,(ps-compile-statement `(progn ,else)))))))
(define-ps-special-form switch (test-expr &rest clauses)
- `(js:switch ,(compile-parenscript-form test-expr :expecting :expression)
+ `(js:switch ,(ps-compile-expression test-expr)
,(loop for (val . body) in clauses collect
(cons (if (eq val 'default)
'default
- (compile-parenscript-form val :expecting :expression))
- (mapcar (lambda (x) (compile-parenscript-form x :expecting :statement))
+ (ps-compile-expression val))
+ (mapcar (lambda (x) (ps-compile-statement x))
body)))))
(defpsmacro case (value &rest clauses)
(let* ((*enclosing-lexical-block-declarations* ())
(*vars-bound-in-enclosing-lexical-scopes* (append args
*vars-bound-in-enclosing-lexical-scopes*))
- (body (compile-parenscript-form `(progn ,@body)))
- (var-decls (compile-parenscript-form
+ (body (ps-compile-statement `(progn ,@body)))
+ (var-decls (ps-compile-statement
`(progn ,@(mapcar (lambda (var) `(var ,var)) *enclosing-lexical-block-declarations*)))))
`(js:block ,@(cdr var-decls) ,@(cdr body))))))
(let ((fn-renames (make-macro-dictionary)))
(loop for (fn-name) in fn-defs do
(setf (gethash fn-name fn-renames) (ps-gensym fn-name)))
- (let ((fn-defs (compile-parenscript-form
+ (let ((fn-defs (ps-compile
`(progn ,@(loop for (fn-name . def) in fn-defs collect
- `(var ,(gethash fn-name fn-renames) (lambda ,@def))))
- :expecting expecting))
+ `(var ,(gethash fn-name fn-renames) (lambda ,@def))))))
(*ps-local-function-names* (cons fn-renames *ps-local-function-names*)))
- (append fn-defs (cdr (compile-parenscript-form `(progn ,@body) :expecting expecting))))))
+ (append fn-defs (cdr (ps-compile `(progn ,@body)))))))
(define-ps-special-form labels (fn-defs &rest body)
(with-local-macro-environment (local-fn-renames *ps-local-function-names*)
(loop for (fn-name) in fn-defs do
(setf (gethash fn-name local-fn-renames) (ps-gensym fn-name)))
- (compile-parenscript-form
+ (ps-compile
`(progn ,@(loop for (fn-name . def) in fn-defs collect
`(var ,(gethash fn-name local-fn-renames) (lambda ,@def)))
- ,@body)
- :expecting expecting)))
+ ,@body))))
(define-ps-special-form function (fn-name)
- (compile-parenscript-form (maybe-rename-local-function fn-name) :expecting expecting))
+ (ps-compile (maybe-rename-local-function fn-name)))
(defvar *defun-setf-name-prefix* "__setf_")
(destructuring-bind (name arglist &body body)
macro
(setf (gethash name local-macro-dict) (eval (make-ps-macro-function arglist body)))))
- (compile-parenscript-form `(progn ,@body) :expecting expecting)))
+ (ps-compile `(progn ,@body))))
(define-ps-special-form symbol-macrolet (symbol-macros &body body)
(with-local-macro-environment (local-macro-dict *ps-symbol-macro-env*)
(push name local-var-bindings)))
(let ((*vars-bound-in-enclosing-lexical-scopes* (append local-var-bindings
*vars-bound-in-enclosing-lexical-scopes*)))
- (compile-parenscript-form `(progn ,@body) :expecting expecting)))))
+ (ps-compile `(progn ,@body))))))
(define-ps-special-form defmacro (name args &body body) ;; should this be a macro?
(eval `(defpsmacro ,name ,args ,@body))
(define-ps-special-form create (&rest arrows)
`(js:object
,@(loop for (key-expr val-expr) on arrows by #'cddr collecting
- (let ((compiled-key (compile-parenscript-form (ps-macroexpand key-expr)
- :expecting :expression)))
+ (let ((compiled-key (ps-compile-expression (ps-macroexpand key-expr))))
(assert (or (stringp compiled-key)
(numberp compiled-key)
(keywordp compiled-key)
compiled-key))
it
compiled-key)))
- (cons key (compile-parenscript-form (ps-macroexpand val-expr)
- :expecting :expression)))))))
+ (cons key (ps-compile-expression (ps-macroexpand val-expr))))))))
(define-ps-special-form instanceof (value type)
- `(js:instanceof ,(compile-parenscript-form value :expecting :expression)
- ,(compile-parenscript-form type :expecting :expression)))
+ `(js:instanceof ,(ps-compile-expression value)
+ ,(ps-compile-expression type)))
(define-ps-special-form %js-slot-value (obj slot)
(let ((slot (ps-macroexpand slot)))
- `(js:slot-value ,(compile-parenscript-form (ps-macroexpand obj) :expecting :expression)
+ `(js:slot-value ,(ps-compile-expression (ps-macroexpand obj))
,(let ((slot (if (and (listp slot) (eq 'quote (car slot)))
(second slot) ;; assume we're quoting a symbol
- (compile-parenscript-form slot))))
+ (ps-compile-expression slot))))
(if (and (symbolp slot)
(ps-reserved-symbol-p slot))
(symbol-name-to-js-string slot)
(t nil)))
(define-ps-special-form setf1% (lhs rhs)
- (let ((lhs (compile-parenscript-form (ps-macroexpand lhs) :expecting :expression))
- (rhs (compile-parenscript-form (ps-macroexpand rhs) :expecting :expression)))
+ (let ((lhs (ps-compile-expression (ps-macroexpand lhs)))
+ (rhs (ps-compile-expression (ps-macroexpand rhs))))
(if (and (listp rhs)
(eq 'js:operator (car rhs))
(member (cadr rhs) '(+ *))
(define-ps-special-form var (name &optional (value (values) value-provided?) documentation)
(declare (ignore documentation))
(let ((name (ps-macroexpand name)))
- (ecase expecting
- (:statement
- `(js:var ,name ,@(when value-provided?
- (list (compile-parenscript-form (ps-macroexpand value) :expecting :expression)))))
- (:expression
- (push name *enclosing-lexical-block-declarations*)
- (when value-provided?
- (compile-parenscript-form `(setf ,name ,value) :expecting :expression))))))
+ (if compile-expression?
+ (progn (push name *enclosing-lexical-block-declarations*)
+ (when value-provided?
+ (ps-compile-expression `(setf ,name ,value))))
+ `(js:var ,name ,@(when value-provided?
+ (list (ps-compile-expression (ps-macroexpand value))))))))
(defpsmacro defvar (name &optional (value (values) value-provided?) documentation)
;; this must be used as a top-level form, otherwise the resulting behavior will be undefined.
,@body))
(*vars-bound-in-enclosing-lexical-scopes* (append lexical-bindings-introduced-here
*vars-bound-in-enclosing-lexical-scopes*)))
- (compile-parenscript-form
+ (ps-compile
`(progn
,@(mapcar (lambda (x) `(var ,(or (rename x) (var x)) ,(val x))) lexical-bindings)
,(if dynamic-bindings
,renamed-body)
(:finally
(setf ,@(mapcan (lambda (x) `(,(var x) ,(rename x))) dynamic-bindings)))))
- renamed-body))
- :expecting expecting)))))
+ renamed-body)))))))
(defpsmacro let* (bindings &body body)
(if bindings
(defun make-for-vars/inits (init-forms)
(mapcar (lambda (x)
(cons (ps-compile-symbol (ps-macroexpand (if (atom x) x (first x))))
- (compile-parenscript-form (ps-macroexpand (if (atom x) nil (second x))) :expecting :expression)))
+ (ps-compile-expression (ps-macroexpand (if (atom x) nil (second x))))))
init-forms))
(define-ps-special-form labeled-for (label init-forms cond-forms step-forms &rest body)
`(js:for ,label
,(make-for-vars/inits init-forms)
- ,(mapcar (lambda (x) (compile-parenscript-form (ps-macroexpand x) :expecting :expression)) cond-forms)
- ,(mapcar (lambda (x) (compile-parenscript-form (ps-macroexpand x) :expecting :expression)) step-forms)
- ,(compile-parenscript-form `(progn ,@body))))
+ ,(mapcar (lambda (x) (ps-compile-expression (ps-macroexpand x))) cond-forms)
+ ,(mapcar (lambda (x) (ps-compile-expression (ps-macroexpand x))) step-forms)
+ ,(ps-compile-statement `(progn ,@body))))
(defpsmacro for (init-forms cond-forms step-forms &body body)
`(labeled-for nil ,init-forms ,cond-forms ,step-forms ,@body))
,(do-make-iter-psteps decls)))))
(define-ps-special-form for-in ((var object) &rest body)
- `(js:for-in ,(compile-parenscript-form var :expecting :expression)
- ,(compile-parenscript-form (ps-macroexpand object) :expecting :expression)
- ,(compile-parenscript-form `(progn ,@body))))
+ `(js:for-in ,(ps-compile-expression var)
+ ,(ps-compile-expression (ps-macroexpand object))
+ ,(ps-compile-statement `(progn ,@body))))
(define-ps-special-form while (test &rest body)
- `(js:while ,(compile-parenscript-form test :expecting :expression)
- ,(compile-parenscript-form `(progn ,@body))))
+ `(js:while ,(ps-compile-expression test)
+ ,(ps-compile-statement `(progn ,@body))))
(defpsmacro dotimes ((var count &optional (result nil result?)) &rest body)
`(do* ((,var 0 (1+ ,var)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; misc
(define-ps-special-form with (expression &rest body)
- `(js:with ,(compile-parenscript-form expression :expecting :expression)
- ,(compile-parenscript-form `(progn ,@body))))
+ `(js:with ,(ps-compile-expression expression)
+ ,(ps-compile-statement `(progn ,@body))))
(define-ps-special-form try (form &rest clauses)
(let ((catch (cdr (assoc :catch clauses)))
(assert (not (cdar catch)) nil "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-parenscript-form `(progn ,form))
+ `(js:try ,(ps-compile-statement `(progn ,form))
:catch ,(when catch (list (ps-compile-symbol (caar catch))
- (compile-parenscript-form `(progn ,@(cdr catch)))))
- :finally ,(when finally (compile-parenscript-form `(progn ,@finally))))))
+ (ps-compile-statement `(progn ,@(cdr catch)))))
+ :finally ,(when finally (ps-compile-statement `(progn ,@finally))))))
(define-ps-special-form cc-if (test &rest body)
- `(js:cc-if ,test ,@(mapcar #'compile-parenscript-form body)))
+ `(js:cc-if ,test ,@(mapcar #'ps-compile-statement body)))
(define-ps-special-form regex (regex)
`(js:regex ,(string regex)))
(define-ps-special-form lisp (lisp-form)
;; (ps (foo (lisp bar))) is in effect equivalent to (ps* `(foo ,bar))
;; when called from inside of ps*, lisp-form has access only to the dynamic environment (like for eval)
- `(js:escape (compiled-form-to-string (compile-parenscript-form ,lisp-form :expecting ,expecting))))
+ `(js:escape (compiled-form-to-string (let ((compile-expression? ,compile-expression?))
+ (ps-compile ,lisp-form)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; eval-when
(member *ps-compilation-level* '(:toplevel :inside-toplevel-form)))
(eval `(progn ,@body)))
(if (member :execute situation-list)
- (compile-parenscript-form `(progn ,@body) :expecting expecting)
- (compile-parenscript-form `(progn) :expecting expecting)))
\ No newline at end of file
+ (ps-compile `(progn ,@body))
+ (ps-compile `(progn))))
HCoop / clinton / parenscript.git / commitdiff