public void MatchRestInvocationArgumentsFromRemainingValues()
{
// a &rest the-rest
// 1 2 3
var matched = MatchArguments(
new[]
{
new LispRegularInvocationArgument(LispSymbol.CreateFromString("A")),
},
Array.Empty <LispOptionalInvocationArgument>(),
Array.Empty <LispKeywordInvocationArgument>(),
Array.Empty <LispAuxiliaryInvocationArgument>(),
new LispRestInvocationArgument(LispSymbol.CreateFromString("THE-REST")),
new LispObject[]
{
new LispInteger(1),
new LispInteger(2),
new LispInteger(3),
}
);
Assert.Equal(2, matched.Length);
Assert.Equal("A", matched[0].Item1.Name);
Assert.Equal(1, ((LispInteger)matched[0].Item2).Value);
Assert.Equal("THE-REST", matched[1].Item1.Name);
var rest = ((LispList)matched[1].Item2).ToList();
Assert.Equal(2, rest.Count);
Assert.Equal(2, ((LispInteger)rest[0]).Value);
Assert.Equal(3, ((LispInteger)rest[1]).Value);
}
public void MatchOptionalInvocationArguments()
{
// a &optional (defaults-to-fourteen 14) defaults-to-nil
// 1 2
var matched = MatchArguments(
new[]
{
new LispRegularInvocationArgument(LispSymbol.CreateFromString("A")),
},
new[]
{
new LispOptionalInvocationArgument(LispSymbol.CreateFromString("DEFAULTS-TO-FOURTEEN"), new LispInteger(14)),
new LispOptionalInvocationArgument(LispSymbol.CreateFromString("DEFAULTS-TO-NIL"), LispNilList.Instance),
},
Array.Empty <LispKeywordInvocationArgument>(),
Array.Empty <LispAuxiliaryInvocationArgument>(),
null,
new LispObject[]
{
new LispInteger(1),
new LispInteger(2),
}
);
Assert.Equal(3, matched.Length);
Assert.Equal("A", matched[0].Item1.Name);
Assert.Equal(1, ((LispInteger)matched[0].Item2).Value);
Assert.Equal("DEFAULTS-TO-FOURTEEN", matched[1].Item1.Name);
Assert.Equal(2, ((LispInteger)matched[1].Item2).Value);
Assert.Equal("DEFAULTS-TO-NIL", matched[2].Item1.Name);
Assert.True(matched[2].Item2.IsNil());
}
internal LispObject Trace(LispObject[] args)
{
if (args.Length == 0)
{
return(LispList.FromEnumerable(TracedFunctions.Select(f => LispSymbol.CreateFromString(f))));
}
else
{
var addedFunctions = new HashSet <string>();
var hasInvalidArguments = false;
foreach (var arg in args)
{
if (arg is LispSymbol symbol)
{
var resolvedSymbol = symbol.Resolve(Host.CurrentPackage);
TracedFunctions.Add(resolvedSymbol.Value);
addedFunctions.Add(resolvedSymbol.Value);
}
else
{
hasInvalidArguments = true;
}
}
if (hasInvalidArguments)
{
return(new LispError("Expected only symbols"));
}
else
{
return(LispList.FromEnumerable(addedFunctions.Select(f => LispSymbol.CreateFromString(f))));
}
}
}
public void MatchRestInvocationArgumentsFromNothing()
{
// a &rest the-rest
// 1
var matched = MatchArguments(
new[]
{
new LispRegularInvocationArgument(LispSymbol.CreateFromString("A")),
},
Array.Empty <LispOptionalInvocationArgument>(),
Array.Empty <LispKeywordInvocationArgument>(),
Array.Empty <LispAuxiliaryInvocationArgument>(),
new LispRestInvocationArgument(LispSymbol.CreateFromString("THE-REST")),
new LispObject[]
{
new LispInteger(1),
}
);
Assert.Equal(2, matched.Length);
Assert.Equal("A", matched[0].Item1.Name);
Assert.Equal(1, ((LispInteger)matched[0].Item2).Value);
Assert.Equal("THE-REST", matched[1].Item1.Name);
Assert.True(matched[1].Item2.IsNil());
}
public void MatchRegularInvocationArguments()
{
// a b c
// 1 "two" 3.0
var matched = MatchArguments(
new[]
{
new LispRegularInvocationArgument(LispSymbol.CreateFromString("A")),
new LispRegularInvocationArgument(LispSymbol.CreateFromString("B")),
new LispRegularInvocationArgument(LispSymbol.CreateFromString("C")),
},
Array.Empty <LispOptionalInvocationArgument>(),
Array.Empty <LispKeywordInvocationArgument>(),
Array.Empty <LispAuxiliaryInvocationArgument>(),
null,
new LispObject[]
{
new LispInteger(1),
new LispString("TWO"),
new LispFloat(3.0),
}
);
Assert.Equal(3, matched.Length);
Assert.Equal("A", matched[0].Item1.Name);
Assert.Equal(1, ((LispInteger)matched[0].Item2).Value);
Assert.Equal("B", matched[1].Item1.Name);
Assert.Equal("TWO", ((LispString)matched[1].Item2).Value);
Assert.Equal("C", matched[2].Item1.Name);
Assert.Equal(3.0, ((LispFloat)matched[2].Item2).Value);
}
public void MatchAuxiliaryInvocationArguments()
{
// a &aux (two 2) nniill
// 1
var matched = MatchArguments(
new[]
{
new LispRegularInvocationArgument(LispSymbol.CreateFromString("A")),
},
Array.Empty <LispOptionalInvocationArgument>(),
Array.Empty <LispKeywordInvocationArgument>(),
new[]
{
new LispAuxiliaryInvocationArgument(LispSymbol.CreateFromString("TWO"), new LispInteger(2)),
new LispAuxiliaryInvocationArgument(LispSymbol.CreateFromString("NNIILL"), LispNilList.Instance),
},
null,
new LispObject[]
{
new LispInteger(1),
}
);
Assert.Equal(3, matched.Length);
Assert.Equal(1, ((LispInteger)matched[0].Item2).Value);
Assert.Equal(2, ((LispInteger)matched[1].Item2).Value);
Assert.True((matched[2].Item2).IsNil());
}
public void PackageAndSymbolNameSplitting()
{
Assert.Equal(Tuple.Create((string)null, "SOME-SYMBOL", true), LispSymbol.SplitPackageAndSymbolName("SOME-SYMBOL"));
Assert.Equal(Tuple.Create("SOME-PACKAGE", "SOME-SYMBOL", true), LispSymbol.SplitPackageAndSymbolName("SOME-PACKAGE:SOME-SYMBOL"));
Assert.Equal(Tuple.Create("SOME-PACKAGE", "SOME-SYMBOL", false), LispSymbol.SplitPackageAndSymbolName("SOME-PACKAGE::SOME-SYMBOL"));
Assert.Equal(Tuple.Create("KEYWORD", "SOME-SYMBOL", true), LispSymbol.SplitPackageAndSymbolName(":SOME-SYMBOL"));
Assert.Equal(Tuple.Create("KEYWORD", "SOME-SYMBOL", false), LispSymbol.SplitPackageAndSymbolName("::SOME-SYMBOL"));
}
public void InvokeBuiltInNamedFunctionReference()
{
var host = new LispHost();
var result = host.Eval(@"(funcall #'cons 'a 'b)").LastResult;
var expected = LispList.FromItemsImproper(LispSymbol.CreateFromString("A"), LispSymbol.CreateFromString("B"));
Assert.Equal(expected, result);
}
static public dynamic element(LispList args, LispEnvironment env)
{
LispSymbol name = args[0].Eval(env);
LispString format = args[1].Eval(env);
env.Add(name, VertexFormats.getParserFor(format.Value));
return(new InputElement(name.Value, 0, VertexFormats.getDXFormatOf(format.Value), 0, 0));
}
public void Quoted()
{
var host = new LispHost();
Assert.Equal(LispSymbol.CreateFromString("A"), host.Eval("'a").LastResult);
Assert.Equal(LispList.FromItems(new LispUnresolvedSymbol("QUOTE"), LispSymbol.CreateFromString("A")), host.Eval("''a").LastResult);
Assert.Equal(LispList.FromItems(new LispInteger(1)), host.Eval("'(1)").LastResult);
Assert.Equal("(QUOTE A)", host.Eval("(eval '''a)").LastResult.ToString());
}
public void SimpleFormatArguments()
{
TestFormat(
"A: a, B: (b), C: 5",
"A: ~s, B: ~s, C: ~s",
LispSymbol.CreateFromString("a"),
new LispList(LispSymbol.CreateFromString("b")),
new LispInteger(5));
}
internal virtual void CopyLocalsToParentForTailCall(LispPackage currentPackage, HashSet <string> invocationArgumentNames)
{
foreach (var valuePair in _values)
{
if (invocationArgumentNames.Contains(valuePair.Key))
{
Parent?.SetValue(LispSymbol.CreateFromString(valuePair.Key).Resolve(currentPackage), valuePair.Value);
}
}
}
public void MacroExpansionWithFunctionReferences()
{
var host = new LispHost();
var evalResult = host.Eval(@"
(labels ((square (x) (* x x)))
(car (mapcar #'square '(2))))
");
Assert.Equal(4, ((LispInteger)evalResult.LastResult).Value);
Assert.Null(evalResult.ExecutionState.StackFrame.GetValue(LispSymbol.CreateFromString("SQUARE").Resolve(host.CurrentPackage))); // no leakage
}
public static LispList PerformMacroReplacements(this IEnumerable <LispObject> body, LispPackage currentPackage, IDictionary <string, LispObject> replacements)
{
if (replacements is null)
{
throw new ArgumentNullException(nameof(replacements));
}
var itemReplacements = body.Select(item => item.PerformMacroReplacements(currentPackage, replacements)).ToList();
var bodyList = LispList.FromEnumerable(itemReplacements);
var result = new LispList(LispSymbol.CreateFromString("COMMON-LISP:PROGN"), bodyList);
return(result);
}
public void Pop()
{
var host = new LispHost();
var evalResult = host.Eval(@"
(setf my-stack '(2 1))
(setf a (pop my-stack))
(setf b (pop my-stack))
");
Assert.Equal("()", evalResult.ExecutionState.StackFrame.GetValue(LispSymbol.CreateFromString("MY-STACK").Resolve(host.CurrentPackage)).ToString());
Assert.Equal("2", evalResult.ExecutionState.StackFrame.GetValue(LispSymbol.CreateFromString("A").Resolve(host.CurrentPackage)).ToString());
Assert.Equal("1", evalResult.ExecutionState.StackFrame.GetValue(LispSymbol.CreateFromString("B").Resolve(host.CurrentPackage)).ToString());
}
public void LambdaWithLexicalClosure()
{
var host = new LispHost();
var result = host.Eval(@"
(setf words '((one uno) (two dos) (three tres)))
(defun my-assoc (key table)
(find-if #'(lambda (entry)
(equal key (first entry)))
table))
(my-assoc 'two words)
").LastResult;
var expected = LispList.FromItems(LispSymbol.CreateFromString("TWO"), LispSymbol.CreateFromString("DOS"));
Assert.Equal(expected, result);
}
public void BindRestArgument()
{
// a &rest the-rest
var argumentCollection = GetArgumentCollection(
LispSymbol.CreateFromString("A"),
new LispLambdaListKeyword("&REST"),
LispSymbol.CreateFromString("THE-REST")
);
Assert.Equal(1, argumentCollection.RegularArguments.Count);
Assert.Empty(argumentCollection.OptionalArguments);
Assert.Empty(argumentCollection.KeywordArguments);
Assert.NotNull(argumentCollection.RestArgument);
Assert.Equal("A", argumentCollection.RegularArguments[0].Name);
Assert.Equal("THE-REST", argumentCollection.RestArgument.Name);
}
public void MatchKeywordAndOptionalAndRestArgumentsWithValues()
{
// a &optional dos &key tres &rest the-rest
// 1 2 :tres 3 4
var matched = MatchArguments(
new[]
{
new LispRegularInvocationArgument(LispSymbol.CreateFromString("A")),
},
new[]
{
new LispOptionalInvocationArgument(LispSymbol.CreateFromString("DOS"), LispNilList.Instance),
},
new[]
{
new LispKeywordInvocationArgument(LispSymbol.CreateFromString("TRES"), LispNilList.Instance),
},
Array.Empty <LispAuxiliaryInvocationArgument>(),
new LispRestInvocationArgument(LispSymbol.CreateFromString("THE-REST")),
new LispObject[]
{
new LispInteger(1),
new LispInteger(2),
LispSymbol.CreateFromString(":TRES"),
new LispInteger(3),
new LispInteger(4),
}
);
Assert.Equal(4, matched.Length);
Assert.Equal("A", matched[0].Item1.Name);
Assert.Equal(1, ((LispInteger)matched[0].Item2).Value);
Assert.Equal("DOS", matched[1].Item1.Name);
Assert.Equal(2, ((LispInteger)matched[1].Item2).Value);
Assert.Equal("TRES", matched[2].Item1.Name);
Assert.Equal(3, ((LispInteger)matched[2].Item2).Value);
Assert.Equal("THE-REST", matched[3].Item1.Name);
var rest = ((LispList)matched[3].Item2).ToList();
Assert.Equal(1, rest.Count);
Assert.Equal(4, ((LispInteger)rest[0]).Value);
}
public void BindBuildRegularInvocationArguments()
{
// a b c
var argumentCollection = GetArgumentCollection(
LispSymbol.CreateFromString("A"),
LispSymbol.CreateFromString("B"),
LispSymbol.CreateFromString("C")
);
Assert.Equal(3, argumentCollection.RegularArguments.Count);
Assert.Empty(argumentCollection.OptionalArguments);
Assert.Empty(argumentCollection.KeywordArguments);
Assert.Empty(argumentCollection.AuxiliaryArguments);
Assert.Null(argumentCollection.RestArgument);
Assert.Equal("A", argumentCollection.RegularArguments[0].Name);
Assert.Equal("B", argumentCollection.RegularArguments[1].Name);
Assert.Equal("C", argumentCollection.RegularArguments[2].Name);
}
public void IsTLike()
{
Assert.False(LispNilList.Instance.IsTLike());
Assert.True(LispList.FromItems(LispSymbol.CreateFromString("COMMON-LISP:QUOTE"), LispSymbol.CreateFromString("A")).IsTLike());
Assert.True(LispList.FromItems(LispSymbol.CreateFromString("COMMON-LISP:QUOTE"), LispNilList.Instance).IsTLike());
Assert.True(new LispError("e").IsTLike());
Assert.True(LispSymbol.CreateFromString("a").IsTLike());
Assert.True(new LispInteger(0).IsTLike());
Assert.True(new LispFloat(0.0).IsTLike());
Assert.True(new LispRatio(1, 2).IsTLike());
Assert.True(new LispString("a").IsTLike());
Assert.True(LispList.FromItems(new LispInteger(0)).IsTLike());
Assert.True(new LispCodeFunction(new LispResolvedSymbol("some-module", "function", true), null, LispArgumentCollection.Empty, Enumerable.Empty <LispObject>()).IsTLike());
Assert.True(new LispNativeFunction(new LispResolvedSymbol("some-module", "function", true), null, null).IsTLike());
Assert.True(new LispQuotedNamedFunctionReference("function").IsTLike());
Assert.True(new LispQuotedLambdaFunctionReference(new LispCodeFunction(new LispResolvedSymbol("some-module", "function", true), null, new LispArgumentCollection(Array.Empty <LispRegularInvocationArgument>(), Array.Empty <LispOptionalInvocationArgument>(), Array.Empty <LispKeywordInvocationArgument>(), Array.Empty <LispAuxiliaryInvocationArgument>(), null), Enumerable.Empty <LispObject>())).IsTLike());
Assert.True(new LispCodeMacro(new LispResolvedSymbol("some-module", "function", true), LispArgumentCollection.Empty, Enumerable.Empty <LispObject>()).IsTLike());
Assert.True(new LispNativeMacro(new LispResolvedSymbol("some-module", "function", true), null).IsTLike());
}
public void MatchOptionalAndKeywordAndRestArgumentsFromNothing()
{
// a &optional nil-list &key some-special-value &rest the-rest
// 1
var matched = MatchArguments(
new[]
{
new LispRegularInvocationArgument(LispSymbol.CreateFromString("A")),
},
new[]
{
new LispOptionalInvocationArgument(LispSymbol.CreateFromString("NIL-LIST"), LispNilList.Instance),
},
new[]
{
new LispKeywordInvocationArgument(LispSymbol.CreateFromString("SOME-SPECIAL-VALUE"), LispNilList.Instance),
},
Array.Empty <LispAuxiliaryInvocationArgument>(),
new LispRestInvocationArgument(LispSymbol.CreateFromString("THE-REST")),
new LispObject[]
{
new LispInteger(1),
}
);
Assert.Equal(4, matched.Length);
Assert.Equal("A", matched[0].Item1.Name);
Assert.Equal(1, ((LispInteger)matched[0].Item2).Value);
Assert.Equal("NIL-LIST", matched[1].Item1.Name);
Assert.True(matched[1].Item2.IsNil());
Assert.Equal("SOME-SPECIAL-VALUE", matched[2].Item1.Name);
Assert.True(matched[2].Item2.IsNil());
Assert.Equal("THE-REST", matched[3].Item1.Name);
Assert.True(matched[3].Item2.IsNil());
}
public void BindKeywordArguments()
{
// a &key (should-be-fourteen 14) should-be-nil
var argumentCollection = GetArgumentCollection(
LispSymbol.CreateFromString("A"),
new LispLambdaListKeyword("&KEY"),
LispList.FromItems(
LispSymbol.CreateFromString("SHOULD-BE-FOURTEEN"),
new LispInteger(14)),
LispSymbol.CreateFromString("SHOULD-BE-NIL")
);
Assert.Equal(1, argumentCollection.RegularArguments.Count);
Assert.Empty(argumentCollection.OptionalArguments);
Assert.Equal(2, argumentCollection.KeywordArguments.Count);
Assert.Empty(argumentCollection.AuxiliaryArguments);
Assert.Null(argumentCollection.RestArgument);
Assert.Equal("A", argumentCollection.RegularArguments[0].Name);
Assert.Equal(14, ((LispInteger)argumentCollection.KeywordArguments["SHOULD-BE-FOURTEEN"].DefaultValue).Value);
Assert.True(argumentCollection.KeywordArguments["SHOULD-BE-NIL"].DefaultValue.IsNil());
}
public void BindOptionalAndKeywordAndRestArguments()
{
// a &optional should-be-nil &key some-special-value &rest the-rest
var argumentCollection = GetArgumentCollection(
LispSymbol.CreateFromString("A"),
new LispLambdaListKeyword("&OPTIONAL"),
LispSymbol.CreateFromString("SHOULD-BE-NIL"),
new LispLambdaListKeyword("&KEY"),
LispSymbol.CreateFromString("SOME-SPECIAL-VALUE"),
new LispLambdaListKeyword("&REST"),
LispSymbol.CreateFromString("THE-REST")
);
Assert.Equal(1, argumentCollection.RegularArguments.Count);
Assert.Equal(1, argumentCollection.OptionalArguments.Count);
Assert.Equal(1, argumentCollection.KeywordArguments.Count);
Assert.NotNull(argumentCollection.RestArgument);
Assert.Equal("A", argumentCollection.RegularArguments[0].Name);
Assert.Equal("SHOULD-BE-NIL", argumentCollection.OptionalArguments[0].Name);
Assert.True(argumentCollection.KeywordArguments.ContainsKey("SOME-SPECIAL-VALUE"));
Assert.Equal("THE-REST", argumentCollection.RestArgument.Name);
}
public void BindAuxiliaryArguments()
{
// a &aux (two 2) nniill
var argumentCollection = GetArgumentCollection(
LispSymbol.CreateFromString("A"),
new LispLambdaListKeyword("&AUX"),
LispList.FromItems(
LispSymbol.CreateFromString("TWO"),
new LispInteger(2)),
LispSymbol.CreateFromString("NNIILL")
);
Assert.Equal(1, argumentCollection.RegularArguments.Count);
Assert.Empty(argumentCollection.OptionalArguments);
Assert.Empty(argumentCollection.KeywordArguments);
Assert.Equal(2, argumentCollection.AuxiliaryArguments.Count);
Assert.Null(argumentCollection.RestArgument);
Assert.Equal("A", argumentCollection.RegularArguments[0].Name);
Assert.Equal("TWO", argumentCollection.AuxiliaryArguments[0].Name);
Assert.Equal(2, ((LispInteger)argumentCollection.AuxiliaryArguments[0].InitialValue).Value);
Assert.Equal("NNIILL", argumentCollection.AuxiliaryArguments[1].Name);
Assert.True(argumentCollection.AuxiliaryArguments[1].InitialValue.IsNil());
}
public LispObject Untrace(LispHost host, LispExecutionState executionState, LispObject[] args)
{
var untracedList = _repl.Untrace(args);
return(LispList.FromItems(LispSymbol.CreateFromString("COMMON-LISP:QUOTE"), untracedList));
}
internal LispKeywordInvocationArgument(LispSymbol declaration, LispObject defaultValue)
: base(declaration)
{
DefaultValue = defaultValue;
}
public void ExecutionCannotBeHaltedWhenEvaluatingFromWithinANativeMacro()
{
var host = new LispHost();
host.AddMacro("NATIVE-FUNCTION", (host, executionState, args) =>
{
var result = host.EvalAtStackFrame(executionState.StackFrame, LispList.FromEnumerable(new LispObject[] { LispSymbol.CreateFromString("*"), new LispInteger(2), new LispInteger(2) }));
return(result);
});
var hitBreakpoint = false;
host.RootFrame.EvaluatingExpression += (s, e) =>
{
if (!hitBreakpoint &&
e.Expression is LispList list &&
list.ToString() == "(* 2 2)")
{
hitBreakpoint = true;
e.HaltExecution = true; // this should not be honored
}
};
var evalResult = host.Eval("(native-function)");
Assert.True(hitBreakpoint);
Assert.True(evalResult.ExecutionState.IsExecutionComplete);
Assert.Equal(4, ((LispInteger)evalResult.LastResult).Value);
}
protected LispInvocationArgument(LispSymbol declaration)
{
Declaration = declaration;
}
internal LispAuxiliaryInvocationArgument(LispSymbol declaration, LispObject initialValue)
: base(declaration)
{
InitialValue = initialValue;
}
internal LispRestInvocationArgument(LispSymbol declaration)
: base(declaration)
{
}
