//=================================================================
static object ForceEval(Env env, object exp)
{
IASTNode node = Compile(null, TransformLibraryForm(exp));
GlobalEnv.Instance().ExtendTo(GlobalSymbolTable.Instance().GetSymbolCount());
KeyValuePair <object, Continue> p = node.Eval(env, (v => new KeyValuePair <object, Continue>(v, null)));;
while (p.Value != null)
{
p = p.Value(p.Key);
}
return(p.Key);
}
static void SetupGlobalEnv()
{
Dictionary <string, object> builtinVars = new Dictionary <string, object>()
{
{ "true", true },
{ "false", false },
{ "else", true },
{ "null", null },
};
Dictionary <string, Procedure> builtinProcedures = new Dictionary <string, Procedure>()
{
{ "not", (args, k) => k(!(bool)args[0]) },
{ "identity", (args, k) => k(args[0]) },
{ "sqr", (args, k) => {
if (args[0] is BigInteger)
{
var a = (BigInteger)args[0]; return(k(a * a));
}
else
{
var a = (decimal)args[0]; return(k(a * a));
}
} },
{ "+", (args, k) => {
if (args[0] is decimal || args[1] is decimal)
{
return(k(CastToDecimal(args[0]) + CastToDecimal(args[1])));
}
return(k((BigInteger)args[0] + (BigInteger)args[1]));
} },
{ "-", (args, k) => {
if (args[0] is decimal || args[1] is decimal)
{
return(k(CastToDecimal(args[0]) - CastToDecimal(args[1])));
}
return(k((BigInteger)args[0] - (BigInteger)args[1]));
} },
{ "*", (args, k) => {
if (args[0] is decimal || args[1] is decimal)
{
return(k(CastToDecimal(args[0]) * CastToDecimal(args[1])));
}
return(k((BigInteger)args[0] * (BigInteger)args[1]));
} },
{ "/", (args, k) => {
if (args[0] is decimal || args[1] is decimal)
{
return(k(CastToDecimal(args[0]) / CastToDecimal(args[1])));
}
return(k((BigInteger)args[0] / (BigInteger)args[1]));
} },
{ "quotient", (args, k) => {
if (args[0] is decimal || args[1] is decimal)
{
return(k((BigInteger)(CastToDecimal(args[0]) / CastToDecimal(args[1]))));
}
return(k((BigInteger)args[0] / (BigInteger)args[1]));
} },
{ "remainder", (args, k) => {
if (args[0] is decimal || args[1] is decimal)
{
return(k(CastToDecimal(args[0]) % CastToDecimal(args[1])));
}
return(k((BigInteger)args[0] % (BigInteger)args[1]));
} },
{ "=", (args, k) => k(args[0].Equals(args[1])) },
{ "<", (args, k) => k((args[0] as IComparable).CompareTo(args[1]) < 0) },
{ "<=", (args, k) => k((args[0] as IComparable).CompareTo(args[1]) <= 0) },
{ ">", (args, k) => k((args[0] as IComparable).CompareTo(args[1]) > 0) },
{ ">=", (args, k) => k((args[0] as IComparable).CompareTo(args[1]) >= 0) },
{ "eq?", (args, k) => k(object.ReferenceEquals(args[0], args[1])) },
{ "cons", (args, k) => k(new Pair()
{
Car = args[0], Cdr = args[1]
}) },
{ "car", (args, k) => k(((Pair)args[0]).Car) },
{ "cdr", (args, k) => k(((Pair)args[0]).Cdr) },
{ "drop", (args, k) => {
Pair l = (Pair)args[0]; int n = (int)(BigInteger)args[1];
for (; n > 0; --n)
{
l = (Pair)l.Cdr;
}
return(k(l));
} },
{ "length", (args, k) => {
int n = 0;
for (Pair l = (Pair)args[0]; l != null; ++n, l = (Pair)l.Cdr)
{
;
}
return(k(n));
} },
{ "append", (args, k) => {
var l = PairToList((Pair)args[0]);
l.InsertRange(l.Count, PairToList((Pair)args[1]));
return(k(ListToPair(l)));
} },
{ "empty?", (args, k) => k(args[0] == null) },
{ "pretty-print", (args, k) => {
PrintPairExp(args[0]);
return(k(null));
} },
{ "display", (args, k) => {
PrintListExp(PairExpToListExp(args[0]));
return(k(null));
} },
{ "current-inexact-milliseconds", (args, k) => {
long now;
QueryPerformanceCounter(out now);
return(k((decimal)(now - sTimerStart) * 1000 / sTimerFreq));
} },
{ "exit", (args, k) => {
Environment.Exit(0);
return(k(null));
} },
{ "random", (args, k) => k((BigInteger)sRandom.Next((int)(BigInteger)args[0])) },
{ "eval", (args, k) => k(ForceEval(null, PairExpToListExp(args[0]))) },
{ "call/cc", (args, k) => {
return(((Procedure)args[0])(new List <object>()
{
(Procedure)((args2, k2) => new KeyValuePair <object, Continue>(args2[0], k)),
}, k));
} },
};
GlobalEnv.Instance().ExtendTo(builtinVars.Count + builtinProcedures.Count);
foreach (var nameValue in builtinVars)
{
int index = GlobalSymbolTable.Instance().LookupOrDefine(nameValue.Key);
GlobalEnv.Instance()[index] = nameValue.Value;
}
foreach (var nameValue in builtinProcedures)
{
int index = GlobalSymbolTable.Instance().LookupOrDefine(nameValue.Key);
GlobalEnv.Instance()[index] = nameValue.Value;
}
}
static IASTNode Compile(SymbolTable symTable, object exp)
{
if (exp is string)
{
string name = (string)exp;
if (symTable != null && symTable.Lookup(name) != -1)
{
return(new ASTNode_GetLocalVar()
{
Index = symTable.Lookup(name)
});
}
int envIndex = 0;
for (; symTable != null && symTable.Lookup(name) == -1; symTable = symTable.PrevTalbe, ++envIndex)
{
;
}
if (symTable == null)
{
return(new ASTNode_GetGlobalVar()
{
Index = GlobalSymbolTable.Instance().LookupOrDefine(name)
});
}
else
{
return(new ASTNode_GetFreeVar()
{
EnvIndex = envIndex, Index = symTable.Lookup(name)
});
}
}
else if (!(exp is List <object>))
{
return(new ASTNode_Literal()
{
Value = exp
});
}
List <object> l = (List <object>)exp;
switch (l[0] as string)
{
case "quote":
return(new ASTNode_Literal()
{
Value = ListExpToPairExp(l[1])
});
case "if":
return(new ASTNode_If()
{
PredNode = Compile(symTable, l[1]), ThenNode = Compile(symTable, l[2]), ElseNode = Compile(symTable, l[3])
});
case "lambda": {
SymbolTable newSymTable = new SymbolTable(symTable);
foreach (string name in ((List <object>)l[1]))
{
newSymTable.Define(name);
}
List <string> defines = new List <string>();
FindDefinition(defines, (List <object>)l[2], 1);
foreach (string name in defines)
{
newSymTable.Define(name);
}
return(new ASTNode_Lambda()
{
LocalVarCount = newSymTable.GetSymbolCount(), BodyNode = Compile(newSymTable, l[2])
});
}
case "begin":
return(new ASTNode_Begin()
{
Nodes = l.Skip(1).Select(e => Compile(symTable, e)).ToArray()
});
case "define":
return(Compile(symTable, new List <object>()
{
"set!", l[1], l[2]
}));
case "set!": {
IASTNode right = Compile(symTable, l[2]);
string name = (string)l[1];
if (symTable != null && symTable.Lookup(name) != -1)
{
return(new ASTNode_SetLocalVar()
{
Index = symTable.Lookup(name), RightNode = right
});
}
int envIndex = 0;
for (; symTable != null && symTable.Lookup(name) == -1; symTable = symTable.PrevTalbe, ++envIndex)
{
;
}
if (symTable == null)
{
return(new ASTNode_SetGlobalVar()
{
Index = GlobalSymbolTable.Instance().LookupOrDefine(name), RightNode = right
});
}
else
{
return(new ASTNode_SetFreeVar()
{
EnvIndex = envIndex, Index = symTable.Lookup(name), RightNode = right
});
}
}
default: {
return(new ASTNode_Application()
{
ProcedureNode = Compile(symTable, l[0]), ActualNodes = l.Skip(1).Select(e => Compile(symTable, e)).ToArray()
});
}
}
}
