Skip to content
Permalink
master
Switch branches/tags
Go to file
 
 
Cannot retrieve contributors at this time
/*
Copyright (c) 2017 OKI Software Co., Ltd.
Copyright (c) 2018 SUZUKI Hisao
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.
*/
// H29.3/1 - H30.6/27 by SUZUKI Hisao
// lisp.exe: csc /doc:lisp.xml /o lisp.cs
// doc: mdoc update -i lisp.xml -o xml lisp.exe; mdoc export-html -o html xml
// [assembly: AssemblyProduct("Nukata Lisp Light")]
// [assembly: AssemblyVersion("1.2.2.*")]
// [assembly: AssemblyTitle("A Lisp interpreter in C# 7")]
// [assembly: AssemblyCopyright("© 2017 Oki Software Co., Ltd.; " +
// "© 2018 SUZUKI Hisao [MIT License]")]
using System;
using System.Collections;
using System.Collections.Generic;
using System.Diagnostics;
using System.IO;
using System.Linq;
using System.Text;
using System.Threading;
using System.Threading.Tasks;
using ServiceStack.IO;
using ServiceStack.Text;
using ServiceStack.Text.Json;
namespace ServiceStack.Script
{
public sealed class ScriptLisp : ScriptLanguage, IConfigureScriptContext
{
private ScriptLisp() {} // force usage of singleton
public static readonly ScriptLanguage Language = new ScriptLisp();
public override string Name => "lisp";
public override string LineComment => ";";
public void Configure(ScriptContext context)
{
Lisp.Init();
context.ScriptMethods.Add(new LispScriptMethods());
context.ScriptBlocks.Add(new DefnScriptBlock());
}
public override List<PageFragment> Parse(ScriptContext context, ReadOnlyMemory<char> body, ReadOnlyMemory<char> modifiers)
{
var quiet = false;
if (!modifiers.IsEmpty)
{
quiet = modifiers.EqualsOrdinal("q") || modifiers.EqualsOrdinal("quiet") || modifiers.EqualsOrdinal("mute");
if (!quiet)
throw new NotSupportedException($"Unknown modifier '{modifiers.ToString()}', expected 'code|q', 'code|quiet' or 'code|mute'");
}
return new List<PageFragment> {
new PageLispStatementFragment(context.ParseLisp(body)) {
Quiet = quiet
}
};
}
public override async Task<bool> WritePageFragmentAsync(ScriptScopeContext scope, PageFragment fragment, CancellationToken token)
{
if (fragment is PageLispStatementFragment blockFragment)
{
if (blockFragment.Quiet && scope.OutputStream != Stream.Null)
scope = scope.ScopeWithStream(Stream.Null);
await WriteStatementAsync(scope, blockFragment.LispStatements, token);
return true;
}
return false;
}
public override async Task<bool> WriteStatementAsync(ScriptScopeContext scope, JsStatement statement, CancellationToken token)
{
var page = scope.PageResult;
if (statement is LispStatements lispStatement)
{
var lispCtx = scope.PageResult.GetLispInterpreter(scope);
page.ResetIterations();
var len = lispStatement.SExpressions.Length;
foreach (var sExpr in lispStatement.SExpressions)
{
var value = lispCtx.Eval(sExpr, null);
if (value != null && value != JsNull.Value && value != StopExecution.Value && value != IgnoreResult.Value)
{
if (value is Lisp.Sym s)
continue;
var strValue = page.Format.EncodeValue(value);
if (!string.IsNullOrEmpty(strValue))
{
var bytes = strValue.ToUtf8Bytes();
await scope.OutputStream.WriteAsync(bytes, token);
}
if (len > 1) // don't emit new lines for single expressions
await scope.OutputStream.WriteAsync(JsTokenUtils.NewLineUtf8, token);
}
}
}
else return false;
return true;
}
}
public class LispStatements : JsStatement
{
public object[] SExpressions { get; }
public LispStatements(object[] sExpressions) => SExpressions = sExpressions;
protected bool Equals(LispStatements other) => Equals(SExpressions, other.SExpressions);
public override bool Equals(object obj)
{
if (ReferenceEquals(null, obj)) return false;
if (ReferenceEquals(this, obj)) return true;
if (obj.GetType() != this.GetType()) return false;
return Equals((LispStatements) obj);
}
public override int GetHashCode() => (SExpressions != null ? SExpressions.GetHashCode() : 0);
}
public class PageLispStatementFragment : PageFragment
{
public LispStatements LispStatements { get; }
public bool Quiet { get; set; }
public PageLispStatementFragment(LispStatements statements) => LispStatements = statements;
protected bool Equals(PageLispStatementFragment other) => Equals(LispStatements, other.LispStatements);
public override bool Equals(object obj)
{
if (ReferenceEquals(null, obj)) return false;
if (ReferenceEquals(this, obj)) return true;
if (obj.GetType() != this.GetType()) return false;
return Equals((PageJsBlockStatementFragment) obj);
}
public override int GetHashCode() => (LispStatements != null ? LispStatements.GetHashCode() : 0);
}
public class LispScriptMethods : ScriptMethods
{
public List<string> symbols(ScriptScopeContext scope)
{
var interp = scope.GetLispInterpreter();
return interp.Globals.Keys.Map(x => x.Name).OrderBy(x => x).ToList();
}
public List<GistLink> gistindex(ScriptScopeContext scope)
{
return Lisp.Interpreter.GetGistIndexLinks(scope);
}
}
/// <summary>
/// Define and export a LISP function to the page
/// Usage: {{#defn calc [a, b] }}
/// (let ( (c (* a b)) )
/// (+ a b c)
/// )
/// {{/defn}}
/// </summary>
public class DefnScriptBlock : ScriptBlock
{
public override string Name => "defn";
public override ScriptLanguage Body => ScriptLanguage.Verbatim;
public override Task WriteAsync(ScriptScopeContext scope, PageBlockFragment block, CancellationToken token)
{
// block.Argument key is unique to exact memory fragment, not string equality
// Parse sExpression once for all Page Results
var sExpr = (List<object>) scope.Context.CacheMemory.GetOrAdd(block.Argument, key => {
var literal = block.Argument.Span.ParseVarName(out var name);
var strName = name.ToString();
var strFragment = (PageStringFragment) block.Body[0];
var lispDefnAndExport =
$@"(defn {block.Argument} {strFragment.Value}) (export {strName} (to-delegate {strName}))";
return Lisp.Parse(lispDefnAndExport);
});
var interp = scope.PageResult.GetLispInterpreter(scope);
interp.Eval(sExpr);
return TypeConstants.EmptyTask;
}
}
/// <summary>Exception in evaluation</summary>
public class LispEvalException: Exception
{
/// <summary>Stack trace of Lisp evaluation</summary>
public List<string> Trace { get; } = new List<string>();
/// <summary>Construct with a base message, cause, and
/// a flag whether to quote strings in the cause.</summary>
public LispEvalException(string msg, object x, bool quoteString=true)
: base(msg + ": " + Lisp.Str(x, quoteString)) {}
/// <summary>Return a string representation which contains
/// the message and the stack trace.</summary>
public override string ToString()
{
var sb = StringBuilderCache.Allocate().Append($"EvalException: {Message}");
foreach (var line in Trace)
sb.Append($"\n\t{line}");
return StringBuilderCache.ReturnAndFree(sb);
}
}
public static class ScriptLispUtils
{
public static Lisp.Interpreter GetLispInterpreter(this ScriptScopeContext scope) =>
scope.PageResult.GetLispInterpreter(scope);
public static Lisp.Interpreter GetLispInterpreter(this PageResult pageResult, ScriptScopeContext scope)
{
if (!pageResult.Args.TryGetValue(nameof(ScriptLisp), out var oInterp))
{
var interp = Lisp.CreateInterpreter();
pageResult.Args[nameof(ScriptLisp)] = interp;
interp.Scope = scope;
return interp;
}
else
{
var interp = (Lisp.Interpreter) oInterp;
interp.Scope = scope;
return interp;
}
}
public static SharpPage LispSharpPage(this ScriptContext context, string lisp)
=> context.Pages.OneTimePage(lisp, context.PageFormats[0].Extension,p => p.ScriptLanguage = ScriptLisp.Language);
private static void AssertLisp(this ScriptContext context)
{
if (!context.ScriptLanguages.Contains(ScriptLisp.Language))
throw new NotSupportedException($"ScriptLisp.Language is not registered in {context.GetType().Name}.{nameof(context.ScriptLanguages)}");
}
private static PageResult GetLispPageResult(ScriptContext context, string lisp, Dictionary<string, object> args)
{
context.AssertLisp();
PageResult pageResult = null;
try
{
var page = context.LispSharpPage(lisp);
pageResult = new PageResult(page);
args.Each((x, y) => pageResult.Args[x] = y);
return pageResult;
}
catch (Exception e)
{
if (ScriptContextUtils.ShouldRethrow(e))
throw;
throw ScriptContextUtils.HandleException(e, pageResult ?? new PageResult(context.EmptyPage));
}
}
public static string RenderLisp(this ScriptContext context, string lisp, Dictionary<string, object> args=null)
{
var pageResult = GetLispPageResult(context, lisp, args);
return pageResult.RenderScript();
}
public static async Task<string> RenderLispAsync(this ScriptContext context, string lisp, Dictionary<string, object> args=null)
{
var pageResult = GetLispPageResult(context, lisp, args);
return await pageResult.RenderScriptAsync();
}
public static LispStatements ParseLisp(this ScriptContext context, string lisp) =>
context.ParseLisp(lisp.AsMemory());
public static LispStatements ParseLisp(this ScriptContext context, ReadOnlyMemory<char> lisp)
{
var sExpressions = Lisp.Parse(lisp);
return new LispStatements(sExpressions.ToArray());
}
public static T EvaluateLisp<T>(this ScriptContext context, string lisp, Dictionary<string, object> args = null) =>
context.EvaluateLisp(lisp, args).ConvertTo<T>();
public static object EvaluateLisp(this ScriptContext context, string lisp, Dictionary<string, object> args=null)
{
var pageResult = GetLispPageResult(context, lisp, args);
if (!pageResult.EvaluateResult(out var returnValue))
throw new NotSupportedException(ScriptContextUtils.ErrorNoReturn);
return ScriptLanguage.UnwrapValue(returnValue);
}
public static async Task<T> EvaluateLispAsync<T>(this ScriptContext context, string lisp, Dictionary<string, object> args = null) =>
(await context.EvaluateLispAsync(lisp, args)).ConvertTo<T>();
public static async Task<object> EvaluateLispAsync(this ScriptContext context, string lisp, Dictionary<string, object> args=null)
{
var pageResult = GetLispPageResult(context, lisp, args);
var ret = await pageResult.EvaluateResultAsync();
if (!ret.Item1)
throw new NotSupportedException(ScriptContextUtils.ErrorNoReturn);
return ScriptLanguage.UnwrapValue(ret.Item2);
}
public static string EnsureReturn(string lisp)
{
// if code doesn't contain a return, wrap and return the expression
if ((lisp ?? throw new ArgumentNullException(nameof(lisp))).IndexOf("(return",StringComparison.Ordinal) == -1)
lisp = "(return (let () " + lisp + " ))";
return lisp;
}
}
internal static class Utils
{
internal static object lispBool(this bool t) => t ? Lisp.TRUE : null;
internal static object fromLisp(this object o) => o == Lisp.TRUE ? true : o;
internal static object lastArg(this object[] a)
{
var last = a[a.Length - 1];
return last is Lisp.Cell lastCell ? lastCell.Car : last;
}
internal static IEnumerable assertEnumerable(this object a)
{
if (a == null)
return TypeConstants.EmptyObjectArray;
if (a is IEnumerable e)
return e;
throw new LispEvalException("not IEnumerable", a);
}
internal static int compareTo(this object a, object b)
{
return a == null || b == null
? (a == b ? 0 : a == null ? -1 : 1)
: DynamicNumber.IsNumber(a.GetType())
? DynamicNumber.CompareTo(a, b)
: a is IComparable c
? (int) c.CompareTo(b)
: throw new LispEvalException("not IComparable", a);
}
public static Lisp.Cell unwrapDataListArgs(this Lisp.Cell arg)
{
if (arg.Car is Lisp.Cell c && c.Car == Lisp.LIST) // allow clojure data list [] for fn args list by unwrapping (list ...) => ...
arg.Car = c.Cdr;
return arg;
}
internal static object unwrapScriptValue(this object o)
{
if (o is Task t)
o = t.GetResult();
if (o is bool b)
return b ? Lisp.TRUE : null;
return ScriptLanguage.UnwrapValue(o);
}
}
/// <summary>
/// A Lisp interpreter written in C# 7
/// </summary><remarks>
/// This is ported from Nuka Lisp in Dart
/// (https://github.com/nukata/lisp-in-dart) except for bignum.
/// It is named after ex-Nukata Town in Japan.
/// </remarks>
public static class Lisp
{
/// <summary>
/// Allow loading of remote scripts
/// - https://example.org/lib.l
/// - gist:{gist-id}
/// - gist:{gist-id}/file.l
/// - index:{name}
/// - index:{name}/file.l
/// </summary>
public static bool AllowLoadingRemoteScripts { get; set; } = true;
/// <summary>
/// Gist where to resolve `index:{name}` references from
/// </summary>
public static string IndexGistId { get; set; } = "3624b0373904cfb2fc7bb3c2cb9dc1a3";
private static Interpreter GlobalInterpreter;
static Lisp()
{
Reset();
}
/// <summary>
/// Reset Global Symbols back to default
/// </summary>
public static void Reset()
{
//Create and cache pre-loaded global symbol table once.
GlobalInterpreter = new Interpreter();
Run(GlobalInterpreter, new Reader(InitScript.AsMemory()));
}
/// <summary>
/// Load Lisp into Global Symbols, a new CreateInterpreter() starts with a copy of global symbols
/// </summary>
public static void Import(string lisp) => Import(lisp.AsMemory());
/// <summary>
/// Load Lisp into Global Symbols, a new CreateInterpreter() starts with a copy of global symbols
/// </summary>
public static void Import(ReadOnlyMemory<char> lisp)
{
Run(GlobalInterpreter, new Reader(lisp));
}
public static void Set(string symbolName, object value)
{
GlobalInterpreter.Globals[Sym.New(symbolName)] = value;
}
public static void Init() {} // Force running static initializers
/// <summary>Create a Lisp interpreter initialized pre-configured with Global Symbols.</summary>
public static Interpreter CreateInterpreter() {
Init();
var interp = new Interpreter(GlobalInterpreter);
return interp;
}
/// <summary>Cons cell</summary>
public sealed class Cell : IEnumerable
{
/// <summary>Head part of the cons cell</summary>
public object Car;
/// <summary>Tail part of the cons cell</summary>
public object Cdr;
/// <summary>Construct a cons cell with its head and tail.</summary>
public Cell(object car, object cdr) {
Car = car;
Cdr = cdr;
}
/// <summary>Make a simple string representation.</summary>
/// <remarks>Do not invoke this for any circular list.</remarks>
public override string ToString() =>
$"({Car ?? "null"} . {Cdr ?? "null"})";
/// <summary>Length as a list</summary>
public int Length => FoldL(0, this, (i, e) => i + 1);
public IEnumerator GetEnumerator()
{
var j = this;
do {
yield return j.Car;
} while ((j = CdrCell(j)) != null);
}
public void Walk(Action<Cell> fn)
{
fn(this);
if (Car is Cell l)
l.Walk(fn);
if (Cdr is Cell r)
r.Walk(fn);
}
}
// MapCar((a b c), fn) => (fn(a) fn(b) fn(c))
static Cell MapCar(Cell j, Func<object, object> fn) {
if (j == null)
return null;
object a = fn(j.Car);
object d = j.Cdr;
if (d is Cell dc)
d = MapCar(dc, fn);
if (j.Car == a && j.Cdr == d)
return j;
return new Cell(a, d);
}
// FoldL(x, (a b c), fn) => fn(fn(fn(x, a), b), c)
static T FoldL<T> (T x, Cell j, Func<T, object, T> fn) {
while (j != null) {
x = fn(x, j.Car);
j = (Cell) j.Cdr;
}
return x;
}
// Supports both Cell + IEnumerable
static T FoldL<T> (T x, IEnumerable j, Func<T, object, T> fn) {
foreach (var e in j)
x = fn(x, e);
return x;
}
/// <summary>Lisp symbol</summary>
public class Sym {
/// <summary>The symbol's name</summary>
public string Name { get; }
/// <summary>Construct a symbol that is not interned.</summary>
public Sym(string name) {
Name = name;
}
/// <summary>Return the symbol's name</summary>
public override string ToString() => Name;
/// <summary>Return the hashcode of the symbol's name</summary>
public override int GetHashCode() => Name.GetHashCode();
/// <summary>Table of interned symbols</summary>
protected static readonly Dictionary<string, Sym> Table =
new Dictionary<string, Sym>();
/// <summary>Return an interned symbol for the name.</summary>
/// <remarks>If the name is not interned yet, such a symbol
/// will be constructed with <paramref name="make"/>.</remarks>
protected static Sym New(string name, Func<string, Sym> make) {
lock (Table) {
if (! Table.TryGetValue(name, out Sym result)) {
result = make(name);
Table[name] = result;
}
return result;
}
}
/// <summary>Construct an interned symbol.</summary>
public static Sym New(string name) => New(name, s => new Sym(s));
/// <summary>Is it interned?</summary>
public bool IsInterned {
get {
lock (Table) {
return Table.TryGetValue(Name, out Sym s) &&
Object.ReferenceEquals(this, s);
}
}
}
}
// Expression keyword
sealed class Keyword: Sym {
Keyword(string name): base(name) {}
internal static new Sym New(string name)
=> New(name, s => new Keyword(s));
}
/// <summary>The symbol of <c>t</c></summary>
public static readonly Sym TRUE = Sym.New("t");
public static readonly Sym BOOL_TRUE = Sym.New("true");
public static readonly Sym BOOL_FALSE = Sym.New("false");
static readonly Sym VERBOSE = Sym.New("verbose");
static readonly Sym COND = Keyword.New("cond");
static readonly Sym LAMBDA = Keyword.New("lambda");
static readonly Sym FN = Keyword.New("fn");
static readonly Sym MACRO = Keyword.New("macro");
static readonly Sym PROGN = Keyword.New("progn");
static readonly Sym QUASIQUOTE = Keyword.New("quasiquote");
static readonly Sym QUOTE = Keyword.New("quote");
static readonly Sym SETQ = Keyword.New("setq");
static readonly Sym EXPORT = Keyword.New("export");
static readonly Sym BOUND = Sym.New("bound?");
static readonly Sym BACK_QUOTE = Sym.New("`");
static readonly Sym COMMAND_AT = Sym.New(",@");
static readonly Sym COMMA = Sym.New(",");
static readonly Sym DOT = Sym.New(".");
static readonly Sym LEFT_PAREN = Sym.New("(");
static readonly Sym RIGHT_PAREN = Sym.New(")");
static readonly Sym SINGLE_QUOTE = Sym.New("'");
static readonly Sym APPEND = Sym.New("append");
static readonly Sym CONS = Sym.New("cons");
internal static readonly Sym LIST = Sym.New("list");
static readonly Sym REST = Sym.New("&rest");
static readonly Sym UNQUOTE = Sym.New("unquote");
static readonly Sym UNQUOTE_SPLICING = Sym.New("unquote-splicing");
static readonly Sym LEFT_BRACE = Sym.New("{");
static readonly Sym RIGHT_BRACE = Sym.New("}");
static readonly Sym HASH = Sym.New("#");
static readonly Sym PERCENT = Sym.New("%");
static readonly Sym NEWMAP = Sym.New("new-map");
static readonly Sym ARG = Sym.New("_a");
static readonly Sym LEFT_BRACKET = Sym.New("[");
static readonly Sym RIGHT_BRACKET = Sym.New("]");
//------------------------------------------------------------------
// Get cdr of list x as a Cell or null.
static Cell CdrCell(Cell x) {
var k = x.Cdr;
if (k == null) {
return null;
} else {
if (k is Cell c)
return c;
else
throw new LispEvalException("proper list expected", x);
}
}
/// <summary>Common base class of Lisp functions</summary>
public abstract class LispFunc {
/// <summary>Number of arguments, made negative if the function
/// has &amp;rest</summary>
public int Carity { get; }
int Arity => (Carity < 0) ? -Carity : Carity;
bool HasRest => (Carity < 0);
// Number of fixed arguments
int FixedArgs => (Carity < 0) ? -Carity - 1 : Carity;
/// <summary>Construct with Carity.</summary>
protected LispFunc(int carity) {
Carity = carity;
}
/// <summary>Make a frame for local variables from a list of
/// actual arguments.</summary>
public object[] MakeFrame(Cell arg) {
var frame = new object[Arity];
int n = FixedArgs;
int i;
for (i = 0; i < n && arg != null; i++) {
// Set the list of fixed arguments.
frame[i] = arg.Car;
arg = CdrCell(arg);
}
if (i != n || (arg != null && !HasRest))
throw new LispEvalException("arity not matched", this);
if (HasRest)
frame[n] = arg;
return frame;
}
/// <summary>Evaluate each expression in a frame.</summary>
public void EvalFrame(object[] frame, Interpreter interp, Cell env) {
int n = FixedArgs;
for (int i = 0; i < n; i++)
frame[i] = interp.Eval(frame[i], env);
if (HasRest) {
if (frame[n] is Cell j) {
Cell z = null;
Cell y = null;
do {
var e = interp.Eval(j.Car, env);
Cell x = new Cell(e, null);
if (z == null)
z = x;
else
y.Cdr = x;
y = x;
j = CdrCell(j);
} while (j != null);
frame[n] = z;
}
}
}
}
// Common base class of functions which are defined with Lisp expressions
abstract class DefinedFunc: LispFunc {
// Lisp list as the function body
public readonly Cell Body;
protected DefinedFunc(int carity, Cell body): base(carity) {
Body = body;
}
}
// Common function type which represents any factory method of DefinedFunc
delegate DefinedFunc FuncFactory(int carity, Cell body, Cell env);
// Compiled macro expression
sealed class Macro: DefinedFunc {
Macro(int carity, Cell body): base(carity, body) {}
public override string ToString() => $"#<macro:{Carity}:{Str(Body)}>";
// Expand the macro with a list of actual arguments.
public object ExpandWith(Interpreter interp, Cell arg) {
object[] frame = MakeFrame(arg);
Cell env = new Cell(frame, null);
object x = null;
for (Cell j = Body; j != null; j = CdrCell(j))
x = interp.Eval(j.Car, env);
return x;
}
public static DefinedFunc Make(int carity, Cell body, Cell env) {
Debug.Assert(env == null);
return new Macro(carity, body);
}
}
// Compiled lambda expression (Within another function)
sealed class Lambda: DefinedFunc {
Lambda(int carity, Cell body): base(carity, body) {}
public override string ToString() => $"#<lambda:{Carity}:{Str(Body)}>";
public static DefinedFunc Make(int carity, Cell body, Cell env) {
Debug.Assert(env == null);
return new Lambda(carity, body);
}
}
// Compiled lambda expression (Closure with environment)
sealed class Closure: DefinedFunc {
// The environment of the closure
public readonly Cell Env;
Closure(int carity, Cell body, Cell env): base(carity, body) {
Env = env;
}
public Closure(Lambda x, Cell env): this(x.Carity, x.Body, env) {}
public override string ToString() =>
$"#<closure:{Carity}:{Str(Env)}:{Str(Body)}>";
// Make an environment to evaluate the body from a list of actual args.
public Cell MakeEnv(Interpreter interp, Cell arg, Cell interpEnv) {
object[] frame = MakeFrame(arg);
EvalFrame(frame, interp, interpEnv);
return new Cell(frame, Env); // Prepend the frame to this Env.
}
public static DefinedFunc Make(int carity, Cell body, Cell env) =>
new Closure(carity, body, env);
}
/// <summary>Function type which represents any built-in function body
/// </summary>
public delegate object BuiltInFuncBody(Interpreter interp, object[] frame);
/// <summary>Built-in function</summary>
public sealed class BuiltInFunc: LispFunc {
/// <summary>Name of this function</summary>
public string Name { get; }
/// <summary>C# function as the body of this function</summary>
public BuiltInFuncBody Body { get; }
/// <summary>Construct with Name, Carity and Body.</summary>
public BuiltInFunc(string name, int carity, BuiltInFuncBody body)
: base(carity) {
Name = name;
Body = body;
}
/// <summary>Return a string representation in Lisp.</summary>
public override string ToString() => $"#<{Name}:{Carity}>";
/// <summary>Invoke the built-in function with a list of
/// actual arguments.</summary>
public object EvalWith(Interpreter interp, Cell arg, Cell interpEnv) {
object[] frame = MakeFrame(arg);
EvalFrame(frame, interp, interpEnv);
try {
return Body(interp, frame);
} catch (LispEvalException) {
throw;
} catch (Exception ex) {
throw new LispEvalException($"{ex} -- {Name}", frame);
}
}
}
// Bound variable in a compiled lambda/macro expression
sealed class Arg {
public readonly int Level;
public readonly int Offset;
public readonly Sym Symbol;
public Arg(int level, int offset, Sym symbol) {
Level = level;
Offset = offset;
Symbol = symbol;
}
public override string ToString() => $"#{Level}:{Offset}:{Symbol}";
// Set a value x to the location corresponding to the variable in env.
public void SetValue(object x, Cell env) {
for (int i = 0; i < Level; i++)
env = (Cell) env.Cdr;
object[] frame = (object[]) env.Car;
frame[Offset] = x;
}
// Get a value from the location corresponding to the variable in env.
public object GetValue(Cell env) {
for (int i = 0; i < Level; i++)
env = (Cell) env.Cdr;
object[] frame = (object[]) env.Car;
if (frame == null || Offset >= frame.Length)
throw new IndexOutOfRangeException();
return frame[Offset];
}
}
// Exception which indicates on absence of a variable
sealed class NotVariableException: LispEvalException {
public NotVariableException(object x): base("variable expected", x) {}
}
//------------------------------------------------------------------
public static Cell ToCons(IEnumerable seq)
{
if (!(seq is IEnumerable e))
return null;
Cell j = null;
foreach (var item in e.Cast<object>().Reverse())
{
j = new Cell(item, j);
}
return j;
}
static bool isTrue(object test) => test != null && !(test is bool b && !b);
/// <summary>Core of the Lisp interpreter</summary>
public class Interpreter
{
private static int totalEvaluations = 0;
public static int TotalEvaluations => Interlocked.CompareExchange(ref totalEvaluations, 0, 0);
public int Evaluations { get; set; }
/// <summary>Table of the global values of symbols</summary>
internal readonly Dictionary<Sym, object> Globals = new Dictionary<Sym, object>();
public object GetSymbolValue(string name) => Globals.TryGetValue(Sym.New(name), out var value)
? value.fromLisp()
: null;
public void SetSymbolValue(string name, object value) => Globals[Sym.New(name)] = value.unwrapScriptValue();
/// <summary>Standard out</summary>
public TextWriter COut { get; set; } = Console.Out;
/// <summary>Set each built-in function/variable as the global value
/// of symbol.</summary>
public Interpreter() {
InitGlobals();
}
public Interpreter(Interpreter globalInterp)
{
Globals = new Dictionary<Sym, object>(globalInterp.Globals); // copy existing globals
}
public string ReplEval(ScriptContext context, Stream outputStream, string lisp, Dictionary<string, object> args=null)
{
var returnResult = ScriptLispUtils.EnsureReturn(lisp);
var page = new PageResult(context.LispSharpPage(returnResult)) {
Args = {
[nameof(ScriptLisp)] = this
}
};
args?.Each(x => page.Args[x.Key] = x.Value);
this.Scope = new ScriptScopeContext(page, outputStream, args);
var output = page.RenderScript();
if (page.ReturnValue != null)
{
var ret = ScriptLanguage.UnwrapValue(page.ReturnValue.Result);
if (ret == null)
return output;
if (ret is Cell c)
return Str(c);
if (ret is Sym sym)
return Str(sym);
if (ret is string s)
return s;
if (Globals.TryGetValue(VERBOSE, out var verbose) && isTrue(verbose))
return ret.Dump();
return ret.ToSafeJsv();
}
return output;
}
Func<object, object> resolve1ArgFn(object f, Interpreter interp)
{
switch (f) {
case Closure fnclosure:
return x => interp.invoke(fnclosure, x);
case Macro fnmacro:
return x => interp.invoke(fnmacro, x);
case BuiltInFunc fnbulitin:
return x => interp.invoke(fnbulitin, x);
case Delegate fndel:
return x => interp.invoke(fndel, x);
default:
throw new LispEvalException("not applicable", f);
}
}
Func<object, object, object> resolve2ArgFn(object f, Interpreter interp)
{
switch (f) {
case Closure fnclosure:
return (x,y) => interp.invoke(fnclosure, x,y);
case Macro fnmacro:
return (x,y) => interp.invoke(fnmacro, x, y);
case BuiltInFunc fnbulitin:
return (x,y) => interp.invoke(fnbulitin, x, y);
case Delegate fndel:
return (x,y) => interp.invoke(fndel, x, y);
default:
throw new LispEvalException("not applicable", f);
}
}
Func<object, bool> resolvePredicate(object f, Interpreter interp)
{
var fn = resolve1ArgFn(f, interp);
return x => isTrue(fn(x));
}
object invoke(Closure fnclosure, params object[] args)
{
var env = fnclosure.MakeEnv(this, ToCons(args), null);
var ret = EvalProgN(fnclosure.Body, env);
ret = Eval(ret, env);
return ret;
}
object invoke(Macro fnmacro, params object[] args)
{
var ret = fnmacro.ExpandWith(this, ToCons(args));
ret = Eval(ret, null);
return ret;
}
object invoke(BuiltInFunc fnbulitin, params object[] args) => fnbulitin.Body(this, args);
object invoke(Delegate fndel, params object[] args)
{
var scriptMethodArgs = new List<object>(EvalArgs(ToCons(args), this));
var ret = JsCallExpression.InvokeDelegate(fndel, null, isMemberExpr: false, scriptMethodArgs);
return ret.unwrapScriptValue();
}
List<object> toList(IEnumerable seq) => seq == null
? new List<object>()
: seq.Cast<object>().ToList();
class ObjectComparer : IComparer<object>
{
private readonly IComparer comparer;
public ObjectComparer(IComparer comparer) => this.comparer = comparer;
public int Compare(object x, object y) => comparer.Compare(x, y);
public static IComparer<object> GetComparer(object x, Interpreter I)
{
if (x is IComparer<object> objComparer)
return objComparer;
if (x is IComparer comparer)
return new ObjectComparer(comparer);
if (x is Func<object, object, int> fnCompareTo)
return new FnComparer(fnCompareTo);
if (x is Func<object, object, bool> fnEquals)
return new FnComparer(fnEquals);
if (x is Closure fnclosure)
return new FnComparer(I, fnclosure);
if (x is Macro fnmacro)
return new FnComparer(I, fnmacro);
if (x is Delegate fndel)
return new FnComparer(fndel);
throw new LispEvalException("Not a IComparer", x);
}
public static IEqualityComparer<object> GetEqualityComparer(object x, Interpreter I)
{
if (x is IEqualityComparer<object> objComparer)
return objComparer;
if (x is Func<object, object, bool> fnEquals)
return new FnComparer(fnEquals);
return (IEqualityComparer<object>) GetComparer(x, I);
}
}
class FnComparer : IComparer, IComparer<object>, IEqualityComparer<object>
{
private Interpreter I;
private readonly Closure fnclosure;
private readonly Macro fnmacro;
private readonly Delegate fndel;
private readonly Func<object, object, int> fnCompareTo;
private readonly Func<object, object, bool> fnCompareEquals;
public FnComparer(Interpreter i) => I = i;
public FnComparer(Interpreter I, Closure fnclosure) : this(I) => this.fnclosure = fnclosure;
public FnComparer(Interpreter I, Macro fnmacro) : this(I) => this.fnmacro = fnmacro;
public FnComparer(Func<object, object, int> fn) => this.fnCompareTo = fn;
public FnComparer(Func<object, object, bool> fnCompareEquals) => this.fnCompareEquals = fnCompareEquals;
public FnComparer(Delegate fndel) => this.fndel = fndel;
public int Compare(object x, object y) =>
fnclosure != null
? DynamicInt.Instance.Convert(I.invoke(fnclosure, x, y))
: fnmacro != null
? DynamicInt.Instance.Convert(I.invoke(fnclosure, x, y))
: fnCompareTo != null
? fnCompareTo(x, y)
: DynamicInt.Instance.Convert(I.invoke(fndel, x, y));
public new bool Equals(object x, object y) =>
fnclosure != null
? I.invoke(fnclosure, x, y).ConvertTo<bool>()
: fnmacro != null
? I.invoke(fnclosure, x, y).ConvertTo<bool>()
: fnCompareEquals != null
? fnCompareEquals(x, y)
: I.invoke(fndel, x, y).ConvertTo<bool>();
public int GetHashCode(object obj) => obj.GetHashCode();
}
static ReadOnlyMemory<char> DownloadCachedUrl(ScriptScopeContext scope, string url, string cachePrefix, bool force=false)
{
var cachedContents = GetCachedContents(scope, url, cachePrefix, out var vfsCache, out var cachedPath);
if (!force && cachedContents != null)
return cachedContents.Value;
var text = url.GetStringFromUrl(requestFilter: req => req.With(c => c.UserAgent = "Script" + nameof(Lisp)));
WriteCacheFile(scope, vfsCache, cachedPath, text.AsMemory());
return text.AsMemory();
}
/// <summary>
/// Cache final output from load reference
/// </summary>
private static ReadOnlyMemory<char> WriteCacheFile(ScriptScopeContext scope, IVirtualPathProvider vfsCache, string cachedPath, ReadOnlyMemory<char> text)
{
if (vfsCache is IVirtualFiles vfsWrite)
{
try
{
vfsWrite.WriteFile(cachedPath, text);
}
catch (Exception e)
{
scope.Context.Log.Error($"Could not write cached file '{cachedPath}'", e);
}
}
return text;
}
private static ReadOnlyMemory<char>? GetCachedContents(ScriptScopeContext scope, string url, string cachePrefix, out IVirtualPathProvider vfsCache, out string cachedPath)
{
vfsCache = scope.Context.CacheFiles ?? scope.Context.VirtualFiles;
var fileName = VirtualPathUtils.SafeFileName(url);
cachedPath = $".lisp/{cachePrefix}{fileName}";
var cachedFile = vfsCache.GetFile(cachedPath);
return cachedFile?.GetTextContentsAsMemory();
}
private static GithubGist DownloadCachedGist(ScriptScopeContext scope, string gistId, bool force=false)
{
var gistUrl = GitHubGateway.ApiBaseUrl.CombineWith($"gists/{gistId}");
var gistJson = DownloadCachedUrl(scope, gistUrl, "gist_", force);
var gist = JsonSerializer.DeserializeFromSpan<GithubGist>(gistJson.Span);
return gist;
}
private static string GetGistContents(ScriptScopeContext scope, GistFile gistFile) => IsTruncated(gistFile)
? DownloadCachedUrl(scope, gistFile.Raw_Url, "gist_file_").ToString()
: gistFile.Content;
/// <summary>
/// Load examples:
/// - file.l
/// - virtual/path/file.l
/// - index:lib-calc
/// - index:lib-calc/lib1.l
/// - gist:{gist-id}
/// - gist:{gist-id}/single-file.l
/// - https://mydomain.org/file.l
/// </summary>
static ReadOnlyMemory<char> lispContents(ScriptScopeContext scope, string path)
{
var isUrl = path.IndexOf("://", StringComparison.Ordinal) >= 0;
if (path.StartsWith("index:") || path.StartsWith("gist:") || isUrl)
{
if (!AllowLoadingRemoteScripts)
throw new NotSupportedException($"Lisp.AllowLoadingRemoteScripts has been disabled");
scope.Context.AssertProtectedMethods();
if (isUrl)
{
if (!path.StartsWith("https://"))
throw new NotSupportedException("https:// is required for loading remote scripts");
var textContents = DownloadCachedUrl(scope, path, "url_");
return textContents;
}
if (path.StartsWith("gist:"))
{
var cachedContents = GetCachedContents(scope, path, "gist_", out var vfsCache, out var cachedPath);
if (cachedContents != null)
return cachedContents.Value;
var gistId = path.RightPart(':');
var specificFile = gistId.IndexOf('/') >= 0
? gistId.RightPart('/')
: null;
gistId = gistId.LeftPart('/');
var gist = DownloadCachedGist(scope, gistId);
if (specificFile != null)
{
if (!gist.Files.TryGetValue(specificFile, out var gistFile))
throw new NotSupportedException($"File '{specificFile}' does not exist in gist '{gistId}'");
var contents = GetGistContents(scope, gistFile);
return WriteCacheFile(scope, vfsCache, cachedPath, contents.AsMemory());
}
var sb = StringBuilderCache.Allocate();
foreach (var entry in gist.Files)
{
var contents = GetGistContents(scope, entry.Value);
sb.AppendLine(contents);
}
return WriteCacheFile(scope, vfsCache, cachedPath, StringBuilderCache.ReturnAndFree(sb).AsMemory());
}
if (path.StartsWith("index:"))
{
var cachedContents = GetCachedContents(scope, path, "index_", out var vfsCache, out var cachedPath);
if (cachedContents != null)
return cachedContents.Value;
if (IndexGistId == null)
throw new NotSupportedException("IndexGistId is unspecified");
var indexName = path.RightPart(':');
indexName = path.RightPart(':');
var specificFile = indexName.IndexOf('/') >= 0
? indexName.RightPart('/')
: null;
indexName = indexName.LeftPart('/');
var indexLinks = GetGistIndexLinks(scope);
var indexLink = indexLinks.FirstOrDefault(x => x.Name == indexName);
// If can't find named link index.md could be stale, re-download and cache
if (indexLink == null)
{
indexLinks = GetGistIndexLinks(scope, force: true);
indexLink = indexLinks.FirstOrDefault(x => x.Name == indexName);
if (indexLink == null)
throw new NotSupportedException($"Could not resolve '{indexName}' from Gist Index '{IndexGistId}'");
}
if (!indexLink.Url.StartsWith("https://gist.github.com/"))
throw new NotSupportedException($"{indexName} '{indexLink.Url}' is not a Gist URL");
var gistId = indexLink.Url.LastRightPart('/');
var gist = DownloadCachedGist(scope, gistId);
if (specificFile != null)
{
if (!gist.Files.TryGetValue(specificFile, out var gistFile))
throw new NotSupportedException($"File '{specificFile}' does not exist in gist '{gistId}'");
var contents = GetGistContents(scope, gistFile);
return WriteCacheFile(scope, vfsCache, cachedPath, contents.AsMemory());
}
var sb = StringBuilderCache.Allocate();
foreach (var entry in gist.Files)
{
var contents = GetGistContents(scope, entry.Value);
sb.AppendLine(contents);
}
return WriteCacheFile(scope, vfsCache, cachedPath, StringBuilderCache.ReturnAndFree(sb).AsMemory());
}
}
var file = scope.Context.VirtualFiles.GetFile(path);
if (file == null)
throw new NotSupportedException($"File does not exist '{path}'");
var lisp = file.GetTextContentsAsMemory();
return lisp;
}
internal static List<GistLink> GetGistIndexLinks(ScriptScopeContext scope, bool force=false)
{
var gistIndex = DownloadCachedGist(scope, IndexGistId, force);
if (!gistIndex.Files.TryGetValue("index.md", out var indexGistFile))
throw new NotSupportedException($"IndexGistId '{IndexGistId}' does not contain index.md");
var indexGistContents = GetGistContents(scope, indexGistFile);
var indexLinks = GistLink.Parse(indexGistContents);
return indexLinks;
}
private static bool IsTruncated(GistFile f) => (string.IsNullOrEmpty(f.Content) || f.Content.Length < f.Size) && f.Truncated;
private static long gensymCounter = 0;
public void InitGlobals()
{
Globals[TRUE] = Globals[BOOL_TRUE] = TRUE;
Globals[BOOL_FALSE] = null;
Def("load", 1, (I, a) => {
var scope = I.AssertScope();
var path = a[0] is string s
? s
: a[0] is Sym sym
? sym.Name + ".l"
: throw new LispEvalException("not a string or symbol name", a[0]);
var cacheKey = nameof(Lisp) + ":load:" + path;
var importSymbols = (Dictionary<Sym, object>) scope.Context.Cache.GetOrAdd(cacheKey, k => {
var span = lispContents(scope, path);
var interp = new Interpreter(I); // start from copy of these symbols
Run(interp, new Reader(span));
var globals = GlobalInterpreter.Globals; // only cache + import new symbols not in Global Interpreter
var newSymbols = new Dictionary<Sym, object>();
foreach (var entry in interp.Globals)
{
if (!globals.ContainsKey(entry.Key))
newSymbols[entry.Key] = entry.Value;
}
return newSymbols;
});
foreach (var importSymbol in importSymbols)
{
I.Globals[importSymbol.Key] = importSymbol.Value;
}
return null;
});
Def("load-src", 1, (I, a) => {
var scope = I.AssertScope();
var path = a[0] is string s
? s
: a[0] is Sym sym
? sym.Name + ".l"
: throw new LispEvalException("not a string or symbol name", a[0]);
var span = lispContents(scope, path);
return span.ToString();
});
Def("error", 1, a => throw new Exception(((string)a[0])));
Def("not", 1, a => a[0] == null || a[0] is false);
Def("return", 1, (I, a) => {
var scope = I.AssertScope();
var ret = a == null
? null
: a[0] is Cell c
? EvalArgs(c, I)
: a[0];
scope.ReturnValue(ret.fromLisp());
return null;
});
Def("F", -1, (I, a) => {
var scope = I.AssertScope();
var args = EvalArgs(a[0] as Cell, I);
if (!(args[0] is string fnName))
throw new LispEvalException($"F requires a string Function Reference", args[0]);
var fnArgs = new List<object>();
for (var i=1; i<args.Length; i++)
fnArgs.Add(args[i]);
var fn = scope.Context.AssertProtectedMethods().F(fnName, fnArgs);
var ret = JsCallExpression.InvokeDelegate(fn, null, isMemberExpr: false, fnArgs);
return ret.unwrapScriptValue();
});
Def("C", -1, (I, a) => {
var scope = I.AssertScope();
var args = EvalArgs(a[0] as Cell, I);
if (!(args[0] is string fnName))
throw new LispEvalException($"C requires a string Constructor Reference", args[0]);
var fn = scope.Context.AssertProtectedMethods().C(fnName);
var fnArgs = new List<object>();
for (var i=1; i<args.Length; i++)
fnArgs.Add(args[i]);
var ret = JsCallExpression.InvokeDelegate(fn, null, isMemberExpr: false, fnArgs);
return ret;
});
Def("new", -1, (I, a) => {
var scope = I.AssertScope();
var args = EvalArgs(a[0] as Cell, I);
var fnArgs = new List<object>();
for (var i=1; i<args.Length; i++)
fnArgs.Add(args[i]);
if (args[0] is string typeName)
{
var ret = scope.Context.AssertProtectedMethods().@new(typeName, fnArgs);
return ret;
}
if (args[0] is Type type)
{
var ret = scope.Context.AssertProtectedMethods().createInstance(type, fnArgs);
return ret;
}
throw new LispEvalException("new requires Type Name or Type", a[0]);
});
Def("to-delegate", 1, (I, a) => {
var f = a[0];
switch (f) {
case Closure fnclosure:
return (StaticMethodInvoker)(p => I.invoke(fnclosure, p));
case Macro fnmacro:
return (StaticMethodInvoker)(p => I.invoke(fnmacro, p));
case BuiltInFunc fnbulitin:
return (StaticMethodInvoker)(p => I.invoke(fnbulitin, p));
case Delegate fndel:
return (StaticMethodInvoker)(p => I.invoke(fndel, p));
default:
throw new LispEvalException("not applicable", f);
}
});
Def("to-cons", 1, a => a[0] == null ? null : a[0] is IEnumerable e ? ToCons(e)
: throw new LispEvalException("not IEnumerable", a[0]));
Def("to-array", 1, a => toList(a[0] as IEnumerable).ToArray());
Def("to-list", 1, a => toList(a[0] as IEnumerable));
Def("to-dictionary", 2, (I, a) => EnumerableUtils.ToList(a[1].assertEnumerable()).ToDictionary(resolve1ArgFn(a[0], I)));
Def("new-map", -1, (I, a) => EvalMapArgs(a[0] as Cell, I));
// can use (:key x) as indexer instead, e.g. (:i array) (:"key" map) (:Prop obj) or (.Prop obj)
Def("nth", 2, a => {
if (a[0] == null)
return null;
if (!(a[1] is int i))
throw new LispEvalException("not integer", a[1]);
if (a[0] is IList c)
return c[i];
return a[0].assertEnumerable().Cast<object>().ElementAt(i);
});
Def("first", 1, a => EnumerableUtils.FirstOrDefault(a[0].assertEnumerable()));
Def("second", 1, a => EnumerableUtils.ElementAt(a[0].assertEnumerable(), 1));
Def("third", 1, a => EnumerableUtils.ElementAt(a[0].assertEnumerable(), 2));
Def("rest", 1, body: a => a[0] is Cell c ? c.Cdr : EnumerableUtils.NullIfEmpty(EnumerableUtils.Skip(a[0].assertEnumerable(), 1)));
Def("skip", 2, a => EnumerableUtils.Skip(a[1].assertEnumerable(), DynamicInt.Instance.Convert(a[0])));
Def("take", 2, a => EnumerableUtils.Take(a[1].assertEnumerable(), DynamicInt.Instance.Convert(a[0])));
Def("enumerator", 1, a => a[0] == null ? TypeConstants.EmptyObjectArray.GetEnumerator() : a[0].assertEnumerable().GetEnumerator());
Def("enumeratorNext", 1, a => {
if (!(a[0] is IEnumerator e))
throw new LispEvalException("not IEnumerator", a[0]);
return e.MoveNext().lispBool();
});
Def("enumeratorCurrent", 1, a => {
if (!(a[0] is IEnumerator e))
throw new LispEvalException("not IEnumerator", a[0]);
return e.Current;
});
Def("dispose", 1, a => {
using (a[0] as IDisposable) {}
return null;
});
Def("map", 2, (I, a) => a[1]?.assertEnumerable().Map(resolve1ArgFn(a[0], I)));
Def("map-where", 3, (I, a) => EnumerableUtils.ToList(a[2]?.assertEnumerable()).Where(resolvePredicate(a[0], I)).Map(resolve1ArgFn(a[1], I)));
Def("where", 2, (I, a) => EnumerableUtils.ToList(a[1]?.assertEnumerable()).Where(resolvePredicate(a[0], I)).ToList());
Def("dorun", 2, (I, a) => {
var converter = resolve1ArgFn(a[0], I);
foreach (var x in a[1]?.assertEnumerable())
{
converter(x);
}
return null;
});
Def("do", -1, (I, a) => enumerableArg(a).Cast<object>().Last());
Def("reduce", -2, (I, a) => {
var fn = resolve2ArgFn(a[0], I);
var varArgs = EnumerableUtils.ToList(a[1].assertEnumerable());
if (varArgs.Count == 1) // (reduce fn L)
{
var list = EnumerableUtils.ToList(varArgs[0].assertEnumerable());
return list.Aggregate(fn);
}
else // (reduce fn L seed)
{
var list = EnumerableUtils.ToList(varArgs[0].assertEnumerable());
var seed = varArgs[1];
return list.Aggregate(seed, fn);
}
});
Def("flatten", -1, (I,a) => I.AssertScope().Context.DefaultMethods.flatten(a[0] as IEnumerable ?? a));
Def("sort", 1, (I, a) => {
var arr = a[0].assertEnumerable().Cast<object>().ToArray();
Array.Sort(arr, (x,y) => x.compareTo(y));
return arr;
});
Def("sort-by", -2, (I, a) => {
var keyFn = resolve1ArgFn(a[0], I);
var varArgs = EnumerableUtils.ToList(a[1].assertEnumerable());
if (varArgs.Count == 1) // (sort-by keyfn list)
{
var list = EnumerableUtils.ToList(varArgs[0].assertEnumerable()).ToArray();
Array.Sort(list, (x,y) => keyFn(x).compareTo(keyFn(y)));
return list;
}
else // (sort-by keyfn comparer list)
{
if (!(varArgs[0] is IComparer comparer))
throw new LispEvalException("not IComparable", varArgs[1]);
var results = EnumerableUtils.ToList(varArgs[1].assertEnumerable()).OrderBy(keyFn, new ObjectComparer(comparer));
return results;
}
});
Def("order-by", 2, (I, a) => {
var keyFns = EnumerableUtils.ToList(a[0].assertEnumerable());
var list = a[1].assertEnumerable().Cast<object>();
if (keyFns.Count == 0)
return list;
IOrderedEnumerable<object> seq = null;
for (var i = 0; i < keyFns.Count; i++)
{
var keyFn = keyFns[i];
if (keyFn is Dictionary<string, object> obj)
{
var fn = obj.TryGetValue("key", out var oKey)
? resolve1ArgFn(oKey, I)
: x => x;
var comparer = obj.TryGetValue("comparer", out var oComparer)
? ObjectComparer.GetComparer(oComparer, I)
: Comparer<object>.Default;
var desc = obj.TryGetValue("desc", out var oDesc)
&& oDesc != null && (oDesc == TRUE || (bool) oDesc);
if (seq == null)
seq = desc
? list.OrderByDescending(fn, comparer)
: list.OrderBy(fn, comparer);
else
seq = desc
? seq.ThenByDescending(fn, comparer)
: seq.ThenBy(fn, comparer);
}
else
{
var fn = resolve1ArgFn(keyFn, I);
if (seq == null)
seq = list.OrderBy(fn);
else
seq = seq.ThenBy(fn);
}
}
return EnumerableUtils.ToList(seq);
});
Def("group-by", -2, (I, a) => {
var keyFn = resolve1ArgFn(a[0], I);
var varArgs = EnumerableUtils.ToList(a[1].assertEnumerable());
if (varArgs.Count == 1) // (group-by #(mod % 5) numbers)
{
var list = EnumerableUtils.ToList(varArgs[0].assertEnumerable());
var ret = list.GroupBy(keyFn);
return ret;
}
if (varArgs.Count == 2 && varArgs[0] is Dictionary<string, object> obj)
{
var mapFn = obj.TryGetValue("map", out var oKey)
? resolve1ArgFn(oKey, I)
: x => x;
var comparer = obj.TryGetValue("comparer", out var oComparer)
? ObjectComparer.GetEqualityComparer(oComparer, I)
: EqualityComparer<object>.Default;
var list = EnumerableUtils.ToList(varArgs[1].assertEnumerable());
var ret = list.GroupBy(
keyFn,
mapFn,
comparer);
return ret;
}
throw new LispEvalException("syntax: (group-by keyFn list) (group-by keyFn { :map mapFn :comparer comparer } list)", varArgs.Last());
});
Def("sum", 1, a => {
object acc = 0;
foreach (var num in a[0].assertEnumerable())
acc = DynamicNumber.Add(acc, num);
return acc;
});
Def("str", -1, a => {
var sb = StringBuilderCache.Allocate();
var c = (Cell) a[0];
foreach (var x in c)
{
sb.Append(Str(x, false));
}
return StringBuilderCache.ReturnAndFree(sb);
});
Def("car", 1, a => (a[0] as Cell)?.Car);
Def("cdr", 1, a => (a[0] as Cell)?.Cdr);
Def("cons", 2, a => new Cell(a[0], a[1]));
Def("atom", 1, a => (a[0] is Cell) ? null : TRUE);
Def("eq", 2, a => (a[0] == a[1]) ? TRUE : null);
Def("seq?", 1, a => a[0] is IEnumerable e ? TRUE : null);
Def("consp", 1, a => a[0] is Cell c ? TRUE : null);
Def("endp", 1, a => (a[0] is Cell c)
? (c.Car == null ? TRUE : null)
: a[0] == null
? TRUE
: EnumerableUtils.FirstOrDefault(a[0].assertEnumerable()) == null ? TRUE : null);
Def("list", -1, a => a[0]);
Def("rplaca", 2, a => { ((Cell) a[0]).Car = a[1]; return a[1]; });
Def("rplacd", 2, a => { ((Cell) a[0]).Cdr = a[1]; return a[1]; });
Def("length", 1, a => {
if (a[0] == null)
return 0;
return DefaultScripts.Instance.length(a[0]);
});
Def("string", 1, a => $"{a[0]}");
Def("string-downcase", 1, a =>
(a[0] is string s) ? s.ToLower() : a[0] != null ? throw new Exception("not a string") : "");
Def("string-upcase", 1, a => (a[0] is string s) ? s.ToUpper() : a[0] != null ? throw new LispEvalException("not a string", a[0]) : "");
Def("string?", 1, a => a[0] is string ? TRUE : null);
Def("number?", 1, a => DynamicNumber.IsNumber(a[0]?.GetType()) ? TRUE : null);
Def("instance?", 2, (I, a) => I.AssertScope().Context.DefaultMethods.instanceOf(a[1], a[0] is Sym s ? s.Name : a[0]) ? TRUE : null);
Def("eql", 2, a => a[0] == null
? a[1] == null
? TRUE : null
: a[0].Equals(a[1])
? TRUE : null);
Def("<", 2, a => a[0].compareTo(a[1]) < 0 ? TRUE : null);
Def("%", 2, a => DynamicNumber.Mod(a[0], a[1]));
Def("mod", 2, a => {
var x = a[0];
var y = a[1];
if ((DynamicNumber.CompareTo(x, 0) < 0 && DynamicNumber.CompareTo(y, 0) > 0)
|| (DynamicNumber.CompareTo(x, 0) > 0 && DynamicNumber.CompareTo(y, 0) < 0))
return DynamicNumber.Mod(x, DynamicNumber.Add(y, y));
return DynamicNumber.Mod(x, y);
});
Def("+", -1, a => FoldL((object)0, a[0] as IEnumerable ?? a, DynamicNumber.Add));
Def("*", -1, a => FoldL((object)1, a[0] as IEnumerable ?? a, DynamicNumber.Mul));
Def("-", -1, a => {
var e = a[0] as IEnumerable ?? a;
var rest = EnumerableUtils.SplitOnFirst(e, out var first);
if (rest.Count == 0)
return DynamicNumber.Mul(first,-1);
return FoldL(first, rest, DynamicNumber.Sub);
});
Def("/", -1, a => {
var e = a[0] as IEnumerable ?? a;
var rest = EnumerableUtils.SplitOnFirst(e, out var first);
if (rest.Count == 0)
return DynamicNumber.Div(1, first);
return FoldL(first, rest, DynamicNumber.Div);
});
Def("count", 1, a => EnumerableUtils.Count(a[0].assertEnumerable()));
Def("remove", 2, a => {
var oNeedle = a[0];
if (oNeedle is string needle)
return a[1].ToString().Replace(needle,"");
else if (a[1] is Cell c)
{
var j = c;
while (j != null) {
var prev = j;
j = (Cell) j.Cdr;
if (j != null && Equals(j.Car,oNeedle))
prev.Cdr = j.Cdr;
}
return c;
}
if (a[1] is IEnumerable e)
{
var to = new List<object>();
var find = a[1];
foreach (var x in e)
{
if (x == find)
continue;
to.Add(x);
}
return to;
}
throw new LispEvalException("not IEnumerable", a[1]);