Reworked Eval extensions1.0.312

9 files changed, 106 insertions, 89 deletions

diff --git a/IronScheme/IronScheme/Compiler/Generator.cs b/IronScheme/IronScheme/Compiler/Generator.cs
index 19949f25..68d10c9b 100644
--- a/IronScheme/IronScheme/Compiler/Generator.cs
+++ b/IronScheme/IronScheme/Compiler/Generator.cs
@@ -127,6 +127,10 @@ namespace IronScheme.Compiler
         {

           args = new SerializedConstant(args);

         }

+        else if (args != null && args is Condition)

+        {

+          args = new SerializedConstant(args);

+        }

         return Ast.Constant(args);

       }

     }

diff --git a/IronScheme/IronScheme/Hosting/IronSchemeConsoleHost.cs b/IronScheme/IronScheme/Hosting/IronSchemeConsoleHost.cs
index f12fcdab..42e32169 100644
--- a/IronScheme/IronScheme/Hosting/IronSchemeConsoleHost.cs
+++ b/IronScheme/IronScheme/Hosting/IronSchemeConsoleHost.cs
@@ -34,7 +34,7 @@ namespace IronScheme.Hosting
     string logo;

     public IronSchemeConsoleHost()

     {

-      logo = string.Format("IronScheme {0} github.com/IronScheme © 2007-2021 Llewellyn Pritchard ", VERSION);

+      logo = string.Format("IronScheme {0} github.com/IronScheme © 2007-2022 Llewellyn Pritchard ", VERSION);

     }

 

     public static int Execute(string[] args)

diff --git a/IronScheme/IronScheme/Runtime/Builtins.cs b/IronScheme/IronScheme/Runtime/Builtins.cs
index 7c7c4718..fe1c82dd 100644
--- a/IronScheme/IronScheme/Runtime/Builtins.cs
+++ b/IronScheme/IronScheme/Runtime/Builtins.cs
@@ -591,6 +591,7 @@ namespace IronScheme.Runtime
     }

 

     static int evalcounter = 0;

+    internal static bool evalSpecial = false;

 

     [Builtin("compile-core")]

     public static object CompileCore(object expr)

@@ -669,8 +670,22 @@ namespace IronScheme.Runtime
           sc.LibraryGlobalsN = Compiler.SimpleGenerator.libraryglobalsN;

           sc.LibraryGlobalsX = Compiler.SimpleGenerator.libraryglobalsX;

 

-          ScriptModule sm = ScriptDomainManager.CurrentManager.CreateModule(string.Format("eval-core({0:D3})", c), sc);

-          sc = sm.GetScripts()[0];

+          try

+          {

+            ScriptModule sm = ScriptDomainManager.CurrentManager.CreateModule(string.Format("eval-core({0:D3})", c), sc);

+            sc = sm.GetScripts()[0];

+          }

+          catch (NotSupportedException)

+          {

+            if (evalSpecial)

+            {

+              sc.EnsureCompiled();

+            }

+            else

+            {

+              throw;

+            }

+          }

 

 #if DEBUG

       sw.Stop();

@@ -792,7 +807,6 @@ namespace IronScheme.Runtime
     static Scope ModuleScope;

 

     [Builtin("symbol-value")]

-    [UnspecifiedReturn]

     public static object SymbolValue(object symbol)

     {

       if (ModuleScope == null)

diff --git a/IronScheme/IronScheme/Runtime/R6RS/Conditions.cs b/IronScheme/IronScheme/Runtime/R6RS/Conditions.cs
index d7f94b63..0cfc95f0 100644
--- a/IronScheme/IronScheme/Runtime/R6RS/Conditions.cs
+++ b/IronScheme/IronScheme/Runtime/R6RS/Conditions.cs
@@ -12,6 +12,7 @@ using Microsoft.Scripting;
 

 namespace IronScheme.Runtime.R6RS

 {

+  [Serializable]

   public abstract class Condition

   {

     // make-record-type needs a public default constructor when abstract

@@ -19,14 +20,22 @@ namespace IronScheme.Runtime.R6RS
     {

     }

 

+    static Callable display;

+

     public override string ToString()

     {

-      var w = new StringWriter();

-      "(display {0} {1})".Eval(this, w);

-      return w.GetBuffer();

+      if (display == null)

+      {

+        display = "display".Eval<Callable>();

+      }

+

+      var sw = new StringWriter();

+      display.Call(this, sw);

+      return sw.ToString();

     }

   }

 

+  [Serializable]

   sealed class CompoundCondition : Condition

   {

     internal object[] conds;

diff --git a/IronScheme/IronScheme/Runtime/SchemeException.cs b/IronScheme/IronScheme/Runtime/SchemeException.cs
index 16802133..5a15bca7 100644
--- a/IronScheme/IronScheme/Runtime/SchemeException.cs
+++ b/IronScheme/IronScheme/Runtime/SchemeException.cs
@@ -18,37 +18,44 @@ namespace IronScheme.Runtime
       Condition = cond;

     }

 

-    public string Who

-    {

-      get

-      {

-        return "(and (who-condition? {0}) (condition-who {0}))"

-          .Eval(Condition).ToString();

-      }

-    }

+    //public string Who

+    //{

+    //  get

+    //  {

+    //    return "(and (who-condition? {0}) (condition-who {0}))"

+    //      .Eval(Condition).ToString();

+    //  }

+    //}

 

-    public override string StackTrace

-    {

-      get

-      {

-        return "(and (stacktrace-condition? {0}) (condition-stacktrace {0}))"

-          .Eval(Condition) as string;

-      }

-    }

+    //public override string StackTrace

+    //{

+    //  get

+    //  {

+    //    return "(and (stacktrace-condition? {0}) (condition-stacktrace {0}))"

+    //      .Eval(Condition) as string;

+    //  }

+    //}

+

+    //public override string Message

+    //{

+    //  get

+    //  {

+    //    return "(and (message-condition? {0}) (condition-message {0}))"

+    //      .Eval(Condition) as string;

+    //  }

+    //}

 

-    public override string Message

+    static Callable display;

+

+    public override string ToString()

     {

-      get

+      if (display == null)

       {

-        return "(and (message-condition? {0}) (condition-message {0}))"

-          .Eval(Condition) as string;

+        display = "display".Eval<Callable>();

       }

-    }

 

-    public override string ToString()

-    {

       var sw = new StringWriter();

-      "(display {0} {1})".Eval(Condition, sw);

+      display.Call(Condition, sw);

       return sw.ToString();

     }

   }

diff --git a/IronScheme/IronScheme/RuntimeExtensions.cs b/IronScheme/IronScheme/RuntimeExtensions.cs
index 52d78cc7..45d6edf2 100644
--- a/IronScheme/IronScheme/RuntimeExtensions.cs
+++ b/IronScheme/IronScheme/RuntimeExtensions.cs
@@ -25,6 +25,8 @@ namespace IronScheme
 

     readonly static ScriptEngine se = provider.GetEngine();

 

+    static Callable eval, interactionEnv;

+

     public static ScriptEngine ScriptEngine

     {

       get { return se; }

@@ -55,82 +57,60 @@ namespace IronScheme
         throw new ArgumentException("importspec cannot be null or empty");

       }

 

-      if (importspec != INTERACTION_ENVIRONMENT)

+      if (INTERACTION_ENVIRONMENT == importspec)

       {

-        importspec = importspec.Replace("(environment", "(environment '(only (ironscheme) define begin symbol-value)");

-      }

+        interactionEnv = interactionEnv ?? (Callable) se.Evaluate("interaction-environment");

 

-      var env = se.Evaluate(importspec);

-

-      return EvalWithEnvironmentInstance(expr, env, args);

+        var env = interactionEnv.Call();

+        return EvalWithEnvironmentInstance(expr, env, args);

+      }

+      else

+      {

+        var env = se.Evaluate(importspec);

+        return EvalWithEnvironmentInstance(expr, env, args);

+      }

     }

 

+

     public static object EvalWithEnvironmentInstance(this string expr, object env, params object[] args)

     {

-      var currentInteractionEnv = se.Evaluate("(interaction-environment)");

-      var envId = string.Format("env:{0}", Guid.NewGuid());

-      Builtins.SetSymbolValueFast(SymbolTable.StringToObject(envId), env);

-      var isInteractive = Builtins.IsTrue(se.Evaluate(string.Format("(interaction-environment? (symbol-value '{0}))", envId)));

-

-      Guid[] replacements = new Guid[args.Length];

       string[] vars = new string[args.Length];

 

       expr = INDEXREPLACE.Replace(expr, m =>

       {

-        Guid g = Guid.NewGuid();

         var index = Convert.ToInt32(m.Groups["index"].Value);

-        var p = replacements[index];

-        if (p == Guid.Empty)

-        {

-          replacements[index] = g;

-        }

-        else

+        if (index >= vars.Length)

         {

-          g = p;

+          throw new ArgumentException("Missing argument for {" + index + "}");

         }

-        return vars[index] = string.Format("$eval:{0}", g);

+

+        vars[index] = string.Format("$arg:{0}", index);

+        return "'," + vars[index];

       });

 

-      string[] assigns = new string[args.Length];

+      eval = eval ?? (Callable)se.Evaluate("eval");

 

-      for (int i = 0; i < args.Length; i++)

-      {

-        var arg = vars[i];

-        var rarg = args[i];

+      object src;

 

-        // intern symbols

-        if (rarg is SymbolId)

-        {

-          rarg = SymbolTable.Intern((SymbolId)rarg);

-        }

-

-        Builtins.SetSymbolValueFast(SymbolTable.StringToObject(arg), rarg);

-        assigns[i] = string.Format("(define {0} (symbol-value '{0}))", arg);

+      if (args.Length == 0)

+      {

+        src = se.Evaluate("'" + expr);

+      }

+      else

+      {

+        var getSource = (Callable)se.Evaluate(string.Format("(lambda ({0}) `{1})", string.Join(" ", vars), expr));

+        src = getSource.Call(args);

       }

 

-      // must start try here, values have been assigned

+      var es = Builtins.evalSpecial;

       try

       {

-        if (assigns.Length > 0)

-        {

-          expr = string.Format("({2} {0} {1})", string.Join(" ", assigns), expr, isInteractive ? "begin" : "let ()");

-        }

-

-        if (!isInteractive || env != currentInteractionEnv)

-        {

-          expr = string.Format("(eval '{0} (symbol-value '{1}))", expr, envId);

-        }

-

-        return se.Evaluate(expr);

+        Builtins.evalSpecial = true;

+        return eval.Call(src, env);

       }

       finally

       {

-        for (int i = 0; i < args.Length; i++)

-        {

-          Builtins.RemoveLocation(SymbolTable.StringToObject(vars[i]));

-        }

-

-        Builtins.RemoveLocation(SymbolTable.StringToObject(envId));

+        Builtins.evalSpecial = es;

       }

     }

 

diff --git a/IronScheme/Microsoft.Scripting/Generation/CodeGen.cs b/IronScheme/Microsoft.Scripting/Generation/CodeGen.cs
index 74a9393a..33d6b300 100644
--- a/IronScheme/Microsoft.Scripting/Generation/CodeGen.cs
+++ b/IronScheme/Microsoft.Scripting/Generation/CodeGen.cs
@@ -2316,7 +2316,10 @@ namespace Microsoft.Scripting.Generation {
               if (block.DecorateWithNonRecursive)
               {
                 var mb = impl.MethodBase as MethodBuilder;
-                mb.SetCustomAttribute(CAB);
+                if (mb != null)
+                {
+                    mb.SetCustomAttribute(CAB);
+                }
               }
 
               // add custom attributes to method
diff --git a/IronScheme/Microsoft.Scripting/OptimizedModuleGenerator.cs b/IronScheme/Microsoft.Scripting/OptimizedModuleGenerator.cs
index c1cb5ef3..ab3828dc 100644
--- a/IronScheme/Microsoft.Scripting/OptimizedModuleGenerator.cs
+++ b/IronScheme/Microsoft.Scripting/OptimizedModuleGenerator.cs
@@ -251,7 +251,7 @@ namespace Microsoft.Scripting.Generation {
                 GlobalFieldAllocator gfa = sa.LocalAllocator as GlobalFieldAllocator;

                 if (gfa != null)

                 {

-                  Dictionary<SymbolId, Slot> fields = gfa.SlotFactory.Fields;

+                  Dictionary<SymbolId, Slot> fields = gfa.SlotFactory.Fields; 

 

                   Label ok = cg.DefineLabel();

                   cg.ContextSlot.EmitGet(cg);

@@ -545,7 +545,7 @@ namespace Microsoft.Scripting.Generation {
             case "visit-code":

             case "invoke-code":

             case "guard-code":

-              TypeGen tg = ag.DefinePublicType("syntax-" + sc.CodeBlock.Name, typeof(CustomSymbolDictionary));

+              TypeGen tg = ag.DefinePublicType("syntax-" + n, typeof(CustomSymbolDictionary));

               tg.AddCodeContextField();

               tg.DefaultConstructor = tg.TypeBuilder.DefineDefaultConstructor(MethodAttributes.Public);

               return tg;

diff --git a/IronScheme/Microsoft.Scripting/RuntimeHelpers.cs b/IronScheme/Microsoft.Scripting/RuntimeHelpers.cs
index b33836a8..29539654 100644
--- a/IronScheme/Microsoft.Scripting/RuntimeHelpers.cs
+++ b/IronScheme/Microsoft.Scripting/RuntimeHelpers.cs
@@ -200,10 +200,10 @@ namespace Microsoft.Scripting {
         /// Called from generated code, helper to do a global name lookup

         /// </summary>

         public static object LookupGlobalName(CodeContext context, SymbolId name) {

-          return context.Scope.ModuleScope.LookupName(name);

+            //return context.Scope.ModuleScope.LookupName(name);

             // TODO: could we get rid of new context creation:

-            //CodeContext moduleScopedContext = new CodeContext(context.Scope.ModuleScope, context.LanguageContext, context.ModuleContext);

-            //return context.LanguageContext.LookupName(moduleScopedContext, name);

+            CodeContext moduleScopedContext = new CodeContext(context.Scope.ModuleScope, context.LanguageContext, context.ModuleContext);

+            return context.LanguageContext.LookupName(moduleScopedContext, name);

         }

 

         /// <summary>