src/compilation-interface.lisp

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