mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-22 03:30:22 +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

13543
module/ice-9/psyntax-pp.scm
View file

File diff suppressed because it is too large Load diff

67
module/ice-9/psyntax.scm
View file

@ -402,12 +402,14 @@
(lambda (src req opt rest kw inits vars body else-case)
(make-lambda-case src req opt rest kw inits vars body else-case)))
(define build-primcall
(lambda (src name args)
(make-primcall src name args)))
(define build-primref
(lambda (src name)
(if (equal? (module-name (current-module)) '(guile))
(make-toplevel-ref src name)
(make-module-ref src '(guile) name #f))))
(make-primitive-ref src name)))
(define (build-data src exp)
(make-const src exp))
@ -1038,9 +1040,9 @@
(build-global-definition
no-source
name
(build-call
(build-primcall
no-source
(build-primref no-source 'make-syntax-transformer)
'make-syntax-transformer
(list (build-data no-source name)
(build-data no-source 'macro)
e)))))
@ -1954,9 +1956,7 @@
(if (list? (cadr x))
(build-simple-lambda no-source (cadr x) #f (cadr x) '() (regen (caddr x)))
(error "how did we get here" x)))
(else (build-call no-source
(build-primref no-source (car x))
(map regen (cdr x)))))))
(else (build-primcall no-source (car x) (map regen (cdr x)))))))
(lambda (e r w s mod)
(let ((e (source-wrap e w s mod)))
@ -2288,20 +2288,21 @@
(lambda (pvars exp y r mod)
(let ((ids (map car pvars)) (levels (map cdr pvars)))
(let ((labels (gen-labels ids)) (new-vars (map gen-var ids)))
(build-call no-source
(build-primref no-source 'apply)
(list (build-simple-lambda no-source (map syntax->datum ids) #f new-vars '()
(chi exp
(extend-env
labels
(map (lambda (var level)
(make-binding 'syntax `(,var . ,level)))
new-vars
(map cdr pvars))
r)
(make-binding-wrap ids labels empty-wrap)
mod))
y))))))
(build-primcall
no-source
'apply
(list (build-simple-lambda no-source (map syntax->datum ids) #f new-vars '()
(chi exp
(extend-env
labels
(map (lambda (var level)
(make-binding 'syntax `(,var . ,level)))
new-vars
(map cdr pvars))
r)
(make-binding-wrap ids labels empty-wrap)
mod))
y))))))
(define gen-clause
(lambda (x keys clauses r pat fender exp mod)
@ -2330,22 +2331,18 @@
(build-dispatch-call pvars exp y r mod)
(gen-syntax-case x keys clauses r mod))))
(list (if (eq? p 'any)
(build-call no-source
(build-primref no-source 'list)
(list x))
(build-call no-source
(build-primref no-source '$sc-dispatch)
(list x (build-data no-source p)))))))))))))
(build-primcall no-source 'list (list x))
(build-primcall no-source '$sc-dispatch
(list x (build-data no-source p)))))))))))))
(define gen-syntax-case
(lambda (x keys clauses r mod)
(if (null? clauses)
(build-call no-source
(build-primref no-source 'syntax-violation)
(list (build-data no-source #f)
(build-data no-source
"source expression failed to match any pattern")
x))
(build-primcall no-source 'syntax-violation
(list (build-data no-source #f)
(build-data no-source
"source expression failed to match any pattern")
x))
(syntax-case (car clauses) ()
((pat exp)
(if (and (id? #'pat)