diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/compiler.tl | 27 | ||||
| -rw-r--r-- | stdlib/doc-syms.tl | 1 |
2 files changed, 28 insertions, 0 deletions
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index cdbd3a3f..cc4eef7b 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -531,6 +531,7 @@ (and me.(compile oreg env (expand-and form))) (or me.(comp-or oreg env form)) (prog1 me.(comp-prog1 oreg env form)) + (progv me.(comp-progv oreg env form)) (sys:quasi me.(comp-quasi oreg env form)) (dohash me.(compile oreg env (expand-dohash form))) (tree-bind me.(comp-tree-bind oreg env form)) @@ -1324,6 +1325,32 @@ ((t fi) me.(compile oreg env fi)) ((t) me.(compile oreg env nil)))) +(defmeth compiler comp-progv (me oreg env form) + (tree-case form + ((t syms vals) + me.(comp-progn oreg env ^(progn ,syms ,vals nil))) + ((t syms vals . body) + (let* ((denv (new env up env co me)) + (sreg me.(alloc-treg)) + (vreg me.(alloc-treg)) + (sfrag me.(compile sreg env syms)) + (vfrag me.(compile vreg env vals)) + (bfrag me.(comp-progn oreg denv body))) + me.(free-treg sreg) + me.(free-treg vreg) + (new (frag bfrag.oreg + (append sfrag.code + vfrag.code + ^((dframe ,denv.lev 0) + (gcall ,oreg + ,me.(get-sidx 'sys:rt-progv) + ,sfrag.oreg + ,vfrag.oreg)) + bfrag.code + '((end nil))) + (uni sfrag.fvars (uni vfrag.fvars bfrag.fvars)) + (uni sfrag.ffuns (uni vfrag.ffuns bfrag.ffuns)))))))) + (defmeth compiler comp-quasi (me oreg env form) (let ((qexp (expand-quasi form))) me.(compile oreg env (expand qexp)))) diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index f3e6e9b7..8dbadf88 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -1504,6 +1504,7 @@ ("prog1" "N-03F7A8B8") ("prog2" "N-03A0E48C") ("progn" "N-03F7A8B8") + ("progv" "N-033405DF") ("promisep" "N-00C7553F") ("prop" "N-01C6D406") ("proper-list-p" "N-03F70343") |