public static ILispNode Neq(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object [] args)
{
#region DateTime
try
{
var merger = new AtomMerger(new LispMissing());
var walker = new DateTimeWalker("!=");
var result = functor.WalkAsBoolean(arguments, callStack, 2, merger, walker);
return((merger.MissingSymbols.Count() > 0)
? merger.MissingSymbols
: result);
}
catch {}
#endregion
try
{
var merger = new AtomMerger(new LispMissing());
var walker = new NumberWalker("!=");
var result = functor.WalkAsBoolean(arguments, callStack, 2, merger, walker);
return((merger.MissingSymbols.Count() > 0)
? merger.MissingSymbols
: result);
}
catch {}
try
{
var merger = new AtomMerger(new LispMissing());
var walker = new BooleanWalker("!=");
var result = functor.WalkAsBoolean(arguments, callStack, 2, merger, walker);
return((merger.MissingSymbols.Count() > 0)
? merger.MissingSymbols
: result);
}
catch {}
try
{
var merger = new AtomMerger(new LispMissing());
var walker = new StringWalker("!=");
var result = functor.WalkAsBoolean(arguments, callStack, 2, merger, walker);
return((merger.MissingSymbols.Count() > 0)
? merger.MissingSymbols
: result);
}
catch {}
throw new Exception("!= requires all arguments to be dates, numbers, booleans or strings");
}
public static ILispNode Apply(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object[] args)
{
#if TRACE_FLOW
try
{
#endif
try
{
if (arguments.Count < 1)
{
throw new Exception("MAP requires at least 1 argument");
}
var applyFunctor = arguments[0].Eval(callStack, args);
return(Functor.Apply(applyFunctor, new LispList(null, arguments.Skip(1)), callStack, args));
}
catch
{
return(new LispNil());
}
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("apply threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(apply {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode Print(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object[] args)
{
#if TRACE_FLOW
try
{
#endif
var strResult = arguments.Aggregate(
String.Empty,
(r, x) => r + (((r == String.Empty)
? ""
: " ") + x.Eval(callStack, true).ToString()));
Console.WriteLine(strResult);
return(new LispAtom(strResult));
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("print threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(print {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode Prod(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object [] args)
{
#if TRACE_FLOW
try
{
#endif
try
{
var merger = new AtomMerger(new LispMissing(), (r, x) => (double)r * (double)x);
var result = functor.MergeAsNumber(arguments, callStack, 2, merger);
return((merger.MissingSymbols.Count() > 0)
? merger.MissingSymbols
: result);
}
catch
{
throw new Exception("PROD requires all arguments to be numbers");
}
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("prod threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(prod {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode Prog(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object[] args)
{
#if TRACE_FLOW
try
{
#endif
var values = arguments.Select(x => x.Eval(callStack, true)).ToList();
var missingSymbols = values.Aggregate(new LispMissing(), (r, x) => r.Merge(x));
return((missingSymbols.Count() > 0)
? missingSymbols
: values.Last());
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("prog threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(prog {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode Negate(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object [] args)
{
#if TRACE_FLOW
try
{
#endif
try
{
var merger = new AtomMerger(new LispMissing(), (r, x) => - 1 * (double)x);
var result = functor.MergeAsNumber(arguments, callStack, 1, merger);
return((merger.MissingSymbols.Count() > 0)
? merger.MissingSymbols
: result);
}
catch (Exception ex)
{
throw new LispException(null, "NEGATE throws exception!", ex);
}
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("negate threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(negate {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode Not(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object [] args)
{
#if TRACE_FLOW
try
{
#endif
try
{
var merger = new AtomMerger(new LispMissing(), (r, x) => !(bool)x);
var result = functor.MergeAsBoolean(arguments, callStack, 1, merger);
return((merger.MissingSymbols.Count() > 0)
? merger.MissingSymbols
: result);
}
catch
{
throw new Exception("NOT requires its single argument to be Boolean");
}
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("not threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(not {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode AddNumber(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object [] args)
{
#if TRACE_FLOW
try
{
#endif
var merger = new AtomMerger(new LispMissing(), (r, x) => (double)r + (double)x);
var result = functor.MergeAsNumber(arguments, callStack, 2, merger);
return((merger.MissingSymbols.Count() > 0)
? merger.MissingSymbols
: result);
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("add_number throws: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(add_number {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode SubDate(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object [] args)
{
#if TRACE_FLOW
try
{
#endif
var merger = new AtomMerger(new LispMissing(), (r, x) => (DateTime)r - (TimeSpan)x);
var result = functor.MergeAsDateTime(arguments, callStack, 2, merger);
return((merger.MissingSymbols.Count() > 0)
? merger.MissingSymbols
: result);
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("sub_date throws: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(sub_date {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode Concat(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object [] args)
{
#if TRACE_FLOW
try
{
#endif
var merger = new AtomMerger(new LispMissing(), (r, x) => (((string)r).Unquote() + ((string)x).Unquote()).Quote());
var result = functor.MergeAsString(arguments, callStack, 2, merger);
return((merger.MissingSymbols.Count() > 0)
? merger.MissingSymbols
: result);
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("concat throws: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(concat {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode ApplyDynamicFunction(Lambda lambda, LispList arguments, CallStack callStack, params object [] args)
{
try
{
callStack.PushFrame();
var functionBodyStatements = lambda.Body;
var fOptional = false;
for (var iParam = 0; iParam < lambda.FormalParameters.Count; iParam++)
{
var param = lambda.FormalParameters[iParam];
Debug.Assert(param is LispAtom, "Formal Parameter should be an Atom");
var paramName = (param as LispAtom).ValueAsString;
Debug.Assert(paramName != String.Empty, "Formal Parameter name cannot be a null string");
fOptional |= paramName.EndsWith("?");
paramName = paramName.TrimEnd('?');
ILispNode paramValue = null;
try
{
paramValue = arguments[iParam].Eval(callStack, true);
if (paramValue is LispMissing)
{
throw new Exception("Value to be bound cannot be evaluated");
}
}
catch
{
if (!fOptional)
{
throw new Exception(String.Format("Cannot find value to bind to {0}", paramName));
}
paramValue = new LispNil();
}
finally
{
Debug.Assert(paramValue != null, paramName + " is bound to null");
var invocationParamName = String.Format("{0}_{1}", paramName, callStack.NumberOfFrames);
callStack[invocationParamName] = paramValue;
functionBodyStatements = functionBodyStatements.Select(x => ReplaceParamName(x, paramName, invocationParamName)).ToList();
}
}
ILispNode result = new LispNil();
foreach (var statement in functionBodyStatements)
{
result = statement.Eval(callStack);
}
return(result);
}
finally
{
callStack.PopFrame();
}
}
public static ILispNode MergeAsBoolean(this ILispNode root, IList <ILispNode> arguments, CallStack callStack, int arity, IMerger merger)
{
if (arguments.Count < arity)
{
throw new Exception("Not enough arguments");
}
var fFirst = true;
var fUnary = (arity == 1);
return(new LispAtom(
arguments.Aggregate(
false,
(result, xArg) =>
{
var xEval = xArg.Eval(callStack);
// nil is treated as false
if (xEval is LispNil)
{
xEval = new LispAtom(false);
}
if ((xEval is LispMissing) && (merger.MergeMissing != null))
{
return (bool)merger.MergeMissing(result, xEval as LispMissing);
}
if ((xEval is LispList) && (merger.MergeList != null))
{
return (bool)merger.MergeList(result, xEval as LispList);
}
Debug.Assert(xEval is LispAtom, "Argument does not evaluate to an Atom!");
try
{
if (!(xEval as LispAtom).IsBoolean)
{
throw new Exception();
}
// if fUnary, it means the function has only the first argument, which must be merged
// otherwise, we can prime the pump with the value of the first argument
if (fFirst && !fUnary)
{
result = (xEval as LispAtom).ValueAsBoolean;
fFirst = false;
return result;
}
return (bool)merger.MergeAtom(result, (xEval as LispAtom).ValueAsBoolean);
}
catch
{
throw new Exception("Argument does not evaluate to a Boolean");
}
})));
}
public static ILispNode Cond(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object[] args)
{
#if TRACE_FLOW
try
{
#endif
var missing = new LispMissing();
if (arguments.Count < 1)
{
throw new Exception("COND requires at least 1 argument");
}
for (var i = 0; i <= arguments.Count; i++)
{
var _case = arguments[i];
if (_case is LispMissing)
{
missing.Merge(_case);
continue;
}
if (!(_case is LispList) && ((_case as LispList).Count != 2))
{
throw new Exception("Each COND case requires exactly 2 arguments");
}
var test = (_case as LispList)[0].Eval(callStack, true);
if (test is LispMissing)
{
missing.Merge(test);
continue;
}
if ((test is LispNil) || (!(test as LispAtom).ValueAsBoolean))
{
continue;
}
return((_case as LispList)[1].Eval(callStack, true));
}
return(new LispNil());
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("cond threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(cond {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode WalkAsBoolean(this ILispNode root, IList <ILispNode> arguments, CallStack callStack, int arity, IMerger merger, IWalker walker)
{
ILispNode xPrev = null;
return(new LispAtom(
arguments.Aggregate(
true,
(result, xArg) =>
{
var xEval = xArg.Eval(callStack);
if ((xEval is LispNil) && (merger.MergeNil != null))
{
return (bool)merger.MergeNil(result, xEval as LispNil);
}
if ((xEval is LispMissing) && (merger.MergeMissing != null))
{
return (bool)merger.MergeMissing(result, xEval as LispMissing);
}
if ((xEval is LispList) && (merger.MergeList != null))
{
return (bool)merger.MergeList(result, xEval as LispList);
}
try
{
Debug.Assert(xEval is LispAtom, "Argument does not evaluate to an Atom!");
if (walker.ItemTest(xEval))
{
if (xPrev == null)
{
walker.First(xEval);
return true;
}
else
{
return (bool)walker.Sequence(result, xPrev, xEval);
}
}
throw new Exception("ItemTest failed without throwing an exception!");
}
catch (Exception ex)
{
throw new Exception("Argument is invalid", ex);
}
finally
{
xPrev = xEval;
}
})));
}
public static ILispNode Defun(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object[] args)
{
#if TRACE_FLOW
try
{
#endif
try
{
if (arguments.Count < 3)
{
throw new Exception("DEFUN requires at least 3 arguments");
}
var functionName = arguments[0].Eval(callStack, false);
if (!(functionName is LispAtom))
{
throw new Exception("A defun must have a first argument which evaluates to an Atom");
}
var name = (functionName as LispAtom).ValueAsString;
if (name == String.Empty)
{
throw new Exception("A defun must have a non-null string for a name as its first argument");
}
if (!(arguments[1] is LispList))
{
throw new Exception("A defun must have a LIST of formal parameters as its second argument");
}
var formalParams = (arguments[1] as LispList);
callStack[name] = new Defun(name, formalParams, arguments.Skip(2).ToList());
return(new LispAtom(null, name, Token.ValidName));
}
catch
{
return(new LispNil());
}
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("defun threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(defun {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode WeekOfYear(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object [] args)
{
DateTime result;
if (DateTime.TryParse((arguments[0].Eval(callStack, true) as LispAtom).ValueAsDateTime.ToString(), out result))
{
return(new LispAtom(CultureInfo.CurrentCulture.Calendar.GetWeekOfYear(result, CalendarWeekRule.FirstFourDayWeek, System.DayOfWeek.Sunday)));
}
else
{
return(new LispNil());
}
}
public static ILispNode DayOfYear(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object [] args)
{
DateTime result;
if (DateTime.TryParse((arguments[0].Eval(callStack, true) as LispAtom).ValueAsDateTime.ToString(), out result))
{
return(new LispAtom(result.DayOfYear));
}
else
{
return(new LispNil());
}
}
public static ILispNode Iff(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object[] args)
{
#if TRACE_FLOW
try
{
#endif
if (arguments.Count < 2)
{
throw new Exception("IF requires at least 2 arguments");
}
if (arguments.Count > 3)
{
throw new Exception("IF requires at most 3 arguments");
}
var test = arguments[0].Eval(callStack, true);
if (test is LispMissing)
{
return(test);
}
if (test is LispList)
{
throw new Exception("IF requires a test which evaluates to an Atom");
}
var fTrue = (test as LispAtom).ValueAsBoolean;
return(fTrue
? arguments[1].Eval(callStack, true)
: ((arguments.Count == 3)
? arguments[2].Eval(callStack, true)
: (new LispNil())));
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("iif threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(iif {0}) done", arguments.ToLispArgString());
}
#endif
}
public LispMissing Merge(ILispNode source)
{
try
{
if (source is LispMissing)
{
(source as LispMissing).ToList().ForEach(x => _missingSymbols.Add(x));
}
return(this);
}
catch
{
return(new LispMissing());
}
}
public static ILispNode Lambda(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object[] args)
{
#if TRACE_FLOW
try
{
#endif
try
{
if (arguments.Count < 2)
{
throw new Exception("LAMBDA requires at least 2 arguments");
}
if (!(arguments[0] is LispList))
{
throw new Exception("A lambda must have a LIST of formal parameters as its first argument");
}
var result = new LispList
{
(arguments[0] as LispList)
};
foreach (var argument in arguments.Skip(1))
{
result.Add(argument);
}
return(result);
}
catch
{
return(new LispNil());
}
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("lambda threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(lambda {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode Today(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object [] args)
{
try
{
var formatParam = (arguments.Count > 0)
? arguments[0].Eval(callStack, true)
: null;
var strFormat = (((formatParam == null) || (formatParam is LispNil))
? String.Empty
: (formatParam as LispAtom).ValueAsString);
return(new LispAtom(DateTime.Today.ToString(strFormat)));
}
catch
{
return(new LispNil());
}
}
public static ILispNode List(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object[] args)
{
#if TRACE_FLOW
try
{
#endif
if (arguments.Count < 1)
{
return(new LispNil());
}
var missing = new LispMissing();
var result = new LispList();
foreach (var xEval in arguments.Select(x => x.Eval(callStack, true)))
{
if (xEval is LispMissing)
{
missing.Merge(xEval);
}
else
{
result.Add(xEval);
}
}
return((missing.Count() > 0)
? missing
: result as ILispNode);
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("list threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(list {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode Bool(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object [] args)
{
#if TRACE_FLOW
try
{
#endif
try
{
var xEval = arguments[0].Eval(callStack, true);
if (xEval is LispMissing)
{
return(xEval);
}
if (xEval is LispAtom)
{
bool result;
if (bool.TryParse((xEval as LispAtom).ValueAsNumber.ToString(), out result))
{
return(new LispAtom(result));
}
}
throw new Exception();
}
catch
{
return(new LispNil());
}
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("bool threw Exception" + ex.Message);
throw;
}
finally
{
Console.WriteLine("(bool {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode Cdr(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object[] args)
{
#if TRACE_FLOW
try
{
#endif
if (arguments.Count != 1)
{
throw new Exception("CDR requires exactly 1 argument");
}
try
{
var arg = arguments[0].Eval(callStack, true);
if (arg is LispMissing)
{
return(arg);
}
if ((arg is LispNil) || (arg is LispAtom))
{
return(new LispNil());
}
return((arg as LispList).Cdr);
}
catch (Exception)
{
return(new LispNil());
}
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("cdr threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(cdr {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode NilP(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object[] args)
{
#if TRACE_FLOW
try
{
#endif
if (arguments.Count != 1)
{
throw new Exception("NIL-P requires exactly one argument");
}
var result = arguments[0].Eval(callStack, true);
if (result is LispNil)
{
return(new LispAtom(true));
}
if ((result is LispAtom) && !(result as LispAtom).ValueAsBoolean)
{
return(new LispAtom(true));
}
if ((result is LispList) && ((result as LispList).Count == 0))
{
return(new LispAtom(true));
}
return(new LispAtom(false));
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("nil_p threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(nil_p {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode Date(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object [] args)
{
DateTime result;
if (DateTime.TryParse((arguments[0].Eval(callStack, true) as LispAtom).ValueAsDateTime.ToString(), out result))
{
var formatParam = (arguments.Count > 1)
? arguments[1].Eval(callStack, true)
: null;
var strFormat = ((formatParam is LispNil)
? String.Empty
: (formatParam as LispAtom).ValueAsString);
return(new LispAtom(result.ToString(strFormat)));
}
else
{
return(new LispNil());
}
}
public static ILispNode SetQ(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object[] args)
{
#if TRACE_FLOW
try
{
#endif
if (arguments.Count != 2)
{
throw new Exception("SETQ requires exactly 2 arguments");
}
var variableName = arguments[0].Eval(callStack, false);
if (!(variableName is LispAtom))
{
throw new Exception("A setq must have a first argument which evaluates to an Atom");
}
var name = (variableName as LispAtom).ValueAsString;
if (name == String.Empty)
{
throw new Exception("A setq must have a non-null string for a name as its first argument");
}
callStack[name] = arguments[1].Eval(callStack, true);
return(callStack[name] as ILispNode);
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("setq threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(setq {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode Atom(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object[] args)
{
#if TRACE_FLOW
try
{
#endif
if (arguments.Count != 1)
{
throw new Exception("ATOM requires exactly one argument");
}
var result = arguments[0].Eval(callStack, true);
if (result is LispNil)
{
return(result);
}
if (result is LispMissing)
{
return(result);
}
if (result is LispAtom)
{
return(result);
}
throw new Exception("ATOM requires arguments that evaluate to Atom");
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("atom threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(atom {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode False(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object [] args)
{
#if TRACE_FLOW
try
{
#endif
return(new LispAtom(false));
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("false threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(false {0}) done", arguments.ToLispArgString());
}
#endif
}
public static ILispNode Map(ILispNode functor, IList <ILispNode> arguments, CallStack callStack, params object[] args)
{
#if TRACE_FLOW
try
{
#endif
try
{
if (arguments.Count < 1)
{
throw new Exception("MAP requires at least 1 argument");
}
var result = new LispList();
var mapFunctor = arguments[0].Eval(callStack, args);
// run through the arguments list one at a time and map them to the result with the lambda
arguments.Skip(1).ToList().ForEach(x => result.Add(Functor.Apply(mapFunctor, new LispList().Add(x), callStack, args)));
return(result);
}
catch
{
return(new LispNil());
}
#if TRACE_FLOW
}
catch (Exception ex)
{
Console.WriteLine("map threw Exception: " + ex.Message);
throw;
}
finally
{
Console.WriteLine("(map {0}) done", arguments.ToLispArgString());
}
#endif
}
