-(in-package :parenscript)
+(in-package "PARENSCRIPT")
;;; reserved symbols/literals
(gethash name *ps-special-forms*))
(defmacro define-ps-special-form (name lambda-list &rest body)
- "Define a special form NAME. The first argument given to the special
-form is a keyword indicating whether the form is expected to produce
-an :expression or a :statement. The resulting Parenscript language
-types are appended to the ongoing javascript compilation."
- (let ((arglist (gensym "ps-arglist-")))
+ "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 ,arglist)
- (destructuring-bind ,lambda-list
- ,arglist
+ (lambda (&rest ,args)
+ (destructuring-bind ,(cons 'expecting lambda-list)
+ ,args
+ (declare (ignorable expecting))
,@body)))))
(defun undefine-ps-special-form (name)
(not (op-form-p form))
(not (ps-special-form-p form))))
-(defun method-call-p (form)
- (and (funcall-form-p form)
- (symbolp (first form))
- (eql (char (symbol-name (first form)) 0) #\.)))
-
;;; macro expansion
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun make-macro-env-dictionary ()
(lookup-macro-spec name environment)
(values (cdr macro-spec) parent-env)))
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun make-ps-macro-function (args body)
- (let* ((whole-var (when (eql '&whole (first args)) (second args)))
- (effective-lambda-list (if whole-var (cddr args) args))
- (form-arg (or whole-var (gensym "ps-macro-form-arg-")))
- (body (if (and (cdr body) (stringp (first body))) (rest body) body))) ;; drop docstring
- (compile nil `(lambda (,form-arg)
- (destructuring-bind ,effective-lambda-list
- (cdr ,form-arg)
- ,@body)))))
-
- (defun define-ps-macro% (name args body &key symbol-macro-p)
- (undefine-ps-special-form name)
- (setf (get-macro-spec name *ps-macro-toplevel*)
- (cons symbol-macro-p (make-ps-macro-function args body)))
- nil))
+(defun make-ps-macro-function (args body)
+ (let* ((whole-var (when (eql '&whole (first args)) (second args)))
+ (effective-lambda-list (if whole-var (cddr args) args))
+ (whole-arg (or whole-var (gensym "ps-macro-form-arg-"))))
+ `(lambda (,whole-arg)
+ (destructuring-bind ,effective-lambda-list
+ (cdr ,whole-arg)
+ ,@body))))
(defmacro defpsmacro (name args &body body)
- "Define a ParenScript macro, and store it in the toplevel ParenScript
-macro environment."
- `(define-ps-macro% ',name ',args ',body :symbol-macro-p nil))
+ `(progn (undefine-ps-special-form ',name)
+ (setf (get-macro-spec ',name *ps-macro-toplevel*)
+ (cons nil ,(make-ps-macro-function args body)))
+ ',name))
-(defmacro define-ps-symbol-macro (name &body body)
- "Define a ParenScript symbol macro, and store it in the toplevel ParenScript
-macro environment. BODY is a Lisp form that should return a ParenScript form."
- `(define-ps-macro% ',name () ',body :symbol-macro-p t))
+(defmacro define-ps-symbol-macro (symbol expansion)
+ (let ((x (gensym)))
+ `(progn (undefine-ps-special-form ',symbol)
+ (setf (get-macro-spec ',symbol *ps-macro-toplevel*) (cons t (lambda (,x) (declare (ignore ,x)) ',expansion)))
+ ',symbol)))
(defun import-macros-from-lisp (&rest names)
"Import the named Lisp macros into the ParenScript macro
it is first fully macroexpanded in the Lisp macro environment, and
then that expansion is further expanded by ParenScript."
(dolist (name names)
- (define-ps-macro% name '(&rest args)
- (list `(common-lisp:macroexpand `(,',name ,@args)))
- :symbol-macro-p nil)))
+ (eval `(defpsmacro ,name (&rest args)
+ (macroexpand `(,',name ,@args))))))
(defmacro defmacro/ps (name args &body body)
"Define a Lisp macro and import it into the ParenScript macro environment."
`(progn (defmacro ,name ,args ,@body)
- (ps:import-macros-from-lisp ',name)))
+ (import-macros-from-lisp ',name)))
(defmacro defmacro+ps (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."
+ "Define a Lisp macro and a ParenScript macro with the same macro
+function (ie - the same result from macroexpand-1), for cases when the
+two have different full macroexpansions (for example if the CL macro
+contains implementation-specific code when macroexpanded fully in the
+CL environment)."
`(progn (defmacro ,name ,args ,@body)
(defpsmacro ,name ,args ,@body)))
"Recursively macroexpands ParenScript macros and symbol-macros in
the given ParenScript form. Returns two values: the expanded form, and
whether any expansion was performed on the form or not."
- (if (consp form)
- (let ((op (car form))
- (args (cdr form)))
- (cond ((equal op 'quote) (values (if (equalp '(nil) args) nil form) ; leave quotes alone, unless it's a quoted nil
- nil))
- ((ps-macro-p op) (values (ps-macroexpand (funcall (lookup-macro-expansion-function op) form)) t))
- (t (values form nil))))
- (cond ((ps-symbol-macro-p form) (values (ps-macroexpand (funcall (lookup-macro-expansion-function form) (list form))) t))
- (t (values form nil)))))
+ (let ((macro-function (cond ((ps-symbol-macro-p form) form)
+ ((and (consp form) (ps-macro-p (car form))) (car form)))))
+ (if macro-function
+ (values (ps-macroexpand (funcall (lookup-macro-expansion-function macro-function) form)) t)
+ (values form nil))))
;;;; compiler interface
(defgeneric compile-parenscript-form (form &key expecting)
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)))
- (when (or (eql (first exp) 'js-variable)
- (eql (first exp) 'ps-quote))
+ (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)
(if (ps-literal-p symbol)
(funcall (get-ps-special-form symbol) :symbol)
(error "Attempting to use Parenscript special form ~a as variable" symbol)))
- (t (list 'js-variable symbol))))
-
-(defun compile-function-argument-forms (arg-forms)
- "Compiles a bunch of Parenscript forms from a funcall form to an effective set of
-Javascript arguments. The only extra processing this does is makes :keyword arguments
-into a single options argument via CREATE."
- (let ((compiled-args (mapcar (lambda (arg) (compile-parenscript-form arg :expecting :expression))
- arg-forms)))
- (do ((effective-expressions nil)
- (expressions-subl compiled-args))
- ((not expressions-subl) (reverse effective-expressions))
- (let ((arg-expr (first expressions-subl)))
- (if (keywordp arg-expr)
- (progn (when (oddp (length expressions-subl))
- (error "Odd number of keyword arguments: ~A." arg-forms))
- (push (list 'js-object (loop for (name val) on expressions-subl by #'cddr
- collect (list (list 'js-variable name) val)))
- effective-expressions)
- (setf expressions-subl nil))
- (progn (push arg-expr effective-expressions)
- (setf expressions-subl (rest expressions-subl))))))))
+ (t `(js:variable ,symbol))))
(defun ps-convert-op-name (op)
(case (ensure-ps-symbol op)
(defmethod compile-parenscript-form ((form cons) &key (expecting :statement))
(let* ((name (car form))
(args (cdr form)))
- (cond ((eql name 'quote)
- (assert (= 1 (length args)) () "Wrong number of arguments to quote: ~s" args)
- (list 'ps-quote (first args)))
- ((ps-special-form-p form) (apply (get-ps-special-form name) (cons expecting args)))
+ (cond ((ps-special-form-p form) (apply (get-ps-special-form name) (cons expecting args)))
((op-form-p form)
- (list 'operator
- (ps-convert-op-name (compile-parenscript-form (first form) :expecting :symbol))
- (mapcar (lambda (form) (compile-parenscript-form form :expecting :expression)) (rest form))))
- ((method-call-p form)
- (list 'js-method-call
- (compile-parenscript-form name :expecting :symbol)
- (compile-parenscript-form (first args) :expecting :expression)
- (compile-function-argument-forms (rest args))))
+ `(js:operator
+ ,(ps-convert-op-name (compile-parenscript-form (first form) :expecting :symbol))
+ ,@(mapcar (lambda (form) (compile-parenscript-form form :expecting :expression)) (rest form))))
((funcall-form-p form)
- (list 'js-funcall
- (compile-parenscript-form name :expecting :expression)
- (compile-function-argument-forms args)))
+ `(js:funcall ,(compile-parenscript-form name :expecting :expression)
+ ,@(mapcar (lambda (arg) (compile-parenscript-form arg :expecting :expression)) args)))
(t (error "Cannot compile ~S to a ParenScript form." form)))))
(defvar *ps-gensym-counter* 0)