diff options
Diffstat (limited to 'stdlib/compiler.tl')
| -rw-r--r-- | stdlib/compiler.tl | 27 |
1 files changed, 27 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)))) |