~ chicken-core (chicken-5) fb74f2a13695b275e942de06b384ec72bf791e40

commit fb74f2a13695b275e942de06b384ec72bf791e40
Author:     felix <felix@y.(none)>
AuthorDate: Wed Mar 31 23:47:43 2010 +0200
Commit:     felix <felix@y.(none)>
CommitDate: Wed Mar 31 23:47:43 2010 +0200

    removed broken toplevel-alias optimization

diff --git a/compiler.scm b/compiler.scm
index bf4c0d24..cb856acb 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -90,7 +90,6 @@
 ;   ##compiler#profile -> BOOL
 ;   ##compiler#unused -> BOOL
 ;   ##compiler#foldable -> BOOL
-;   ##compiler#toplevel-alias -> SYMBOL
 
 ; - Source language:
 ;
diff --git a/manual/Modules and macros b/manual/Modules and macros
index 2c33a089..9f901994 100644
--- a/manual/Modules and macros	
+++ b/manual/Modules and macros	
@@ -290,6 +290,8 @@ Allows augmenting module-exports from inside the module-body.
 {{module}} export list. An export must precede its first occurrence
 (either use or definition).
 
+If used outside of a module, then this form does nothing.
+
 ==== import
 
 <macro>(import IMPORT ...)</macro>
diff --git a/optimizer.scm b/optimizer.scm
index c17bda6f..14a39f27 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -97,14 +97,6 @@
 		 (copy-node!
 		  (make-node '##core#undefined '() '())
 		  p))
-	       (when (and (not escaped)
-			  (not (memq var e))
-			  (not (memq var unsafe))
-			  (eq? '##core#variable (node-class val)))
-		 (let ((valname (first (node-parameters val))))
-		   (unless (memq valname e)
-		     (debugging 'x (sprintf "toplevel-alias: ~s -> ~s" var valname))
-		     (##sys#put! var '##compiler#toplevel-alias valname))))
 	       (unless (memq var e) (mark var))
 	       (remember var n) ) ) ]
 
@@ -223,7 +215,6 @@
 		    (touch)
 		    (debugging 'o "substituted constant variable" var)
 		    (qnode (car (node-parameters (test var 'value)))) )
-		   ((##sys#get var '##compiler#toplevel-alias) => replace)
 		   (else
 		    (if (not (eq? var (first params)))
 			(begin
@@ -1458,20 +1449,20 @@
     (define (find-lifting-candidates)
       ;; Collect potentially liftable procedures and return as a list of (<name> . <value>) pairs:
       ;; - Also build a-list that maps lambda-nodes to names.
-      (let ([cs '()])
+      (let ((cs '()))
 	(##sys#hash-table-for-each
 	 (lambda (sym plist)
-	   (and-let* ([val (assq 'value plist)]
-		      [refs (assq 'references plist)]
-		      [css (assq 'call-sites plist)] 
-		      [nrefs (length (cdr refs))] )
-	     (when (and (not (assq 'unknown plist))
-			(eq? 'lambda (node-class (cdr val)))
-			(not (assq 'global plist)) 
-			#;(> nrefs 1)
-			(= nrefs (length (cdr css))) )
-	       (set! lambda-values (alist-cons (cdr val) sym lambda-values))
-	       (set! cs (alist-cons sym (cdr val) cs)) ) ) )
+	   (and-let* ((val (assq 'value plist))
+		      (refs (assq 'references plist))
+		      (css (assq 'call-sites plist)) )
+	     (let ((nrefs (length (cdr refs))))
+	       (when (and (not (assq 'unknown plist))
+			  (eq? 'lambda (node-class (cdr val)))
+			  (not (assq 'global plist)) 
+			  #;(> nrefs 1)
+			  (= nrefs (length (cdr css))) )
+		 (set! lambda-values (alist-cons (cdr val) sym lambda-values))
+		 (set! cs (alist-cons sym (cdr val) cs)) ) ) ) )
 	 db)
 	cs) )