[clinton/parenscript.git] / src / js-macrology.lisp

(in-package :parenscript)

;;;; The macrology of the basic Javascript-in-SEXPs language.  Special forms and macros.

;;; literals
(defmacro defpsliteral (name string)
  `(define-ps-special-form ,name (expecting) (list 'js-literal ,string)))

(defpsliteral this      "this")
(defpsliteral t         "true")
(defpsliteral true      "true")
(defpsliteral false     "false")
(defpsliteral f         "false")
(defpsliteral nil       "null")
(defpsliteral undefined "undefined")

(defmacro defpskeyword (name string)
  `(define-ps-special-form ,name (expecting) (list 'js-keyword ,string)))

(defpskeyword break    "break")
(defpskeyword continue "continue")

(define-ps-special-form array (expecting &rest values)
  (cons 'array-literal (mapcar (lambda (form) (compile-parenscript-form form :expecting :expression))
                               values)))

(define-ps-special-form aref (expecting array &rest coords)
  (list 'js-aref (compile-parenscript-form array :expecting :expression)
        (mapcar (lambda (form)
                  (compile-parenscript-form form :expecting :expression))
                coords)))

(define-ps-special-form {} (expecting &rest arrows)
  (cons 'object-literal (loop for (key value) on arrows by #'cddr
                              collect (cons key (compile-parenscript-form value :expecting :expression)))))

;;; operators
(define-ps-special-form incf (expecting x &optional (delta 1))
  (if (equal delta 1)
      (list 'unary-operator "++" (compile-parenscript-form x :expecting :expression) :prefix t)
      (list 'operator '+= (list (compile-parenscript-form x :expecting :expression)
                                (compile-parenscript-form delta :expecting :expression)))))

(define-ps-special-form decf (expecting x &optional (delta 1))
  (if (equal delta 1)
      (list 'unary-operator "--" (compile-parenscript-form x :expecting :expression) :prefix t)
      (list 'operator '-= (list (compile-parenscript-form x :expecting :expression)
                                (compile-parenscript-form delta :expecting :expression)))))

(define-ps-special-form - (expecting first &rest rest)
  (if (null rest)
      (list 'unary-operator "-" (compile-parenscript-form first :expecting :expression) :prefix t)
      (list 'operator '- (mapcar (lambda (val) (compile-parenscript-form val :expecting :expression))
                                 (cons first rest)))))

(define-ps-special-form not (expecting x)
  (let ((form (compile-parenscript-form x :expecting :expression))
        (not-op nil))
    (if (and (eql (first form) 'operator)
	     (= (length (third form)) 2)
             (setf not-op (case (second form)
                            (== '!=)
                            (< '>=)
                            (> '<=)
                            (<= '>)
                            (>= '<)
                            (!= '==)
                            (=== '!==)
                            (!== '===)
                            (t nil))))
        (list 'operator not-op (third form))
        (list 'unary-operator "!" form :prefix t))))

(define-ps-special-form ~ (expecting x)
  (list 'unary-operator "~" (compile-parenscript-form x :expecting :expressin) :prefix t))

(defun flatten-progns (body)
  (unless (null body)
    (if (and (listp (car body))
             (eql 'progn (caar body)))
        (append (cdar body) (flatten-progns (cdr body)))
        (cons (car body) (flatten-progns (cdr body))))))

(define-ps-special-form progn (expecting &rest body)
  (list 'js-block
        (if (eql expecting :statement) t nil)
        (remove nil (mapcar (lambda (form)
                              (compile-parenscript-form form :expecting :statement))
                            (flatten-progns body)))))

;;; function definition
(define-ps-special-form %js-lambda (expecting args &rest body)
  (list 'js-lambda (mapcar (lambda (arg)
                             (compile-parenscript-form arg :expecting :symbol))
                           args)
        (compile-parenscript-form `(progn ,@body))))

(define-ps-special-form %js-defun (expecting name args &rest body)
  (list 'js-defun (compile-parenscript-form name :expecting :symbol)
        (mapcar (lambda (val) (compile-parenscript-form val :expecting :symbol)) args)
	(compile-parenscript-form `(progn ,@body))))

;;; object creation
(define-ps-special-form create (expecting &rest args)
  (list 'js-object (loop for (name val) on args by #'cddr collecting
                         (let ((name-expr (compile-parenscript-form name :expecting :expression)))
                           (assert (or (stringp name-expr)
                                       (numberp name-expr)
                                       (and (listp name-expr)
                                            (or (eql 'js-variable (car name-expr))
                                                (eql 'script-quote (car name-expr)))))
                                   ()
                                   "Slot ~s is not one of js-variable, keyword, string or number." name-expr)
                           (list name-expr (compile-parenscript-form val :expecting :expression))))))

(define-ps-special-form %js-slot-value (expecting obj slot)
  (if (ps::ps-macroexpand slot)
      (list 'js-slot-value (compile-parenscript-form obj :expecting :expression) (compile-parenscript-form slot))
      (compile-parenscript-form obj :expecting :expression)))

(define-ps-special-form cond (expecting &rest clauses)
  (list 'js-cond (mapcar (lambda (clause)
                           (destructuring-bind (test &rest body)
                               clause
                             (list (compile-parenscript-form test :expecting :expression)
                                   (mapcar (lambda (form) (compile-parenscript-form form :expecting :statement))
                                           body))))
                         clauses)))

(define-ps-special-form if (expecting test then &optional else)
  (ecase expecting
    (:statement (list 'js-statement-if (compile-parenscript-form test :expecting :expression)
                      (compile-parenscript-form `(progn ,then))
                      (when else (compile-parenscript-form `(progn ,else)))))
    (:expression (list 'js-expression-if (compile-parenscript-form test :expecting :expression)
                       (compile-parenscript-form then :expecting :expression)
                       (when else (compile-parenscript-form else :expecting :expression))))))

(define-ps-special-form switch (expecting test-expr &rest clauses)
  (let ((clauses (mapcar (lambda (clause)
			     (let ((val (car clause))
				   (body (cdr clause)))
			       (list (if (eql val 'default)
					 'default
					 (compile-parenscript-form val :expecting :expression))
                                     (compile-parenscript-form `(progn ,@body)))))
			 clauses))
	(expr (compile-parenscript-form test-expr :expecting :expression)))
    (list 'js-switch expr clauses)))

;;; assignment
(defun assignment-op (op)
  (case op
    (+ '+=)
    (~ '~=)
    (\& '\&=)
    (\| '\|=)
    (- '-=)
    (* '*=)
    (% '%=)
    (>> '>>=)
    (^  '^=)
    (<< '<<=)
    (>>> '>>>=)
    (/   '/=)
    (t   nil)))

(defun smart-setf (lhs rhs)
  (if (and (listp rhs)
           (eql 'operator (car rhs))
	   (member lhs (third rhs) :test #'equalp))
      (let ((args-without (remove lhs (third rhs) :count 1 :test #'equalp))
	    (args-without-first (remove lhs (third rhs) :count 1 :end 1 :test #'equalp)))
	(cond ((and (equal (car args-without) 1) (eql (second rhs) '+))
	       (list 'unary-operator "++" lhs :prefix nil))
	      ((and (equal (second args-without-first) 1) (eql (second rhs) '-))
	       (list 'unary-operator "--" lhs :prefix nil))
	      ((and (assignment-op (second rhs))
		    (member (second rhs) '(+ *))
                    (equalp lhs (first (third rhs))))
	       (list 'operator (assignment-op (second rhs))
                     (list lhs (list 'operator (second rhs) args-without-first))))
	      ((and (assignment-op (second rhs)) (equalp (first (third rhs)) lhs))
	       (list 'operator (assignment-op (second rhs))
                     (list lhs (list 'operator (second rhs) (cdr (third rhs))))))
	      (t (list 'js-assign lhs rhs))))
      (list 'js-assign lhs rhs)))

(define-ps-special-form setf1% (expecting lhs rhs)
  (smart-setf (compile-parenscript-form lhs :expecting :expression) (compile-parenscript-form rhs :expecting :expression)))

(define-ps-special-form defvar (expecting name &rest value)
  (append (list 'js-defvar (compile-parenscript-form name :expecting :symbol))
          (when value
            (assert (= (length value) 1) () "Wrong number of arguments to defvar: ~s" `(defvar ,name ,@value))
           (list (compile-parenscript-form (car value) :expecting :expression)))))

;;; iteration
(defun make-for-vars (decls)
  (loop for decl in decls
	for var = (if (atom decl) decl (first decl))
	for init-value = (if (atom decl) nil (second decl))
	collect (cons (compile-parenscript-form var :expecting :symbol) (compile-parenscript-form init-value))))

(defun make-for-steps (decls)
  (loop for decl in decls
	when (= (length decl) 3)
	collect (compile-parenscript-form (third decl) :expecting :expression)))

(define-ps-special-form do (expecting decls termination-test &rest body)
  (let ((vars (make-for-vars decls))
	(steps (make-for-steps decls))
	(test (compile-parenscript-form `(not ,(first termination-test)) :expecting :expression))
	(body (compile-parenscript-form `(progn ,@body))))
    (list 'js-for vars steps test body)))

(define-ps-special-form doeach (expecting decl &rest body)
  (list 'js-for-each
        (compile-parenscript-form (first decl) :expecting :symbol)
        (compile-parenscript-form (second decl) :expecting :expression)
	(compile-parenscript-form `(progn ,@body))))

(define-ps-special-form while (expecting test &rest body)
  (list 'js-while (compile-parenscript-form test :expecting :expression)
                  (compile-parenscript-form `(progn ,@body))))

(define-ps-special-form with (expecting expression &rest body)
  (list 'js-with (compile-parenscript-form expression :expecting :expression)
		 (compile-parenscript-form `(progn ,@body))))

(define-ps-special-form try (expecting form &rest clauses)
  (let ((catch (cdr (assoc :catch clauses)))
        (finally (cdr (assoc :finally clauses))))
    (assert (not (cdar catch)) nil "Sorry, currently only simple catch forms are supported.")
    (list 'js-try (compile-parenscript-form `(progn ,form))
          :catch (when catch (list (compile-parenscript-form (caar catch) :expecting :symbol)
                                   (compile-parenscript-form `(progn ,@(cdr catch)))))
          :finally (when finally (compile-parenscript-form `(progn ,@finally))))))

(define-ps-special-form regex (expecting regex)
  (list 'js-regex (string regex)))

;;; TODO instanceof
(define-ps-special-form instanceof (expecting value type)
  (list 'js-instanceof (compile-parenscript-form value :expecting :expression)
        (compile-parenscript-form type :expecting :expression)))

;;; single operations
(mapcar (lambda (op) (eval `(define-ps-special-form ,op (expecting value)
                             (list 'js-named-operator ',op (compile-parenscript-form value)))))
        '(throw delete void typeof new))

(define-ps-special-form return (expecting &optional value)
  (list 'js-return (compile-parenscript-form value :expecting :expression)))

;;; conditional compilation
(define-ps-special-form cc-if (expecting test &rest body)
  (list 'cc-if test (mapcar #'compile-parenscript-form body)))

;;; standard macros
(defpsmacro when (test &rest body)
  `(if ,test (progn ,@body)))

(defpsmacro unless (test &rest body)
  `(if (not ,test) (progn ,@body)))

(defpsmacro 1- (form)
  `(- ,form 1))

(defpsmacro 1+ (form)
  `(+ ,form 1))

;;; helper macros
(define-ps-special-form js (expecting &rest body)
  (string-join (ps-print (compile-parenscript-form `(progn ,@body)) 0) " "))

(define-ps-special-form ps-inline (expecting &rest body)
  (concatenate 'string
               "javascript:"
               (string-join (reduce #'append (mapcar (lambda (form)
                                                       (ps-print (compile-parenscript-form form :expecting :statement)
                                                                 0))
                                                     body))
                            ";")
               ";"))
Commit	Line	Data
4a987e2b	1	(in-package :parenscript)
5aa10005 RD	2
	3	;;;; The macrology of the basic Javascript-in-SEXPs language. Special forms and macros.
	4
	5	;;; literals
4a987e2b VS	6	(defmacro defpsliteral (name string)
	7	`(define-ps-special-form ,name (expecting) (list 'js-literal ,string)))
	8
	9	(defpsliteral this "this")
	10	(defpsliteral t "true")
	11	(defpsliteral true "true")
	12	(defpsliteral false "false")
	13	(defpsliteral f "false")
	14	(defpsliteral nil "null")
	15	(defpsliteral undefined "undefined")
	16
	17	(defmacro defpskeyword (name string)
	18	`(define-ps-special-form ,name (expecting) (list 'js-keyword ,string)))
	19
	20	(defpskeyword break "break")
	21	(defpskeyword continue "continue")
	22
	23	(define-ps-special-form array (expecting &rest values)
	24	(cons 'array-literal (mapcar (lambda (form) (compile-parenscript-form form :expecting :expression))
	25	values)))
	26
	27	(define-ps-special-form aref (expecting array &rest coords)
	28	(list 'js-aref (compile-parenscript-form array :expecting :expression)
	29	(mapcar (lambda (form)
	30	(compile-parenscript-form form :expecting :expression))
	31	coords)))
	32
	33	(define-ps-special-form {} (expecting &rest arrows)
	34	(cons 'object-literal (loop for (key value) on arrows by #'cddr
	35	collect (cons key (compile-parenscript-form value :expecting :expression)))))
5aa10005 RD	36
5aa10005 RD	37	;;; operators
4a987e2b VS	38	(define-ps-special-form incf (expecting x &optional (delta 1))
	39	(if (equal delta 1)
	40	(list 'unary-operator "++" (compile-parenscript-form x :expecting :expression) :prefix t)
	41	(list 'operator '+= (list (compile-parenscript-form x :expecting :expression)
	42	(compile-parenscript-form delta :expecting :expression)))))
	43
	44	(define-ps-special-form decf (expecting x &optional (delta 1))
	45	(if (equal delta 1)
	46	(list 'unary-operator "--" (compile-parenscript-form x :expecting :expression) :prefix t)
	47	(list 'operator '-= (list (compile-parenscript-form x :expecting :expression)
	48	(compile-parenscript-form delta :expecting :expression)))))
	49
	50	(define-ps-special-form - (expecting first &rest rest)
5aa10005	51	(if (null rest)
4a987e2b VS	52	(list 'unary-operator "-" (compile-parenscript-form first :expecting :expression) :prefix t)
	53	(list 'operator '- (mapcar (lambda (val) (compile-parenscript-form val :expecting :expression))
	54	(cons first rest)))))
	55
	56	(define-ps-special-form not (expecting x)
	57	(let ((form (compile-parenscript-form x :expecting :expression))
	58	(not-op nil))
	59	(if (and (eql (first form) 'operator)
	60	(= (length (third form)) 2)
	61	(setf not-op (case (second form)
	62	(== '!=)
	63	(< '>=)
	64	(> '<=)
	65	(<= '>)
	66	(>= '<)
	67	(!= '==)
	68	(=== '!==)
	69	(!== '===)
	70	(t nil))))
	71	(list 'operator not-op (third form))
	72	(list 'unary-operator "!" form :prefix t))))
	73
	74	(define-ps-special-form ~ (expecting x)
	75	(list 'unary-operator "~" (compile-parenscript-form x :expecting :expressin) :prefix t))
	76
	77	(defun flatten-progns (body)
	78	(unless (null body)
	79	(if (and (listp (car body))
	80	(eql 'progn (caar body)))
	81	(append (cdar body) (flatten-progns (cdr body)))
	82	(cons (car body) (flatten-progns (cdr body))))))
	83
	84	(define-ps-special-form progn (expecting &rest body)
	85	(list 'js-block
	86	(if (eql expecting :statement) t nil)
	87	(remove nil (mapcar (lambda (form)
	88	(compile-parenscript-form form :expecting :statement))
	89	(flatten-progns body)))))
5aa10005 RD	90
5aa10005 RD	91	;;; function definition
4a987e2b VS	92	(define-ps-special-form %js-lambda (expecting args &rest body)
	93	(list 'js-lambda (mapcar (lambda (arg)
	94	(compile-parenscript-form arg :expecting :symbol))
	95	args)
	96	(compile-parenscript-form `(progn ,@body))))
	97
	98	(define-ps-special-form %js-defun (expecting name args &rest body)
	99	(list 'js-defun (compile-parenscript-form name :expecting :symbol)
	100	(mapcar (lambda (val) (compile-parenscript-form val :expecting :symbol)) args)
	101	(compile-parenscript-form `(progn ,@body))))
5aa10005 RD	102
5aa10005 RD	103	;;; object creation
4a987e2b VS	104	(define-ps-special-form create (expecting &rest args)
	105	(list 'js-object (loop for (name val) on args by #'cddr collecting
	106	(let ((name-expr (compile-parenscript-form name :expecting :expression)))
	107	(assert (or (stringp name-expr)
	108	(numberp name-expr)
	109	(and (listp name-expr)
	110	(or (eql 'js-variable (car name-expr))
	111	(eql 'script-quote (car name-expr)))))
	112	()
	113	"Slot ~s is not one of js-variable, keyword, string or number." name-expr)
	114	(list name-expr (compile-parenscript-form val :expecting :expression))))))
	115
	116	(define-ps-special-form %js-slot-value (expecting obj slot)
	117	(if (ps::ps-macroexpand slot)
	118	(list 'js-slot-value (compile-parenscript-form obj :expecting :expression) (compile-parenscript-form slot))
	119	(compile-parenscript-form obj :expecting :expression)))
	120
	121	(define-ps-special-form cond (expecting &rest clauses)
	122	(list 'js-cond (mapcar (lambda (clause)
	123	(destructuring-bind (test &rest body)
	124	clause
	125	(list (compile-parenscript-form test :expecting :expression)
	126	(mapcar (lambda (form) (compile-parenscript-form form :expecting :statement))
	127	body))))
	128	clauses)))
	129
	130	(define-ps-special-form if (expecting test then &optional else)
	131	(ecase expecting
	132	(:statement (list 'js-statement-if (compile-parenscript-form test :expecting :expression)
	133	(compile-parenscript-form `(progn ,then))
	134	(when else (compile-parenscript-form `(progn ,else)))))
	135	(:expression (list 'js-expression-if (compile-parenscript-form test :expecting :expression)
	136	(compile-parenscript-form then :expecting :expression)
	137	(when else (compile-parenscript-form else :expecting :expression))))))
	138
	139	(define-ps-special-form switch (expecting test-expr &rest clauses)
	140	(let ((clauses (mapcar (lambda (clause)
	141	(let ((val (car clause))
5aa10005 RD	142	(body (cdr clause)))
	143	(list (if (eql val 'default)
	144	'default
4a987e2b VS	145	(compile-parenscript-form val :expecting :expression))
4a987e2b VS	146	(compile-parenscript-form `(progn ,@body)))))
5aa10005	147	clauses))
4a987e2b VS	148	(expr (compile-parenscript-form test-expr :expecting :expression)))
4a987e2b VS	149	(list 'js-switch expr clauses)))
5aa10005 RD	150
	151	;;; assignment
	152	(defun assignment-op (op)
	153	(case op
	154	(+ '+=)
	155	(~ '~=)
	156	(\& '\&=)
	157	(\\| '\\|=)
	158	(- '-=)
	159	(* '*=)
	160	(% '%=)
	161	(>> '>>=)
	162	(^ '^=)
	163	(<< '<<=)
	164	(>>> '>>>=)
	165	(/ '/=)
	166	(t nil)))
	167
4a987e2b VS	168	(defun smart-setf (lhs rhs)
	169	(if (and (listp rhs)
	170	(eql 'operator (car rhs))
	171	(member lhs (third rhs) :test #'equalp))
	172	(let ((args-without (remove lhs (third rhs) :count 1 :test #'equalp))
	173	(args-without-first (remove lhs (third rhs) :count 1 :end 1 :test #'equalp)))
	174	(cond ((and (equal (car args-without) 1) (eql (second rhs) '+))
	175	(list 'unary-operator "++" lhs :prefix nil))
	176	((and (equal (second args-without-first) 1) (eql (second rhs) '-))
	177	(list 'unary-operator "--" lhs :prefix nil))
	178	((and (assignment-op (second rhs))
	179	(member (second rhs) '(+ *))
	180	(equalp lhs (first (third rhs))))
	181	(list 'operator (assignment-op (second rhs))
	182	(list lhs (list 'operator (second rhs) args-without-first))))
	183	((and (assignment-op (second rhs)) (equalp (first (third rhs)) lhs))
	184	(list 'operator (assignment-op (second rhs))
	185	(list lhs (list 'operator (second rhs) (cdr (third rhs))))))
	186	(t (list 'js-assign lhs rhs))))
	187	(list 'js-assign lhs rhs)))
	188
	189	(define-ps-special-form setf1% (expecting lhs rhs)
	190	(smart-setf (compile-parenscript-form lhs :expecting :expression) (compile-parenscript-form rhs :expecting :expression)))
	191
	192	(define-ps-special-form defvar (expecting name &rest value)
	193	(append (list 'js-defvar (compile-parenscript-form name :expecting :symbol))
	194	(when value
	195	(assert (= (length value) 1) () "Wrong number of arguments to defvar: ~s" `(defvar ,name ,@value))
	196	(list (compile-parenscript-form (car value) :expecting :expression)))))
5aa10005 RD	197
	198	;;; iteration
	199	(defun make-for-vars (decls)
	200	(loop for decl in decls
	201	for var = (if (atom decl) decl (first decl))
4a987e2b VS	202	for init-value = (if (atom decl) nil (second decl))
4a987e2b VS	203	collect (cons (compile-parenscript-form var :expecting :symbol) (compile-parenscript-form init-value))))
5aa10005 RD	204
	205	(defun make-for-steps (decls)
	206	(loop for decl in decls
	207	when (= (length decl) 3)
4a987e2b	208	collect (compile-parenscript-form (third decl) :expecting :expression)))
5aa10005	209
4a987e2b	210	(define-ps-special-form do (expecting decls termination-test &rest body)
5aa10005 RD	211	(let ((vars (make-for-vars decls))
5aa10005 RD	212	(steps (make-for-steps decls))
4a987e2b VS	213	(test (compile-parenscript-form `(not ,(first termination-test)) :expecting :expression))
	214	(body (compile-parenscript-form `(progn ,@body))))
	215	(list 'js-for vars steps test body)))
	216
	217	(define-ps-special-form doeach (expecting decl &rest body)
	218	(list 'js-for-each
	219	(compile-parenscript-form (first decl) :expecting :symbol)
	220	(compile-parenscript-form (second decl) :expecting :expression)
	221	(compile-parenscript-form `(progn ,@body))))
	222
	223	(define-ps-special-form while (expecting test &rest body)
	224	(list 'js-while (compile-parenscript-form test :expecting :expression)
	225	(compile-parenscript-form `(progn ,@body))))
	226
	227	(define-ps-special-form with (expecting expression &rest body)
	228	(list 'js-with (compile-parenscript-form expression :expecting :expression)
	229	(compile-parenscript-form `(progn ,@body))))
	230
	231	(define-ps-special-form try (expecting form &rest clauses)
	232	(let ((catch (cdr (assoc :catch clauses)))
	233	(finally (cdr (assoc :finally clauses))))
5aa10005	234	(assert (not (cdar catch)) nil "Sorry, currently only simple catch forms are supported.")
4a987e2b VS	235	(list 'js-try (compile-parenscript-form `(progn ,form))
	236	:catch (when catch (list (compile-parenscript-form (caar catch) :expecting :symbol)
	237	(compile-parenscript-form `(progn ,@(cdr catch)))))
	238	:finally (when finally (compile-parenscript-form `(progn ,@finally))))))
	239
	240	(define-ps-special-form regex (expecting regex)
	241	(list 'js-regex (string regex)))
5aa10005 RD	242
5aa10005 RD	243	;;; TODO instanceof
4a987e2b VS	244	(define-ps-special-form instanceof (expecting value type)
	245	(list 'js-instanceof (compile-parenscript-form value :expecting :expression)
	246	(compile-parenscript-form type :expecting :expression)))
5aa10005 RD	247
5aa10005 RD	248	;;; single operations
4a987e2b VS	249	(mapcar (lambda (op) (eval `(define-ps-special-form ,op (expecting value)
	250	(list 'js-named-operator ',op (compile-parenscript-form value)))))
	251	'(throw delete void typeof new))
5aa10005	252
4a987e2b VS	253	(define-ps-special-form return (expecting &optional value)
4a987e2b VS	254	(list 'js-return (compile-parenscript-form value :expecting :expression)))
a2434734	255
5aa10005	256	;;; conditional compilation
4a987e2b VS	257	(define-ps-special-form cc-if (expecting test &rest body)
4a987e2b VS	258	(list 'cc-if test (mapcar #'compile-parenscript-form body)))
5aa10005 RD	259
5aa10005 RD	260	;;; standard macros
4a987e2b	261	(defpsmacro when (test &rest body)
5aa10005 RD	262	`(if ,test (progn ,@body)))
5aa10005 RD	263
4a987e2b	264	(defpsmacro unless (test &rest body)
5aa10005 RD	265	`(if (not ,test) (progn ,@body)))
5aa10005 RD	266
4a987e2b	267	(defpsmacro 1- (form)
5aa10005 RD	268	`(- ,form 1))
5aa10005 RD	269
4a987e2b	270	(defpsmacro 1+ (form)
5aa10005 RD	271	`(+ ,form 1))
5aa10005 RD	272
5aa10005	273	;;; helper macros
4a987e2b VS	274	(define-ps-special-form js (expecting &rest body)
	275	(string-join (ps-print (compile-parenscript-form `(progn ,@body)) 0) " "))
	276
	277	(define-ps-special-form ps-inline (expecting &rest body)
	278	(concatenate 'string
	279	"javascript:"
	280	(string-join (reduce #'append (mapcar (lambda (form)
	281	(ps-print (compile-parenscript-form form :expecting :statement)
	282	0))
	283	body))
	284	";")
	285	";"))
	286