/// <summary>
/// Implements quasi-quotes.
///
/// TODO: refactor to move to <see cref="OpenLisp.Core.StaticClasses.CoreNameSpace"/>.
/// </summary>
/// <param name="abstractSyntaxTree"></param>
/// <returns></returns>
public static OpenLispVal QuasiQuote(OpenLispVal abstractSyntaxTree)
{
if (!IsPair(abstractSyntaxTree))
{
return(new OpenLispList(new OpenLispSymbol("quote"), abstractSyntaxTree));
}
OpenLispVal caputPrimus = ((OpenLispList)abstractSyntaxTree)[0];
var symbol = caputPrimus as OpenLispSymbol;
if ((symbol != null) && (symbol.ToString() == "unquote"))
{
return(((OpenLispList)abstractSyntaxTree)[1]);
}
if (!IsPair(caputPrimus))
{
return(new OpenLispList(new OpenLispSymbol("cons"),
QuasiQuote(caputPrimus),
QuasiQuote(((OpenLispList)abstractSyntaxTree).Rest())));
}
OpenLispVal caputSecundus = ((OpenLispList)caputPrimus)[0];
var lispSymbol = caputSecundus as OpenLispSymbol;
return((lispSymbol != null) && (lispSymbol.ToString() == "splice-unquote")
? new OpenLispList(new OpenLispSymbol("concat"),
((OpenLispList)caputPrimus)[1],
QuasiQuote(((OpenLispList)abstractSyntaxTree).Rest()))
: new OpenLispList(new OpenLispSymbol("cons"),
QuasiQuote(caputPrimus),
QuasiQuote(((OpenLispList)abstractSyntaxTree).Rest())));
}
/// <summary>
/// Constructor accepting an <see cref="OpenLispVal"/>, an <see cref="Env"/>, an <see cref="OpenLispList"/>,
/// and a <see cref="Func{T, TResult}"/>.
/// </summary>
/// <param name="ast"></param>
/// <param name="env"></param>
/// <param name="fparams"></param>
/// <param name="lambda"></param>
public OpenLispFunc(OpenLispVal ast, Env env, OpenLispList fparams, Func <OpenLispList, OpenLispVal> lambda)
{
Ast = ast;
Env = env;
FParams = fparams;
Lambda = lambda;
}
/// <summary>
/// Evalues an AST in the environment.
///
/// TODO: refactor to move to <see cref="OpenLisp.Core.StaticClasses.CoreNameSpace"/>.
/// </summary>
/// <param name="abstractSyntaxTree"></param>
/// <param name="environment"></param>
/// <returns></returns>
public static OpenLispVal EvalAst(OpenLispVal abstractSyntaxTree, Env environment)
{
var key = abstractSyntaxTree as OpenLispSymbol;
if (key != null)
{
return(environment.Get(key));
}
var list = abstractSyntaxTree as OpenLispList;
if (list == null)
{
var map = abstractSyntaxTree as OpenLispHashMap;
if (map == null)
{
return(abstractSyntaxTree);
}
var newDictionary =
map.Value.ToDictionary(
entry => entry.Key, entry => Eval(entry.Value, environment));
return(new OpenLispHashMap(newDictionary));
}
OpenLispList oldList = list;
OpenLispList newList = abstractSyntaxTree.ListQ() ? new OpenLispList()
: (OpenLispList) new OpenLispVector();
foreach (OpenLispVal movedValue in oldList.Value)
{
newList.Conj(Eval(movedValue, environment));
}
return(newList);
}
/// <summary>
/// Expands a macro.
///
/// TODO: refactor to move to <see cref="OpenLisp.Core.StaticClasses.CoreNameSpace"/>.
/// </summary>
/// <param name="abstractSyntaxTree"></param>
/// <param name="environment"></param>
/// <returns></returns>
public static OpenLispVal MacroExpand(OpenLispVal abstractSyntaxTree, Env environment)
{
while (IsMacroCall(abstractSyntaxTree, environment))
{
OpenLispSymbol caputPrimus = (OpenLispSymbol)((OpenLispList)abstractSyntaxTree)[0];
OpenLispFunc macro = (OpenLispFunc)environment.Get(caputPrimus);
abstractSyntaxTree = macro.Apply(((OpenLispList)abstractSyntaxTree).Rest());
}
return(abstractSyntaxTree);
}
/// <summary>
/// Compares equality between two instances of <see cref="OpenLispVal"/>.
/// </summary>
/// <param name="a"></param>
/// <param name="b"></param>
/// <returns></returns>
public static bool OpenLispEqualQ(OpenLispVal a, OpenLispVal b)
{
Type typeA = a.GetType();
Type typeB = b.GetType();
if ((typeA != typeB) && (!(a is OpenLispList) || !(b is OpenLispList)))
{
return(false);
}
if (a is OpenLispInt)
{
return(((OpenLispInt)a).Value ==
((OpenLispInt)b).Value);
}
if (a is OpenLispSymbol)
{
return(((OpenLispSymbol)a).Value ==
((OpenLispSymbol)b).Value);
}
if (a is OpenLispString)
{
return(((OpenLispString)a).Value ==
((OpenLispString)b).Value);
}
if (!(a is OpenLispList))
{
return(a == b);
}
if (((OpenLispList)a).Size != ((OpenLispList)b).Size)
{
return(false);
}
for (int i = 0; i < ((OpenLispList)a).Size; i++)
{
if (OpenLispEqualQ(((OpenLispList)a)[i], ((OpenLispList)b)[i]))
{
continue;
}
return(false);
}
return(true);
//return (typeA == typeB) || (a is OpenLispList && b is OpenLispList);
}
/// <summary>
/// Is this <see cref="OpenLispVal"/> a macro call in the current <see cref="Env"/>?
/// </summary>
/// <param name="abstractSyntaxTree"></param>
/// <param name="environment"></param>
/// <returns></returns>
public static bool IsMacroCall(OpenLispVal abstractSyntaxTree, Env environment)
{
var list = abstractSyntaxTree as OpenLispList;
OpenLispVal caputPrimus = list?[0];
if (!(caputPrimus is OpenLispSymbol) || environment.Find((OpenLispSymbol)caputPrimus) == null)
{
return(false);
}
OpenLispVal macro = environment.Get((OpenLispSymbol)caputPrimus);
var func = macro as OpenLispFunc;
return(func != null &&
func.Macro);
}
/// <summary>
/// Sets an <see cref="OpenLispSymbol"/> key's value to an instance of <see cref="OpenLispVal"/>.
/// </summary>
/// <param name="key"></param>
/// <param name="value"></param>
/// <returns></returns>
public Env Set(OpenLispSymbol key, OpenLispVal value)
{
_data[key.Value] = value;
return(this);
}
/// <summary>
/// Constructor accepting a <see cref="OpenLispVal"/>.
/// </summary>
/// <param name="value"></param>
public OpenLispAtom(OpenLispVal value)
{
Value = value;
}
/// <summary>
/// Initializes a new instance of the <see cref="T:OpenLisp.Core.DataTypes.OpenLispInt"/> class.
/// </summary>
/// <param name="value">Value.</param>
public OpenLispInt(OpenLispVal value)
{
Value = ((OpenLispInt)value).Value;
}
/// <summary>
/// Public constructor with an <see cref="OpenLispVal"/>
/// instance parameter.
/// </summary>
/// <param name="instance"></param>
public OpenLispMonad(OpenLispVal instance)
{
_instance = instance;
}
/// <summary>
/// Default public constructor.
/// </summary>
/// <param name="instance"></param>
/// <param name="env"></param>
public OpenLispMonad(OpenLispVal instance, Env env)
{
_env = env;
_instance = instance;
}
/// <summary>
///
/// </summary>
/// <param name="dataType"></param>
/// <returns></returns>
public virtual IOpenLispMonad <OpenLispVal> UnitFunction(OpenLispVal dataType)
{
throw new NotImplementedException();
}
/// <summary>
/// Is this <see cref="OpenLispVal"/> a pair?
/// </summary>
/// <param name="x"></param>
/// <returns></returns>
public static bool IsPair(OpenLispVal x)
{
return(x is OpenLispList && ((OpenLispList)x).Size > 0);
}
/// <summary>
/// Evaluate an <see cref="OpenLispVal"/> inside an <seealso cref="Env"/>.
///
/// The core namespace is defined in <seealso cref="OpenLisp.Core.StaticClasses.CoreNameSpace"/>.
///
/// TODO: refactor the switch over treeHeadSymbol. All symbols of the core language should be defined in the same place.
/// </summary>
/// <param name="originalAbstractSyntaxTree"></param>
/// <param name="environment"></param>
/// <returns></returns>
public static OpenLispVal Eval(OpenLispVal originalAbstractSyntaxTree, Env environment)
{
while (true)
{
//Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true));
if (!originalAbstractSyntaxTree.ListQ())
{
return(EvalAst(originalAbstractSyntaxTree, environment));
}
// apply list
OpenLispVal expanded = MacroExpand(originalAbstractSyntaxTree, environment);
if (!expanded.ListQ())
{
return(expanded);
}
OpenLispList abstractSyntaxTree = (OpenLispList)expanded;
if (abstractSyntaxTree.Size == 0)
{
return(abstractSyntaxTree);
}
var treeHead = abstractSyntaxTree[0];
var symbol = treeHead as OpenLispSymbol;
String treeHeadSymbol = symbol?.ToString() ?? "__<*fn*>__";
// Let's get alchemical in our metaphors:
OpenLispVal caputPrimus; // The First Head. Here's a vector: [1 lol 2 3 apple]. caputPrimus should be: 1.
OpenLispVal caputSecundus; // The Second Head. Here's a list: `(1 lol 2 3 apple). caputSecundus should be: lol.
OpenLispVal solutio;
switch (treeHeadSymbol)
{
// TODO: extract this switch out of the REPL and consolidate in the core NS.
case "def!":
caputPrimus = abstractSyntaxTree[1];
caputSecundus = abstractSyntaxTree[2];
solutio = Eval(caputSecundus, environment);
environment.Set((OpenLispSymbol)caputPrimus, solutio);
return(solutio);
case "let*":
caputPrimus = abstractSyntaxTree[1];
caputSecundus = abstractSyntaxTree[2];
OpenLispSymbol key;
OpenLispVal value;
Env letEnvironment = new Env(environment); // TODO: explain ramifications to memory allocation and protection by creating a new Env object this way.
for (int i = 0; i < ((OpenLispList)caputPrimus).Size; i += 2)
{
key = (OpenLispSymbol)((OpenLispList)caputPrimus)[i];
value = ((OpenLispList)caputPrimus)[i + 1];
letEnvironment.Set(key, Eval(value, letEnvironment));
}
originalAbstractSyntaxTree = caputSecundus;
environment = letEnvironment;
break;
case "quote":
return(abstractSyntaxTree[1]);
case "quasiquote":
originalAbstractSyntaxTree = QuasiQuote(abstractSyntaxTree[1]);
break;
case "defmacro!":
caputPrimus = abstractSyntaxTree[1];
caputSecundus = abstractSyntaxTree[2];
solutio = Eval(caputSecundus, environment);
((OpenLispFunc)solutio).Macro = true;
environment.Set(((OpenLispSymbol)caputPrimus), solutio);
return(solutio);
case "macroexpand":
caputPrimus = abstractSyntaxTree[1];
return(MacroExpand(caputPrimus, environment));
case "try*":
try
{
return(Eval(abstractSyntaxTree[1], environment));
}
catch (Exception caught)
{
if (abstractSyntaxTree.Size <= 2)
{
throw caught;
}
OpenLispVal openLispException;
caputSecundus = abstractSyntaxTree[2];
OpenLispVal caputSecundusHead = ((OpenLispList)caputSecundus)[0];
if (((OpenLispSymbol)caputSecundusHead).ToString() != "catch*")
{
throw caught;
}
var exception = caught as OpenLispException;
openLispException = exception != null
? (OpenLispVal)exception.Value
#if TRACE
: new OpenLispString(caught.StackTrace);
#elif !TRACE
: new OpenLispString("Stack Trace not yet available in OS.");
#endif
return(Eval(((OpenLispList)caputSecundus)[2],
new Env(environment, ((OpenLispList)caputSecundus).Slice(1, 2),
new OpenLispList(openLispException))));
}
/// <summary>
/// This static method recursively processes
/// OpenLisp.NET forms and tokenizes them.
/// </summary>
/// <param name="reader"></param>
/// <returns></returns>
public static OpenLispVal ReadForm(TokensReader reader)
{
string token = reader.Peek();
if (token == null)
{
throw new OpenLispContinue();
}
OpenLispVal form = null;
switch (token)
{
case "'":
reader.Next();
return(new OpenLispList(new OpenLispSymbol("quote"),
ReadForm(reader)));
case "`":
reader.Next();
return(new OpenLispList(new OpenLispSymbol("quasiquote"),
ReadForm(reader)));
case "~":
reader.Next();
return(new OpenLispList(new OpenLispSymbol("unquote"),
ReadForm(reader)));
case "~@":
reader.Next();
return(new OpenLispList(new OpenLispSymbol("splice-unquote"),
ReadForm(reader)));
case "^":
reader.Next();
OpenLispVal meta = ReadForm(reader);
return(new OpenLispList(new OpenLispSymbol("with-meta"),
ReadForm(reader),
meta));
case "@":
reader.Next();
return(new OpenLispList(new OpenLispSymbol("deref"),
ReadForm(reader)));
case "(": form = ReadList(reader, new OpenLispList(), '(', ')'); break;
case ")": throw new ParseError("unexpected ')'");
case "[": form = ReadList(reader, new OpenLispVector(), '[', ']'); break;
case "]": throw new ParseError("unexpected ']'");
case "{": form = ReadHashMap(reader); break;
case "}": throw new ParseError("unexpected '}'");
default: form = ReadAtom(reader); break;
}
return(form);
}
/// <summary>
/// pr-str implementation.
/// </summary>
/// <param name="value"></param>
/// <param name="printReadably"></param>
/// <returns></returns>
public static string PrStr(OpenLispVal value, bool printReadably)
{
return(value.ToString(printReadably));
}
