* removed stuff from lib directory.

scheme/ikarus.compiler.ss

@@ -1136,6 +1136,7 @@
       [(fix lhs* rhs* body) (known-value body)]
       [(seq e0 e1) (known-value e1)]
       [else #f]))
+    
   (define (same-values? x y)
     (cond
       [(constant? x)
@@ -1174,7 +1175,9 @@
              [(var-referenced lhs)
               (values (cons lhs lhs*) (cons rhs rhs*) eff*)]
              [else
-              (values lhs* rhs* (mk-seq eff* (Effect rhs)))])))]))
+              (values lhs* rhs* 
+                (mk-seq eff* 
+                  (Effect rhs)))])))]))
   (define (partition/assign-known lhs* rhs*)
     (cond
       [(null? lhs*) (values '() '() the-void)]
@@ -1225,50 +1228,53 @@
                 (make-clambda-case info (Value body))]))
            cls*)
       cp free name))
-  (define (Effect x)
+  (define (MKEffect ctxt)
-    (struct-case x
+    (define (Effect x)
-      [(constant) the-void]
+      (struct-case x
-      [(var)      the-void]
+        [(constant) the-void]
-      [(primref)  the-void]
+        [(var)      the-void]
-      [(bind lhs* rhs* body)
+        [(primref)  the-void]
-       (do-bind lhs* rhs* body Effect)]
+        [(bind lhs* rhs* body)
-      [(fix lhs* rhs* body)
+         (do-bind lhs* rhs* body Effect)]
-       (do-fix lhs* rhs* body Effect)]
+        [(fix lhs* rhs* body)
-      [(conditional e0 e1 e2)
+         (do-fix lhs* rhs* body Effect)]
-       (let ([e0 (Pred e0)])
+        [(conditional e0 e1 e2)
-         (cond
+         (let ([e0 (Pred e0)])
-           [(predicate-value e0) =>
+           (cond
-            (lambda (v)
+             [(predicate-value e0) =>
-              (mk-seq e0 (if (eq? v 't) (Effect e1) (Effect e2))))]
+              (lambda (v)
-           [else
+                (mk-seq e0 (if (eq? v 't) (Effect e1) (Effect e2))))]
-            (make-conditional e0 (Effect e1) (Effect e2))]))]
+             [else
-      [(seq e0 e1) (mk-seq (Effect e0) (Effect e1))]
+              (make-conditional e0 (Effect e1) (Effect e2))]))]
-      [(clambda g cls*) the-void]
+        [(seq e0 e1) (mk-seq (Effect e0) (Effect e1))]
-      [(primcall rator rand*) 
+        [(clambda g cls*) the-void]
-       (optimize-primcall 'e rator (map Value rand*))]
+        [(primcall rator rand*) 
-      [(funcall rator rand*)
+         (optimize-primcall ctxt rator (map Value rand*))]
-       (let ([rator (Value rator)])
+        [(funcall rator rand*)
-         (cond
+         (let ([rator (Value rator)])
-           [(known-value rator) =>
+           (cond
-            (lambda (v)
+             [(known-value rator) =>
-              (struct-case v
+              (lambda (v)
-                [(primref op)
+                (struct-case v
-                 (mk-seq rator
+                  [(primref op)
-                    (optimize-primcall 'e op (map Value rand*)))]
+                   (mk-seq rator
-                [else
+                      (optimize-primcall ctxt op (map Value rand*)))]
-                 (make-funcall rator (map Value rand*))]))]
+                  [else
-           [else (make-funcall rator (map Value rand*))]))]
+                   (make-funcall rator (map Value rand*))]))]
-      [(forcall rator rand*) 
+             [else (make-funcall rator (map Value rand*))]))]
-       (make-forcall rator (map Value rand*))]
+        [(forcall rator rand*) 
-      [(mvcall p c)
+         (make-forcall rator (map Value rand*))]
-       (mk-mvcall (Value p) (Value c))]
+        [(mvcall p c)
-      [(assign lhs rhs)
+         (mk-mvcall (Value p) (Value c))]
-       (unless (var-assigned lhs)
+        [(assign lhs rhs)
-         (error who "var is not assigned" lhs))
+         (unless (var-assigned lhs)
-       (if (var-referenced lhs)
+           (error who "var is not assigned" lhs))
-           (make-assign lhs (Value rhs))
+         (if (var-referenced lhs)
-           (Effect rhs))]
+             (make-assign lhs (Value rhs))
-      [else (error who "invalid effect expression" (unparse x))]))
+             (Effect rhs))]
+        [else (error who "invalid effect expression" (unparse x))]))
+    Effect)
+  (define Effect (MKEffect 'e))
   (define (Pred x)
     (struct-case x
       [(constant) x]

scheme/last-revision

@@ -1 +1 @@
-1151
+1153