~ chicken-core (chicken-5) 822198a259da69336a36cfe7e0eb385d1ad3d08f
commit 822198a259da69336a36cfe7e0eb385d1ad3d08f
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Jul 26 03:31:50 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Tue Jul 26 03:31:50 2011 +0200
removed ##core#global-ref
diff --git a/compiler.scm b/compiler.scm
index 16a80772..7a6d8e95 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -95,7 +95,6 @@
; <constant>
; (##core#declare {<spec>})
; (##core#immutable <exp>)
-; (##core#global-ref <variable>)
; (##core#quote <exp>)
; (##core#syntax <exp>)
; (##core#if <exp> <exp> [<exp>])
@@ -153,7 +152,6 @@
; [##core#lambda {<id> <mode> (<variable>... [. <variable>]) <size>} <exp>]
; [set! {<variable>} <exp>]
; [##core#undefined {}]
-; [##core#global-ref {<variable>}]
; [##core#primitive {<name>}]
; [##core#inline {<op>} <exp>...]
; [##core#inline_allocate {<op> <words>} <exp>...]
@@ -1601,7 +1599,7 @@
(params (node-parameters n))
(class (node-class n)) )
(case (node-class n)
- ((##core#variable quote ##core#undefined ##core#primitive ##core#global-ref) (k n))
+ ((##core#variable quote ##core#undefined ##core#primitive) (k n))
((if) (let* ((t1 (gensym 'k))
(t2 (gensym 'r))
(k1 (lambda (r) (make-node '##core#call '(#t) (list (varnode t1) r)))) )
@@ -1693,7 +1691,7 @@
(define (atomic? n)
(let ((class (node-class n)))
- (or (memq class '(quote ##core#variable ##core#undefined ##core#global-ref))
+ (or (memq class '(quote ##core#variable ##core#undefined))
(and (memq class '(##core#inline ##core#inline_allocate ##core#inline_ref ##core#inline_update
##core#inline_loc_ref ##core#inline_loc_update))
(every atomic? (node-subexpressions n)) ) ) ) )
@@ -1740,12 +1738,6 @@
((not (get db var 'global))
(put! db var 'global #t) ) ) ) ) )
- ((##core#global-ref)
- (let ((var (first params)))
- (ref var n)
- (grow 1)
- (put! db var 'global #t) ) )
-
((##core#callunit ##core#recurse)
(grow 1)
(walkeach subs env localenv here #f) )
@@ -2137,7 +2129,7 @@
(list var)
'())))
- ((quote ##core#undefined ##core#proc ##core#primitive ##core#global-ref)
+ ((quote ##core#undefined ##core#proc ##core#primitive)
'())
((let)
@@ -2218,7 +2210,7 @@
(class (node-class n)) )
(case class
- ((quote ##core#undefined ##core#proc ##core#global-ref) n)
+ ((quote ##core#undefined ##core#proc) n)
((##core#variable)
(let* ((var (first params))
@@ -2444,9 +2436,6 @@
((##core#variable)
(walk-var (first params) e #f) )
- ((##core#global-ref)
- (walk-global (first params) #t) )
-
((##core#direct_call)
(set! allocated (+ allocated (fourth params)))
(make-node class params (mapwalk subs e here boxes)) )
diff --git a/eval.scm b/eval.scm
index 3c4d08d8..2878ccf6 100644
--- a/eval.scm
+++ b/eval.scm
@@ -323,15 +323,6 @@
(let ((c (cadr x)))
(lambda v c)))
- [(##core#global-ref)
- ;;XXX this is only used in tinyclos and should be removed
- ;; together will all other occurrences of it
- (let ([var (cadr x)]) ;XXX broken - should alias (see above)
- (if ##sys#eval-environment
- (let ([loc (##sys#hash-table-location ##sys#eval-environment var #t)])
- (lambda v (##sys#slot loc 1)) )
- (lambda v (##core#inline "C_slot" var 0)) ) ) ]
-
[(##core#check)
(compile (cadr x) e h tf cntr se) ]
diff --git a/modules.scm b/modules.scm
index 6188286a..726b4fa0 100644
--- a/modules.scm
+++ b/modules.scm
@@ -93,7 +93,8 @@
(meta-expressions module-meta-expressions set-module-meta-expressions!) ; (EXP ...)
(vexports module-vexports set-module-vexports!) ; ((SYMBOL . SYMBOL) ...)
(sexports module-sexports set-module-sexports!) ; ((SYMBOL SE TRANSFORMER) ...)
- (saved-environments module-saved-environments set-module-saved-environments!)) ; for csi's ",m" command, holds (<env> . <macroenv>)
+ ;; for csi's ",m" command, holds (<env> . <macroenv>)
+ (saved-environments module-saved-environments set-module-saved-environments!))
(define ##sys#module-name module-name)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 99f6840c..f741680f 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -538,7 +538,6 @@
((quote) (list (constant-result (first params))))
((##core#undefined) '(*))
((##core#proc) '(procedure))
- ((##core#global-ref) (global-result (first params) loc))
((##core#variable) (variable-result (first params) e loc))
((if)
(let ((rt (single "in conditional" (walk (first subs) e loc #f #f) loc))
diff --git a/support.scm b/support.scm
index 1efe0813..5192eb54 100644
--- a/support.scm
+++ b/support.scm
@@ -477,7 +477,6 @@
((not-pair? x) (bomb "bad expression" x))
((symbol? (car x))
(case (car x)
- ((##core#global-ref) (make-node '##core#global-ref (list (cadr x)) '()))
((if ##core#undefined) (make-node (car x) '() (map walk (cdr x))))
((quote)
(let ((c (cadr x)))
@@ -553,7 +552,7 @@
((if ##core#box ##core#cond) (cons class (map walk subs)))
((##core#closure)
`(##core#closure ,params ,@(map walk subs)) )
- ((##core#variable ##core#global-ref) (car params))
+ ((##core#variable) (car params))
((quote) `(quote ,(car params)))
((let)
`(let ,(map list params (map walk (butlast subs)))
@@ -775,7 +774,7 @@
(let walk ([n node])
(let ([subs (node-subexpressions n)])
(case (node-class n)
- [(##core#variable quote ##core#undefined ##core#proc ##core#global-ref) #f]
+ [(##core#variable quote ##core#undefined ##core#proc) #f]
[(##core#lambda)
(let ([id (first (node-parameters n))])
(find (lambda (fs)
diff --git a/unboxing.scm b/unboxing.scm
index 40224766..85abda21 100644
--- a/unboxing.scm
+++ b/unboxing.scm
@@ -260,7 +260,6 @@
((##core#undefined
##core#proc
- ##core#global-ref
##core#inline_ref
##core#inline_loc_ref) #f)
Trap