public void ImportApi(Type module, Env env)
{
foreach (var method in module.GetMethods())
{
var attributes = method.GetCustomAttributes(typeof(LispApiAttribute), true);
foreach (var attr in attributes)
{
var api = (LispApiAttribute)attr;
var name = api.Name;
if (name == null)
{
name = method.Name.Replace('_', '-');
}
var param = method.GetParameters();
Delegate del;
switch (param.Length)
{
case 1:
del = method.CreateDelegate(typeof(LispApi.Func0));
break;
case 2:
if (param[1].ParameterType == typeof(Value))
{
del = method.CreateDelegate(typeof(LispApi.Func1));
}
else
{
del = method.CreateDelegate(typeof(LispApi.FuncVararg));
}
break;
case 3:
del = method.CreateDelegate(typeof(LispApi.Func2));
break;
case 4:
del = method.CreateDelegate(typeof(LispApi.Func3));
break;
case 5:
del = method.CreateDelegate(typeof(LispApi.Func4));
break;
case 6:
del = method.CreateDelegate(typeof(LispApi.Func5));
break;
default:
throw new LispException("Invalid parameter size");
}
var nameSymbol = Symbol.Intern(name);
var func = new LispApi(del, nameSymbol);
env.Define(nameSymbol, new Value(func));
}
}
}
static Value parseToken(string str)
{
if (isNumber(str[0]) || (str.Length >= 2 && str[0] == '-' && isNumber(str[1])))
{
for (int i = 1; i < str.Length; i++)
{
if (!isNumber(str[i]))
{
return(new Value(Symbol.Intern(str)));
}
}
return(new Value(int.Parse(str)));
}
else
{
return(new Value(Symbol.Intern(str)));
}
}
public void provideEmbedModules()
{
Env e = new Env(null);
ImportApi(typeof(Stdlib.Core), e);
ImportApi(typeof(Stdlib.List), e);
ImportApi(typeof(Stdlib.Number), e);
ImportApi(typeof(Stdlib.Symbol), e);
ImportApi(typeof(Stdlib.StringLib), e);
ImportApi(typeof(Stdlib.Misc), e);
ImportApi(typeof(Stdlib.BooleanLib), e);
ImportApi(typeof(Stdlib.CharLib), e);
ImportApi(typeof(Stdlib.ByteVectorLib), e);
ImportApi(typeof(Stdlib.VectorLib), e);
ImportApi(typeof(Stdlib.PortLib), e);
ImportApi(typeof(Stdlib.IdentifierLib), e);
e.Define(Symbol.Intern("%if"), C.Nil);
e.Define(Symbol.Intern("%define-syntax"), C.Nil);
e.Define(Symbol.Intern("%define"), C.Nil);
e.Define(Symbol.Intern("%lambda"), C.Nil);
e.Define(Symbol.Intern("%quote"), C.Nil);
e.Define(Symbol.Intern("%set!"), C.Nil);
e.Define(Symbol.Intern("%begin"), C.Nil);
e.Define(Symbol.Intern("begin"), C.Nil);
e.Define(Symbol.Intern("quasiquote"), C.Nil);
e.Define(Symbol.Intern("quote"), C.Nil);
e.Define(Symbol.Intern("unquote"), C.Nil);
e.Define(Symbol.Intern("unquote-splicing"), C.Nil);
e.Define(Symbol.Intern("apply"), C.Nil);
e.Define(Symbol.Intern("%make-current-continuation"), C.Nil);
e.Define(Symbol.Intern("define-library"), C.Nil);
e.Define(Symbol.Intern("import"), C.Nil);
var embedModule = new Module("%embeded");
foreach (var sym in e.RawDict.Keys)
{
embedModule.Export(sym);
}
embedModule.ExportFromEnv(e);
Modules[embedModule.Name] = embedModule;
}
//====================================================
// Utility methods
//====================================================
public static Value Intern(string symbol) => new Value(Symbol.Intern(symbol));
public Value Execute()
{
Context ctx = ctx_;
int pc = pc_;
Code[] code = code_;
var closure = closure_;
var s = stack_;
Env e = env_;
var d = dump_;
SourceLocation location = new SourceLocation();
EvalStatistics stat = statistics_;
restart:
try
{
Code c;
while (true)
{
location = closure.Lambda.Locations[pc];
c = code[pc++];
stat.ExecCount[(int)c.Op]++;
stat.MaxStack = Math.Max(stat.MaxStack, s.Count);
stat.MaxDump = Math.Max(stat.MaxDump, d.Count);
var l = location;
if (l.Line == 0)
{
l = closure.Lambda.DefinedLocation;
}
//Console.WriteLine("{0} {3} at {1}:{2}", c, l.Filename, l.Line, s.Count);
if (Trace)
{
var stackStr = string.Join(", ", s.ToArray().Select(x => x.ToString()));
Console.WriteLine($"{pc}: {c} {d.Count} [{stackStr}]");
}
switch (c.Op)
{
case Operator.Ldc:
s.Push(c.Val);
break;
case Operator.Ld:
{
if (c.Val.IsSymbol)
{
var sym = c.Val.AsSymbol;
var val = e.Get(sym);
s.Push(val);
}
else
{
var id = c.Val.AsIdentifier;
var val = e.Get(id.Symbol);
s.Push(val);
}
}
break;
case Operator.Pop:
{
s.Pop();
}
break;
case Operator.Def:
{
var val = s.Peek();
var sym = c.Val.AsSymbol;
if (val.IsClosure)
{
var lmd = val.AsClosure.Lambda;
lmd.Name = sym;
}
e.Define(sym, val);
}
break;
case Operator.Set:
{
var val = s.Peek();
var sym = c.Val.AsSymbol;
e.Set(sym, val);
}
break;
case Operator.Syn:
{
var val = s.Peek();
var sym = c.Val.AsSymbol;
val.AsClosure.IsSyntax = true;
val.AsClosure.Lambda.Name = sym;
e.Define(sym, val);
}
break;
case Operator.Ldf:
{
s.Push(new Value(new Closure(c.Val.As <Lambda>(), e)));
}
break;
case Operator.Goto:
{
pc = c.Val.AsInt;
}
break;
case Operator.Ret:
{
Dump restored;
if (d.TryPop(out restored))
{
#if DEBUG
if (restored.StackSize != s.Count - 1)
{
Console.WriteLine($"Invalid stack size {restored.StackSize} {s.Count - 1}");
}
#endif
closure = restored.Closure;
pc = restored.Pc;
e = restored.Env;
code = closure.Lambda.Code;
}
else
{
saveRegisters(pc, code, closure, s, e, d);
return(s.Pop());
}
}
break;
case Operator.If:
{
var val = s.Pop();
if (val.IsNil || val == Value.F)
{
pc = c.Val.AsInt;
}
}
break;
case Operator.Ccc:
{
var cc = makeContinuation(ref pc, ref code, ref closure, ref s, ref e, ref d);
var f = s.Pop();
applyClosure(f.AsClosure, new Value[] { cc }, ref pc, ref code, ref closure, ref s, ref e, ref d);
}
break;
case Operator.Ap:
case Operator.Ap1:
{
int len;
Value[] args;
if (c.Op == Operator.Ap)
{
len = c.Val.AsInt;
args = popMulti(s, len - 1);
}
else
{
var tmpLen = c.Val.AsInt - 1 - 1; // applicant と tail
if (tmpLen >= 0)
{
var tail = Value.ListToArray(s.Pop());
var tmpArgs = popMulti(s, tmpLen);
args = new Value[tmpLen + tail.Length];
len = args.Length;
for (int i = 0; i < tmpLen; i++)
{
args[i] = tmpArgs[i];
}
for (int i = 0; i < tail.Length; i++)
{
args[tmpLen + i] = tail[i];
}
}
else
{
args = new Value[0];
}
}
var applicant = s.Pop();
var vt = applicant.ValueType;
if (vt == ValueType.Closure)
{
stat.ApLispCount++;
d.Push(new Dump(closure, pc, e, s.Count));
var cl = applicant.AsClosure;
var lmd = cl.Lambda;
if (lmd.Name != null)
{
stat.ApplyCount[lmd.Name] = stat.ApplyCount.GetValueOrDefault(lmd.Name, 0) + 1;
}
e = new Env(cl.Env);
code = cl.Lambda.Code;
closure = cl;
loadParameters(e, lmd, args);
pc = 0;
}
else if (vt == ValueType.LispApi)
{
stat.ApNativeCount++;
var func = applicant.AsLispApi;
if (func.Name != null)
{
stat.ApplyCount[func.Name] = stat.ApplyCount.GetValueOrDefault(func.Name, 0) + 1;
}
ctx.Env = e;
if (func.Arity >= 0)
{
if (args.Length < func.Arity)
{
throw new LispException($"Invalid argument length, expect {func.Arity} but {args.Length} for {func.Func}");
}
}
Value result;
switch (func.Arity)
{
case 0:
result = ((LispApi.Func0)func.Func)(ctx);
break;
case 1:
result = ((LispApi.Func1)func.Func)(ctx, args[0]);
break;
case 2:
result = ((LispApi.Func2)func.Func)(ctx, args[0], args[1]);
break;
case 3:
result = ((LispApi.Func3)func.Func)(ctx, args[0], args[1], args[2]);
break;
case 4:
result = ((LispApi.Func4)func.Func)(ctx, args[0], args[1], args[2], args[3]);
break;
case 5:
result = ((LispApi.Func5)func.Func)(ctx, args[0], args[1], args[2], args[3], args[4]);
break;
default:
result = ((LispApi.FuncVararg)func.Func)(ctx, args);
break;
}
s.Push(result);
}
else if (vt == ValueType.Continuation)
{
applyContinuation(applicant.AsContinuation, args, ref pc, ref code, ref closure, ref s, ref e, ref d);
}
else
{
throw new Exception($"Can't apply {applicant}");
}
}
break;
default:
throw new Exception("BUG");
}
}
}
catch (ExitException ex)
{
throw;
}
#if !DONT_CATCH_ERROR
catch (LispException ex)
{
// Convert exception to scheme error.
ex.SetLocation(location);
Closure errorFunc = null;
Value found;
if (e.TryGet(Symbol.Intern("error"), out found))
{
if (found.IsClosure)
{
errorFunc = found.AsClosure;
}
}
if (errorFunc != null)
{
applyClosure(errorFunc, new Value[] { new Value(ex.Message) }, ref pc, ref code, ref closure, ref s, ref e, ref d);
goto restart;
}
else
{
saveRegisters(pc, code, closure, s, e, d);
ShowBacktrace(ex);
throw;
}
}
#endif
}
