mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 16:50:21 +02:00
Code Activity

add <primcall> to tree-il

Browse source 
* libguile/expand.c:
* libguile/expand.h (SCM_EXPANDED_PRIMCALL_TYPE_NAME):
  (SCM_EXPANDED_PRIMCALL_FIELD_NAMES):
  (SCM_EXPANDED_PRIMCALL_SRC):
  (SCM_EXPANDED_PRIMCALL_NAME):
  (SCM_EXPANDED_PRIMCALL_ARGS):
  (SCM_MAKE_EXPANDED_PRIMCALL): Add "primcall" Tree-IL type.

* doc/ref/compiler.texi (Tree-IL): Update docs.

* libguile/memoize.c (memoize): Memoizer for primcalls.

* module/ice-9/psyntax.scm: Build primcalls, sometimes.  Also change
  build-primref to just make a primitive-ref.

* module/language/tree-il.scm: Add primcall to the exports, parsers,
  serializers, etc.

* module/language/tree-il/analyze.scm:
* module/language/tree-il/compile-glil.scm:
* module/language/tree-il/fix-letrec.scm:
* module/language/tree-il/inline.scm:
* module/language/tree-il/primitives.scm:
* module/language/elisp/compile-tree-il.scm: Add primcall support.

* test-suite/tests/tree-il.test: Use primcalls sometimes.
This commit is contained in:
Andy Wingo 2011-06-02 17:41:45 +02:00
parent 7081d4f981
commit a881a4ae3b
14 changed files with 7186 additions and 7090 deletions
Download patch file Download diff file Expand all files Collapse all files

46
test-suite/tests/tree-il.test
View file

@ -63,7 +63,7 @@
(begin (void) (const 1))
(program () (std-prelude 0 0 #f) (label _) (const 1) (call return 1)))
(assert-tree-il->glil
(call (primitive +) (void) (const 1))
(primcall + (void) (const 1))
(program () (std-prelude 0 0 #f) (label _) (void) (call add1 1) (call return 1))))
(with-test-prefix "application"
@ -98,7 +98,7 @@
(eq? l1 l3) (eq? l2 l4))
(assert-tree-il->glil
(call (primitive null?) (if (toplevel foo) (const 1) (const 2)))
(primcall null? (if (toplevel foo) (const 1) (const 2)))
(program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (branch br-if-not ,l1)
(const 1) (branch br ,l2)
(label ,l3) (const 2) (label ,l4)
@ -115,7 +115,7 @@
(program () (std-prelude 0 0 #f) (label _) (const #f) (call return 1)))
(assert-tree-il->glil
(call (primitive null?) (primitive +))
(primcall null? (primitive +))
(program () (std-prelude 0 0 #f) (label _) (toplevel ref +) (call null? 1)
(call return 1))))
@ -135,7 +135,7 @@
(unbind)))
(assert-tree-il->glil
(let (x) (y) ((const 1)) (call (primitive null?) (lexical x y)))
(let (x) (y) ((const 1)) (primcall null? (lexical x y)))
(program () (std-prelude 0 1 #f) (label _)
(const 1) (bind (x #f 0)) (lexical #t #f set 0)
(lexical #t #f ref 0) (call null? 1) (call return 1)
@ -145,7 +145,7 @@
(assert-tree-il->glil
;; unreferenced sets may be optimized away -- make sure they are ref'd
(let (x) (y) ((const 1))
(set! (lexical x y) (call (primitive 1+) (lexical x y))))
(set! (lexical x y) (primcall 1+ (lexical x y))))
(program () (std-prelude 0 1 #f) (label _)
(const 1) (bind (x #t 0)) (lexical #t #t box 0)
(lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0)
@ -154,7 +154,7 @@
(assert-tree-il->glil
(let (x) (y) ((const 1))
(begin (set! (lexical x y) (call (primitive 1+) (lexical x y)))
(begin (set! (lexical x y) (primcall 1+ (lexical x y)))
(lexical x y)))
(program () (std-prelude 0 1 #f) (label _)
(const 1) (bind (x #t 0)) (lexical #t #t box 0)
@ -164,8 +164,8 @@
(assert-tree-il->glil
(let (x) (y) ((const 1))
(call (primitive null?)
(set! (lexical x y) (call (primitive 1+) (lexical x y)))))
(primcall null?
(set! (lexical x y) (primcall 1+ (lexical x y)))))
(program () (std-prelude 0 1 #f) (label _)
(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)
@ -186,7 +186,7 @@
(const #f) (call return 1)))
(assert-tree-il->glil
(call (primitive null?) (@ (foo) bar))
(primcall null? (@ (foo) bar))
(program () (std-prelude 0 0 #f) (label _)
(module public ref (foo) bar)
(call null? 1) (call return 1)))
@ -204,7 +204,7 @@
(const #f) (call return 1)))
(assert-tree-il->glil
(call (primitive null?) (@@ (foo) bar))
(primcall null? (@@ (foo) bar))
(program () (std-prelude 0 0 #f) (label _)
(module private ref (foo) bar)
(call null? 1) (call return 1))))
@ -223,7 +223,7 @@
(const #f) (call return 1)))
(assert-tree-il->glil
(call (primitive null?) (set! (@ (foo) bar) (const 2)))
(primcall null? (set! (@ (foo) bar) (const 2)))
(program () (std-prelude 0 0 #f) (label _)
(const 2) (module public set (foo) bar)
(void) (call null? 1) (call return 1)))
@ -241,7 +241,7 @@
(const #f) (call return 1)))
(assert-tree-il->glil
(call (primitive null?) (set! (@@ (foo) bar) (const 2)))
(primcall null? (set! (@@ (foo) bar) (const 2)))
(program () (std-prelude 0 0 #f) (label _)
(const 2) (module private set (foo) bar)
(void) (call null? 1) (call return 1))))
@ -260,7 +260,7 @@
(const #f) (call return 1)))
(assert-tree-il->glil
(call (primitive null?) (toplevel bar))
(primcall null? (toplevel bar))
(program () (std-prelude 0 0 #f) (label _)
(toplevel ref bar)
(call null? 1) (call return 1))))
@ -279,7 +279,7 @@
(const #f) (call return 1)))
(assert-tree-il->glil
(call (primitive null?) (set! (toplevel bar) (const 2)))
(primcall null? (set! (toplevel bar) (const 2)))
(program () (std-prelude 0 0 #f) (label _)
(const 2) (toplevel set bar)
(void) (call null? 1) (call return 1))))
@ -298,7 +298,7 @@
(const #f) (call return 1)))
(assert-tree-il->glil
(call (primitive null?) (define bar (const 2)))
(primcall null? (define bar (const 2)))
(program () (std-prelude 0 0 #f) (label _)
(const 2) (toplevel define bar)
(void) (call null? 1) (call return 1))))
@ -315,7 +315,7 @@
(const #f) (call return 1)))
(assert-tree-il->glil
(call (primitive null?) (const 2))
(primcall null? (const 2))
(program () (std-prelude 0 0 #f) (label _)
(const 2) (call null? 1) (call return 1))))
@ -336,7 +336,7 @@
;; complex bindings -> box and set! within let
(assert-tree-il->glil
(letrec (x y) (x1 y1) ((call (toplevel foo)) (call (toplevel bar)))
(call (primitive +) (lexical x x1) (lexical y y1)))
(primcall + (lexical x x1) (lexical y y1)))
(program () (std-prelude 0 4 #f) (label _)
(void) (void) ;; what are these?
(bind (x #t 0) (y #t 1))
@ -352,7 +352,7 @@
;; complex bindings in letrec* -> box and set! in order
(assert-tree-il->glil
(letrec* (x y) (x1 y1) ((call (toplevel foo)) (call (toplevel bar)))
(call (primitive +) (lexical x x1) (lexical y y1)))
(primcall + (lexical x x1) (lexical y y1)))
(program () (std-prelude 0 2 #f) (label _)
(void) (void) ;; what are these?
(bind (x #t 0) (y #t 1))
@ -470,7 +470,7 @@
(const #t) (call return 1)))
(assert-tree-il->glil
(call (primitive null?) (begin (const #f) (const 2)))
(primcall null? (begin (const #f) (const 2)))
(program () (std-prelude 0 0 #f) (label _)
(const 2) (call null? 1) (call return 1))))
@ -512,10 +512,10 @@
(with-test-prefix "apply"
(assert-tree-il->glil
(call (primitive @apply) (toplevel foo) (toplevel bar))
(primcall @apply (toplevel foo) (toplevel bar))
(program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (toplevel ref bar) (call tail-apply 2)))
(assert-tree-il->glil
(begin (call (primitive @apply) (toplevel foo) (toplevel bar)) (void))
(begin (primcall @apply (toplevel foo) (toplevel bar)) (void))
(program () (std-prelude 0 0 #f) (label _)
(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 0 #f)
@ -531,10 +531,10 @@
(with-test-prefix "call/cc"
(assert-tree-il->glil
(call (primitive @call-with-current-continuation) (toplevel foo))
(primcall @call-with-current-continuation (toplevel foo))
(program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call tail-call/cc 1)))
(assert-tree-il->glil
(begin (call (primitive @call-with-current-continuation) (toplevel foo)) (void))
(begin (primcall @call-with-current-continuation (toplevel foo)) (void))
(program () (std-prelude 0 0 #f) (label _)
(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 0 #f)