summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-05-22 16:07:41 +0200
committerAndy Wingo <wingo@pobox.com>2009-05-22 16:07:41 +0200
commit55ae815b62c5d4bf324351d64919bdb8d4070148 (patch)
treeb370e8502397f07ab1f714a49b10f7177035f126
parente0c90f9084914956d90db73b21ef2ab32d1a477a (diff)
downloadguile-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.am2
-rw-r--r--module/language/tree-il/optimize.scm54
-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))