/// <summary>
/// Define the sync clr procedure primitives.
/// </summary>
/// <param name="primEnv">The environment to define the primitives into.</param>
internal static new void DefinePrimitives(PrimitiveEnvironment primEnv)
{
const int MaxInt = int.MaxValue;
primEnv
.DefinePrimitive(
"constructor",
new[] { "(constructor <class-name> <arg-class-name> ...)" },
(args, env, caller) => new ClrConstructor(First(args).ToString(), ClassList(Rest(args))),
new ArgsInfo(1, MaxInt, ArgType.StringOrSymbol));
}
/// <summary>
/// Define the sync clr procedure primitives.
/// </summary>
/// <param name="primEnv">The environment to define the primitives into.</param>
internal static new void DefinePrimitives(PrimitiveEnvironment primEnv)
{
const int MaxInt = int.MaxValue;
primEnv
.DefinePrimitive(
"method",
new[] { "(method <target-class-name> <method-name> <arg-class-name> ...)" },
(args, env, caller) => new SynchronousClrProcedure(
First(args).ToString(),
Second(args).ToString(),
Class(First(args)),
ClassList(Rest(Rest(args))),
caller),
new ArgsInfo(1, MaxInt, ArgType.StringOrSymbol))
.DefinePrimitive(
"property-get",
new[] { "(property-get <target-class-name> <property-name>)" },
(args, env, caller) => new SynchronousClrProcedure(
First(args).ToString(),
"get_" + Second(args).ToString(),
Class(First(args)),
ClassList(Rest(Rest(args))),
caller),
new ArgsInfo(2, ArgType.StringOrSymbol))
.DefinePrimitive(
"property-set",
new[] { "(property-set <target-class-name> <property-name> <arg-class-name>)" },
(args, env, caller) => new SynchronousClrProcedure(
First(args).ToString(),
"set_" + Second(args).ToString(),
Class(First(args)),
ClassList(Rest(Rest(args))),
caller),
new ArgsInfo(3, ArgType.StringOrSymbol))
.DefinePrimitive(
"index-get",
new[] { "(index-get <target-class-name> <arg-class-name> <index-type>)" },
(args, env, caller) => new SynchronousClrProcedure(
First(args).ToString(),
"get_Item",
Class(First(args)),
ClassList(Rest(args)),
caller),
new ArgsInfo(2, ArgType.StringOrSymbol))
.DefinePrimitive(
"index-set",
new[] { "(index-set <target-class-name> <arg-class-name> <index-type> <arg-class-name>)" },
(args, env, caller) => new SynchronousClrProcedure(
First(args).ToString(),
"set_Item",
Class(First(args)),
ClassList(Rest(args)),
caller),
new ArgsInfo(3, ArgType.StringOrSymbol));
}
/// <summary>
/// Define the async clr procedure primitives.
/// </summary>
/// <param name="primEnv">The environment to define the primitives into.</param>
internal static new void DefinePrimitives(PrimitiveEnvironment primEnv)
{
const int MaxInt = int.MaxValue;
primEnv
.DefinePrimitive(
"method-async",
new[] { "(method-async <target-class-name> <method-name> <arg-class-name> ...)" },
(args, env, caller) => new AsynchronousClrProcedure(
First(args).ToString(),
Second(args).ToString(),
Class(First(args)),
ClassListBegin(Rest(Rest(args))),
caller),
new ArgsInfo(2, MaxInt, ArgType.StringOrSymbol));
}
/// <summary>
/// Initializes a new instance of the Interpreter class.
/// Create an interpreter and install the primitives into the global environment.
/// Then read a list of files.
/// </summary>
/// <param name="loadStandardMacros">Load standard macros and other primitives.</param>
/// <param name="primEnvironment">Environment containing the primitives (can be null).</param>
/// <param name="files">The files to read.</param>
/// <param name="reader">The input reader.</param>
/// <param name="writer">The output writer.</param>
private Interpreter(
bool loadStandardMacros,
PrimitiveEnvironment primEnvironment,
IEnumerable<string> files,
TextReader reader,
TextWriter writer)
{
this.Trace = false;
this.Count = false;
this.Transcript = new TranscriptLogger(this);
this.CurrentInputPort = InputPort.New(reader ?? Console.In, this);
this.CurrentOutputPort = OutputPort.New(writer ?? Console.Out, this);
this.PrimEnvironment = primEnvironment ?? new PrimitiveEnvironment();
this.CurrentCounters = new Counter();
this.GlobalEnvironment = new Environment(this, this.PrimEnvironment);
this.halted = new HaltedEvaluator(this.GlobalEnvironment);
var echo = (writer != null) ? this.CurrentOutputPort : null;
try
{
if (loadStandardMacros)
{
this.Load(SchemePrimitives.Code);
}
if (files != null)
{
foreach (string file in files)
{
this.LoadFile((Symbol)file, echo);
}
}
}
catch (Exception ex)
{
ErrorHandlers.PrintException(ex);
}
}
/// <summary>
/// Define the counter primitives.
/// </summary>
/// <param name="primEnv">The environment to define the primitives into.</param>
internal static void DefinePrimitives(PrimitiveEnvironment primEnv)
{
primEnv
.DefinePrimitive(
"dump-counters",
new[] { "(dump-counters)" },
(args, env, caller) => caller.Interp.CurrentCounters.DumpCounters(caller.Interp.CurrentOutputPort),
new ArgsInfo(0))
.DefinePrimitive(
"get-counters",
new[] { "(get-counters)" },
(args, env, caller) => caller.Interp.CurrentCounters.GetCounters(),
new ArgsInfo(0))
.DefinePrimitive(
"get-counter",
new[] { "(get-counter <name>)" },
(args, env, caller) => caller.Interp.CurrentCounters.GetCounter(List.First(args)),
new ArgsInfo(1, ArgType.String))
.DefinePrimitive(
"reset-counters",
new[] { "(reset-counters)" },
(args, env, caller) => caller.Interp.CurrentCounters.ResetCounters(),
new ArgsInfo(0));
}
/// <summary>
/// Define the output primitives.
/// </summary>
/// <param name="primEnv">The environment to define the primitives into.</param>
internal static new void DefinePrimitives(PrimitiveEnvironment primEnv)
{
// TODO not implemented
//// <r4rs section="6.10.1">(with-output-to-file <string> <thunk>)</r4rs>
primEnv
.DefinePrimitive(
"call-with-output-file",
new[] {"6.10.1", "(call-with-output-file <string> <proc>)"},
(args, env, caller) => EvaluateCallWithOutputFile.Call(args, caller),
new ArgsInfo(2, ArgType.String, ArgType.Proc))
.DefinePrimitive(
"close-output-port", new[] { "6.10.1", "(close-output-port <port>)" },
(args, env, caller) => Port(First(args), caller.Interp.CurrentOutputPort).CloseOutputPort(),
new ArgsInfo(1, ArgType.OutputPort))
.DefinePrimitive(
"current-output-port", new[] { "6.10.1", "(current-output-port)" },
(args, env, caller) => caller.Interp.CurrentOutputPort,
new ArgsInfo(0))
.DefinePrimitive(
"display", new[] { "6.10.3", "(display <obj>)", "(display <obj> <port>)" },
(args, env, caller) => Port(Second(args), caller.Interp.CurrentOutputPort).Display(First(args)),
new ArgsInfo(1, 2, ArgType.Obj, ArgType.OutputPort))
.DefinePrimitive(
"newline", new[] { "6.10.3", "(newline)", "(newline <port>)" },
(args, env, caller) => Port(First(args), caller.Interp.CurrentOutputPort).Newline(),
new ArgsInfo(0, 1, ArgType.OutputPort))
.DefinePrimitive(
"open-output-file", new[] { "6.10.1", "(open-output-file <filename>)" },
(args, env, caller) => EvaluateCallWithOutputFile.OpenOutputFile(First(args), caller.Interp),
new ArgsInfo(1, ArgType.String))
.DefinePrimitive(
"output-port?", new[] { "6.10.1", "(output-port? <obj>)" },
(args, env, caller) => SchemeBoolean.Truth(First(args) is OutputPort),
new ArgsInfo(1, ArgType.Obj))
.DefinePrimitive(
"write", new[] { "6.10.3", "(write <obj>)", "(write <obj> <port>)" },
(args, env, caller) => Port(Second(args), caller.Interp.CurrentOutputPort).Write(First(args)),
new ArgsInfo(1, 2, ArgType.Obj, ArgType.OutputPort))
.DefinePrimitive(
"p", new[] { "(p <expr>)", "(p <expr> <port>)" },
(args, env, caller) => Port(Second(args), caller.Interp.CurrentOutputPort).P(First(args)),
new ArgsInfo(1, ArgType.Obj, ArgType.OutputPort))
.DefinePrimitive(
"write-char", new[] { "6.10.3", "(write-char <char>)", "(write-char> <char> <port>)" },
(args, env, caller) => Port(Second(args), caller.Interp.CurrentOutputPort).WriteChar(First(args)),
new ArgsInfo(1, 2, ArgType.Char, ArgType.OutputPort))
.DefinePrimitive(
"dump-env", new[] { "(dump-env)" },
(args, env, caller) => DumpEnv(caller.Env),
new ArgsInfo(0));
}
/// <summary>
/// Define the clr procedure primitives.
/// </summary>
/// <param name="primEnv">The environment to define the primitives into.</param>
internal static new void DefinePrimitives(PrimitiveEnvironment primEnv)
{
primEnv
.DefinePrimitive(
"class",
new[] { "(class <class-name>)" },
(args, env, caller) => ClrObject.New(Class(First(args).ToString())),
new ArgsInfo(1, ArgType.String))
.DefinePrimitive(
"new",
new[] { "(new <class-name>)" },
(args, env, caller) => ClrObject.New(New(First(args).ToString())),
new ArgsInfo(1, ArgType.String))
.DefinePrimitive(
"new-clr-array",
new[] { "(new-clr-array <class-name> <length>)" },
(args, env, caller) => ClrObject.New(NewArray(First(args).ToString(), Second(args))),
new ArgsInfo(2, ArgType.String, ArgType.Number))
.DefinePrimitive(
"clr->native",
new[] { "(clr->native <obj>)" },
(args, env, caller) => ClrObject.FromClrObject(First(args)),
new ArgsInfo(1, ArgType.Obj));
}
/// <summary>
/// Define the counter primitives.
/// </summary>
/// <param name="primEnv">The environment to define the primitives into.</param>
internal static void DefinePrimitives(PrimitiveEnvironment primEnv)
{
primEnv
.DefinePrimitive(
"exit",
new[] { "(exit)" },
(args, env, caller) => Exit(args, caller),
new ArgsInfo(0, 1, ArgType.Number))
.DefinePrimitive(
"time-call",
new[] { "(time-call <thunk>)", "(time-call <thunk> <count>)" },
(args, env, caller) => EvaluateTimeCall.Call((Procedure)List.First(args), List.Second(args), caller.Env, caller),
new ArgsInfo(1, 2, ArgType.Proc, ArgType.Number));
}
/// <summary>
/// Define the list primitives.
/// Each of these could go through Apply, but for those primitives that will really need to instantiate
/// EvaluateExpression, we just do that directly.
/// Usually we can recognize these in InitialStep of the caller and dispatch the correct Evaluator without having to
/// instantiate another evaluator. But if the primitive is assigned to a variable and the variable appears in the
/// proc spot, it gets here. For instance ((lambda (fun)(fun 0)) and) will use this primitive, whereas
/// (and 0) will use InitialStep.
/// </summary>
/// <param name="primEnv">The environment to define the primitives into.</param>
internal static new void DefinePrimitives(PrimitiveEnvironment primEnv)
{
primEnv
.DefinePrimitive(
"and",
new[] { "4.2.1", "(and <test1> ...)" },
EvaluateAnd.Call,
new ArgsInfo(true, ArgType.Obj))
.DefinePrimitive(
"begin",
new[] { "4.2.3", "(begin <expression1> <expression2> ...)", "5.2", "(begin <definition1> <definition2> ...)" },
EvaluateSequence.Call,
new ArgsInfo(true, ArgType.Obj))
.DefinePrimitive(
"parallel",
new[] { "(parallel <expr> ...)" },
EvaluateParallel.Call,
new ArgsInfo(true, ArgType.Obj)) // *** was Pair
.DefinePrimitive(
"case",
new[]
{
"4.2.1",
"(case <key> <clause1> <clause2> ...)",
"clause: ((<datum1> ...) <expression1> <expression2> ...)",
"else clause: (else <expression1> <expression2> ...)"
},
EvaluateCase.Call,
new ArgsInfo(true, ArgType.Pair))
.DefinePrimitive(
"cond",
new[]
{
"4.2.1",
"(cond <clause1> <clause2> ... )",
"clause: (<test> <expression>)",
"clause: (<test> => <recipient>)",
"else clause: (else <expression1> <expression2> ...)"
},
EvaluateCond.Call,
new ArgsInfo(true, ArgType.Obj))
.DefinePrimitive(
"define",
new[]
{
"5.2",
"(define <variable> <expression>)",
"(define (<variable> <formals>) <body>)",
"(define (<variable> . <formal>) <body>)"
},
EvaluateDefine.Call,
new ArgsInfo(true, ArgType.PairOrSymbol, ArgType.Obj))
.DefinePrimitive(
"do",
new[] { "4.2.4", "(do ((variable1> <init1> <step1>) ...) (<test> <expression> ...) <command> ...)" },
EvaluateDo.Call,
new ArgsInfo(true, ArgType.Pair))
.DefinePrimitive(
"if",
new[] { "4.1.5", "(if <test> <consequent> <alternate>)", "(if <test> <consequent>)" },
EvaluateIf.Call,
new ArgsInfo(true, ArgType.Obj))
.DefinePrimitive(
"increment!",
new[] { "(increment <variable>)" },
Increment,
new ArgsInfo(1, true, ArgType.Symbol))
.DefinePrimitive(
"lambda",
new[]
{
"4.1.4",
"(lambda <formals> <body>)",
"formals: (<variable1> ...)",
"formals: <variable>",
"formals: (<variable 1> ... <variable n-1> . <variable n>)"
},
Lambda.Call,
new ArgsInfo(true, ArgType.PairOrSymbolOrEmpty, ArgType.Obj)) // *** Was PairOrSymbol (empty list permitted)
.DefinePrimitive(
"let",
new[]
{
"4.2.2",
"(let <bindings> <body>)",
"(let <variable> <bindings> <body>)",
"bindings: ((<variable1> <init1>) ...)",
"body: <expression> ..."
},
EvaluateLet.Call,
new ArgsInfo(true, ArgType.PairOrSymbolOrEmpty, ArgType.Obj))
.DefinePrimitive(
"let*",
new[]
{
"4.2.2",
"(let* <bindings> <body>)",
"bindings: ((<variable1> <init1>) ...)",
"body: <expression> ..."
},
EvaluateLetStar.Call,
new ArgsInfo(true, ArgType.PairOrEmpty, ArgType.Obj))
.DefinePrimitive(
"letrec",
new[] { "4.2.2", "(letrec <bindings> <body>)", "bindings: ((<variable1> <init1>) ...)", "body: <expression> ..." },
EvaluateLetRec.Call,
new ArgsInfo(true, ArgType.PairOrEmpty, ArgType.Obj))
.DefinePrimitive(
"macro",
new[] { "(macro (variable1 ...) <body>)" },
Macro.Call,
new ArgsInfo(true, ArgType.Pair))
.DefinePrimitive(
"or",
new[] { "4.2.1", "(or <test1> ...)" },
EvaluateOr.Call,
new ArgsInfo(true, ArgType.Obj))
.DefinePrimitive(
"quote",
new[] { "4.1.2", "(quote <datum>)" },
EvalQuote,
new ArgsInfo(1, true, ArgType.Obj))
.DefinePrimitive(
"set!",
new[] { "4.1.6", "(set! <variable> <expression>)" },
EvaluateSet.Call,
new ArgsInfo(2, true, ArgType.Symbol, ArgType.Obj))
.DefinePrimitive(
"time",
new[] { "(time <expr>)" },
EvaluateTime.Call,
new ArgsInfo(1, true, ArgType.Obj))
//// Instead of returning a value, return an evaulator that can be run to get the value
.DefinePrimitive(
"eval",
new[] { "(eval <expr>)" },
(args, env, caller) => Call(First(args), caller.Env, caller),
new ArgsInfo(1, 2, ArgType.Obj));
}
/// <summary>
/// Define all the combinations of c([ad]+)r functions up to four levels.
/// </summary>
/// <param name="primEnv">The environment to define the functions in.</param>
/// <param name="access">The access string so far.</param>
private static void DefineAccessPrimitives(PrimitiveEnvironment primEnv, string access)
{
string prim = "c" + access + "r";
primEnv.DefinePrimitive(
prim,
new[]
{
"6.3", "(" + prim + "<pair>)"
},
(args, env, caller) => Cxr(prim, args),
new ArgsInfo(1,
ArgType.Pair));
if (access.Length >= 4)
{
return;
}
DefineAccessPrimitives(primEnv, access + "a");
DefineAccessPrimitives(primEnv, access + "d");
}
/// <summary>
/// Define the list primitives.
/// </summary>
/// <param name="primEnv">The environment to define the primitives into.</param>
internal static void DefinePrimitives(PrimitiveEnvironment primEnv)
{
const int MaxInt = int.MaxValue;
primEnv
.DefinePrimitive(
"append", new[] { "6.3", "(append <list> ...)" },
(args, env, caller) => Append(args),
new ArgsInfo(0, MaxInt, ArgType.Obj))
.DefinePrimitive(
"assoc", new[] { "6.3", "(assoc <obj> <alist>)" },
(args, env, caller) => MemberAssoc(First(args), Second(args), First, (x, y) => SchemeBoolean.Equal(x, y).Value),
new ArgsInfo(2, ArgType.Obj, ArgType.PairOrEmpty))
.DefinePrimitive(
"assq", new[] { "(assq <obj> <alist>)" },
(args, env, caller) => MemberAssoc(First(args), Second(args), First, (x, y) => SchemeBoolean.Eqv(x, y).Value),
new ArgsInfo(2, ArgType.Obj, ArgType.PairOrEmpty))
.DefinePrimitive(
"assv", new[] { "6.3", "(assv <obj> <alist>)" },
(args, env, caller) => MemberAssoc(First(args), Second(args), First, (x, y) => SchemeBoolean.Eqv(x, y).Value),
new ArgsInfo(2, ArgType.Obj, ArgType.PairOrEmpty))
.DefinePrimitive(
"car", new[] { "6.3", "(car <pair>)" },
(args, env, caller) => First(First(args)),
new ArgsInfo(1, ArgType.Pair))
.DefinePrimitive(
"first", new[] { "(first <pair>)" },
(args, env, caller) => First(First(args)),
new ArgsInfo(1, ArgType.Pair))
.DefinePrimitive(
"second", new[] { "(second <pair>)" },
(args, env, caller) => Second(First(args)),
new ArgsInfo(1, ArgType.Pair))
.DefinePrimitive(
"third", new[] { "(third <pair>)" },
(args, env, caller) => Third(First(args)),
new ArgsInfo(1, ArgType.Pair))
.DefinePrimitive(
"nth", new[] { "(nth <pair> <n>)" },
(args, env, caller) => Nth(First(args), Second(args)),
new ArgsInfo(2, ArgType.Pair, ArgType.Number))
.DefinePrimitive(
"cdr", new[] { "6.3", "(cdr <pair>)" },
(args, env, caller) => Rest(First(args)),
new ArgsInfo(1, ArgType.Pair))
.DefinePrimitive(
"rest", new[] { "(rest <pair>)" },
(args, env, caller) => Rest(First(args)),
new ArgsInfo(1, ArgType.Pair))
.DefinePrimitive(
"cons", new[] { "6.3", "(cons <obj1> <obj2>)" },
(args, env, caller) => Cons(First(args), Second(args)),
new ArgsInfo(2, ArgType.Obj))
.DefinePrimitive(
"length", new[] { "6.3", "(length <list> ...)" },
(args, env, caller) => (Number)ListLength(First(args)),
new ArgsInfo(1, ArgType.PairOrEmpty))
.DefinePrimitive(
"list", new[] { "6.3", "(list <obj> ...)" },
(args, env, caller) => args,
new ArgsInfo(0, MaxInt, ArgType.Obj))
.DefinePrimitive(
"list-ref", new[] { "6.3", "(list-ref <list> <k>)" },
(args, env, caller) => ListRef(First(args), Second(args)),
new ArgsInfo(2, ArgType.Pair,
ArgType.Number))
.DefinePrimitive(
"list-tail", new[] { "6.3", "(list-tail <list> <k>)" },
(args, env, caller) => ListTail(First(args), Second(args)),
new ArgsInfo(2, ArgType.Pair,
ArgType.Number))
.DefinePrimitive(
"list*", new[] { "(list* <obj> ...)" },
(args, env, caller) => ListStar(args),
new ArgsInfo(2, MaxInt, ArgType.Obj))
.DefinePrimitive(
"list?", new[] { "6.3", "(list? <obj>)" },
(args, env, caller) => SchemeBoolean.Truth(IsList(First(args))),
new ArgsInfo(1, ArgType.Obj))
.DefinePrimitive(
"member", new[] { "6.3", "(member <obj> <list>)" },
(args, env, caller) => MemberAssoc(First(args), Second(args), x => x, (x, y) => SchemeBoolean.Equal(x, y).Value),
new ArgsInfo(2, ArgType.Obj,
ArgType.Pair))
.DefinePrimitive(
"memq", new[] { "6.3", "(memq <obj> <list>)" },
(args, env, caller) => MemberAssoc(First(args), Second(args), x => x, (x, y) => SchemeBoolean.Eqv(x, y).Value),
new ArgsInfo(2, ArgType.Obj,
ArgType.Pair))
.DefinePrimitive(
"memv", new[] { "6.3", "(memv <obj> <list>)" },
(args, env, caller) => MemberAssoc(First(args), Second(args), x => x, (x, y) => SchemeBoolean.Eqv(x, y).Value),
new ArgsInfo(2, ArgType.Obj,
ArgType.Pair))
.DefinePrimitive(
"pair?", new[] { "6.3", "(pair? <obj>)" },
(args, env, caller) => SchemeBoolean.Truth(First(args) is Pair),
new ArgsInfo(1, ArgType.Obj))
.DefinePrimitive(
"reverse", new[] { "6.3", "(reverse <list>)" },
(args, env, caller) => ReverseList(First(args)),
new ArgsInfo(1, ArgType.PairOrEmpty))
.DefinePrimitive(
"set-car!", new[] { "6.3", "(set-car! <pair> <obj>)" },
(args, env, caller) => SetFirst(First(args), Second(args)),
new ArgsInfo(2, ArgType.Pair,
ArgType.Obj))
.DefinePrimitive(
"set-first!", new[] { "(set-first! <pair> <obj>)" },
(args, env, caller) => SetFirst(First(args), Second(args)),
new ArgsInfo(2, ArgType.Pair,
ArgType.Obj))
.DefinePrimitive(
"set-cdr!", new[] { "6.3", "(set-cdr! <pair> <obj>)" },
(args, env, caller) => SetRest(First(args), Second(args)),
new ArgsInfo(2, ArgType.Pair,
ArgType.Obj))
.DefinePrimitive(
"set-rest!", new[] { "(set-rest! <pair> <obj>)" },
(args, env, caller) => SetRest(First(args), Second(args)),
new ArgsInfo(2, ArgType.Pair, ArgType.Obj));
DefineAccessPrimitives(primEnv, "aa");
DefineAccessPrimitives(primEnv, "ad");
DefineAccessPrimitives(primEnv, "da");
DefineAccessPrimitives(primEnv, "dd");
}
