From: Michael D. Lowis <mike.lowis@gentex.com>
Date: Thu, 26 Jan 2023 21:19:52 +0000 (-0500)
Subject: added single-level closures
X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;ds=sidebyside;p=proto%2Fsclpl-rb.git

added single-level closures
---

diff --git a/lib/cerise.rb b/lib/cerise.rb
index d93ebc7..a4d6698 100755
--- a/lib/cerise.rb
+++ b/lib/cerise.rb
@@ -648,6 +648,8 @@ def close_func(env, func, close_funcs = true)
     name = "__func#{$lifted.length}".to_sym
     $lifted[name] = func
     func = ANF::Var.new(0, func.type, name)
+    freevars = env[:$free].keys.map {|v| ANF::Var.new(0, nil, v) }
+    func = ANF::Apply.new(0, func.type, :__mkclosure, [func] + freevars)
   end
   func
 end
@@ -658,8 +660,6 @@ $toplevel = $parser.exprs.map do |e|
     else
       patch_vars($parser.syms.clone, e, true)
     end
-#    pp e
-#    puts ""
     e
 end
 
@@ -671,13 +671,13 @@ $lifted.each do |name, value|
     ANF::Var.new(0, nil, name),
     value,
     nil)
-  ANF.check(let)
+#  ANF.check(let)
   ANF.pp(let)
   puts ""
 end
 
 $toplevel.each do |e|
   ANF.pp(e)
-  ANF.check(e)
+#  ANF.check(e)
   puts ""
 end
diff --git a/lib/utils/anf.rb b/lib/utils/anf.rb
index 0865c58..c77523a 100644
--- a/lib/utils/anf.rb
+++ b/lib/utils/anf.rb
@@ -25,7 +25,6 @@ module ANF
   Const  = Struct.new(:loc, :type, :value)
   Var    = Struct.new(:loc, :type, :name)
   EnvRef = Struct.new(:loc, :type, :index)
-  Env    = Struct.new(:loc, :type, :index)
   Let    = Struct.new(:loc, :type, :var,  :expr, :body)
   If     = Struct.new(:loc, :type, :cond, :then, :else)
   Set    = Struct.new(:loc, :type, :var,  :expr)
@@ -107,7 +106,7 @@ module ANF
     elsif expr.is_a? Env
       print("ENV_CREATE\n", indent)
     elsif expr.is_a? EnvRef
-      print("ENV_REF\n", indent)
+      print("(env-ref #{expr.index}\n", indent)
     else
       raise "unexpected form: #{expr.class}"
     end
@@ -143,7 +142,7 @@ module ANF
       elsif a.is_a? Var
         "#{a.name}"
       elsif a.is_a? EnvRef
-        "ENV_REF"
+        "(env-ref #{a.index})"
       else
         raise "argument to apply is not atomic"
       end