Commit | Line | Data |
---|---|---|
cc4f1551 RD |
1 | (in-package :parenscript) |
2 | ||
9da682ca RD |
3 | ;;;; The mechanisms for defining macros & parsing Parenscript. |
4 | ||
5 | (defclass identifier () | |
6 | ((symbol :accessor id-symbol :initform nil :type symbol)) | |
7 | (:documentation "")) | |
8 | ||
9 | (defclass script-package () | |
10 | ;; configuration slots | |
11 | ((name :accessor script-package-name :initform nil :initarg :name :type string | |
12 | :documentation "Canonical name of the package (a String).") | |
13 | (nicknames :accessor script-package-nicknames :initform nil :initarg :nicknames | |
14 | :documentation "List of nicknames for the package (as strings).") | |
15 | (lisp-package :accessor script-package-lisp-package :initform nil :initarg :lisp-package) | |
16 | (secondary-lisp-packages :accessor script-package-secondary-lisp-packages :initform nil | |
17 | :initarg :secondary-lisp-packages) | |
18 | (exports :accessor script-package-exports :initform nil :initarg :exports | |
19 | :documentation "List of exported identifiers.") | |
20 | (used-packages :accessor script-package-used-packages :initform nil :initarg :used-packages | |
21 | :documentation "") | |
22 | (documentation :accessor script-package-documentation :initform nil :initarg :documentation) | |
23 | (compilation-env :accessor script-package-comp-env :initform nil :initarg :comp-env) | |
24 | (locked? :accessor script-package-locked? :initform nil :initarg :locked? | |
25 | :documentation "t if redefinition of top-level symbols is disallowed.") | |
26 | ;; internal use slots | |
27 | (exclusive-lisp-package-p | |
28 | :initform nil :initarg :exclusive-lisp-package? | |
29 | :accessor script-package-exclusive-lisp-package-p | |
30 | :documentation "t if the lisp package is an anonymous package created exclusively for | |
31 | the script package.") | |
a98e58ee RD |
32 | ; (toplevel-identifiers :accessor script-package-toplevel-ids :initarg :toplevel-ids |
33 | ; :initform nil) | |
34 | ; (macro-table :accessor script-package-macro-table | |
35 | ; :initform (make-hash-table :test #'eql) | |
36 | ; :documentation "This package's macro environment, set up as a hash table | |
37 | ; from symbols to macro functions") | |
38 | ; (special-form-table :accessor script-package-special-form-table | |
39 | ; :initform (make-hash-table :test #'equal) | |
40 | ; :documentation "Holds special form macros for the package. | |
41 | ; Probably not used except for built-in packages.")) | |
42 | ) | |
9da682ca RD |
43 | (:documentation "A Parenscript package is a lisp object that holds information |
44 | about a set of Suavescript code.")) | |
45 | ||
46 | (defclass compilation-environment () | |
47 | ((script-packages :accessor comp-env-script-packages :initform nil :initarg :packages | |
48 | :documentation "List of packages defined in this environment.") | |
49 | (current-package :accessor comp-env-current-package :initform nil :initarg :current-package | |
50 | :documentation "Current in-package.") | |
a98e58ee | 51 | |
9da682ca RD |
52 | (lisp-to-script-package-table |
53 | :accessor comp-env-lisp-to-script-package-table :initform (make-hash-table) | |
a98e58ee RD |
54 | :documentation "Maps a lisp package to a script package.") |
55 | (compiling-toplevel-p | |
56 | :accessor comp-env-compiling-toplevel-p :initform nil :initarg :processing-toplevel-p | |
57 | :documentation "T if the environment is currently processing toplevel forms.")) | |
9da682ca RD |
58 | (:documentation "")) |
59 | ||
a98e58ee RD |
60 | (defgeneric compiler-in-situation-p (comp-env situation) |
61 | (:documentation "Returns true when the compiler is considered 'in' the situation | |
62 | given by SITUATION, which is one of :compile-toplevel.") | |
63 | (:method ((comp-env compilation-environment) situation) | |
64 | (cond | |
65 | ((eql situation :compile-toplevel) (processing-toplevel-p comp-env)) | |
66 | ((eql situation :execute) (not (processing-toplevel-p comp-env))) | |
67 | (t nil)))) | |
68 | ||
69 | (defgeneric processing-toplevel-p (comp-env) | |
70 | (:documentation "T if we are compiling TOPLEVEL forms, as in | |
71 | http://www.lispworks.com/documentation/HyperSpec/Body/03_bca.htm") | |
72 | (:method ((comp-env compilation-environment)) | |
73 | (comp-env-compiling-toplevel-p comp-env) | |
74 | )) | |
75 | ||
9da682ca RD |
76 | (defvar *compilation-environment* nil |
77 | "The active compilation environment. | |
78 | ||
79 | Right now all code assumes that *compilation-environment* is accurately bound to the | |
80 | current compilation environment--even some functions that take the compilation environment | |
81 | as arguments.") | |
82 | ||
83 | ;;; parenscript packages | |
84 | (defun lisp-to-script-package (lisp-package &optional (comp-env *compilation-environment*)) | |
85 | "Gets a script package corresponding to the given Lisp package." | |
86 | (gethash lisp-package (comp-env-lisp-to-script-package-table comp-env))) | |
87 | ||
88 | (defsetf lisp-to-script-package (lisp-package &optional (comp-env *compilation-environment*)) | |
89 | (script-package) | |
90 | "Sets the script package corresponding to the given Lisp package." | |
91 | `(setf (gethash ,lisp-package (comp-env-lisp-to-script-package-table ,comp-env)) | |
92 | ,script-package)) | |
93 | ||
94 | (defun symbol-script-package (symbol &optional (comp-env *compilation-environment*)) | |
95 | "Gets the Parenscript package associated with a Lisp symbol." | |
96 | (lisp-to-script-package (symbol-package symbol) comp-env)) | |
97 | ||
98 | (defun find-script-package (name &optional (comp-env *compilation-environment*)) | |
99 | "Find the script package with the name NAME in the given compilation environment." | |
100 | (find (string name) (comp-env-script-packages comp-env) :test #'equal)) | |
101 | ||
102 | (defun destroy-script-package (script-package) | |
103 | "Disposes of relevant resources when the script package is no longer relevant." | |
104 | (when (script-package-exclusive-lisp-package-p script-package) | |
105 | (delete-package (script-package-lisp-package script-package)))) | |
106 | ||
107 | ;; environmental considerations | |
108 | (defun make-basic-compilation-environment () | |
109 | "Creates a compilation environment object from scratch. Fills it in with the default | |
110 | script packages (parenscript, global, and parenscript-user)." | |
111 | (let ((comp-env (make-instance 'compilation-environment))) | |
112 | comp-env)) | |
113 | ||
114 | (defun create-script-package (comp-env | |
115 | &key name nicknames secondary-lisp-packages used-packages | |
116 | lisp-package exports documentation) | |
117 | "Creates a script package in the given compilation environment" | |
118 | (labels ((normalize (string-like) (string string-like))) | |
119 | (let* ((explicit-lisp-package-p (not (null lisp-package))) | |
120 | (lisp-package | |
121 | (or (and explicit-lisp-package-p (find-package lisp-package)) | |
122 | (make-package (gensym (string name)))))) | |
123 | (labels ((package-intern (string-like) | |
124 | (intern (normalize string-like) lisp-package))) | |
125 | (let ((script-package | |
126 | (make-instance 'script-package | |
127 | :name (normalize name) | |
128 | :comp-env comp-env | |
129 | :nicknames (mapcar #'normalize nicknames) | |
130 | :lisp-package (find-package lisp-package) | |
131 | :secondary-lisp-packages (mapcar #'find-package secondary-lisp-packages) | |
132 | :exclusive-lisp-package? (not explicit-lisp-package-p) | |
133 | :exports (mapcar #'package-intern exports) | |
134 | :used-packages (mapcar #'(lambda (script-package-designator) | |
135 | (find-script-package | |
136 | script-package-designator comp-env)) | |
137 | used-packages) | |
138 | :documentation documentation))) | |
139 | (push script-package (comp-env-script-packages comp-env))))))) | |
140 | ||
141 | (defmethod initialize-instance :after ((package script-package) &key) | |
142 | (assert (script-package-comp-env package)) | |
143 | (assert (script-package-lisp-package package)) | |
144 | (let ((lisp-packages (cons (script-package-lisp-package package) | |
145 | (script-package-secondary-lisp-packages package)))) | |
146 | (dolist (lisp-package lisp-packages) | |
147 | (when (lisp-to-script-package lisp-package (script-package-comp-env package)) | |
148 | (error "Lisp package already has corresponding script package: ~A" (package-name lisp-package))) | |
149 | (setf (lisp-to-script-package lisp-package (script-package-comp-env package)) | |
150 | package)))) | |
151 | ||
152 | (defgeneric comp-env-find-package (comp-env package-designator) | |
153 | (:documentation "Finds the script package named by PACKAGE-DESIGNATOR in the current | |
154 | compilation environment. PACKAGE-DESIGNATOR is a string or symbol.") | |
155 | (:method ((comp-env compilation-environment) (name string)) | |
156 | (find name (comp-env-script-packages comp-env) | |
157 | :key #'script-package-name :test #'equal)) | |
158 | (:method ((comp-env compilation-environment) (package-designator symbol)) | |
159 | (comp-env-find-package comp-env (string package-designator)))) | |
160 | ||
161 | ;; TODO loop through all defined macros and add them to the script package's | |
162 | ;; macro environment | |
163 | ; (labels ((name-member (name) | |
164 | ; (eql (script-package-lisp-package script-package) (symbol-package name))) | |
165 | ; (import-macro (name function) | |
166 | ; (when (name-member name) | |
167 | ; (setf (gethash name (script-package-macro-table script-package)) | |
168 | ; function))) | |
169 | ; (import-special-form (name function) | |
170 | ; (when (name-member name) | |
171 | ; (setf (gethash name (script-package-special-form-table script-package)) | |
172 | ; function)))) | |
173 | ; (maphash #'import-special-form *toplevel-special-forms*) | |
174 | ; (maphash #'import-special-form *toplevel-special-forms*) | |
175 | ||
176 | ;(defgeneric comp-env-select-package (comp-env script-package) | |
177 | ; (:documentation "") | |
178 | ; (:method ((comp-env compilation-environment) (package script-package)) | |
179 | ; (setf (comp-env-current-package | |
180 | ||
cc4f1551 RD |
181 | |
182 | (eval-when (:compile-toplevel :load-toplevel :execute) | |
9da682ca RD |
183 | (defvar *toplevel-special-forms* (make-hash-table) |
184 | "A hash-table containing functions that implement Parenscript special forms, | |
185 | indexed by name (as symbols)") | |
186 | ||
187 | (defun undefine-script-special-form (name) | |
188 | "Undefines the special form with the given name (name is a symbol)." | |
189 | (declare (type symbol name)) | |
190 | (when (gethash name *toplevel-special-forms*) | |
191 | (remhash name *toplevel-special-forms*)))) | |
cc4f1551 | 192 | |
9da682ca | 193 | (defmacro define-script-special-form (name lambda-list &rest body) |
cc4f1551 | 194 | "Define a special form NAME. Arguments are destructured according to |
9da682ca | 195 | LAMBDA-LIST. The resulting Parenscript language types are appended to the |
cc4f1551 | 196 | ongoing javascript compilation." |
9da682ca RD |
197 | (declare (type symbol name)) |
198 | (let ((script-name | |
199 | (intern (format nil "PAREN-~A" (symbol-name name)) | |
200 | (find-package :parenscript))) | |
201 | (arglist (gensym "ps-arglist-"))) | |
cc4f1551 | 202 | `(eval-when (:compile-toplevel :load-toplevel :execute) |
9da682ca RD |
203 | (defun ,script-name (&rest ,arglist) |
204 | (destructuring-bind ,lambda-list | |
205 | ,arglist | |
206 | ,@body)) | |
207 | (setf (gethash (quote ,name) *toplevel-special-forms*) #',script-name)))) | |
208 | ||
209 | (defun get-script-special-form (name) | |
210 | "Returns the special form function corresponding to the given name." | |
211 | ; (declare (type symbol name)) | |
212 | (when (symbolp name) | |
213 | (gethash name *toplevel-special-forms*))) | |
cc4f1551 | 214 | |
9da682ca RD |
215 | ;;; sexp form predicates |
216 | (defun script-special-form-p (form) | |
217 | "Returns T if FORM is a special form and NIL otherwise." | |
cc4f1551 RD |
218 | (and (consp form) |
219 | (symbolp (car form)) | |
9da682ca | 220 | (gethash (car form) *toplevel-special-forms*))) |
cc4f1551 | 221 | |
9da682ca RD |
222 | (defun funcall-form-p (form) |
223 | (and (listp form) | |
224 | (not (op-form-p form)) | |
225 | (not (script-special-form-p form)))) | |
cc4f1551 | 226 | |
9da682ca RD |
227 | (defun method-call-p (form) |
228 | (and (funcall-form-p form) | |
229 | (symbolp (first form)) | |
230 | (eql (char (symbol-name (first form)) 0) #\.))) | |
cc4f1551 | 231 | |
9da682ca | 232 | ;;; macro expansion |
cc4f1551 RD |
233 | (eval-when (:compile-toplevel :load-toplevel :execute) |
234 | (defun make-macro-env-dictionary () | |
9da682ca RD |
235 | "Creates a standard macro dictionary." |
236 | (make-hash-table)) | |
237 | (defvar *script-macro-toplevel* (make-macro-env-dictionary) | |
238 | "Toplevel macro environment dictionary. Key is symbol-name of the macro, value | |
239 | is (symbol-macro-p . expansion-function).") | |
240 | (defvar *script-macro-env* (list *script-macro-toplevel*) ;(list nil) | |
cc4f1551 RD |
241 | "Current macro environment.")) |
242 | ||
243 | (defmacro get-macro-spec (name env-dict) | |
9da682ca RD |
244 | "Retrieves the macro spec of the given name with the given environment dictionary. |
245 | SPEC is of the form (symbol-macro-op expansion-function)." | |
246 | `(gethash ,name ,env-dict)) | |
247 | ||
248 | (defun lookup-macro-spec (name &optional (environment *script-macro-env*)) | |
249 | "Looks up the macro spec associated with NAME in the given environment. A | |
250 | macro spec is of the form (symbol-macro-p function). Returns two values: | |
251 | the SPEC and the parent macro environment. | |
cc4f1551 | 252 | |
9da682ca | 253 | NAME must be a symbol." |
cc4f1551 RD |
254 | (when (symbolp name) |
255 | (do ((env environment (cdr env))) | |
256 | ((null env) nil) | |
257 | (let ((val (get-macro-spec name (car env)))) | |
258 | (when val | |
259 | (return-from lookup-macro-spec | |
260 | (values val (or (cdr env) | |
9da682ca | 261 | (list *script-macro-toplevel*))))))))) |
cc4f1551 | 262 | |
9da682ca RD |
263 | (defun script-symbol-macro-p (name &optional (environment *script-macro-env*)) |
264 | "True if there is a Parenscript symbol macro named by the symbol NAME." | |
cc4f1551 RD |
265 | (and (symbolp name) (car (lookup-macro-spec name environment)))) |
266 | ||
9da682ca RD |
267 | (defun script-macro-p (name &optional (environment *script-macro-env*)) |
268 | "True if there is a Parenscript macro named by the symbol NAME." | |
269 | (and (symbolp name) | |
270 | (let ((macro-spec (lookup-macro-spec name environment))) | |
271 | (and macro-spec (not (car macro-spec)))))) | |
cc4f1551 | 272 | |
9da682ca | 273 | (defun lookup-macro-expansion-function (name &optional (environment *script-macro-env*)) |
cc4f1551 RD |
274 | "Lookup NAME in the given macro expansion environment (which |
275 | defaults to the current macro environment). Returns the expansion | |
276 | function and the parent macro environment of the macro." | |
277 | (multiple-value-bind (macro-spec parent-env) | |
278 | (lookup-macro-spec name environment) | |
279 | (values (cdr macro-spec) parent-env))) | |
280 | ||
9da682ca RD |
281 | (defmacro defscriptmacro (name args &body body) |
282 | "Define a ParenScript macro, and store it in the toplevel ParenScript | |
283 | macro environment." | |
cc4f1551 RD |
284 | (let ((lambda-list (gensym "ps-lambda-list-")) |
285 | (body (if (stringp (first body)) (rest body) body))) ;; drop docstring | |
9da682ca RD |
286 | (undefine-script-special-form name) |
287 | `(setf (get-macro-spec ',name *script-macro-toplevel*) | |
cc4f1551 RD |
288 | (cons nil (lambda (&rest ,lambda-list) |
289 | (destructuring-bind ,args | |
290 | ,lambda-list | |
291 | ,@body)))))) | |
292 | ||
9da682ca RD |
293 | (defmacro defpsmacro (name args &body body) |
294 | `(defscriptmacro (,name ,args ,@body))) | |
295 | ||
296 | (defun expand-script-form (expr) | |
297 | "Expands a Parenscript form down to special forms." | |
cc4f1551 RD |
298 | (if (consp expr) |
299 | (let ((op (car expr)) | |
300 | (args (cdr expr))) | |
9da682ca RD |
301 | (cond ((equal op 'quote) expr) ;; leave quotes alone |
302 | ((script-macro-p op) ;; recursively expand parenscript macros in parent env. | |
303 | (multiple-value-bind (expansion-function macro-env) | |
304 | (lookup-macro-expansion-function op) | |
305 | (expand-script-form (let ((*script-macro-env* macro-env)) | |
306 | (apply expansion-function args))))) | |
cc4f1551 | 307 | (t expr))) |
9da682ca RD |
308 | ;; not a cons |
309 | (cond ((script-special-form-p expr) | |
310 | ;; leave special forms alone (expanded during compile) | |
311 | expr) | |
312 | ((script-symbol-macro-p expr) | |
313 | ;; recursively expand symbol macros in parent env. | |
314 | (multiple-value-bind (expansion-function macro-env) | |
315 | (lookup-macro-expansion-function expr) | |
316 | (expand-script-form (let ((*script-macro-env* macro-env)) | |
317 | (funcall expansion-function))))) | |
318 | ;; leave anything else alone | |
cc4f1551 RD |
319 | (t expr)))) |
320 | ||
a98e58ee RD |
321 | (defun process-eval-when-args (args) |
322 | "(eval-when form-language? (situation*) form*) - returns 3 values: | |
323 | form-language, a list of situations, and a list of body forms" | |
324 | (let* ((rest args) | |
325 | (form-language | |
326 | (when (not (listp (first rest))) | |
327 | (setf rest (rest args)) | |
328 | (first args))) | |
329 | (situations (first rest)) | |
330 | (body (rest rest))) | |
331 | (when (and (find :compile-toplevel situations) (find :execute situations)) | |
332 | (error "Cannot use EVAL-WHEN to execute COMPILE-TOPLEVEL and EXECUTE code simultaneously.")) | |
333 | (when (null form-language) | |
334 | (setf form-language | |
335 | (cond | |
336 | ((find :compile-toplevel situations) :lisp) | |
337 | ((find :execute situations) :parenscript)))) | |
338 | (values form-language situations body))) | |
339 | ||
cc4f1551 | 340 | ;;;; compiler interface ;;;; |
a98e58ee RD |
341 | (defgeneric compile-parenscript-form (compilation-environment form &key toplevel-p) |
342 | (:documentation "Compiles FORM, which is a ParenScript form. | |
343 | If toplevel-p is NIL, the result is a compilation object (the AST root). | |
344 | Subsequently TRANSLATE-AST can be called to convert the result to Javascript. | |
345 | ||
346 | If the compiler is in the COMPILE-TOPLEVEL stage, then the result will | |
347 | be a Parenscript form (after it has been processed according to semantics | |
348 | like those of Lisp's COMPILE-FILE). See | |
349 | http://www.lispworks.com/documentation/HyperSpec/Body/03_bca.htm")) | |
9da682ca | 350 | |
a98e58ee | 351 | (defmethod compile-parenscript-form ((comp-env compilation-environment) form &key toplevel-p) |
9da682ca | 352 | (setf form (expand-script-form form)) |
a98e58ee RD |
353 | ;; ensures proper compilation environment TOPLEVEL-P slot value |
354 | (setf (comp-env-compiling-toplevel-p comp-env) toplevel-p) | |
355 | (if | |
356 | toplevel-p | |
357 | (cond | |
358 | ((not (listp form)) form) | |
359 | ;; process each clause of a progn as a toplevel form | |
360 | ((eql 'progn (car form)) | |
361 | `(progn | |
362 | ,@(mapcar #'(lambda (subform) | |
363 | (compile-parenscript-form comp-env subform :toplevel-p t)) | |
364 | (rest form)))) | |
365 | ;; TODO process macrolets, symbol-macrolets, and file inclusions | |
366 | ;; process eval-when. evaluates in :COMPILE-TOPLEVEL situation and returns | |
367 | ;; the resultant form. for :EXECUTE situation it returns | |
368 | ((eql 'eval-when (car form)) | |
369 | (multiple-value-bind (body-language situations body) | |
370 | (process-eval-when-args (rest form)) | |
371 | (cond | |
372 | ((find :compile-toplevel situations) | |
373 | (when (eql body-language :lisp) | |
374 | (let ((other-situations (remove :compile-toplevel situations))) | |
375 | (multiple-value-bind (function warnings-p failure-p) | |
376 | (compile nil `(lambda () ,@body)) | |
377 | (declare (ignore warnings-p) (ignore failure-p)) | |
378 | `(progn | |
379 | ,(funcall function) | |
380 | ,@(when other-situations | |
381 | (list `(eval-when ,other-situations ,@body)))))))) | |
382 | ;; if :compile-toplevel is not in the situation list, return the form | |
383 | (t form)))) | |
384 | (t form)) | |
385 | (cond ((stringp form) | |
386 | (make-instance 'string-literal :value form)) | |
387 | ((characterp form) | |
388 | (make-instance 'string-literal :value (string form))) | |
389 | ((numberp form) | |
390 | (make-instance 'number-literal :value form)) | |
391 | ((symbolp form) ;; is this the correct behavior? | |
392 | (let ((c-macro (get-script-special-form form))) | |
393 | (if c-macro | |
394 | (funcall c-macro) | |
395 | (make-instance 'script-variable :value form)))) | |
396 | ((and (consp form) | |
397 | (eql (first form) 'quote)) | |
398 | (make-instance 'script-quote :value (second form))) | |
399 | ((consp form) | |
400 | (let* ((name (car form)) | |
401 | (args (cdr form)) | |
402 | (script-form (get-script-special-form name))) | |
403 | (cond (script-form | |
404 | (apply script-form args)) | |
405 | ||
406 | ((op-form-p form) | |
407 | (make-instance 'op-form | |
408 | :operator (script-convert-op-name (compile-to-symbol (first form))) | |
409 | :args (mapcar #'compile-to-expression (rest form)))) | |
410 | ||
411 | ((method-call-p form) | |
412 | (make-instance 'method-call | |
413 | :method (compile-to-symbol (first form)) | |
414 | :object (compile-to-expression (second form)) | |
415 | :args (mapcar #'compile-to-expression (cddr form)))) | |
416 | ||
417 | ((funcall-form-p form) | |
418 | (make-instance 'function-call | |
419 | :function (compile-to-expression (first form)) | |
420 | :args (mapcar #'compile-to-expression (rest form)))) | |
421 | ||
422 | (t (error "Unknown form ~S" form))))) | |
423 | (t (error "Unknown atomar expression ~S" form))))) | |
cc4f1551 | 424 | |
9da682ca RD |
425 | (defun compile-script-form (form &key (comp-env *compilation-environment*)) |
426 | "Compiles a Parenscript form to an AST node." | |
a98e58ee | 427 | (compile-parenscript-form comp-env form )) |
9da682ca RD |
428 | |
429 | (defun compile-to-expression (form) | |
430 | "Compiles the given Parenscript form and guarantees the result is an expression." | |
431 | (let ((res (compile-script-form form))) | |
cc4f1551 RD |
432 | (assert (typep res 'expression)) |
433 | res)) | |
434 | ||
9da682ca RD |
435 | (defun compile-to-symbol (form) |
436 | "Compiles the given Parenscript form and guarantees a symbolic result." | |
437 | (let ((res (compile-script-form form))) | |
438 | (when (typep res 'script-variable) | |
cc4f1551 | 439 | (setf res (value res))) |
30135005 VS |
440 | (assert (symbolp res) () |
441 | "~a is expected to be a symbol, but compiles to ~a. This could be due to ~a being a special form." form res form) | |
cc4f1551 RD |
442 | res)) |
443 | ||
9da682ca RD |
444 | (defun compile-to-statement (form) |
445 | "Compiles the given Parenscript form and guarantees the result is a statement." | |
446 | (let ((res (compile-script-form form))) | |
cc4f1551 RD |
447 | (assert (typep res 'statement)) |
448 | res)) | |
449 | ||
9da682ca RD |
450 | (defun compile-to-body (form &key (indent "")) |
451 | "Compiles the given Parenscript form and guarantees the result is of type SCRIPT-BODY" | |
452 | (let ((res (compile-to-statement form))) | |
453 | (if (typep res 'script-body) | |
cc4f1551 RD |
454 | (progn (setf (b-indent res) indent) |
455 | res) | |
9da682ca | 456 | (make-instance 'script-body |
cc4f1551 | 457 | :indent indent |
9da682ca | 458 | :statements (list res))))) |