diff options
| -rw-r--r-- | lisplib.c | 1 | ||||
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 82 | ||||
| -rw-r--r-- | txr.1 | 35 |
3 files changed, 82 insertions, 36 deletions
@@ -679,6 +679,7 @@ static val compiler_set_entries(val dlt, val fun) }; val name[] = { lit("compile-toplevel"), lit("compile-file"), lit("compile"), + lit("with-compilation-unit"), nil }; diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index f599799d..6a8bc59c 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -1348,6 +1348,16 @@ (sys:vm-desc-datavec vd) (sys:vm-desc-funvec vd))) + +(defmacro usr:with-compilation-unit (. body) + (with-gensyms (rec) + ^(let* ((,rec sys:*load-recursive*) + (sys:*load-recursive* t)) + (unwind-protect + (progn ,*body) + (unless ,rec + (release-deferred-warnings)))))) + (defun usr:compile-file (in-path : out-path) (let ((streams (open-compile-streams in-path out-path)) (err-ret (gensym)) @@ -1355,42 +1365,42 @@ (*emit* t) (*eval* t) (*load-path* in-path) - (*rec-source-loc* t) - (sys:*load-recursive* t)) - (with-resources ((in-stream (car streams) (close-stream in-stream)) - (out-stream (cadr streams) (close-stream out-stream)) - (out (new list-builder))) - (labels ((compile-form (form) - (unless (atom form) - (caseq (car form) - (progn [mapdo compile-form (cdr form)]) - (compile-only (let ((*eval* nil)) - [mapdo compile-form (cdr form)])) - (eval-only (let ((*emit* nil)) - [mapdo compile-form (cdr form)])) - (t (when (and (or *eval* *emit*) - (not (constantp form))) - (let* ((vm-desc (compile-toplevel form)) - (flat-vd (list-from-vm-desc vm-desc))) - (when *eval* - (sys:vm-execute-toplevel vm-desc)) - (when *emit* - out.(add flat-vd))))))))) - (prinl '(0 0) out-stream) - (unwind-protect - (whilet ((obj (read in-stream *stderr* err-ret)) - ((neq obj err-ret))) - (compile-form (sys:expand* obj))) - (let ((*print-circle* t) - (*package* (make-package "$"))) - (unwind-protect - (prinl out.(get) out-stream) - (delete-package *package*)))) - - (let ((parser (sys:get-parser in-stream))) - (when (> (sys:parser-errors parser) 0) - (error "~s: compilation of ~s failed" 'compile-file - (stream-get-prop in-stream :name)))))))) + (*rec-source-loc* t)) + (with-compilation-unit + (with-resources ((in-stream (car streams) (close-stream in-stream)) + (out-stream (cadr streams) (close-stream out-stream)) + (out (new list-builder))) + (labels ((compile-form (form) + (unless (atom form) + (caseq (car form) + (progn [mapdo compile-form (cdr form)]) + (compile-only (let ((*eval* nil)) + [mapdo compile-form (cdr form)])) + (eval-only (let ((*emit* nil)) + [mapdo compile-form (cdr form)])) + (t (when (and (or *eval* *emit*) + (not (constantp form))) + (let* ((vm-desc (compile-toplevel form)) + (flat-vd (list-from-vm-desc vm-desc))) + (when *eval* + (sys:vm-execute-toplevel vm-desc)) + (when *emit* + out.(add flat-vd))))))))) + (prinl '(0 0) out-stream) + (unwind-protect + (whilet ((obj (read in-stream *stderr* err-ret)) + ((neq obj err-ret))) + (compile-form (sys:expand* obj))) + (let ((*print-circle* t) + (*package* (make-package "$"))) + (unwind-protect + (prinl out.(get) out-stream) + (delete-package *package*)))) + + (let ((parser (sys:get-parser in-stream))) + (when (> (sys:parser-errors parser) 0) + (error "~s: compilation of ~s failed" 'compile-file + (stream-get-prop in-stream :name))))))))) (defun usr:compile (obj) (typecase obj @@ -62053,6 +62053,41 @@ is added. Compilation proceeds according to the File Compilation Model. +.coNP Macro @ with-compilation-unit +.synb +.mets (with-compilation-unit << form *) +.syne +.desc +When a file is processed by +.codn compile-file , +certain actions, such as the issuance of diagnostics about undefined functions +and variables, are delayed until the file is completely processed. + +The +.code with-compilation-unit +macro allows these actions to be collectively deferred until multiple files +are completely processed. + +The macro evaluates each enclosed +.meta form +in a single compilation environment. After the last +.meta form +is evaluated, deferred actions of any enclosed +.code compile-file +forms are performed, and then the value of the last +.meta form +is returned. + +It is permissible to nest +.code with-compilation-unit +forms, lexically or dynamically. The outer-most invocation of +.code with-compilation-unit +dominates; all deferred +.code compile-file +actions are held until the outer-most enclosing +.code with-compilation-unit +terminates. + .coNP Operators @ compile-only and @ eval-only .synb .mets (compile-only << form *) |