/// <summary>
///
/// </summary>
/// <param name="args"></param>
public override LispObject execute(LispObject[] args)
{
if (args[0] is Condition)
{
Condition cond = (Condition)args[0];
String s = "DESC:\r\n" + cond.getDescription().princToString() + "\r\nMESG:\r\n" + cond.getMessage() + "\r\nRPRT:\r\n" + cond.getConditionReport() + "\r\n";
DLRConsole.DebugWriteLine(s);
// if (true) return previous.execute(args);
if (args[0] is UndefinedFunction)
{
UndefinedFunction u = (UndefinedFunction)args[0];
return ABCLInterpreter.COMMON_ABCLInterpreter.makeFunction(u.getCellName());
}
if (args[0] is UnboundVariable)
{
UnboundVariable u = (UnboundVariable)args[0];
return ABCLInterpreter.COMMON_ABCLInterpreter.makeVariable(u.getCellName());
}
lock (ABCLInterpreter.SubThreadInDebugMutex)
{
bool wasDebugging = ABCLInterpreter.IsSubThreadInDebug;
try
{
ABCLInterpreter.IsSubThreadInDebug = true;
previous.execute(args); //throw new ConditionThrowable(cond);
}
finally
{
ABCLInterpreter.IsSubThreadInDebug = wasDebugging;
}
}
}
throw new MissingMethodException(Lisp.javaString(args[0]));
} // method: execute
public static LispObject GetNarrowestChild(this LispObject obj, LispSourcePosition position)
{
if (!obj.SourceLocation.HasValue ||
!obj.SourceLocation.Value.ContainsPosition(position))
{
return(null);
}
var children = obj.GetChildren().ToList();
if (children.Count == 0)
{
// can't delve any deeper
return(obj);
}
// otherwise try to find the child that contains the position and recurse
foreach (var child in children)
{
if (child.SourceLocation.HasValue &&
child.SourceLocation.Value.ContainsPosition(position))
{
return(child.GetNarrowestChild(position));
}
}
// no child was more specific, just return this
return(obj);
}
public Interpreter getInterpreter()
{
if (interpreter == null)
{
jlispThread = new Thread(new ThreadStart(StartJLISP));
jlispThread.Start();
while (interpreter == null)
{
ironTextBoxControl.Update();
}
}
if (varPackage == null)
{
varPackage = Symbol._PACKAGE_;
}
LispObject pkg = varPackage.symbolValue();
if (lastPackage != pkg)
{
lastPackage = pkg;
ironTextBoxControl.Prompt = ((Package)pkg).getName() + "> ";
//ironTextBoxControl.ConsoleTextBox
}
return(interpreter);
}
public LispParseResult ParseUntilSourceLocation(string code, LispSourcePosition position)
{
var sourceBindings = new LispSourceBindings(Host.CurrentPackage);
LispObject containingObject = null;
var eofValue = new LispError("EOF");
var textReader = new StringReader(code);
var textStream = new LispTextStream("", textReader, TextWriter.Null);
Host.ObjectReader.SetReaderStream(textStream);
while (true)
{
var result = Host.ObjectReader.Read(false, eofValue, true);
if (ReferenceEquals(result.LastResult, eofValue))
{
break;
}
sourceBindings.TryAddSourceBinding(result.LastResult);
if (result.LastResult.SourceLocation.HasValue &&
result.LastResult.SourceLocation.Value.ContainsPosition(position))
{
containingObject = result.LastResult;
break;
}
}
var narrowestChild = containingObject?.GetNarrowestChild(position);
var parseResult = new LispParseResult(Host, narrowestChild, sourceBindings);
return(parseResult);
}
protected static void EnsureNotError(LispObject obj)
{
if (obj is LispError error)
{
Assert.True(false, $"{error.Message} at {error.SourceLocation}");
}
}
internal LispObject Evaluate(string command)
{
getInterpreter();
LispObject cmd = Lisp.readObjectFromString(command);
LispObject result = Lisp.eval(cmd);
return(result);
}
public LispEvaluatorObjectExpression(LispObject expression)
{
if (expression == null)
{
throw new ArgumentNullException(nameof(expression));
}
Expression = expression;
}
public bool TryGetBoundValue(LispResolvedSymbol symbol, out LispObject value)
{
if (_parsedBindings.TryGetValue(symbol.Value, out value))
{
return(true);
}
return(false);
}
public void AddBinding(Symbol symbol, LispObject value)
{
if (!dict.ContainsKey(symbol))
{
dict.Add(symbol, value);
}
else
{
throw new EnvironmentException(symbol + " already bound");
}
}
internal bool TryPopArgument(out LispObject arg)
{
arg = default;
if (_argumentStack.Count > 0)
{
arg = _argumentStack.Pop();
return(true);
}
return(false);
}
public static bool IsNil(this LispObject o)
{
switch (o)
{
case LispNilList _:
return(true);
default:
return(false);
}
}
internal LispObject clojEval(LateSymbolPrimitive lsp, Symbol previous, LispObject[] args)
{
LispObject pv = previous.getSymbolValue();
LispObject pf = previous.getSymbolFunction();
if (lsp == pf)
{
}
String s = ((Symbol)previous).getName();
return(clojEval(lsp, s, args));
}
public override bool IsSubscriberOf(string eventName)
{
eventName = eventName.ToUpper();
Symbol s = Lisp.getCurrentPackage().findAccessibleSymbol(eventName);
LispObject fun = s.getSymbolFunction();
if (fun == null || fun == Lisp.NIL)
{
return(false);
}
return(true);
}
public void TryAddSourceBinding(LispObject obj)
{
// TODO: delve into labels and functions/macros for arguments
if (obj is LispList list)
{
var listItems = list.ToList();
if (list.Value is LispSymbol symbol)
{
var resolvedSymbol = symbol.Resolve(CurrentPackage);
switch (resolvedSymbol.Value)
{
case "COMMON-LISP:DEFUN":
{
if (LispDefaultContext.TryGetCodeFunctionFromItems(listItems.Skip(1).ToArray(), CurrentPackage, out var codeFunction, out var _error))
{
if (codeFunction != null)
{
_parsedBindings[codeFunction.NameSymbol.Value] = codeFunction;
}
}
}
break;
case "COMMON-LISP:DEFMACRO":
{
if (LispDefaultContext.TryGetCodeMacroFromItems(listItems.Skip(1).ToArray(), CurrentPackage, out var codeMacro, out var _error))
{
if (codeMacro != null)
{
_parsedBindings[codeMacro.NameSymbol.Value] = codeMacro;
}
}
}
break;
case "COMMON-LISP:SETF":
// starting at 1 to skip the `SETF` keyword
for (int i = 1; i < listItems.Count - 1; i++)
{
var name = listItems[i];
var value = listItems[i + 1];
if (name is LispSymbol symbolName)
{
var resolvedSymbolName = symbolName.Resolve(CurrentPackage);
_parsedBindings[resolvedSymbolName.Value] = value;
}
}
break;
}
}
}
}
internal void InsertObjectOperations(LispObject obj, bool createDribbleInstructions)
{
if (createDribbleInstructions)
{
InsertOperation(new LispEvaluatorDribbleExit());
}
InsertOperation(new LispEvaluatorObjectExpression(obj));
if (createDribbleInstructions)
{
InsertOperation(new LispEvaluatorDribbleEnter(obj));
}
}
public static string GetMarkdownDisplay(this LispObject obj, LispHost host)
{
switch (obj)
{
case LispCodeFunction codeFunction:
return($@"
``` lisp
; <in module {codeFunction.NameSymbol.PackageName}>
(DEFUN {codeFunction.NameSymbol.ToDisplayString(host.CurrentPackage)} ({codeFunction.ArgumentCollection}) ...)
```
{codeFunction.Documentation}".Trim());
case LispFunction function:
return($@"
``` lisp
; <native function>
; <in module {function.NameSymbol.PackageName}>
(DEFUN {function.NameSymbol.ToDisplayString(host.CurrentPackage)} (...) ...)
```
{function.Documentation}".Trim());
case LispCodeMacro codeMacro:
return($@"
``` lisp
; <in module {codeMacro.NameSymbol.PackageName}>
(DEFMACRO {codeMacro.NameSymbol.ToDisplayString(host.CurrentPackage)} ({codeMacro.ArgumentCollection}) ...)
```
TODO: documentation".Trim());
case LispMacro macro:
return($@"
``` lisp
; <native macro>
; <in module {macro.NameSymbol.PackageName}>
(DEFMACRO {macro.NameSymbol.ToDisplayString(host.CurrentPackage)} (...) ...)
```
TODO: documentation".Trim());
case LispResolvedSymbol symbol:
// TODO: don't display current package qualifier
return($"`{symbol.Value}`: {host.GetValue(symbol.Value)}");
default:
return(obj?.ToString());
}
}
internal void ReportError(LispError error, LispObject parent)
{
if (!error.SourceLocation.HasValue)
{
error.SourceLocation = parent?.SourceLocation;
}
if (error.StackFrame is null)
{
error.StackFrame = StackFrame;
}
PushArgument(error);
}
/// <summary>
/// (ON-CHAT (@ "My Bot") (@ "hi"))
/// </summary>
/// <param name="s"></param>
/// <returns></returns>
public Object findSymbol(object obj, String s)
{
Package pkg = CurrentPackage();
if (obj == null)
{
LispObject lo = pkg.findAccessibleSymbol(s);
if (lo is Symbol)
{
return(lo.getSymbolValue().javaInstance());
}
}
throw new MissingMethodException("no function binding for " + s);
} // method: findSymbol
public string GetText(LispObject argument)
{
var sb = new StringBuilder();
sb.Append(argument.ToString(useEscapeCharacters: true));
var paddingWidth = Math.Max(0, Width - sb.Length);
if (paddingWidth > 0)
{
sb.Append(new string(' ', paddingWidth));
}
return(sb.ToString());
}
internal void ExecuteToConsole(string command)
{
getInterpreter();
if (buffer.IsNeedy())
{
buffer.AddToBuffer(command + "\n");
buffer.needsChars = false;
}
else
{
buffer.SetBuffer("");
econsole = command;
///new Thread(new ThreadStart(EConsole)).Start();
LispObject lo = Evaluate(econsole);
WriteText("==> " + lo.princToString() + "\r\n");
}
getInterpreter();
return;
}
public Interpreter getInterpreter()
{
if (interpreter == null)
{
if (false)
{
jlispThread = new Thread(new ThreadStart(StartJLISP));
jlispThread.Start();
}
else
{
// StartInstanceBlocked();
// isReady = true;
jrunnable = new JRunnableLisp(this);
jthread = new java.lang.Thread(jrunnable);
jthread.start();
}
while (!isReady)
{
java.lang.Thread.sleep(1000);// Thread.Sleep(1000);// ironTextBoxControl.Update();
Yield();
}
}
if (varPackage == null)
{
varPackage = Symbol._PACKAGE_;
}
LispObject pkg = varPackage.symbolValue();
if (lastPackage != pkg)
{
lastPackage = pkg;
// ironTextBoxControl.Prompt = ((Package)pkg).getName() + "> ";
// ironTextBoxControl.getIronTextBox();
// ironTextBoxControl.getIronTextBox().Parent;
//ironTextBoxControl.ConsoleTextBox
}
return(interpreter);
}
public void HaltExecutionOnFunctionReturn()
{
var host = new LispHost();
bool sentinelHit = false;
host.AddFunction("SENTINEL", (host, executionState, args) =>
{
sentinelHit = true;
return(new LispInteger(54));
});
LispObject capturedReturnValue = null;
host.RootFrame.FunctionReturned += (s, e) =>
{
if (e.Frame.FunctionSymbol.Value == "COMMON-LISP-USER:INNER-FUNCTION")
{
e.HaltExecution = true;
capturedReturnValue = e.ReturnValue;
}
};
var evalResult = host.Eval(@"
(defun inner-function ()
42)
(defun outer-function ()
(inner-function)
(sentinel))
(outer-function)
");
Assert.False(evalResult.ExecutionState.IsExecutionComplete);
Assert.Equal(42, ((LispInteger)capturedReturnValue).Value);
Assert.Equal(42, ((LispInteger)evalResult.LastResult).Value);
Assert.False(sentinelHit);
host.EvalContinue(evalResult.ExecutionState);
Assert.True(evalResult.ExecutionState.IsExecutionComplete);
Assert.Equal(54, ((LispInteger)evalResult.LastResult).Value);
Assert.True(sentinelHit);
}
internal LispObject clojEval(LateSymbolPrimitive lsp, String s, LispObject[] args)
{
Object target = null;
int indexOf = s.IndexOf(".");
if (indexOf > 0)
{
String s1 = s.Substring(0, indexOf);
target = findSymbol(target, s1);
if (target != null)
{
((ScriptInterpreter)this).Intern(s1, target);
}
Package pkg = CurrentPackage();
Symbol sym = pkg.findAccessibleSymbol(s);
LispObject sf = sym.getSymbolFunction();
if (sf != null)
{
if (sf != lsp)
{
return(sf.execute(args));
}
}
s = s.Substring(indexOf + 1);
Object o = clojExecute(target, s, args);
return(JavaObject.getInstance(o));
}
else
{
String s1 = s;
target = findSymbol(target, s1);
Object o = clojExecute(target, "", args);
return(JavaObject.getInstance(o));
}
}
internal Object clojExecute(object target, String s, LispObject[] args)
{
int index = 0;
int found = -1;
char[] cs = s.ToCharArray();
char c = cs[index];
while (index < cs.Length && found==-1)
{
switch (c)
{
case ':':
case '/':
case '.':
found = index;
break;
default:
index++;
break;
} // switch
}
int indexOf = s.IndexOf(".");
while (indexOf > 0)
{
String s1 = s.Substring(0, indexOf - 1);
target = findSymbol(target, s1);
s = s.Substring(indexOf + 1);
indexOf = s.IndexOf(".");
}
throw new MissingMethodException("no function binding for " + target + " . " + s + " arg= " + args);
}
internal LispObject clojEval(LateSymbolPrimitive lsp, Symbol previous, LispObject[] args)
{
LispObject pv = previous.getSymbolValue();
LispObject pf = previous.getSymbolFunction();
if (lsp == pf)
{
}
String s = ((Symbol)previous).getName();
return clojEval(lsp, s, args);
}
public LispEvaluatorFunctionExit(LispFunction function, LispObject invocationExpression, bool popFrame = true)
{
Function = function;
InvocationExpression = invocationExpression;
PopFrame = popFrame;
}
public Macro(string name, LispObject lambdaList, Cons macroBody, LispEnvironment macroEnv)
{
this.name = name;
this.expander = new Lambda(lambdaList, macroBody, macroEnv);
this.macroEnv = macroEnv;
}
public void SetValue(Symbol symbol, LispObject value)
{
if (dict.ContainsKey(symbol))
{
dict[symbol] = value;
}
else if (!IsRoot)
{
parent.SetValue(symbol, value);
}
else
{
throw new EnvironmentException("No binding for " + symbol);
}
}
public LispObjectReaderResult(LispObject lastResult, string incompleteInput, int expressionDepth)
{
LastResult = lastResult;
IncompleteInput = incompleteInput;
ExpressionDepth = expressionDepth;
}
public CSThrowError(LispObject prev)
: base("CSThrowError", "datum &rest arguments")
{
previous = prev;
}
/// <summary>
///
/// </summary>
/// <param name="args"></param>
public override LispObject execute(LispObject[] args)
{
return (LispObject)dynamicDelagate.DynamicInvoke(args);
} // method: execute
public LispObject Eval(LispObject expr)
{
if (expr is Symbol)
{
return LookUp((Symbol)expr);
}
if (expr.IsAtom)
{
return expr;
}
if (this.specials.IsSpecial((Cons)expr))
{
return this.specials.Eval((Cons)expr, this);
}
if (this.IsMacro((Cons)expr))
{
Cons expansion;
MacroExpand.Expand((Cons)expr, this, out expansion);
return this.Eval(expansion);
}
var funVal = this.Eval(Car.Of(expr));
var fun = funVal.As<Function>();
var arguments = Cdr.Of(expr);
var argumentValues = Cons.ToList(arguments.As<Cons>().Select(this.Eval));
return fun.Apply(argumentValues, this);
}
public void AddBinding(string symbolName, LispObject value)
{
AddBinding(Symbols.Intern(Symbol.Canonicalize(symbolName)), value);
}
public bool TryLookUp(Symbol symbol, out LispObject value)
{
if (dict.TryGetValue(symbol, out value))
{
return true;
}
if (!this.IsRoot)
{
return this.parent.TryLookUp(symbol, out value);
}
return false;
}
internal LispObject clojEval(LateSymbolPrimitive lsp, String s, LispObject[] args)
{
Object target = null;
int indexOf = s.IndexOf(".");
if (indexOf > 0)
{
String s1 = s.Substring(0, indexOf );
target = findSymbol(target, s1);
if (target != null)
{
((ScriptInterpreter)this).Intern(s1, target);
}
Package pkg = CurrentPackage();
Symbol sym = pkg.findAccessibleSymbol(s);
LispObject sf = sym.getSymbolFunction();
if (sf!=null)
{
if (sf!=lsp)
{
return sf.execute(args);
}
}
s = s.Substring(indexOf + 1);
Object o = clojExecute(target, s, args);
return JavaObject.getInstance(o);
} else {
String s1 = s;
target = findSymbol(target, s1);
Object o = clojExecute(target, "", args);
return JavaObject.getInstance(o);
}
}
private void AssertList(LispObject list, List<Token> tokens)
{
if (list.IsNil)
{
Assert.IsEmpty(tokens);
}
else
{
var cons = (Cons)list;
var symbol = (Symbol)cons.Car;
Assert.That(symbol.SameName(tokens[0].Name));
AssertList(cons.Cdr, tokens.GetRange(1, tokens.Count - 1));
}
}
/// <summary>
///
/// </summary>
/// <param name="args"></param>
public override LispObject execute(LispObject[] args)
{
return ABCLInterpreter.COMMON_ABCLInterpreter.clojEval(this,previous,args);
} // method: execute
public virtual void SetValue(LispResolvedSymbol symbol, LispObject value)
{
_values[symbol.Value] = value;
Root.OnValueSet(symbol, value, this);
}
public LispException(LispObject value)
{
Value = value;
}
public void Extend(LispObject lambdaList, Cons values)
{
if (lambdaList.IsNil)
{
if (values.IsNil)
{
return;
}
throw new EnvironmentException("Too many values when extending environment");
}
if (lambdaList.IsAtom)
{
this.AddBinding(lambdaList.As<Symbol>(), values);
}
else
{
if (values.IsNil)
{
throw new EnvironmentException("Too few values when extending environment");
}
this.AddBinding(Car.Of(lambdaList).As<Symbol>(), values.Car);
this.Extend(Cdr.Of(lambdaList), values.Cdr.As<Cons>());
}
}
internal void SetValueInParentScope(LispResolvedSymbol symbol, LispObject value)
{
var target = Parent ?? this;
target.SetValue(symbol, value);
}
internal static LispExecutionState CreateExecutionState(LispStackFrame stackFrame, string inputName, LispObject obj, bool useTailCalls, bool allowHalting, bool createDribbleInstructions)
{
var executionState = CreateExecutionState(stackFrame, inputName, string.Empty, useTailCalls, allowHalting);
executionState.InsertObjectOperations(obj, createDribbleInstructions);
return(executionState);
}
public LispEvaluatingExpressionEventArgs(LispObject expression, LispStackFrame stackFrame)
{
Expression = expression;
StackFrame = stackFrame;
}
public LispParseResult(LispHost host, LispObject obj, LispSourceBindings bindings)
{
Host = host;
Object = obj;
Bindings = bindings;
}
private Package CurrentPackage()
{
lastPackage = org.armedbear.lisp.Lisp.getCurrentPackage();
return (Package)lastPackage;
}
public Interpreter getInterpreter()
{
if (interpreter == null)
{
jlispThread = new Thread(new ThreadStart(StartJLISP));
jlispThread.Start();
while (interpreter == null)
{
ironTextBoxControl.Update();
}
}
if (varPackage == null)
{
varPackage = Symbol._PACKAGE_;
}
LispObject pkg = varPackage.symbolValue();
if (lastPackage != pkg)
{
lastPackage = pkg;
ironTextBoxControl.Prompt = ((Package)pkg).getName() + "> ";
//ironTextBoxControl.ConsoleTextBox
}
return interpreter;
}
internal void PushArgument(LispObject argument)
{
_argumentStack.Push(argument);
}
public Interpreter getInterpreter()
{
if (interpreter == null)
{
if (false)
{
jlispThread = new Thread(new ThreadStart(StartJLISP));
jlispThread.Start();
}
else
{
// StartInstanceBlocked();
// isReady = true;
jrunnable = new JRunnableLisp(this);
jthread = new java.lang.Thread(jrunnable);
jthread.start();
}
while (!isReady)
{
java.lang.Thread.sleep(1000);// Thread.Sleep(1000);// ironTextBoxControl.Update();
Yield();
}
}
if (varPackage == null)
{
varPackage = Symbol._PACKAGE_;
}
LispObject pkg = varPackage.symbolValue();
if (lastPackage != pkg)
{
lastPackage = pkg;
// ironTextBoxControl.Prompt = ((Package)pkg).getName() + "> ";
// ironTextBoxControl.getIronTextBox();
// ironTextBoxControl.getIronTextBox().Parent;
//ironTextBoxControl.ConsoleTextBox
}
return interpreter;
}
public static LispObject Of(LispObject x)
{
return x.As<Cons>().Car;
}
internal LispObject makeFunction(LispObject lispObject)
{
return new LateSymbolPrimitive((Symbol)lispObject);
}
public Function(LispObject args)
{
this.args = args;
}
internal LispObject makeVariable(LispObject lispObject)
{
WriteLine("faking " + lispObject);
return lispObject;
//throw new Exception("The method or operation is not implemented.");
}