diff options
author | Andy Wingo <wingo@pobox.com> | 2009-05-22 16:07:41 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-05-22 16:07:41 +0200 |
commit | 55ae815b62c5d4bf324351d64919bdb8d4070148 (patch) | |
tree | b370e8502397f07ab1f714a49b10f7177035f126 | |
parent | e0c90f9084914956d90db73b21ef2ab32d1a477a (diff) | |
download | guile-55ae815b62c5d4bf324351d64919bdb8d4070148.tar.gz |
move things to (language tree-il primitives)
* module/language/tree-il/optimize.scm:
* module/language/tree-il/primitives.scm: Move primitive-related things
to primitive.scm from inline.scm and optimize.scm.
* module/Makefile.am: Update for inventory changes.
-rw-r--r-- | module/Makefile.am | 2 | ||||
-rw-r--r-- | module/language/tree-il/optimize.scm | 54 | ||||
-rw-r--r-- | module/language/tree-il/primitives.scm (renamed from module/language/tree-il/inline.scm) | 57 |
3 files changed, 58 insertions, 55 deletions
diff --git a/module/Makefile.am b/module/Makefile.am index 22a95626d..35959e294 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -72,7 +72,7 @@ SCHEME_LANG_SOURCES = \ language/scheme/inline.scm TREE_IL_LANG_SOURCES = \ - language/tree-il/inline.scm \ + language/tree-il/primitives.scm \ language/tree-il/optimize.scm \ language/tree-il/analyze.scm \ language/tree-il/compile-glil.scm \ diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm index 9ba384f4f..3a02e021e 100644 --- a/module/language/tree-il/optimize.scm +++ b/module/language/tree-il/optimize.scm @@ -20,10 +20,9 @@ ;;; Code: (define-module (language tree-il optimize) - #:use-module (system base syntax) #:use-module (language tree-il) - #:use-module (language tree-il inline) - #:export (optimize! add-interesting-primitive!)) + #:use-module (language tree-il primitives) + #:export (optimize!)) (define (env-module e) (if e (car e) (current-module))) @@ -41,52 +40,3 @@ ;; * degenerate case optimizations ;; * "fixing letrec" -(define *interesting-primitive-names* - '(apply @apply - call-with-values @call-with-values - call-with-current-continuation @call-with-current-continuation - call/cc - values - eq? eqv? equal? - = < > <= >= zero? - + * - / 1- 1+ quotient remainder modulo - not - pair? null? list? acons cons cons* - - list vector - - car cdr - set-car! set-cdr! - - caar cadr cdar cddr - - caaar caadr cadar caddr cdaar cdadr cddar cdddr - - caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr - cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr)) - -(define (add-interesting-primitive! name) - (hashq-set! *interesting-primitive-vars* - (module-variable (current-module) name) name)) - -(define *interesting-primitive-vars* (make-hash-table)) - -(for-each add-interesting-primitive! *interesting-primitive-names*) - -(define (resolve-primitives! x mod) - (post-order! - (lambda (x) - (record-case x - ((<toplevel-ref> src name) - (and (hashq-ref *interesting-primitive-vars* - (module-variable mod name)) - (make-primitive-ref src name))) - ((<module-ref> src mod name public?) - ;; for the moment, we're disabling primitive resolution for - ;; public refs because resolve-interface can raise errors. - (let ((m (and (not public?) (resolve-module mod)))) - (and m (hashq-ref *interesting-primitive-vars* - (module-variable m name)) - (make-primitive-ref src name)))) - (else #f))) - x)) diff --git a/module/language/tree-il/inline.scm b/module/language/tree-il/primitives.scm index 5a8e2db30..25fd8c79e 100644 --- a/module/language/tree-il/inline.scm +++ b/module/language/tree-il/primitives.scm @@ -19,11 +19,64 @@ ;;; Code: -(define-module (language tree-il inline) +(define-module (language tree-il primitives) #:use-module (system base syntax) #:use-module (language tree-il) #:use-module (srfi srfi-16) - #:export (expand-primitives!)) + #:export (resolve-primitives! add-interesting-primitive! + expand-primitives!)) + +(define *interesting-primitive-names* + '(apply @apply + call-with-values @call-with-values + call-with-current-continuation @call-with-current-continuation + call/cc + values + eq? eqv? equal? + = < > <= >= zero? + + * - / 1- 1+ quotient remainder modulo + not + pair? null? list? acons cons cons* + + list vector + + car cdr + set-car! set-cdr! + + caar cadr cdar cddr + + caaar caadr cadar caddr cdaar cdadr cddar cdddr + + caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr + cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr)) + +(define (add-interesting-primitive! name) + (hashq-set! *interesting-primitive-vars* + (module-variable (current-module) name) name)) + +(define *interesting-primitive-vars* (make-hash-table)) + +(for-each add-interesting-primitive! *interesting-primitive-names*) + +(define (resolve-primitives! x mod) + (post-order! + (lambda (x) + (record-case x + ((<toplevel-ref> src name) + (and (hashq-ref *interesting-primitive-vars* + (module-variable mod name)) + (make-primitive-ref src name))) + ((<module-ref> src mod name public?) + ;; for the moment, we're disabling primitive resolution for + ;; public refs because resolve-interface can raise errors. + (let ((m (and (not public?) (resolve-module mod)))) + (and m (hashq-ref *interesting-primitive-vars* + (module-variable m name)) + (make-primitive-ref src name)))) + (else #f))) + x)) + + (define *primitive-expand-table* (make-hash-table)) |