Commit 3789e74e authored by Scott Bell's avatar Scott Bell
Browse files

Define new special form LABEL to provide general JavaScript labels.

LABELED-FOR is now deprecated in favour of LABEL and FOR.
parent e0146173
......@@ -73,3 +73,7 @@ is output to the OUTPUT-STREAM stream."
(warn-deprecated 'defmacro/ps 'defmacro+ps)
`(progn (defmacro ,name ,args ,@body)
(import-macros-from-lisp ',name)))
(defpsmacro labeled-for (label init-forms cond-forms step-forms &rest body)
(warn-deprecated 'labeled-for 'label)
`(label ,label (for ,init-forms ,cond-forms ,step-forms ,@body)))
......@@ -57,6 +57,7 @@
#:slot-value
#:compile-script
#:defmacro/ps
#:labeled-for
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Language
......
......@@ -239,6 +239,11 @@ arguments, defines a printer for that form using the given body."
(psw " = ")
(ps-print (car var-value))))
(defprinter js:label (label statement)
(psw (symbol-to-js-string label))
(psw ": ")
(ps-print statement))
(defprinter js:break (&optional label)
(psw "break")
(when label
......@@ -252,8 +257,7 @@ arguments, defines a printer for that form using the given body."
(psw (symbol-to-js-string label))))
;;; iteration
(defprinter js:for (label vars tests steps body-block)
(when label (psw (symbol-to-js-string label)) (psw ": ") (newline-and-indent))
(defprinter js:for (vars tests steps body-block)
(psw "for (")
(loop for ((var-name . var-init) . remaining) on vars
for decl = "var " then "" do
......
......@@ -29,6 +29,12 @@
(def-for-literal break js:break)
(def-for-literal continue js:continue))
(define-ps-special-form label (label &rest statements)
`(js:label ,label
,(if (> (length statements) 1)
`(js:block ,@(mapcar #'ps-compile-statement statements))
(ps-compile-statement (car statements)))))
(define-ps-special-form quote (x)
(flet ((quote% (expr) (when expr `',expr)))
(ps-compile-expression
......@@ -61,12 +67,12 @@
(and (consp exp)
(member (car exp)
'(throw
labeled-for
for
for-in
while))))
(defun implicit-progn-form? (form)
(member (car form) '(with progn let flet labels macrolet symbol-macrolet)))
(member (car form) '(with progn label let flet labels macrolet symbol-macrolet)))
(define-ps-special-form return (&optional value force-conditional?)
(let ((value (ps-macroexpand value)))
......@@ -542,7 +548,7 @@ lambda-list::=
fun-name))
(defun collect-function-names (fn-defs)
(loop for (fn-name) in fn-defs
(loop for (fn-name) in fn-defs
collect fn-name
collect (if (or (member fn-name *ps-enclosing-lexicals*)
(lookup-macro-def fn-name *ps-symbol-macro-env*))
......@@ -856,15 +862,11 @@ lambda-list::=
(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) (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))
(define-ps-special-form for (init-forms cond-forms step-forms &body body)
`(js:for ,(make-for-vars/inits init-forms)
,(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))))
(defun do-make-let-bindings (decls)
(mapcar (lambda (x)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment