//================================================================= 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() }); } } }