/// <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> /// 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"); }