Implemented LET and LET* by variable renaming, which provides the

[clinton/parenscript.git] / src / compiler.lisp

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 5c1e297..0cc8dc7 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -1,35 +1,61 @@
-(in-package :parenscript)
+(in-package "PARENSCRIPT")

 
 

-;;;; The mechanisms for parsing Parenscript.
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defvar *toplevel-special-forms* (make-hash-table :test #'equal)
-    "A hash-table containing functions that implement Parenscript special forms,
-indexed by name (as symbols)")
-  (defun undefine-ps-special-form (name)
-    "Undefines the special form with the given name (name is a symbol)."
-    (remhash (lisp-symbol-to-ps-identifier name :special-form) *toplevel-special-forms*)))
+;;; reserved symbols/literals

 
 

-(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-")))
-    `(setf (gethash (lisp-symbol-to-ps-identifier ',name :special-form) *toplevel-special-forms*)
-      (lambda (&rest ,arglist)
-        (destructuring-bind ,lambda-list
-            ,arglist
-          ,@body)))))
+(defvar *ps-reserved-symbol-names* ()) ;; symbol names reserved for PS/JS literals
+
+(defun add-ps-literal (name)
+  (push (symbol-name name) *ps-reserved-symbol-names*))
+
+(defun ps-literal-p (symbol)
+  (find (symbol-name symbol) *ps-reserved-symbol-names* :test #'equalp))
+
+;;; special forms
+
+(defvar *ps-special-forms* (make-hash-table :test 'eq))

 
 (defun get-ps-special-form (name)
 
 (defun get-ps-special-form (name)

-  "Returns the special form function corresponding to the given name."
-  (gethash (lisp-symbol-to-ps-identifier name :special-form) *toplevel-special-forms*))
+  (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)))))
+
+(defun undefine-ps-special-form (name)
+  (remhash name *ps-special-forms*))

 
 

-;;; ParenScript form predicates

 (defun ps-special-form-p (form)
   (and (consp form)
        (symbolp (car form))
 (defun ps-special-form-p (form)
   (and (consp form)
        (symbolp (car form))

-       (get-ps-special-form (car form))))
+       (gethash (car form) *ps-special-forms*)))
+
+;;; scoping
+
+(defvar *enclosing-lexical-block-declarations* ()
+  "This special variable is expected to be bound to a fresh list by
+special forms that introduce a new JavaScript lexical block (currently
+function definitions and lambdas). Enclosed special forms are expected
+to push variable declarations onto the list when the variables
+declaration cannot be made by the enclosed form \(for example, a
+\(x,y,z\) expression progn\). It is then the responsibility of the
+enclosing special form to introduce the variable bindings in its
+lexical block.")
+
+(defvar *ps-special-variables* ())
+
+(defun ps-special-variable-p (sym)
+  (member sym *ps-special-variables*))
+
+;;; form predicates

 
 (defun op-form-p (form)
   (and (listp form)
 
 (defun op-form-p (form)
   (and (listp form)


@@ -41,37 +67,38 @@ types are appended to the ongoing javascript compilation."
        (not (op-form-p form))
        (not (ps-special-form-p form))))
 
        (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 ()
 ;;; macro expansion
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun make-macro-env-dictionary ()

-    "Creates a standard macro dictionary."
-    (make-hash-table :test #'equal))
-  (defvar *script-macro-toplevel* (make-macro-env-dictionary)
-    "Toplevel macro environment dictionary. Key is the symbol of the
-macro, value is (symbol-macro-p . expansion-function).")
-  (defvar *script-macro-env* (list *script-macro-toplevel*)
+    (make-hash-table :test 'eq))
+  (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.")
 
     "Current macro environment.")
 

-  (defvar *script-setf-expanders* (make-macro-env-dictionary)
+  (defvar *ps-setf-expanders* (make-macro-env-dictionary)

     "Setf expander dictionary. Key is the symbol of the access
 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.")
     "Setf expander dictionary. Key is the symbol of the access
 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.
 SPEC is of the form (symbol-macro-p . expansion-function)."
   
   (defun get-macro-spec (name env-dict)
     "Retrieves the macro spec of the given name with the given environment dictionary.
 SPEC is of the form (symbol-macro-p . expansion-function)."

-    (gethash (lisp-symbol-to-ps-identifier name :macro) env-dict))
+    (gethash name env-dict))

   (defsetf get-macro-spec (name env-dict)
       (spec)
   (defsetf get-macro-spec (name env-dict)
       (spec)

-    `(setf (gethash (lisp-symbol-to-ps-identifier ,name :macro) ,env-dict) ,spec)))
+    `(setf (gethash ,name ,env-dict) ,spec)))

 
 

-(defun lookup-macro-spec (name &optional (environment *script-macro-env*))
+(defun lookup-macro-spec (name &optional (environment *ps-macro-env*))

   "Looks up the macro spec associated with NAME in the given environment.  A
 macro spec is of the form (symbol-macro-p . function). Returns two values:
 the SPEC and the parent macro environment.
   "Looks up the macro spec associated with NAME in the given environment.  A
 macro spec is of the form (symbol-macro-p . function). Returns two values:
 the SPEC and the parent macro environment.


@@ -84,19 +111,19 @@ NAME must be a symbol."
         (when val
           (return-from lookup-macro-spec
             (values val (or (cdr env)
         (when val
           (return-from lookup-macro-spec
             (values val (or (cdr env)

-                            (list *script-macro-toplevel*)))))))))
+                            (list *ps-macro-toplevel*)))))))))

 
 

-(defun script-symbol-macro-p (name &optional (environment *script-macro-env*))
+(defun ps-symbol-macro-p (name &optional (environment *ps-macro-env*))

   "True if there is a Parenscript symbol macro named by the symbol NAME."
   (and (symbolp name) (car (lookup-macro-spec name environment))))
 
   "True if there is a Parenscript symbol macro named by the symbol NAME."
   (and (symbolp name) (car (lookup-macro-spec name environment))))
 

-(defun script-macro-p (name &optional (environment *script-macro-env*))
+(defun ps-macro-p (name &optional (environment *ps-macro-env*))

   "True if there is a Parenscript macro named by the symbol NAME."
   (and (symbolp name)
        (let ((macro-spec (lookup-macro-spec name environment)))
   "True if there is a Parenscript macro named by the symbol NAME."
   (and (symbolp name)
        (let ((macro-spec (lookup-macro-spec name environment)))

-        (and macro-spec (not (car macro-spec))))))
+         (and macro-spec (not (car macro-spec))))))

 
 

-(defun lookup-macro-expansion-function (name &optional (environment *script-macro-env*))
+(defun lookup-macro-expansion-function (name &optional (environment *ps-macro-env*))

   "Lookup NAME in the given macro expansion environment (which
 defaults to the current macro environment). Returns the expansion
 function and the parent macro environment of the macro."
   "Lookup NAME in the given macro expansion environment (which
 defaults to the current macro environment). Returns the expansion
 function and the parent macro environment of the macro."


@@ -104,32 +131,26 @@ function and the parent macro environment of the macro."
       (lookup-macro-spec name environment)
     (values (cdr macro-spec) parent-env)))
 
       (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-script-macro% (name args body &key symbol-macro-p)
-    (undefine-ps-special-form name)
-    (setf (get-macro-spec name *script-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)
 
 (defmacro defpsmacro (name args &body body)

-  "Define a ParenScript macro, and store it in the toplevel ParenScript
-macro environment."
-  `(define-script-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-script-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-script-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
 
 (defun import-macros-from-lisp (&rest names)
   "Import the named Lisp macros into the ParenScript macro


@@ -137,21 +158,20 @@ environment. When the imported macro is macroexpanded by ParenScript,
 it is first fully macroexpanded in the Lisp macro environment, and
 then that expansion is further expanded by ParenScript."
   (dolist (name names)
 it is first fully macroexpanded in the Lisp macro environment, and
 then that expansion is further expanded by ParenScript."
   (dolist (name names)

-    (define-script-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)
 
 (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)
 
 (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)))
 
   `(progn (defmacro ,name ,args ,@body)
           (defpsmacro ,name ,args ,@body)))
 


@@ -159,15 +179,11 @@ the ParenScript macro environment."
   "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."
   "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))
-              ((script-macro-p op) (values (ps-macroexpand (funcall (lookup-macro-expansion-function op) form)) t))
-              (t (values form nil))))
-      (cond ((script-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)
 
 ;;;; compiler interface
 (defgeneric compile-parenscript-form (form &key expecting)


@@ -176,22 +192,35 @@ ParenScript representation. :expecting determines whether the form is
 compiled to an :expression (the default), a :statement, or a
 :symbol."))
 
 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)
 (defmethod compile-parenscript-form :around (form &key expecting)

+  (assert (if expecting (member expecting '(:expression :statement :symbol)) t))

   (if (eql expecting :symbol)
       (compile-to-symbol form)
       (multiple-value-bind (expanded-form expanded-p)
           (ps-macroexpand form)
         (if expanded-p
             (compile-parenscript-form expanded-form :expecting expecting)
   (if (eql expecting :symbol)
       (compile-to-symbol form)
       (multiple-value-bind (expanded-form expanded-p)
           (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)))
 
 (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 (or (eql (first exp) 'js-variable)
-              (eql (first exp) 'script-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)
       (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)


@@ -215,54 +244,99 @@ the form cannot be compiled to a symbol."
 
 (defmethod compile-parenscript-form ((symbol symbol) &key expecting)
   (declare (ignore expecting))
 
 (defmethod compile-parenscript-form ((symbol symbol) &key expecting)
   (declare (ignore expecting))

-  ;; is this the correct behavior?
-  (let ((special-symbol (get-ps-special-form symbol)))
-    (cond (special-symbol (funcall special-symbol :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."
-  (flet ((keyword-arg (arg)
-          "If the given compiled expression is supposed to be a keyword argument, returns
-the keyword for it."
-          (when (and (listp arg) (eql (first arg) 'script-quote)) (second arg))))
-    (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 (keyword-arg 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 name val)))
-                           effective-expressions)
-                     (setf expressions-subl nil))
-              (progn (push arg-expr effective-expressions)
-                     (setf expressions-subl (rest expressions-subl)))))))))
+  (cond ((keywordp symbol) symbol)
+        ((ps-special-form-p (list symbol))
+         (if (ps-literal-p symbol)
+             (funcall (get-ps-special-form symbol) :symbol)
+             (error "Attempting to use Parenscript special form ~a as variable" symbol)))
+        (t `(js:variable ,symbol))))
+
+(defun ps-convert-op-name (op)
+  (case op
+    (and '\&\&)
+    (or '\|\|)
+    (not '!)
+    (eql '\=\=)
+    (=   '\=\=)
+    (t op)))

 
 (defmethod compile-parenscript-form ((form cons) &key (expecting :statement))
   (let* ((name (car form))
 
 (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 'script-quote (first args)))
-          ((ps-special-form-p form) (apply (get-ps-special-form name) (cons expecting args)))
+         (args (cdr form)))
+    (cond ((ps-special-form-p form) (apply (get-ps-special-form name) (cons expecting args)))

           ((op-form-p form)
           ((op-form-p form)

-           (list 'operator
-                 (script-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)
           ((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)))))
 
           (t (error "Cannot compile ~S to a ParenScript form." form)))))
 

+(defvar *ps-gensym-counter* 0)
+
+(defun ps-gensym (&optional (prefix "_js"))
+  (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.
+
+Each element of SYMBOLS is either a symbol or a list of (symbol
+gensym-prefix-string)."
+  `(let* ,(mapcar (lambda (symbol)
+                    (destructuring-bind (symbol &optional prefix)
+                        (if (consp symbol)
+                            symbol
+                            (list symbol))
+                      (if prefix
+                          `(,symbol (ps-gensym ,prefix))
+                          `(,symbol (ps-gensym ,(symbol-to-js-string symbol))))))
+                  symbols)
+     ,@body))
+
+(defun %check-once-only-vars (vars)
+  (let ((bad-var (find-if (lambda (x) (or (not (symbolp x)) (keywordp x))) vars)))
+    (when bad-var
+      (error "PS-ONLY-ONCE expected a non-keyword symbol but got ~s" bad-var))))
+
+(defmacro ps-once-only ((&rest vars) &body body)
+  (%check-once-only-vars vars)
+  (let ((gensyms (mapcar (lambda (x) (ps-gensym (string x))) vars)))
+    `(let ,(mapcar (lambda (g v) `(,g (ps-gensym ,(string v)))) gensyms vars)
+       `(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)))
+