src/compilation-interface.lisp

   1 (in-package #:parenscript)
   2
   3 (defparameter *js-target-version* 1.3)
   4
   5 (defvar *parenscript-stream* nil)
   6
   7 (defmacro ps (&body body)
   8   "Given Parenscript forms (an implicit progn), compiles those forms
   9 to a JavaScript string at macro-expansion time. Expands into a form
  10 which evaluates to a string."
  11   (let ((printed-forms (parenscript-print (compile-statement `(progn ,@body)) nil)))
  12     (if (and (not (cdr printed-forms))
  13              (stringp (car printed-forms)))
  14         (car printed-forms)
  15         (let ((s (gensym)))
  16           `(with-output-to-string (,s)
  17              ,@(mapcar (lambda (x) `(write-string ,x ,s)) printed-forms))))))
  18
  19 (defmacro ps-to-stream (stream &body body)
  20   "Given Parenscript forms (an implicit progn), compiles those forms
  21 to a JavaScript string at macro-expansion time. Expands into a form
  22 which writes the resulting code to stream."
  23   (let ((printed-forms (parenscript-print (compile-statement `(progn ,@body)) nil)))
  24     `(let ((*parenscript-stream* ,stream))
  25        ,@(mapcar (lambda (x) `(write-string ,x *parenscript-stream*)) printed-forms))))
  26
  27 (defun ps* (&rest body)
  28   "Compiles body to a JavaScript string. If *parenscript-stream* is
  29 bound, writes the output to *parenscript-stream*, otherwise returns a
  30 string."
  31   (let ((*psw-stream* (or *parenscript-stream* (make-string-output-stream))))
  32     (parenscript-print (compile-statement `(progn ,@body)) t)
  33     (unless *parenscript-stream*
  34       (get-output-stream-string *psw-stream*))))
  35
  36 (defmacro with-blank-compilation-environment (&body body)
  37   `(let ((*ps-gensym-counter* 0)
  38          (*special-variables* nil))
  39      ,@body))
  40
  41 (defmacro ps-doc (&body body)
  42   "Expands Parenscript forms in a clean environment."
  43   (with-blank-compilation-environment
  44     (macroexpand-1 `(ps ,@body))))
  45
  46 (defun ps-doc* (&rest body)
  47   (with-blank-compilation-environment
  48     (apply #'ps* body)))
  49
  50 (defvar *js-inline-string-delimiter* #\"
  51   "Controls the string delimiter char used when compiling Parenscript in ps-inline.")
  52
  53 (defun ps-inline* (form &optional (*js-string-delimiter* *js-inline-string-delimiter*))
  54   (concatenate 'string "javascript:" (ps* form)))
  55
  56 (defmacro+ps ps-inline (form &optional (string-delimiter *js-inline-string-delimiter*))
  57   `(concatenate 'string "javascript:"
  58                 ,@(let ((*js-string-delimiter* string-delimiter))
  59                     (parenscript-print (compile-statement form) nil))))
  60
  61 (defvar *ps-read-function* #'read)
  62
  63 (defun ps-compile-stream (stream)
  64   "Reads (using the value of *ps-read-function*, #'read by default, as
  65 the read function) Parenscript forms from stream and compiles them as
  66 if by ps*. If *parenscript-stream* is bound, writes the output to
  67 *parenscript-stream*, otherwise and returns a string."
  68   (let ((output-stream (or *parenscript-stream* (make-string-output-stream))))
  69     (let ((*compilation-level* :toplevel)
  70           (*readtable* *readtable*)
  71           (*package* *package*)
  72           (*parenscript-stream* output-stream)
  73           (eof '#:eof))
  74       (loop for form = (funcall *ps-read-function* stream nil eof)
  75             until (eq form eof) do (ps* form) (fresh-line *parenscript-stream*)))
  76     (unless *parenscript-stream*
  77       (get-output-stream-string output-stream))))
  78
  79 (defun ps-compile-file (source-file &key (element-type 'character) (external-format :default))
  80   "Opens file as input stream and calls ps-compile-stream on it."
  81   (with-open-file (stream source-file :direction :input :element-type element-type :external-format external-format)
  82     (ps-compile-stream stream)))