static object ListToString(object list) { string outStr = ""; while (list != null) { outStr += (char)Cons.Car(list); list = Cons.Cdr(list); } return(outStr); }
object RunClosure(Closure closure, params object[] args) { var prevCONT = _cont; var prevENVT = _envt; var prevEvalStack = _evalStack; var prevTEMPLATE = _template; var prevPC = _pc; _cont = null; _envt = closure.Envt; _evalStack = Cons.Reverse(Cons.ConsFromArray(args)); _template = closure.Template; _pc = 0; _value = Void.TheVoidValue; try { while (true) { var i = _template.Code[_pc]; switch (i.OpCode) { case Instruction.OpCodes.Push: _evalStack = new Cons(_value, _evalStack); _pc++; break; case Instruction.OpCodes.Bind: { var numOfBindings = (int)i.AX; _envt = new LexicalEnvironment(_envt, numOfBindings); for (var x = 0; x < numOfBindings; x++) { _envt.Bindings[numOfBindings - 1 - x] = Cons.Car(_evalStack); _evalStack = Cons.Cdr(_evalStack); } if (_evalStack != null) { throw new InvalidOperationException("Too many parameters given to function"); } _pc++; } break; case Instruction.OpCodes.ToplevelGet: _value = ToplevelLookup(_value as Symbol); _pc++; break; case Instruction.OpCodes.SaveContinuation: _cont = new Continuation(_cont, _envt, _evalStack, _template, i.AX); _evalStack = null; _pc++; break; case Instruction.OpCodes.FetchLiteral: _value = _template.Literals[i.AX]; _pc++; break; case Instruction.OpCodes.LocalGet: { LexicalEnvironment envt = _envt; for (int x = 0; x < i.A; x++) { envt = envt.Parent; } _value = envt.Bindings[i.B]; _pc++; } break; case Instruction.OpCodes.JumpIfFalse: { if (_value is bool && ((bool)_value == false)) { _pc = i.AX; } else { _pc++; } } break; case Instruction.OpCodes.BindVarArgs: { var numOfBindings = (int)i.AX; _envt = new LexicalEnvironment(_envt, numOfBindings); // parameters are reversed on EVAL stack _evalStack = Cons.Reverse(_evalStack); for (var x = 0; x < numOfBindings; x++) { // if it is the last binding, take the rest of the EVAL_STACK if (x == numOfBindings - 1) { _envt.Bindings[x] = _evalStack; _evalStack = null; } else { _envt.Bindings[x] = Cons.Car(_evalStack); _evalStack = Cons.Cdr(_evalStack); } } _pc++; } break; case Instruction.OpCodes.MakeClosure: _value = new Closure(_envt, _value as Template); _pc++; break; case Instruction.OpCodes.Return: Return(); break; case Instruction.OpCodes.ToplevelSet: _toplevelEnv[_value as Symbol] = Cons.Car(_evalStack); _evalStack = Cons.Cdr(_evalStack); _pc++; break; case Instruction.OpCodes.Apply: { if (_value is Closure) { var clos = _value as Closure; _envt = clos.Envt; _template = clos.Template; _value = Void.TheVoidValue; _pc = 0; } else if (_value is Func <object> ) { var func = _value as Func <object>; _value = func(); Return(); } else if (_value is Func <object, object> ) { var func = _value as Func <object, object>; _value = func(Cons.Car(_evalStack)); Return(); } else if (_value is Func <object, object, object> ) { var func = _value as Func <object, object, object>; _value = func(Cons.Car(Cons.Cdr(_evalStack)), Cons.Car(_evalStack)); Return(); } else if (_value is Func <object, object, object, object> ) { var func = _value as Func <object, object, object, object>; _value = func(Cons.Car(Cons.Cdr(Cons.Cdr(_evalStack))), Cons.Car(Cons.Cdr(_evalStack)), Cons.Car(_evalStack)); Return(); } else if (_value is Func <object, object, object, object, object> ) { var func = _value as Func <object, object, object, object, object>; _value = func(Cons.Car(Cons.Cdr(Cons.Cdr(Cons.Cdr(_evalStack)))), Cons.Car(Cons.Cdr(Cons.Cdr(_evalStack))), Cons.Car(Cons.Cdr(_evalStack)), Cons.Car(_evalStack)); Return(); } else if (_value is Func <object[], object> ) { var func = _value as Func <object[], object>; _value = func(Cons.ToReverseObjectArray(_evalStack)); Return(); } else { throw new LunulaException("VALUE register does not contain a callable object: " + _value); } } break; case Instruction.OpCodes.LocalSet: { var envt = _envt; for (var x = 0; x < i.A; x++) { envt = envt.Parent; } envt.Bindings[i.B] = _value; _pc++; } break; case Instruction.OpCodes.Jump: _pc = i.AX; break; case Instruction.OpCodes.End: _finished = true; break; default: throw new InvalidOperationException("Invalid instruction"); } if (_finished) { _finished = false; return(_value); } } } finally { _cont = prevCONT; _envt = prevENVT; _evalStack = prevEvalStack; _template = prevTEMPLATE; _pc = prevPC; } }
static object Car(object cons) { return(Cons.Car(cons)); }
public Builtins(LunulaVM vm) { _vm = vm; vm.DefineFunction("@make-vector", MakeVector); vm.DefineFunction("@vector-ref", VectorRef); vm.DefineFunction("@vector-set", VectorSet); vm.DefineFunction("@vector?", IsVector); vm.DefineFunction("@vector-length", VectorLength); vm.DefineFunction("@make-hash-table", MakeHashTable); vm.DefineFunction("@hash-ref", HashRef); vm.DefineFunction("@hash-set!", HashSet); vm.DefineFunction("@hash-remove!", HashRemove); vm.DefineFunction("@hash-keys", HashKeys); vm.DefineFunction("@hash-values", HashValues); vm.DefineFunction("@boolean?", IsBoolean); vm.DefineFunction("@boolean=?", BooleanEquals); vm.DefineFunction("@char?", IsChar); vm.DefineFunction("@char=?", CharEquals); vm.DefineFunction("@char-alphabetic?", IsCharAlphabetic); vm.DefineFunction("@char-numeric?", IsCharNumeric); vm.DefineFunction("@char-code", CharCode); vm.DefineFunction("@symbol?", IsSymbol); vm.DefineFunction("@symbol=?", SymbolEquals); vm.DefineFunction("@void?", IsVoid); vm.DefineFunction("@void", MakeVoid); vm.DefineFunction("@procedure?", IsProcedure); vm.DefineFunction("@toplevel-defined?", ToplevelIsDefined); vm.DefineFunction("@toplevel-define", ToplevelDefine); vm.DefineFunction("@toplevel-lookup", ToplevelLookup); vm.DefineFunction("cons?", IsCons); vm.DefineFunction("null?", IsNull); vm.DefineFunction("car", Car); vm.DefineFunction("cdr", Cdr); vm.DefineFunction("@string?", IsString); vm.DefineFunction("@string=?", StringEquals); vm.DefineFunction("@string-length", StringLength); vm.DefineFunction("@string-append", StringAppend); vm.DefineFunction("@number->string", NumberToString); vm.DefineFunction("@symbol->string", SymbolToString); vm.DefineFunction("@open-output-string", OpenOutputString); vm.DefineFunction("@open-input-string", OpenInputString); vm.DefineFunction("@get-output-string", GetOutputString); vm.DefineFunction("@open-output-byte-array", OpenOutputByteArray); vm.DefineFunction("@get-output-byte-array", GetOutputByteArray); vm.DefineFunction("@write-byte", WriteByte); vm.DefineFunction("@write-word", WriteWord); vm.DefineFunction("@write-dword", WriteDWord); vm.DefineFunction("@current-output-port", GetStdOut); vm.DefineFunction("@current-error-port", GetStdError); vm.DefineFunction("@current-input-port", GetStdIn); vm.DefineFunction("@cons", MakeCons); vm.DefineFunction("@set-car!", SetCar); vm.DefineFunction("@set-cdr!", SetCdr); vm.DefineFunction("@number?", IsNumber); vm.DefineFunction("@=", NumberEqual); vm.DefineFunction("@>", NumberGreaterThan); vm.DefineFunction("@>=", NumberGreaterThanAndEqual); vm.DefineFunction("@<", NumberLessThan); vm.DefineFunction("@<=", NumberLessThanAndEqual); vm.DefineFunction("@+", TwoArgPlus); vm.DefineFunction("@-", TwoArgMinus); vm.DefineFunction("@*", TwoArgMultiply); vm.DefineFunction("@/", TwoArgDivide); vm.DefineFunction("@bor", BinaryOr); vm.DefineFunction("@left-shift", LeftShift); vm.DefineFunction("@write-char", WriteChar); vm.DefineFunction("@write-string", WriteString); vm.DefineFunction("@flush-output", FlushOutput); vm.DefineFunction("@to-string", StaticToString); vm.DefineFunction("@open-file-output-port", OpenFileOutputPort); vm.DefineFunction("@open-binary-file-output-port", OpenBinaryFileOutputPort); vm.DefineFunction("@close-output-port", CloseOutputPort); vm.DefineFunction("@open-file-input-port", OpenFileInputPort); vm.DefineFunction("@close-input-port", CloseInputPort); vm.DefineFunction("@get-time", GetTime); vm.DefineFunction("@time-difference", TimeDifference); vm.DefineFunction("@string->list", StringToList); vm.DefineFunction("@list->string", ListToString); vm.DefineFunction("@string->number", StringToNumber); vm.DefineFunction("@string->symbol", StringToSymbol); vm.DefineFunction("@fail", Fail); vm.DefineFunction("@read-char", ReadChar); vm.DefineFunction("@peek-char", PeekChar); vm.DefineFunction("@peek-char-skip", PeekCharSkip); vm.DefineFunction("@eof-object?", IsEOFObject); vm.DefineFunction("@cons?", thing => thing is Cons); vm.DefineFunction("@null?", thing => thing == null); vm.DefineFunctionN("@apply", parms => { var fun = parms.First(); var args = Cons.Car(Cons.ConsFromArray(parms.Skip(1).ToArray())); return(vm.Apply(fun, Cons.ToObjectArray(args))); }); vm.DefineFunction("eq?", ObjectEquals); vm.DefineFunction("@catch-error", CatchError); vm.DefineFunction("@run-template", RunTemplate); vm.DefineFunction("@load-lvm-file", LoadLVMFile); vm.DefineFunction("@print-profile-data", () => { throw new LunulaException("Profiler not enabled"); }); vm.DefineFunction("@make-type", (tag, data) => new TaggedType((Symbol)tag, data)); vm.DefineFunction("@type-symbol", type => ((TaggedType)type).Tag); vm.DefineFunction("@type-data", type => ((TaggedType)type).Data); vm.DefineFunction("@type-data-set!", (type, data) => { ((TaggedType)type).Data = data; return(Void.TheVoidValue); }); vm.DefineFunction("call/cc", _vm.CallWithCurrentContinuation); vm.DefineFunction("@exit", x => Void.TheVoidValue); }