mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
implement compilation of label-allocated lambda expressions
* module/language/tree-il/compile-glil.scm (flatten-lambda, flatten): Implement compilation of label-allocated lambda expressions. Quite tricky, we'll see if this works when the new analyzer lands.
This commit is contained in:
Andy Wingo
parent
9059993fe0
commit
230cfcfb3e
1 changed files with 194 additions and 128 deletions
|
|
@ -37,7 +37,7 @@
|
|||
|
||||
;; allocation:
|
||||
;; sym -> {lambda -> address}
|
||||
;; lambda -> (nlocs . closure-vars)
|
||||
;; lambda -> (nlocs labels . free-locs)
|
||||
;;
|
||||
;; address := (local? boxed? . index)
|
||||
;; free-locs ::= ((sym0 . address0) (sym1 . address1) ...)
|
||||
|
|
@ -163,6 +163,7 @@
|
|||
ids
|
||||
vars))
|
||||
|
||||
;; FIXME: always emit? otherwise it's hard to pair bind with unbind
|
||||
(define (emit-bindings src ids vars allocation proc emit-code)
|
||||
(if (pair? vars)
|
||||
(emit-code src (make-glil-bind
|
||||
|
|
@ -188,7 +189,8 @@
|
|||
(else (values (reverse (cons ids oids))
|
||||
(reverse (cons vars ovars))
|
||||
(1+ n) 1))))
|
||||
(let ((nlocs (car (hashq-ref allocation x))))
|
||||
(let ((nlocs (car (hashq-ref allocation x)))
|
||||
(labels (cadr (hashq-ref allocation x))))
|
||||
(make-glil-program
|
||||
nargs nrest nlocs (lambda-meta x)
|
||||
(with-output-to-code
|
||||
|
|
@ -209,35 +211,44 @@
|
|||
(emit-code #f (make-glil-lexical #t #t 'box n)))))
|
||||
vars)
|
||||
;; and here, here, dear reader: we compile.
|
||||
(flatten (lambda-body x) allocation x self-label emit-code)))))))
|
||||
(flatten (lambda-body x) allocation x self-label
|
||||
labels emit-code)))))))
|
||||
|
||||
(define (flatten x allocation self self-label emit-code)
|
||||
(define (flatten x allocation self self-label fix-labels emit-code)
|
||||
(define (emit-label label)
|
||||
(emit-code #f (make-glil-label label)))
|
||||
(define (emit-branch src inst label)
|
||||
(emit-code src (make-glil-branch inst label)))
|
||||
|
||||
;; LMVRA == "let-values MV return address"
|
||||
(let comp ((x x) (context 'tail) (LMVRA #f))
|
||||
(define (comp-tail tree) (comp tree context LMVRA))
|
||||
(define (comp-push tree) (comp tree 'push #f))
|
||||
(define (comp-drop tree) (comp tree 'drop #f))
|
||||
(define (comp-vals tree LMVRA) (comp tree 'vals LMVRA))
|
||||
;; RA: "return address"; #f unless we're in a non-tail fix with labels
|
||||
;; MVRA: "multiple-values return address"; #f unless we're in a let-values
|
||||
(let comp ((x x) (context 'tail) (RA #f) (MVRA #f))
|
||||
(define (comp-tail tree) (comp tree context RA MVRA))
|
||||
(define (comp-push tree) (comp tree 'push #f #f))
|
||||
(define (comp-drop tree) (comp tree 'drop #f #f))
|
||||
(define (comp-vals tree MVRA) (comp tree 'vals #f MVRA))
|
||||
(define (comp-fix tree RA) (comp tree context RA MVRA))
|
||||
|
||||
;; A couple of helpers. Note that if we are in tail context, we
|
||||
;; won't have an RA.
|
||||
(define (maybe-emit-return)
|
||||
(if RA
|
||||
(emit-branch #f 'br RA)
|
||||
(if (eq? context 'tail)
|
||||
(emit-code #f (make-glil-call 'return 1)))))
|
||||
|
||||
(record-case x
|
||||
((<void>)
|
||||
(case context
|
||||
((push vals) (emit-code #f (make-glil-void)))
|
||||
((tail)
|
||||
(emit-code #f (make-glil-void))
|
||||
(emit-code #f (make-glil-call 'return 1)))))
|
||||
((push vals tail)
|
||||
(emit-code #f (make-glil-void))))
|
||||
(maybe-emit-return))
|
||||
|
||||
((<const> src exp)
|
||||
(case context
|
||||
((push vals) (emit-code src (make-glil-const exp)))
|
||||
((tail)
|
||||
(emit-code src (make-glil-const exp))
|
||||
(emit-code #f (make-glil-call 'return 1)))))
|
||||
((push vals tail)
|
||||
(emit-code src (make-glil-const exp))))
|
||||
(maybe-emit-return))
|
||||
|
||||
;; FIXME: should represent sequence as exps tail
|
||||
((<sequence> src exps)
|
||||
|
|
@ -263,7 +274,7 @@
|
|||
;; drop: (lambda () (apply values '(1 2)) 3)
|
||||
;; push: (lambda () (list (apply values '(10 12)) 1))
|
||||
(case context
|
||||
((drop) (for-each comp-drop args))
|
||||
((drop) (for-each comp-drop args) (maybe-emit-return))
|
||||
((tail)
|
||||
(for-each comp-push args)
|
||||
(emit-code src (make-glil-call 'return/values* (length args))))))
|
||||
|
|
@ -277,12 +288,14 @@
|
|||
((push)
|
||||
(comp-push proc)
|
||||
(for-each comp-push args)
|
||||
(emit-code src (make-glil-call 'apply (1+ (length args)))))
|
||||
(emit-code src (make-glil-call 'apply (1+ (length args))))
|
||||
(maybe-emit-return))
|
||||
((vals)
|
||||
(comp-vals
|
||||
(make-application src (make-primitive-ref #f 'apply)
|
||||
(cons proc args))
|
||||
LMVRA))
|
||||
MVRA)
|
||||
(maybe-emit-return))
|
||||
((drop)
|
||||
;; Well, shit. The proc might return any number of
|
||||
;; values (including 0), since it's in a drop context,
|
||||
|
|
@ -290,8 +303,9 @@
|
|||
;; mv-call out to our trampoline instead.
|
||||
(comp-drop
|
||||
(make-application src (make-primitive-ref #f 'apply)
|
||||
(cons proc args)))))))))
|
||||
|
||||
(cons proc args)))
|
||||
(maybe-emit-return)))))))
|
||||
|
||||
((and (primitive-ref? proc) (eq? (primitive-ref-name proc) 'values)
|
||||
(not (eq? context 'push)))
|
||||
;; tail: (lambda () (values '(1 2)))
|
||||
|
|
@ -299,11 +313,11 @@
|
|||
;; push: (lambda () (list (values '(10 12)) 1))
|
||||
;; vals: (let-values (((a b ...) (values 1 2 ...))) ...)
|
||||
(case context
|
||||
((drop) (for-each comp-drop args))
|
||||
((drop) (for-each comp-drop args) (maybe-emit-return))
|
||||
((vals)
|
||||
(for-each comp-push args)
|
||||
(emit-code #f (make-glil-const (length args)))
|
||||
(emit-branch src 'br LMVRA))
|
||||
(emit-branch src 'br MVRA))
|
||||
((tail)
|
||||
(for-each comp-push args)
|
||||
(emit-code src (make-glil-call 'return/values (length args))))))
|
||||
|
|
@ -324,7 +338,8 @@
|
|||
(comp-vals
|
||||
(make-application src (make-primitive-ref #f 'call-with-values)
|
||||
args)
|
||||
LMVRA))
|
||||
MVRA)
|
||||
(maybe-emit-return))
|
||||
(else
|
||||
(let ((MV (make-label)) (POST (make-label))
|
||||
(producer (car args)) (consumer (cadr args)))
|
||||
|
|
@ -341,7 +356,8 @@
|
|||
(else (emit-code src (make-glil-call 'call/nargs 0))
|
||||
(emit-label POST)
|
||||
(if (eq? context 'drop)
|
||||
(emit-code #f (make-glil-call 'drop 1)))))))))
|
||||
(emit-code #f (make-glil-call 'drop 1)))
|
||||
(maybe-emit-return)))))))
|
||||
|
||||
((and (primitive-ref? proc)
|
||||
(eq? (primitive-ref-name proc) '@call-with-current-continuation)
|
||||
|
|
@ -355,16 +371,19 @@
|
|||
(make-application
|
||||
src (make-primitive-ref #f 'call-with-current-continuation)
|
||||
args)
|
||||
LMVRA))
|
||||
MVRA)
|
||||
(maybe-emit-return))
|
||||
((push)
|
||||
(comp-push (car args))
|
||||
(emit-code src (make-glil-call 'call/cc 1)))
|
||||
(emit-code src (make-glil-call 'call/cc 1))
|
||||
(maybe-emit-return))
|
||||
((drop)
|
||||
;; Crap. Just like `apply' in drop context.
|
||||
(comp-drop
|
||||
(make-application
|
||||
src (make-primitive-ref #f 'call-with-current-continuation)
|
||||
args)))))
|
||||
args))
|
||||
(maybe-emit-return))))
|
||||
|
||||
((and (primitive-ref? proc)
|
||||
(or (hash-ref *primcall-ops*
|
||||
|
|
@ -376,13 +395,12 @@
|
|||
(case (instruction-pushes op)
|
||||
((0)
|
||||
(case context
|
||||
((tail) (emit-code #f (make-glil-void))
|
||||
(emit-code #f (make-glil-call 'return 1)))
|
||||
((push vals) (emit-code #f (make-glil-void)))))
|
||||
((tail push vals) (emit-code #f (make-glil-void))))
|
||||
(maybe-emit-return))
|
||||
((1)
|
||||
(case context
|
||||
((tail) (emit-code #f (make-glil-call 'return 1)))
|
||||
((drop) (emit-code #f (make-glil-call 'drop 1)))))
|
||||
((drop) (emit-code #f (make-glil-call 'drop 1))))
|
||||
(maybe-emit-return))
|
||||
(else
|
||||
(error "bad primitive op: too many pushes"
|
||||
op (instruction-pushes op))))))
|
||||
|
|
@ -401,28 +419,50 @@
|
|||
(for-each (lambda (sym)
|
||||
(pmatch (hashq-ref (hashq-ref allocation sym) self)
|
||||
((#t ,boxed? . ,index)
|
||||
;; set unboxed, as the proc prelude will box if needed
|
||||
(emit-code #f (make-glil-lexical #t #f 'set index)))
|
||||
(,x (error "what" x))))
|
||||
(reverse (lambda-vars self)))
|
||||
(emit-branch src 'br self-label))
|
||||
|
||||
;; lambda, the ultimate goto
|
||||
((and (lexical-ref? proc)
|
||||
(assq (lexical-ref-gensym proc) fix-labels))
|
||||
;; evaluate new values, assuming that analyze-lexicals did its
|
||||
;; job, and that the arity was right
|
||||
(for-each comp-push args)
|
||||
;; rename
|
||||
(for-each (lambda (sym)
|
||||
(pmatch (hashq-ref (hashq-ref allocation sym) self)
|
||||
((#t #f . ,index)
|
||||
(emit-code #f (make-glil-lexical #t #f 'set index)))
|
||||
((#t #t . ,index)
|
||||
(emit-code #f (make-glil-lexical #t #t 'box index)))
|
||||
(,x (error "what" x))))
|
||||
(reverse (assq-ref fix-labels (lexical-ref-gensym proc))))
|
||||
;; goto!
|
||||
(emit-branch src 'br (lexical-ref-gensym proc)))
|
||||
|
||||
(else
|
||||
(comp-push proc)
|
||||
(for-each comp-push args)
|
||||
(let ((len (length args)))
|
||||
(case context
|
||||
((tail) (emit-code src (make-glil-call 'goto/args len)))
|
||||
((push) (emit-code src (make-glil-call 'call len)))
|
||||
((vals) (emit-code src (make-glil-mv-call len LMVRA)))
|
||||
((drop)
|
||||
(let ((MV (make-label)) (POST (make-label)))
|
||||
(emit-code src (make-glil-mv-call len MV))
|
||||
(emit-code #f (make-glil-call 'drop 1))
|
||||
(emit-branch #f 'br POST)
|
||||
(emit-label MV)
|
||||
(emit-code #f (make-glil-mv-bind '() #f))
|
||||
(emit-code #f (make-glil-unbind))
|
||||
(emit-label POST))))))))
|
||||
((push) (emit-code src (make-glil-call 'call len))
|
||||
(maybe-emit-return))
|
||||
((vals) (emit-code src (make-glil-mv-call len MVRA))
|
||||
(maybe-emit-return))
|
||||
((drop) (let ((MV (make-label)) (POST (make-label)))
|
||||
(emit-code src (make-glil-mv-call len MV))
|
||||
(emit-code #f (make-glil-call 'drop 1))
|
||||
(emit-branch #f 'br (or RA POST))
|
||||
(emit-label MV)
|
||||
(emit-code #f (make-glil-mv-bind '() #f))
|
||||
(emit-code #f (make-glil-unbind))
|
||||
(if RA
|
||||
(emit-branch #f 'br RA)
|
||||
(emit-label POST)))))))))
|
||||
|
||||
((<conditional> src test then else)
|
||||
;; TEST
|
||||
|
|
@ -436,30 +476,28 @@
|
|||
(emit-branch src 'br-if-not L1)
|
||||
(comp-tail then)
|
||||
(if (not (eq? context 'tail))
|
||||
(emit-branch #f 'br L2))
|
||||
(emit-branch #f 'br (or RA L2)))
|
||||
(emit-label L1)
|
||||
(comp-tail else)
|
||||
(if (not (eq? context 'tail))
|
||||
(emit-label L2))))
|
||||
(if RA
|
||||
(emit-branch #f 'br RA)
|
||||
(emit-label L2)))))
|
||||
|
||||
((<primitive-ref> src name)
|
||||
(cond
|
||||
((eq? (module-variable (fluid-ref *comp-module*) name)
|
||||
(module-variable the-root-module name))
|
||||
(case context
|
||||
((push vals)
|
||||
(emit-code src (make-glil-toplevel 'ref name)))
|
||||
((tail)
|
||||
(emit-code src (make-glil-toplevel 'ref name))
|
||||
(emit-code #f (make-glil-call 'return 1)))))
|
||||
((tail push vals)
|
||||
(emit-code src (make-glil-toplevel 'ref name))))
|
||||
(maybe-emit-return))
|
||||
(else
|
||||
(pk 'ew-the-badness x (current-module) (fluid-ref *comp-module*))
|
||||
(case context
|
||||
((push vals)
|
||||
(emit-code src (make-glil-module 'ref '(guile) name #f)))
|
||||
((tail)
|
||||
(emit-code src (make-glil-module 'ref '(guile) name #f))
|
||||
(emit-code #f (make-glil-call 'return 1)))))))
|
||||
((tail push vals)
|
||||
(emit-code src (make-glil-module 'ref '(guile) name #f))))
|
||||
(maybe-emit-return))))
|
||||
|
||||
((<lexical-ref> src name gensym)
|
||||
(case context
|
||||
|
|
@ -469,8 +507,7 @@
|
|||
(emit-code src (make-glil-lexical local? boxed? 'ref index)))
|
||||
(,loc
|
||||
(error "badness" x loc)))))
|
||||
(case context
|
||||
((tail) (emit-code #f (make-glil-call 'return 1)))))
|
||||
(maybe-emit-return))
|
||||
|
||||
((<lexical-set> src name gensym exp)
|
||||
(comp-push exp)
|
||||
|
|
@ -480,53 +517,45 @@
|
|||
(,loc
|
||||
(error "badness" x loc)))
|
||||
(case context
|
||||
((push vals)
|
||||
(emit-code #f (make-glil-void)))
|
||||
((tail)
|
||||
(emit-code #f (make-glil-void))
|
||||
(emit-code #f (make-glil-call 'return 1)))))
|
||||
((tail push vals)
|
||||
(emit-code #f (make-glil-void))))
|
||||
(maybe-emit-return))
|
||||
|
||||
((<module-ref> src mod name public?)
|
||||
(emit-code src (make-glil-module 'ref mod name public?))
|
||||
(case context
|
||||
((drop) (emit-code #f (make-glil-call 'drop 1)))
|
||||
((tail) (emit-code #f (make-glil-call 'return 1)))))
|
||||
((drop) (emit-code #f (make-glil-call 'drop 1))))
|
||||
(maybe-emit-return))
|
||||
|
||||
((<module-set> src mod name public? exp)
|
||||
(comp-push exp)
|
||||
(emit-code src (make-glil-module 'set mod name public?))
|
||||
(case context
|
||||
((push vals)
|
||||
(emit-code #f (make-glil-void)))
|
||||
((tail)
|
||||
(emit-code #f (make-glil-void))
|
||||
(emit-code #f (make-glil-call 'return 1)))))
|
||||
((tail push vals)
|
||||
(emit-code #f (make-glil-void))))
|
||||
(maybe-emit-return))
|
||||
|
||||
((<toplevel-ref> src name)
|
||||
(emit-code src (make-glil-toplevel 'ref name))
|
||||
(case context
|
||||
((drop) (emit-code #f (make-glil-call 'drop 1)))
|
||||
((tail) (emit-code #f (make-glil-call 'return 1)))))
|
||||
((drop) (emit-code #f (make-glil-call 'drop 1))))
|
||||
(maybe-emit-return))
|
||||
|
||||
((<toplevel-set> src name exp)
|
||||
(comp-push exp)
|
||||
(emit-code src (make-glil-toplevel 'set name))
|
||||
(case context
|
||||
((push vals)
|
||||
(emit-code #f (make-glil-void)))
|
||||
((tail)
|
||||
(emit-code #f (make-glil-void))
|
||||
(emit-code #f (make-glil-call 'return 1)))))
|
||||
((tail push vals)
|
||||
(emit-code #f (make-glil-void))))
|
||||
(maybe-emit-return))
|
||||
|
||||
((<toplevel-define> src name exp)
|
||||
(comp-push exp)
|
||||
(emit-code src (make-glil-toplevel 'define name))
|
||||
(case context
|
||||
((push vals)
|
||||
(emit-code #f (make-glil-void)))
|
||||
((tail)
|
||||
(emit-code #f (make-glil-void))
|
||||
(emit-code #f (make-glil-call 'return 1)))))
|
||||
((tail push vals)
|
||||
(emit-code #f (make-glil-void))))
|
||||
(maybe-emit-return))
|
||||
|
||||
((<lambda>)
|
||||
(let ((free-locs (cddr (hashq-ref allocation x))))
|
||||
|
|
@ -543,9 +572,8 @@
|
|||
(else (error "what" x loc))))
|
||||
free-locs)
|
||||
(emit-code #f (make-glil-call 'vector (length free-locs)))
|
||||
(emit-code #f (make-glil-call 'make-closure 2))))
|
||||
(if (eq? context 'tail)
|
||||
(emit-code #f (make-glil-call 'return 1)))))))
|
||||
(emit-code #f (make-glil-call 'make-closure 2)))))))
|
||||
(maybe-emit-return))
|
||||
|
||||
((<let> src names vars vals body)
|
||||
(for-each comp-push vals)
|
||||
|
|
@ -580,47 +608,85 @@
|
|||
(emit-code #f (make-glil-unbind)))
|
||||
|
||||
((<fix> src names vars vals body)
|
||||
;; For fixpoint procedures, we can do some tricks to avoid
|
||||
;; heap-allocation. Since we know the vals are lambdas, we can
|
||||
;; set them to their local var slots first, then capture their
|
||||
;; bindings, mutating them in place.
|
||||
(for-each (lambda (x v)
|
||||
(emit-code #f (flatten-lambda x v allocation))
|
||||
(if (not (null? (cddr (hashq-ref allocation x))))
|
||||
;; But we do have to make-closure them first, so
|
||||
;; we are mutating fresh closures on the heap.
|
||||
(begin
|
||||
(emit-code #f (make-glil-const #f))
|
||||
(emit-code #f (make-glil-call 'make-closure 2))))
|
||||
(pmatch (hashq-ref (hashq-ref allocation v) self)
|
||||
((#t #f . ,n)
|
||||
(emit-code src (make-glil-lexical #t #f 'set n)))
|
||||
(,loc (error "badness" x loc))))
|
||||
vals
|
||||
vars)
|
||||
(emit-bindings src names vars allocation self emit-code)
|
||||
;; Now go back and fix up the bindings.
|
||||
(for-each
|
||||
(lambda (x v)
|
||||
(let ((free-locs (cddr (hashq-ref allocation x))))
|
||||
(if (not (null? free-locs))
|
||||
(begin
|
||||
(for-each
|
||||
(lambda (loc)
|
||||
(pmatch loc
|
||||
((,local? ,boxed? . ,n)
|
||||
(emit-code #f (make-glil-lexical local? #f 'ref n)))
|
||||
(else (error "what" x loc))))
|
||||
free-locs)
|
||||
(emit-code #f (make-glil-call 'vector (length free-locs)))
|
||||
(pmatch (hashq-ref (hashq-ref allocation v) self)
|
||||
((#t #f . ,n)
|
||||
(emit-code #f (make-glil-lexical #t #f 'fix n)))
|
||||
(,loc (error "badness" x loc)))))))
|
||||
vals
|
||||
vars)
|
||||
(comp-tail body)
|
||||
(emit-code #f (make-glil-unbind)))
|
||||
;; The ideal here is to just render the lambda bodies inline, and
|
||||
;; wire the code together with gotos. We can do that if
|
||||
;; analyze-lexicals has determined that a given var has "label"
|
||||
;; allocation -- which is the case if it is in `fix-labels'.
|
||||
;;
|
||||
;; But even for closures that we can't inline, we can do some
|
||||
;; tricks to avoid heap-allocation for the binding itself. Since
|
||||
;; we know the vals are lambdas, we can set them to their local
|
||||
;; var slots first, then capture their bindings, mutating them in
|
||||
;; place.
|
||||
(let ((RA (if (eq? context 'tail) #f (make-label))))
|
||||
(for-each
|
||||
(lambda (x v)
|
||||
(cond
|
||||
((hashq-ref allocation x)
|
||||
;; allocating a closure
|
||||
(emit-code #f (flatten-lambda x v allocation))
|
||||
(if (not (null? (cddr (hashq-ref allocation x))))
|
||||
;; Need to make-closure first, but with a temporary #f
|
||||
;; free-variables vector, so we are mutating fresh
|
||||
;; closures on the heap.
|
||||
(begin
|
||||
(emit-code #f (make-glil-const #f))
|
||||
(emit-code #f (make-glil-call 'make-closure 2))))
|
||||
(pmatch (hashq-ref (hashq-ref allocation v) self)
|
||||
((#t #f . ,n)
|
||||
(emit-code src (make-glil-lexical #t #f 'set n)))
|
||||
(,loc (error "badness" x loc))))
|
||||
(else
|
||||
;; labels allocation: emit label & body, but jump over it
|
||||
(let ((POST (make-label)))
|
||||
(emit-branch #f 'br POST)
|
||||
(emit-label v)
|
||||
;; we know the lambda vars are a list
|
||||
(emit-bindings #f (lambda-names x) (lambda-vars x)
|
||||
allocation self emit-code)
|
||||
(if (lambda-src x)
|
||||
(emit-code #f (make-glil-source (lambda-src x))))
|
||||
(comp-fix (lambda-body x) RA)
|
||||
(emit-code #f (make-glil-unbind))
|
||||
(emit-label POST)))))
|
||||
vals
|
||||
vars)
|
||||
;; Emit bindings metadata for closures
|
||||
(let ((binds (let lp ((out '()) (vars vars) (names names))
|
||||
(cond ((null? vars) (reverse! out))
|
||||
((memq (car vars) fix-labels)
|
||||
(lp out (cdr vars) (cdr names)))
|
||||
(else
|
||||
(lp (acons (car vars) (car names) out)
|
||||
(cdr vars) (cdr names)))))))
|
||||
(emit-bindings src (map cdr binds) (map car binds)
|
||||
allocation self emit-code))
|
||||
;; Now go back and fix up the bindings for closures.
|
||||
(for-each
|
||||
(lambda (x v)
|
||||
(let ((free-locs (if (hashq-ref allocation x)
|
||||
(cddr (hashq-ref allocation x))
|
||||
;; can hit this latter case for labels allocation
|
||||
'())))
|
||||
(if (not (null? free-locs))
|
||||
(begin
|
||||
(for-each
|
||||
(lambda (loc)
|
||||
(pmatch loc
|
||||
((,local? ,boxed? . ,n)
|
||||
(emit-code #f (make-glil-lexical local? #f 'ref n)))
|
||||
(else (error "what" x loc))))
|
||||
free-locs)
|
||||
(emit-code #f (make-glil-call 'vector (length free-locs)))
|
||||
(pmatch (hashq-ref (hashq-ref allocation v) self)
|
||||
((#t #f . ,n)
|
||||
(emit-code #f (make-glil-lexical #t #f 'fix n)))
|
||||
(,loc (error "badness" x loc)))))))
|
||||
vals
|
||||
vars)
|
||||
(comp-tail body)
|
||||
(emit-label RA)
|
||||
(emit-code #f (make-glil-unbind))))
|
||||
|
||||
((<let-values> src names vars exp body)
|
||||
(let lp ((names '()) (vars '()) (inames names) (ivars vars) (rest? #f))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue