(<glil-program> make-glil-program glil-program?
glil-program-meta glil-program-body
- <glil-arity> make-glil-arity glil-arity?
- glil-arity-nargs glil-arity-nrest glil-arity-label
+ <glil-std-prelude> make-glil-std-prelude glil-std-prelude?
+ glil-std-prelude-nreq glil-std-prelude-nlocs glil-std-prelude-else-label
+
+ <glil-opt-prelude> make-glil-opt-prelude glil-opt-prelude?
+ glil-opt-prelude-nreq glil-opt-prelude-nopt glil-opt-prelude-rest?
+ glil-opt-prelude-nlocs glil-opt-prelude-else-label
+
+ <glil-kw-prelude> make-glil-kw-prelude glil-kw-prelude?
+ glil-kw-prelude-nreq glil-kw-prelude-nopt glil-kw-prelude-kw
+ glil-kw-prelude-allow-other-keys? glil-kw-prelude-rest?
+ glil-kw-prelude-nlocs glil-kw-prelude-else-label
<glil-bind> make-glil-bind glil-bind?
glil-bind-vars
(define-type (<glil> #:printer print-glil)
;; Meta operations
(<glil-program> meta body)
- (<glil-arity> nargs nrest label)
+ (<glil-std-prelude> nreq nlocs else-label)
+ (<glil-opt-prelude> nreq nopt rest? nlocs else-label)
+ (<glil-kw-prelude> nreq nopt rest? kw allow-other-keys? nlocs else-label)
(<glil-bind> vars)
(<glil-mv-bind> vars rest)
(<glil-unbind>)
(pmatch x
((program ,meta . ,body)
(make-glil-program meta (map parse-glil body)))
- ((arity ,nargs ,nrest ,label) (make-glil-arity nargs nrest label))
+ ((std-prelude ,nreq ,nlocs ,else-label)
+ (make-glil-std-prelude nreq nlocs else-label))
+ ((opt-prelude ,nreq ,nopt ,rest? ,nlocs ,else-label)
+ (make-glil-opt-prelude nreq nopt rest? nlocs else-label))
+ ((kw-prelude ,nreq ,nopt ,rest? ,kw ,allow-other-keys? ,nlocs ,else-label)
+ (make-glil-kw-prelude nreq nopt rest? kw allow-other-keys? nlocs else-label))
((bind . ,vars) (make-glil-bind vars))
((mv-bind ,vars ,rest) (make-glil-mv-bind vars rest))
((unbind) (make-glil-unbind))
;; meta
((<glil-program> meta body)
`(program ,meta ,@(map unparse-glil body)))
- ((<glil-arity> nargs nrest label) `(arity ,nargs ,nrest ,label))
+ ((<glil-std-prelude> nreq nlocs else-label)
+ `(std-prelude ,nreq ,nlocs ,else-label))
+ ((<glil-opt-prelude> nreq nopt rest? nlocs else-label)
+ `(opt-prelude ,nreq ,nopt ,rest? ,nlocs ,else-label))
+ ((<glil-kw-prelude> nreq nopt rest? kw allow-other-keys? nlocs else-label)
+ `(kw-prelude ,nreq ,nopt ,rest? ,kw ,allow-other-keys? ,nlocs ,else-label))
((<glil-bind> vars) `(bind ,@vars))
((<glil-mv-bind> vars rest) `(mv-bind ,vars ,rest))
((<glil-unbind>) `(unbind))
(kw (list addr nreq nopt rest? kw))
(rest? (list addr nreq nopt rest?))
(nopt (list addr nreq nopt))
- (nreq (list addr req))
+ (nreq (list addr nreq))
(else (list addr)))
arities))
(define (emit-code/arity x nreq nopt rest? kw)
(values x bindings source-alist label-alist object-alist
(begin-arity (addr+ addr x) nreq nopt rest? kw arities)))
-
+
(record-case glil
((<glil-program> meta body)
(define (process-body)
`(,@table-code
,@(align-program prog (addr+ addr table-code)))))))))))))
+ ((<glil-std-prelude> nreq nlocs else-label)
+ (emit-code/arity
+ `(,(if else-label
+ `(br-if-nargs-ne ,(quotient nreq 256)
+ ,(modulo nreq 256)
+ ,else-label)
+ `(assert-nargs-ee ,(quotient nreq 256)
+ ,(modulo nreq 256)))
+ (reserve-locals ,(quotient nlocs 256)
+ ,(modulo nlocs 256)))
+ nreq #f #f #f))
+
+ ((<glil-opt-prelude> nreq nopt rest? nlocs else-label)
+ (let ((bind-required
+ (if else-label
+ `((br-if-nargs-lt ,(quotient nreq 256)
+ ,(modulo nreq 256)
+ ,else-label))
+ `((assert-nargs-ge ,(quotient nreq 256)
+ ,(modulo nreq 256)))))
+ (bind-optionals
+ (if (zero? nopt)
+ '()
+ `((bind-optionals ,(quotient (+ nopt nreq) 256)
+ ,(modulo (+ nreq nopt) 256)))))
+ (bind-rest
+ (cond
+ (rest?
+ `((bind-rest ,(quotient (+ nreq nopt) 256)
+ ,(modulo (+ nreq nopt) 256))))
+ (else
+ (if else-label
+ `((br-if-nargs-ge ,(quotient (+ nreq nopt) 256)
+ ,(modulo (+ nreq nopt) 256)
+ ,else-label))
+ `((assert-nargs-ee ,(quotient (+ nreq nopt) 256)
+ ,(modulo (+ nreq nopt) 256))))))))
+ (emit-code/arity
+ `(,@bind-required
+ ,@bind-optionals
+ ,@bind-rest
+ (reserve-locals ,(quotient nlocs 256)
+ ,(modulo nlocs 256)))
+ nreq nopt rest? #f)))
+
+ ((<glil-kw-prelude> nreq nopt rest? kw allow-other-keys? nlocs else-label)
+ (receive (kw-idx object-alist)
+ (object-index-and-alist object-alist kw)
+ (let ((bind-required
+ (if else-label
+ `((br-if-nargs-lt ,(quotient nreq 256)
+ ,(modulo nreq 256)
+ ,else-label))
+ `((assert-nargs-ge ,(quotient nreq 256)
+ ,(modulo nreq 256)))))
+ (bind-optionals-and-shuffle
+ `((bind-optionals-and-shuffle-kwargs
+ ,(quotient (+ nreq nopt) 256)
+ ,(modulo (+ nreq nopt) 256)
+ ,(quotient (apply max (+ nreq nopt) (map cdr kw)) 256)
+ ,(modulo (apply max (+ nreq nopt) (map cdr kw)) 256))))
+ (bind-kw
+ ;; when this code gets called, all optionals are filled
+ ;; in, space has been made for kwargs, and the kwargs
+ ;; themselves have been shuffled above the slots for all
+ ;; req/opt/kwargs locals.
+ `((,(if allow-other-keys? 'bind-kwargs/aok 'bind-kwargs/no-aok)
+ ,(quotient kw-idx 256)
+ ,(modulo kw-idx 256)
+ ,(quotient (+ nreq nopt) 256)
+ ,(modulo (+ nreq nopt) 256)
+ ,(quotient (apply max (+ nreq nopt) (map cdr kw)) 256)
+ ,(modulo (apply max (+ nreq nopt) (map cdr kw)) 256))))
+ (bind-rest
+ (if rest?
+ `((bind-rest ,(quotient (apply max (+ nreq nopt) (map cdr kw)) 256)
+ ,(modulo (apply max (+ nreq nopt) (map cdr kw)) 256)))
+ '())))
+
+ (let ((code `(,@bind-required
+ ,@bind-optionals-and-shuffle
+ ,@bind-kw
+ ,@bind-rest
+ (reserve-locals ,(quotient nlocs 256)
+ ,(modulo nlocs 256)))))
+ (values code bindings source-alist label-alist object-alist
+ (begin-arity (addr+ addr code) nreq nopt rest? kw arities))))))
+
((<glil-bind> vars)
(values '()
(open-binding bindings vars addr)
((<glil-branch> inst label)
(emit-code `((,inst ,label))))
- ((<glil-arity> nargs nrest label)
- (emit-code/arity
- (if label
- (if (zero? nrest)
- `((br-if-nargs-ne ,(quotient nargs 256) ,label))
- `(,@(if (> nargs 1)
- `((br-if-nargs-lt ,(quotient (1- nargs) 256)
- ,(modulo (1- nargs 256))
- ,label))
- '())
- (push-rest-list ,(quotient (1- nargs) 256))))
- (if (zero? nrest)
- `((assert-nargs-ee ,(quotient nargs 256)
- ,(modulo nargs 256)))
- `(,@(if (> nargs 1)
- `((assert-nargs-ge ,(quotient (1- nargs) 256)
- ,(modulo (1- nargs) 256)))
- '())
- (push-rest-list ,(quotient (1- nargs) 256)
- ,(modulo (1- nargs) 256)))))
- (- nargs nrest) 0 (< 0 nrest) #f))
-
;; nargs is number of stack args to insn. probably should rename.
((<glil-call> inst nargs)
(if (not (instruction? inst))
(with-test-prefix "void"
(assert-tree-il->glil
(void)
- (program () (arity 0 0 #f) (void) (call return 1)))
+ (program () (std-prelude 0 0 #f) (void) (call return 1)))
(assert-tree-il->glil
(begin (void) (const 1))
- (program () (arity 0 0 #f) (const 1) (call return 1)))
+ (program () (std-prelude 0 0 #f) (const 1) (call return 1)))
(assert-tree-il->glil
(apply (primitive +) (void) (const 1))
- (program () (arity 0 0 #f) (void) (call add1 1) (call return 1))))
+ (program () (std-prelude 0 0 #f) (void) (call add1 1) (call return 1))))
(with-test-prefix "application"
(assert-tree-il->glil
(apply (toplevel foo) (const 1))
- (program () (arity 0 0 #f) (toplevel ref foo) (const 1) (call goto/args 1)))
+ (program () (std-prelude 0 0 #f) (toplevel ref foo) (const 1) (call goto/args 1)))
(assert-tree-il->glil/pmatch
(begin (apply (toplevel foo) (const 1)) (void))
- (program () (arity 0 0 #f) (call new-frame 0) (toplevel ref foo) (const 1) (mv-call 1 ,l1)
+ (program () (std-prelude 0 0 #f) (call new-frame 0) (toplevel ref foo) (const 1) (mv-call 1 ,l1)
(call drop 1) (branch br ,l2)
(label ,l3) (mv-bind () #f) (unbind)
(label ,l4)
(and (eq? l1 l3) (eq? l2 l4)))
(assert-tree-il->glil
(apply (toplevel foo) (apply (toplevel bar)))
- (program () (arity 0 0 #f)(toplevel ref foo) (call new-frame 0) (toplevel ref bar) (call call 0)
+ (program () (std-prelude 0 0 #f)(toplevel ref foo) (call new-frame 0) (toplevel ref bar) (call call 0)
(call goto/args 1))))
(with-test-prefix "conditional"
(assert-tree-il->glil/pmatch
(if (const #t) (const 1) (const 2))
- (program () (arity 0 0 #f) (const #t) (branch br-if-not ,l1)
+ (program () (std-prelude 0 0 #f) (const #t) (branch br-if-not ,l1)
(const 1) (call return 1)
(label ,l2) (const 2) (call return 1))
(eq? l1 l2))
(assert-tree-il->glil/pmatch
(begin (if (const #t) (const 1) (const 2)) (const #f))
- (program () (arity 0 0 #f) (const #t) (branch br-if-not ,l1) (branch br ,l2)
+ (program () (std-prelude 0 0 #f) (const #t) (branch br-if-not ,l1) (branch br ,l2)
(label ,l3) (label ,l4) (const #f) (call return 1))
(eq? l1 l3) (eq? l2 l4))
(assert-tree-il->glil/pmatch
(apply (primitive null?) (if (const #t) (const 1) (const 2)))
- (program () (arity 0 0 #f) (const #t) (branch br-if-not ,l1)
+ (program () (std-prelude 0 0 #f) (const #t) (branch br-if-not ,l1)
(const 1) (branch br ,l2)
(label ,l3) (const 2) (label ,l4)
(call null? 1) (call return 1))
(with-test-prefix "primitive-ref"
(assert-tree-il->glil
(primitive +)
- (program () (arity 0 0 #f) (toplevel ref +) (call return 1)))
+ (program () (std-prelude 0 0 #f) (toplevel ref +) (call return 1)))
(assert-tree-il->glil
(begin (primitive +) (const #f))
- (program () (arity 0 0 #f) (const #f) (call return 1)))
+ (program () (std-prelude 0 0 #f) (const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (primitive +))
- (program () (arity 0 0 #f) (toplevel ref +) (call null? 1)
+ (program () (std-prelude 0 0 #f) (toplevel ref +) (call null? 1)
(call return 1))))
(with-test-prefix "lexical refs"
(assert-tree-il->glil
(let (x) (y) ((const 1)) (lexical x y))
- (program () (arity 0 0 #f) (call reserve-locals 1)
+ (program () (std-prelude 0 1 #f)
(const 1) (bind (x #f 0)) (lexical #t #f set 0)
(lexical #t #f ref 0) (call return 1)
(unbind)))
(assert-tree-il->glil
(let (x) (y) ((const 1)) (begin (lexical x y) (const #f)))
- (program () (arity 0 0 #f) (call reserve-locals 1)
+ (program () (std-prelude 0 1 #f)
(const 1) (bind (x #f 0)) (lexical #t #f set 0)
(const #f) (call return 1)
(unbind)))
(assert-tree-il->glil
(let (x) (y) ((const 1)) (apply (primitive null?) (lexical x y)))
- (program () (arity 0 0 #f) (call reserve-locals 1)
+ (program () (std-prelude 0 1 #f)
(const 1) (bind (x #f 0)) (lexical #t #f set 0)
(lexical #t #f ref 0) (call null? 1) (call return 1)
(unbind))))
;; unreferenced sets may be optimized away -- make sure they are ref'd
(let (x) (y) ((const 1))
(set! (lexical x y) (apply (primitive 1+) (lexical x y))))
- (program () (arity 0 0 #f) (call reserve-locals 1)
+ (program () (std-prelude 0 1 #f)
(const 1) (bind (x #t 0)) (lexical #t #t box 0)
(lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0)
(void) (call return 1)
(let (x) (y) ((const 1))
(begin (set! (lexical x y) (apply (primitive 1+) (lexical x y)))
(lexical x y)))
- (program () (arity 0 0 #f) (call reserve-locals 1)
+ (program () (std-prelude 0 1 #f)
(const 1) (bind (x #t 0)) (lexical #t #t box 0)
(lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0)
(lexical #t #t ref 0) (call return 1)
(let (x) (y) ((const 1))
(apply (primitive null?)
(set! (lexical x y) (apply (primitive 1+) (lexical x y)))))
- (program () (arity 0 0 #f) (call reserve-locals 1)
+ (program () (std-prelude 0 1 #f)
(const 1) (bind (x #t 0)) (lexical #t #t box 0)
(lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0) (void)
(call null? 1) (call return 1)
(with-test-prefix "module refs"
(assert-tree-il->glil
(@ (foo) bar)
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(module public ref (foo) bar)
(call return 1)))
(assert-tree-il->glil
(begin (@ (foo) bar) (const #f))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(module public ref (foo) bar) (call drop 1)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (@ (foo) bar))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(module public ref (foo) bar)
(call null? 1) (call return 1)))
(assert-tree-il->glil
(@@ (foo) bar)
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(module private ref (foo) bar)
(call return 1)))
(assert-tree-il->glil
(begin (@@ (foo) bar) (const #f))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(module private ref (foo) bar) (call drop 1)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (@@ (foo) bar))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(module private ref (foo) bar)
(call null? 1) (call return 1))))
(with-test-prefix "module sets"
(assert-tree-il->glil
(set! (@ (foo) bar) (const 2))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (module public set (foo) bar)
(void) (call return 1)))
(assert-tree-il->glil
(begin (set! (@ (foo) bar) (const 2)) (const #f))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (module public set (foo) bar)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (set! (@ (foo) bar) (const 2)))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (module public set (foo) bar)
(void) (call null? 1) (call return 1)))
(assert-tree-il->glil
(set! (@@ (foo) bar) (const 2))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (module private set (foo) bar)
(void) (call return 1)))
(assert-tree-il->glil
(begin (set! (@@ (foo) bar) (const 2)) (const #f))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (module private set (foo) bar)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (set! (@@ (foo) bar) (const 2)))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (module private set (foo) bar)
(void) (call null? 1) (call return 1))))
(with-test-prefix "toplevel refs"
(assert-tree-il->glil
(toplevel bar)
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(toplevel ref bar)
(call return 1)))
(assert-tree-il->glil
(begin (toplevel bar) (const #f))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(toplevel ref bar) (call drop 1)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (toplevel bar))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(toplevel ref bar)
(call null? 1) (call return 1))))
(with-test-prefix "toplevel sets"
(assert-tree-il->glil
(set! (toplevel bar) (const 2))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (toplevel set bar)
(void) (call return 1)))
(assert-tree-il->glil
(begin (set! (toplevel bar) (const 2)) (const #f))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (toplevel set bar)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (set! (toplevel bar) (const 2)))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (toplevel set bar)
(void) (call null? 1) (call return 1))))
(with-test-prefix "toplevel defines"
(assert-tree-il->glil
(define bar (const 2))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (toplevel define bar)
(void) (call return 1)))
(assert-tree-il->glil
(begin (define bar (const 2)) (const #f))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (toplevel define bar)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (define bar (const 2)))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (toplevel define bar)
(void) (call null? 1) (call return 1))))
(with-test-prefix "constants"
(assert-tree-il->glil
(const 2)
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (call return 1)))
(assert-tree-il->glil
(begin (const 2) (const #f))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const #f) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (const 2))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (call null? 1) (call return 1))))
(with-test-prefix "lambda"
(assert-tree-il->glil
(lambda (x) (y) () (const 2))
- (program () (arity 0 0 #f)
- (program () (arity 1 0 #f)
+ (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 1 1 #f)
(bind (x #f 0))
(const 2) (call return 1))
(call return 1)))
(assert-tree-il->glil
(lambda (x x1) (y y1) () (const 2))
- (program () (arity 0 0 #f)
- (program () (arity 2 0 #f)
+ (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 2 2 #f)
(bind (x #f 0) (x1 #f 1))
(const 2) (call return 1))
(call return 1)))
(assert-tree-il->glil
(lambda x y () (const 2))
- (program () (arity 0 0 #f)
- (program () (arity 1 1 #f)
+ (program () (std-prelude 0 0 #f)
+ (program () (opt-prelude 0 0 #t 1 #f)
(bind (x #f 0))
(const 2) (call return 1))
(call return 1)))
(assert-tree-il->glil
(lambda (x . x1) (y . y1) () (const 2))
- (program () (arity 0 0 #f)
- (program () (arity 2 1 #f)
+ (program () (std-prelude 0 0 #f)
+ (program () (opt-prelude 1 0 #t 2 #f)
(bind (x #f 0) (x1 #f 1))
(const 2) (call return 1))
(call return 1)))
(assert-tree-il->glil
(lambda (x . x1) (y . y1) () (lexical x y))
- (program () (arity 0 0 #f)
- (program () (arity 2 1 #f)
+ (program () (std-prelude 0 0 #f)
+ (program () (opt-prelude 1 0 #t 2 #f)
(bind (x #f 0) (x1 #f 1))
(lexical #t #f ref 0) (call return 1))
(call return 1)))
(assert-tree-il->glil
(lambda (x . x1) (y . y1) () (lexical x1 y1))
- (program () (arity 0 0 #f)
- (program () (arity 2 1 #f)
+ (program () (std-prelude 0 0 #f)
+ (program () (opt-prelude 1 0 #t 2 #f)
(bind (x #f 0) (x1 #f 1))
(lexical #t #f ref 1) (call return 1))
(call return 1)))
(assert-tree-il->glil
(lambda (x) (x1) () (lambda (y) (y1) () (lexical x x1)))
- (program () (arity 0 0 #f)
- (program () (arity 1 0 #f)
+ (program () (std-prelude 0 0 #f)
+ (program () (std-prelude 1 1 #f)
(bind (x #f 0))
- (program () (arity 1 0 #f)
+ (program () (std-prelude 1 1 #f)
(bind (y #f 0))
(lexical #f #f ref 0) (call return 1))
(lexical #t #f ref 0)
(with-test-prefix "sequence"
(assert-tree-il->glil
(begin (begin (const 2) (const #f)) (const #t))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const #t) (call return 1)))
(assert-tree-il->glil
(apply (primitive null?) (begin (const #f) (const 2)))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(const 2) (call null? 1) (call return 1))))
;; FIXME: binding info for or-hacked locals might bork the disassembler,
(lexical x y)
(let (a) (b) ((const 2))
(lexical a b))))
- (program () (arity 0 0 #f) (call reserve-locals 1)
+ (program () (std-prelude 0 1 #f)
(const 1) (bind (x #f 0)) (lexical #t #f set 0)
(lexical #t #f ref 0) (branch br-if-not ,l1)
(lexical #t #f ref 0) (call return 1)
(lexical x y)
(let (a) (b) ((const 2))
(lexical x y))))
- (program () (arity 0 0 #f) (call reserve-locals 1)
+ (program () (std-prelude 0 1 #f)
(const 1) (bind (x #f 0)) (lexical #t #f set 0)
(lexical #t #f ref 0) (branch br-if-not ,l1)
(lexical #t #f ref 0) (call return 1)
(with-test-prefix "apply"
(assert-tree-il->glil
(apply (primitive @apply) (toplevel foo) (toplevel bar))
- (program () (arity 0 0 #f) (toplevel ref foo) (toplevel ref bar) (call goto/apply 2)))
+ (program () (std-prelude 0 0 #f) (toplevel ref foo) (toplevel ref bar) (call goto/apply 2)))
(assert-tree-il->glil/pmatch
(begin (apply (primitive @apply) (toplevel foo) (toplevel bar)) (void))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(call new-frame 0) (toplevel ref apply) (toplevel ref foo) (toplevel ref bar) (mv-call 2 ,l1)
(call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
(label ,l4)
(and (eq? l1 l3) (eq? l2 l4)))
(assert-tree-il->glil
(apply (toplevel foo) (apply (toplevel @apply) (toplevel bar) (toplevel baz)))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(toplevel ref foo)
(call new-frame 0) (toplevel ref bar) (toplevel ref baz) (call apply 2)
(call goto/args 1))))
(with-test-prefix "call/cc"
(assert-tree-il->glil
(apply (primitive @call-with-current-continuation) (toplevel foo))
- (program () (arity 0 0 #f) (toplevel ref foo) (call goto/cc 1)))
+ (program () (std-prelude 0 0 #f) (toplevel ref foo) (call goto/cc 1)))
(assert-tree-il->glil/pmatch
(begin (apply (primitive @call-with-current-continuation) (toplevel foo)) (void))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(call new-frame 0) (toplevel ref call-with-current-continuation) (toplevel ref foo) (mv-call 1 ,l1)
(call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
(label ,l4)
(assert-tree-il->glil
(apply (toplevel foo)
(apply (toplevel @call-with-current-continuation) (toplevel bar)))
- (program () (arity 0 0 #f)
+ (program () (std-prelude 0 0 #f)
(toplevel ref foo)
(toplevel ref bar) (call call/cc 1)
(call goto/args 1))))