(lambda (&rest ,args)
(destructuring-bind ,(cons 'expecting lambda-list)
,args
- (declare (ignore expecting))
+ (declare (ignorable expecting))
,@body)))))
(defun undefine-ps-special-form (name)
(defvar *ps-special-variables* ())
+(defun ps-special-variable-p (sym)
+ (member sym *ps-special-variables*))
+
;;; form predicates
(defun op-form-p (form)
(defvar *ps-macro-toplevel* (make-macro-env-dictionary)
"Toplevel macro environment dictionary. Key is the symbol name of
the macro, value is (symbol-macro-p . expansion-function).")
+
(defvar *ps-macro-env* (list *ps-macro-toplevel*)
"Current macro environment.")
function of the place, value is an expansion function that takes the
arguments of the access functions as a first value and the form to be
stored as the second value.")
+
+ (defparameter *toplevel-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
+nil indicates we are no longer toplevel-related.")
(defun get-macro-spec (name env-dict)
"Retrieves the macro spec of the given name with the given environment dictionary.
compiled to an :expression (the default), a :statement, or a
:symbol."))
+(defun adjust-toplevel-compilation-level (form level)
+ (let ((default-level (if (eql :toplevel level)
+ :inside-toplevel-form
+ nil)))
+ (if (consp form)
+ (case (car form)
+ ('progn level)
+ (t default-level))
+ default-level)))
+
(defmethod compile-parenscript-form :around (form &key expecting)
(assert (if expecting (member expecting '(:expression :statement :symbol)) t))
(if (eql expecting :symbol)
(ps-macroexpand form)
(if expanded-p
(compile-parenscript-form expanded-form :expecting expecting)
- (call-next-method)))))
+ (let ((*toplevel-compilation-level*
+ (progn
+ (adjust-toplevel-compilation-level form *toplevel-compilation-level*))))
+ (call-next-method))))))
(defun compile-to-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)))
- (when (eql (first exp) 'js-variable)
+ (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 (args)
- (let ((remaining-args args))
- (loop while remaining-args collecting
- (if (keywordp (first remaining-args))
- (prog2 (when (oddp (length remaining-args))
- (error "Odd number of keyword arguments: ~A." args))
- (compile-parenscript-form (cons 'create remaining-args) :expecting :expression)
- (setf remaining-args nil))
- (prog1 (compile-parenscript-form (first remaining-args) :expecting :expression)
- (setf remaining-args (cdr remaining-args)))))))
+ (t `(js:variable ,symbol))))
(defun ps-convert-op-name (op)
- (case (ensure-ps-symbol op)
+ (case op
(and '\&\&)
(or '\|\|)
(not '!)
(args (cdr form)))
(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))))
+ `(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)
(defun ps-gensym (&optional (prefix "_js"))
- (make-symbol (format nil "~A~A" prefix (incf *ps-gensym-counter*))))
+ (let ((prefix (if (stringp prefix) prefix (symbol-to-js-string prefix nil))))
+ (make-symbol (format nil "~A~:[~;_~]~A" prefix
+ (digit-char-p (char prefix (1- (length prefix))))
+ (incf *ps-gensym-counter*)))))
(defmacro with-ps-gensyms (symbols &body body)
"Evaluate BODY with SYMBOLS bound to unique ParenScript identifiers.
`(let* (,,@(mapcar (lambda (g v) ``(,,g ,,v)) gensyms vars))
,(let ,(mapcar (lambda (g v) `(,v ,g)) gensyms vars)
,@body)))))
+
+(defvar *read-function* #'read
+ "This should be a function that takes the same inputs and returns the same
+outputs as the common lisp read function. We declare it as a variable to allow
+a user-supplied reader instead of the default lisp reader.")
+
+(defun ps-compile-stream (stream)
+ "Compiles a source stream as if it were a file. Outputs a Javascript string."
+
+ (let ((*toplevel-compilation-level* :toplevel)
+ (*package* *package*)
+ (end-read-form '#:unique))
+ (flet ((read-form () (funcall *read-function* stream nil end-read-form)))
+ (let* ((js-string
+ ;; cons up the forms, compiling as we go, and print the result
+ (do ((form (read-form) (read-form))
+ (compiled-forms nil))
+ ((eql form end-read-form)
+ (format nil "~{~A~^;~%~}"
+ (remove-if
+ #'(lambda (x) (or (null x) (= 0 (length x))))
+ (mapcar 'compiled-form-to-string (nreverse compiled-forms)))))
+ (push (compile-parenscript-form form :expecting :statement) compiled-forms))))
+ js-string))))
+
+
+(defun ps-compile-file (source-file)
+ "Compiles the given Parenscript source file and returns a Javascript string."
+ (with-open-file (stream source-file :direction :input)
+ (ps-compile-stream stream)))
+
HCoop / clinton / parenscript.git / blobdiff