예제 #1
0
        static object StringToList(object str)
        {
            object cons = ((string)str).Aggregate <char, object>(null, (current, c) => new Cons(c, current));

            return(Cons.Reverse(cons));
        }
예제 #2
0
        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;
            }
        }
예제 #3
0
 static object SetCdr(object cons, object value)
 {
     return(Cons.SetCdr(cons, value));
 }
예제 #4
0
 static object Cdr(object cons)
 {
     return(Cons.Cdr(cons));
 }
예제 #5
0
        static object HashValues(object table)
        {
            var d = (Dictionary <object, object>)table;

            return(Cons.ConsFromIEnumerable(d.Values));
        }
예제 #6
0
 static object MakeVector(object list)
 {
     return(Cons.ToObjectArray(list));
 }
예제 #7
0
 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);
 }