eval-when special form

Added the EVAL-WHEN special form to the Parenscript language.  It
works similarly to the EVAL-WHEN form in Lisp.  It has the following
form:

(eval-when body-forms-language? (situation*) body-forms*)

SITUATION is either :compile-toplevel or :execute.

BODY-FORMS-LANGUAGE is optional and either :parenscript or :lisp.  It
defaults to :lisp when :COMPILE-TOPLEVEL is specified and :parenscript
when :EXECUTE is specified.

Parenscript's EVAL-WHEN is relevant when loading toplevel forms,
either from Parenscript files or from within Lisp.

diff --git a/src/compilation-interface.lisp b/src/compilation-interface.lisp
index 2420cb2..fa9ba99 100644 (file)
--- a/src/compilation-interface.lisp
+++ b/src/compilation-interface.lisp
@@ -31,6 +31,7 @@ OUTPUT-SPEC must be :javascript at the moment."
                       (output-spec :javascript)
                       (pretty-print t)
                       (output-stream nil)
+                      (toplevel-p t)
                       (comp-env (make-basic-compilation-environment)))
   "Compiles the Parenscript form SCRIPT-FORM into the language specified by OUTPUT-SPEC.
 Non-null PRETTY-PRINT values result in a pretty-printed output code.  If OUTPUT-STREAM
@@ -46,12 +47,42 @@ potentially other languages)."
                 (let ((,var output-stream))
                   ,@body))))
     (with-output-stream (stream)
-      (let ((*compilation-environment* comp-env))
-       (translate-ast (compile-script-form script-form :comp-env comp-env)
-                      :comp-env comp-env
-                      :output-stream stream
-                      :output-spec output-spec
-                      :pretty-print pretty-print)))))
+      (let* ((*compilation-environment* comp-env)
+            (compiled
+             (if toplevel-p
+                 (compile-parenscript-form 
+                  comp-env
+                  (compile-parenscript-form comp-env script-form :toplevel-p t))
+                 (compile-parenscript-form comp-env script-form :toplevel-p nil))))
+       (translate-ast
+        compiled
+;       (compile-script-form script-form :comp-env comp-env)
+        :comp-env comp-env
+        :output-stream stream
+        :output-spec output-spec
+        :pretty-print pretty-print)))))
+
+(defun compile-script-file (source-file
+                           &key
+                           (output-spec :javascript)
+                           (comp-env (or *compilation-environment*
+                                         (make-basic-compilation-environment)))
+                           (pretty-print t)
+                           (output-stream *standard-output*))
+  "Compiles the given Parenscript source file and outputs the results
+to the given output stream."
+  (setf (comp-env-compiling-toplevel-p comp-env) t)
+  (error "NOT IMPLEMENTED."))
+       
+       
+
+
+;(defun compile-script-file (script-src-file
+;                          &key
+;                          (output-spec :javascript)
+;                          (output-stream *standard-out*)
+;                          (comp-env *compilation-environment*))
+                           
 
 ;;; SEXPs -> Javascript string functionality
 (defmacro script (&body body)
@@ -83,6 +114,8 @@ Body is evaluated."
   (string-join
    (js-to-statement-strings (compile-script-form expr) 0) " "))
 
+
+;;; old file compilation functions:
 (defun compile-parenscript-file-to-string (source-file
                                           &key
                                           (log-stream nil)

diff --git a/src/macrology.lisp b/src/macrology.lisp
index f5b12a3..dae9a60 100644 (file)
--- a/src/macrology.lisp
+++ b/src/macrology.lisp
@@ -407,6 +407,35 @@ prefix)."
                  :value (compile-to-expression value)
                  :type (compile-to-expression type)))
 
+;;; eval-when
+(define-script-special-form eval-when (&rest args)
+  "(eval-when form-language? (situation*) form*)
+
+The given forms are evaluated only during the given SITUATION in the specified 
+FORM-LANGUAGE (either :lisp or :parenscript, def, defaulting to :lisp during
+-toplevel and :parenscript during :execute). The accepted SITUATIONS are :execute,
+:scan-toplevel. :scan-toplevel is the phase of compilation when function definitions 
+and the like are being added to the compilation environment. :execute is the phase when
+the code is being evaluated by a Javascript engine."
+  (multiple-value-bind (body-language situations subforms)
+      (process-eval-when-args args)
+    (format t "~A~%~A~%"
+          (and (compiler-in-situation-p *compilation-environment* :compile-toplevel)
+               (find :compile-toplevel situations))
+          (compiler-in-situation-p *compilation-environment*  :execute)
+           (find :execute situations))
+    (cond
+      ((and (compiler-in-situation-p *compilation-environment* :compile-toplevel)
+           (find :compile-toplevel situations))
+       (error "Should never be processing eval-when :COMPILE-TOPLEVEL forms from here."))
+
+      ((and (compiler-in-situation-p *compilation-environment*  :execute)
+           (find :execute situations))
+       (when (eql body-language :parenscript)
+        (let ((form `(progn ,@subforms)))
+          (format t "Form: ~A~%" form)
+          (compile-to-statement form)))))))
+
 ;;; script packages
 (define-script-special-form blank-statement ()
   (make-instance 'blank-statement))

diff --git a/src/parser.lisp b/src/parser.lisp
index bccae90..de5fcce 100644 (file)
--- a/src/parser.lisp
+++ b/src/parser.lisp
@@ -29,16 +29,17 @@
     :accessor script-package-exclusive-lisp-package-p
     :documentation "t if the lisp package is an anonymous package created exclusively for
                     the script package.")
-   (toplevel-identifiers :accessor script-package-toplevel-ids :initarg :toplevel-ids
-                         :initform nil)
-   (macro-table   :accessor script-package-macro-table
-                  :initform (make-hash-table :test #'eql)
-                  :documentation "This package's macro environment, set up as a hash table
-                                  from symbols to macro functions")
-   (special-form-table :accessor script-package-special-form-table
-                      :initform (make-hash-table :test #'equal)
-                      :documentation "Holds special form macros for the package.
-                                       Probably not used except for built-in packages."))
+;   (toplevel-identifiers :accessor script-package-toplevel-ids :initarg :toplevel-ids
+;                         :initform nil)
+;   (macro-table   :accessor script-package-macro-table
+;                  :initform (make-hash-table :test #'eql)
+;                  :documentation "This package's macro environment, set up as a hash table
+;                                  from symbols to macro functions")
+;   (special-form-table :accessor script-package-special-form-table
+;                     :initform (make-hash-table :test #'equal)
+;                     :documentation "Holds special form macros for the package.
+;                                       Probably not used except for built-in packages."))
+   )
   (:documentation "A Parenscript package is a lisp object that holds information
 about a set of Suavescript code."))
 
@@ -47,11 +48,31 @@ about a set of Suavescript code."))
                    :documentation "List of packages defined in this environment.")
    (current-package :accessor comp-env-current-package :initform nil :initarg :current-package
                    :documentation "Current in-package.")
+
    (lisp-to-script-package-table
     :accessor comp-env-lisp-to-script-package-table :initform (make-hash-table)
-    :documentation   "Maps a lisp package to a script package."))
+    :documentation   "Maps a lisp package to a script package.")
+   (compiling-toplevel-p 
+    :accessor comp-env-compiling-toplevel-p :initform nil :initarg :processing-toplevel-p
+    :documentation "T if the environment is currently processing toplevel forms."))
   (:documentation ""))
 
+(defgeneric compiler-in-situation-p (comp-env situation)
+  (:documentation "Returns true when the compiler is considered 'in' the situation
+given by SITUATION, which is one of :compile-toplevel.")
+  (:method ((comp-env compilation-environment) situation)
+    (cond
+      ((eql situation :compile-toplevel) (processing-toplevel-p comp-env))
+      ((eql situation :execute) (not (processing-toplevel-p comp-env)))
+      (t nil))))
+
+(defgeneric processing-toplevel-p (comp-env)
+  (:documentation "T if we are compiling TOPLEVEL forms, as in 
+http://www.lispworks.com/documentation/HyperSpec/Body/03_bca.htm")
+  (:method ((comp-env compilation-environment))
+    (comp-env-compiling-toplevel-p comp-env)
+    ))
+
 (defvar *compilation-environment* nil
   "The active compilation environment.
 
@@ -297,57 +318,113 @@ macro environment."
            ;; leave anything else alone
             (t expr))))
 
+(defun process-eval-when-args (args)
+  "(eval-when form-language? (situation*) form*) - returns 3 values: 
+form-language, a list of situations, and a list of body forms"
+  (let* ((rest args)
+        (form-language
+         (when (not (listp (first rest)))
+           (setf rest (rest args))
+           (first args)))
+        (situations (first rest))
+        (body (rest rest)))
+    (when (and (find :compile-toplevel situations) (find :execute situations))
+      (error "Cannot use EVAL-WHEN to execute COMPILE-TOPLEVEL and EXECUTE code simultaneously."))
+    (when (null form-language)
+      (setf form-language
+           (cond
+             ((find :compile-toplevel situations) :lisp)
+             ((find :execute situations)          :parenscript))))
+    (values form-language situations body)))
+  
 ;;;; compiler interface ;;;;
-(defgeneric compile-parenscript-form (compilation-environment form)
-  (:documentation "Compiles FORM, which is a ParenScript form, into a pre-text
-compilation object (the AST root).  Subsequently TRANSLATE-AST can be called
-to convert the result to Javascript."))
+(defgeneric compile-parenscript-form (compilation-environment form &key toplevel-p)
+  (:documentation "Compiles FORM, which is a ParenScript form.
+If toplevel-p is NIL, the result is a compilation object (the AST root).
+Subsequently TRANSLATE-AST can be called to convert the result to Javascript.
+
+If the compiler is in the COMPILE-TOPLEVEL stage, then the result will
+be a Parenscript form (after it has been processed according to semantics
+like those of Lisp's COMPILE-FILE). See
+http://www.lispworks.com/documentation/HyperSpec/Body/03_bca.htm"))
 
-(defmethod compile-parenscript-form ((comp-env compilation-environment) form)
+(defmethod compile-parenscript-form ((comp-env compilation-environment) form &key toplevel-p)
   (setf form (expand-script-form form))
-  (cond ((stringp form)
-        (make-instance 'string-literal :value form))
-        ((characterp form)
-        (make-instance 'string-literal :value (string form)))
-       ((numberp form)
-        (make-instance 'number-literal :value form))
-       ((symbolp form) ;; is this the correct behavior?
-        (let ((c-macro (get-script-special-form form)))
-          (if c-macro
-              (funcall c-macro)
-              (make-instance 'script-variable :value form))))
-       ((and (consp form)
-             (eql (first form) 'quote))
-        (make-instance 'script-quote :value (second form)))
-       ((consp form)
-        (let* ((name (car form))
-               (args (cdr form))
-               (script-form (get-script-special-form name)))
-          (cond (script-form
-                 (apply script-form args))
-                
-                ((op-form-p form)
-                 (make-instance 'op-form
-                                :operator (script-convert-op-name (compile-to-symbol (first form)))
-                                :args (mapcar #'compile-to-expression (rest form))))
-                
-                ((method-call-p form)
-                 (make-instance 'method-call
-                                :method (compile-to-symbol (first form))
-                                :object (compile-to-expression (second form))
-                                :args (mapcar #'compile-to-expression (cddr form))))
-                
-                ((funcall-form-p form)
-                 (make-instance 'function-call
-                                :function (compile-to-expression (first form))
-                                :args (mapcar #'compile-to-expression (rest form))))
-                
-                (t (error "Unknown form ~S" form)))))
-       (t (error "Unknown atomar expression ~S" form))))
+  ;; ensures proper compilation environment TOPLEVEL-P slot value
+  (setf (comp-env-compiling-toplevel-p comp-env) toplevel-p)
+  (if
+   toplevel-p
+   (cond
+     ((not (listp form)) form)
+     ;; process each clause of a progn as a toplevel form
+     ((eql 'progn (car form))
+      `(progn
+       ,@(mapcar #'(lambda (subform)
+                     (compile-parenscript-form comp-env subform :toplevel-p t))
+                 (rest form))))
+     ;; TODO process macrolets, symbol-macrolets, and file inclusions
+     ;; process eval-when.  evaluates in :COMPILE-TOPLEVEL situation and returns
+     ;; the resultant form.  for :EXECUTE situation it returns 
+     ((eql 'eval-when (car form))
+      (multiple-value-bind (body-language situations body)
+         (process-eval-when-args (rest form))
+       (cond
+         ((find :compile-toplevel situations)
+          (when (eql body-language :lisp)
+            (let ((other-situations (remove :compile-toplevel situations)))
+              (multiple-value-bind (function warnings-p failure-p)
+                  (compile nil `(lambda () ,@body))
+                (declare (ignore warnings-p) (ignore failure-p))
+                `(progn
+                  ,(funcall function)
+                  ,@(when other-situations
+                          (list `(eval-when ,other-situations ,@body))))))))
+         ;; if :compile-toplevel is not in the situation list, return the form
+         (t form))))
+     (t form))
+   (cond ((stringp form)
+         (make-instance 'string-literal :value form))
+        ((characterp form)
+         (make-instance 'string-literal :value (string form)))
+        ((numberp form)
+         (make-instance 'number-literal :value form))
+        ((symbolp form) ;; is this the correct behavior?
+         (let ((c-macro (get-script-special-form form)))
+           (if c-macro
+               (funcall c-macro)
+               (make-instance 'script-variable :value form))))
+        ((and (consp form)
+              (eql (first form) 'quote))
+         (make-instance 'script-quote :value (second form)))
+        ((consp form)
+         (let* ((name (car form))
+                (args (cdr form))
+                (script-form (get-script-special-form name)))
+              (cond (script-form
+                     (apply script-form args))
+                    
+                    ((op-form-p form)
+                     (make-instance 'op-form
+                                    :operator (script-convert-op-name (compile-to-symbol (first form)))
+                                    :args (mapcar #'compile-to-expression (rest form))))
+                    
+                    ((method-call-p form)
+                     (make-instance 'method-call
+                                    :method (compile-to-symbol (first form))
+                                    :object (compile-to-expression (second form))
+                                    :args (mapcar #'compile-to-expression (cddr form))))
+                    
+                    ((funcall-form-p form)
+                     (make-instance 'function-call
+                                    :function (compile-to-expression (first form))
+                                    :args (mapcar #'compile-to-expression (rest form))))
+                    
+                    (t (error "Unknown form ~S" form)))))
+        (t (error "Unknown atomar expression ~S" form)))))
 
 (defun compile-script-form (form &key (comp-env *compilation-environment*))
   "Compiles a Parenscript form to an AST node."
-  (compile-parenscript-form *compilation-environment* form ))
+  (compile-parenscript-form comp-env form ))
 
 (defun compile-to-expression (form)
   "Compiles the given Parenscript form and guarantees the result is an expression."