public LithpList ResolveParameters(LithpFunctionCall call, LithpOpChain chain)
{
LithpList result = new LithpList();
foreach (var x in call.Parameters)
{
result.Add((LithpPrimitive)resolve((LithpPrimitive)x, chain));
}
return(result);
}
protected ILithpOpChainMember mapParamInner(JValue v, LithpOpChain chain, string fnName)
{
Classification cls = classify(v);
string strV = v.ToString();
parserDebug("Classified: {0}", cls.ToString());
if (cls.HasFlag(Classification.STRING_DOUBLE) || cls.HasFlag(Classification.STRING_SINGLE))
{
strV = strV.Substring(1, strV.Length - 2);
string parsed = LithpParser.ParseEscapes(strV);
if (cls.HasFlag(Classification.STRING_DOUBLE))
{
return(new LithpLiteral(new LithpString(parsed)));
}
else if (cls.HasFlag(Classification.STRING_SINGLE))
{
return(LithpAtom.Atom(parsed));
}
}
else if (cls.HasFlag(Classification.VARIABLE))
{
switch (fnName)
{
case "get":
case "set":
case "var":
return(new LithpVariableReference(strV));
default:
return(LithpFunctionCall.New("get/1", new LithpVariableReference(strV)));
}
}
else if (cls.HasFlag(Classification.NUMBER))
{
if (cls.HasFlag(Classification.NUMBER_INTEGER))
{
return(new LithpLiteral(new LithpInteger(strV)));
}
else if (cls.HasFlag(Classification.NUMBER_FLOAT))
{
return(new LithpLiteral(new LithpFloat(strV)));
}
else
{
throw new NotImplementedException();
}
}
else if (cls.HasFlag(Classification.ATOM))
{
return(new LithpLiteral(LithpAtom.Atom(strV)));
}
throw new NotImplementedException();
}
public static LithpOpChain Factorial()
{
// (
LithpOpChain result = new LithpOpChain();
// (if (== 1 N) (
// (1)
// ) (else (
// (* N (fac (- N 1)))
// )))
LithpOpChain facBody = new LithpOpChain(result);
LithpOpChain return1 = new LithpOpChain(facBody);
return1.Add(new LithpLiteral(1));
LithpOpChain elseBody = new LithpOpChain(facBody);
elseBody.Add(
LithpFunctionCall.New("*/*",
LithpFunctionCall.New("get/1", new LithpVariableReference("N")),
LithpFunctionCall.New("fac/1",
LithpFunctionCall.New("-/*",
LithpFunctionCall.New("get/1", new LithpVariableReference("N")),
new LithpLiteral(1)
)
)
)
);
facBody.Add(
LithpFunctionCall.New("if/3",
LithpFunctionCall.New("==/2",
new LithpLiteral(1),
LithpFunctionCall.New("get/1", new LithpVariableReference("N"))
),
return1,
LithpFunctionCall.New("else/1", elseBody)
)
);
// (def fac #N :: (
LithpFunctionCall def = LithpFunctionCall.New("def/2", LithpAtom.Atom("fac"),
LithpFunctionDefinition.New(result, "fac", facBody, "N")
);
// )
result.Add(def);
int n;
#if DEBUG
n = 10;
#else
n = 500;
#endif
result.Add(LithpFunctionCall.New("print/*", "Factorial result: ", LithpFunctionCall.New("fac/1", n)));
return(result);
}
private ILithpPrimitive resolve(ILithpPrimitive current, LithpOpChain chain)
{
switch (current.LithpType())
{
case LithpType.LITERAL:
return(((LithpLiteral)current).Value);
case LithpType.ATOM:
case LithpType.DICT:
case LithpType.INTEGER:
case LithpType.LIST:
case LithpType.STRING:
case LithpType.FN:
case LithpType.FN_NATIVE:
case LithpType.OPCHAIN:
return(current);
case LithpType.FUNCTIONCALL:
LithpFunctionCall call = (LithpFunctionCall)current;
LithpList resolved = ResolveParameters(call, chain);
LithpPrimitive value = InvokeResolved(call, resolved, chain);
if (value.LithpType() == LithpType.OPCHAIN)
{
LithpOpChain subchain = (LithpOpChain)value;
if (subchain.IsImmediate)
{
value = this.Run(new LithpOpChain(chain, subchain));
}
}
return(value);
case LithpType.VAR:
// TODO: Could just lookup the value now
LithpVariableReference v = (LithpVariableReference)current;
return(new LithpString(v.Name));
default:
throw new NotImplementedException();
}
}
public LithpPrimitive Run(LithpOpChain chain)
{
ILithpPrimitive value = LithpAtom.Atom("nil");
while (chain.AtEnd() == false)
{
ILithpOpChainMember current = chain.Next();
switch (current.LithpType())
{
case LithpType.OPCHAIN:
value = this.Run(new LithpOpChain(chain, (LithpOpChain)current));
break;
case LithpType.FUNCTIONCALL:
LithpFunctionCall call = (LithpFunctionCall)current;
LithpList resolved = ResolveParameters(call, chain);
value = InvokeResolved(call, resolved, chain);
if (value.LithpType() == LithpType.OPCHAIN)
{
LithpOpChain subchain = (LithpOpChain)value;
value = this.Run(new LithpOpChain(chain, subchain));
}
break;
case LithpType.LITERAL:
value = ((LithpLiteral)current).Value;
break;
case LithpType.FN:
case LithpType.FN_NATIVE:
value = current;
break;
default:
throw new NotImplementedException();
}
}
return((LithpPrimitive)value);
}
static void RunTests()
{
LithpOpChain chain = new LithpOpChain();
LithpInteger one = 1;
LithpAtom test = "test";
LithpDict dict = new LithpDict();
dict["foo"] = "bar";
dict["num"] = 1;
dict["list"] = LithpList.New("Hello, world!", one, test);
Console.WriteLine(dict.ToLiteral());
LithpFunctionCall fncall = LithpFunctionCall.New("print/*", dict);
Console.WriteLine("fncall tostring: {0}", fncall);
LithpBuiltins builtins = new LithpBuiltins();
LithpInterpreter interp = new LithpInterpreter();
builtins[fncall.Function].Invoke(fncall.Parameters, chain, interp);
// Now put it all together
chain.Add(fncall);
chain.ImportBuiltins(builtins);
Console.WriteLine("Result of print: {0}", interp.Run(chain));
// More complex
LithpFunctionCall addStrings = LithpFunctionCall.New("+/*", "foo", "bar");
LithpFunctionCall printAddString = LithpFunctionCall.New("print/*",
"Adding two strings: ", addStrings);
chain.Add(printAddString);
interp.Run(chain);
chain.Add(addStrings);
Console.WriteLine("Result of add strings: {0}", interp.Run(chain));
LithpFunctionCall setVar = LithpFunctionCall.New("set/2",
new LithpVariableReference("Test"), "Foo");
LithpFunctionCall printVar = LithpFunctionCall.New("print/*",
"Value of Test:", LithpFunctionCall.New(
"get/1", new LithpVariableReference("Test")
));
chain.Add(setVar);
chain.Add(printVar);
// Now run entire chain from the start
chain.Rewind();
interp.Run(chain);
// Try a user-defined function
LithpOpChain addBody = new LithpOpChain(chain);
addBody.Add(LithpFunctionCall.New(
LithpAtom.Atom("+/*"),
LithpFunctionCall.New("get/1", new LithpVariableReference("A")),
LithpFunctionCall.New("get/1", new LithpVariableReference("B"))
));
chain.Add(LithpFunctionCall.New("def/2",
LithpAtom.Atom("add"),
LithpFunctionDefinition.New(chain, "add", addBody, "A", "B")
));
chain.Add(LithpFunctionCall.New("print/*",
"Calling user function add:", LithpFunctionCall.New(
"add/2", 2, 5
)
));
interp.Run(chain);
}
public LithpPrimitive InvokeResolved(LithpFunctionCall call,
LithpList parameters, LithpOpChain chain)
{
string name = call.Function;
// Use the interface so that we can invoke native and Lithp methods.
ILithpFunctionDefinition def;
if (chain.Closure.TopMost && chain.Closure.TopMost.IsDefined(call.Function))
{
def = (ILithpFunctionDefinition)chain.Closure.TopMost[call.Function];
}
else
if (chain.Closure.IsDefinedAny(call.Function))
{
def = (ILithpFunctionDefinition)chain.Closure[call.Function];
}
else
{
string arityStar = Regex.Replace(call.Function, @"\d+$", "*");
name = arityStar;
if (chain.Closure.IsDefinedAny(arityStar))
{
def = (ILithpFunctionDefinition)chain.Closure[arityStar];
}
else
{
throw new MissingMethodException();
}
}
#if DEBUG
string debug_str = null;
{
string indent;
if (depth < 20)
{
indent = new string('|', depth + 1);
}
else
{
indent = "| " + depth + " | |";
}
debug_str = "+ " + indent + " (" + def.Name +
(parameters.Count > 0 ? (" " + Inspect(parameters)) : "") + ")";
}
#endif
depth++;
fnCalls++;
try
{
LithpPrimitive result;
if (chain.LithpType() == LithpType.FN)
{
chain.FunctionEntry = name;
}
#if DEBUG
{
if (def.LithpType() == LithpType.FN)
{
Console.WriteLine(debug_str);
}
else
{
switch (def.Name)
{
case "while":
case "call":
case "try":
case "eval":
case "apply":
case "next":
case "recurse":
Console.WriteLine(debug_str);
break;
}
}
}
#endif
result = def.Invoke(parameters, chain, this);
#if DEBUG
{
string literal = result.ToLiteral();
if (literal.Length > MaxDebugLen)
{
literal = "(" + result.LithpType().ToString() + ": too large to display)";
}
debug_str += " :: " + literal;
Console.WriteLine(debug_str);
}
#endif
return(result);
}
finally
{
depth--;
}
}
