コード例 #1
0
        public static bool ScodeEval(out object answer, object arg0, object arg1)
        {
            Environment env = Environment.ToEnvironment(arg1);
            //CompileTimeEnvironment ctenv = (env is StandardEnvironment)
            //    ? new CompileTimeEnvironment (((StandardEnvironment) env).Closure.Lambda.Formals)
            //    : new CompileTimeEnvironment (null);
            SCode sarg0 = SCode.EnsureSCode(arg0);

            answer = new TailCallInterpreter(sarg0.PartialEval(PartialEnvironment.Make((ITopLevelEnvironment)env)).Residual, env);
            return(true);
        }
コード例 #2
0
ファイル: Fasl.cs プロジェクト: xach/jrm-code-project
        public SCode ReadExtendedLambda(uint location)
        {
            Symbol name;

            Symbol [] formals;
            ReadFormals(location + 4, out name, out formals);
            object        third    = ReadObject(location + 8);
            EncodedObject argcount = new EncodedObject((uint)(int)third);
            uint          optional = (argcount.Datum & 0x00FF);
            uint          required = (argcount.Datum & 0xFF00) >> 8;
            bool          rest     = ((argcount.Datum & 0x10000) == 0x10000);
            SCode         body     = SCode.EnsureSCode(ReadObject(location));

            return(ExtendedLambda.Make(name, formals, body, required, optional, rest));
        }
コード例 #3
0
ファイル: Fasl.cs プロジェクト: xach/jrm-code-project
        internal object ReadObject(uint location)
        {
            object probe = null;

            if (this.sharingTable.TryGetValue(location, out probe) == true)
            {
                return(probe);
            }

            EncodedObject encoded =
                heapSection.Contains(location) ? heapSection [location]
                : constSection.Contains(location) ? constSection [location]
                : new EncodedObject(0);
            // Console.WriteLine ("{0}", encoded.TypeCode);
            object first = null;

            switch (encoded.TypeCode)
            {
            case TC.ACCESS:
                return(Access.Make(ReadObject(encoded.Datum),
                                   (Symbol)ReadObject(encoded.Datum + 4)));

            case TC.ASSIGNMENT:
                return(ReadAssignment(encoded.Datum));

            case TC.BIG_FIXNUM:
                return(ReadBignum(encoded.Datum));

            case TC.BIG_FLONUM:
                return(ReadBigFlonum(encoded.Datum));

            case TC.CHARACTER:
                return((char)(encoded.Datum));

            case TC.CHARACTER_STRING:
                return(heapSection.ReadString(encoded.Datum));

            case TC.COMBINATION:
                return(Combination.Make(ReadVector(encoded.Datum)));

            case TC.COMBINATION_1:
                return(Combination1.Make(ReadObject(encoded.Datum),
                                         ReadObject(encoded.Datum + 4)));

            case TC.COMBINATION_2:
                return(Combination2.Make(ReadObject(encoded.Datum),
                                         ReadObject(encoded.Datum + 4),
                                         ReadObject(encoded.Datum + 8)));

            case TC.COMMENT:
                return(Comment.Make(ReadObject(encoded.Datum),
                                    ReadObject(encoded.Datum + 4)));

            case TC.COMPLEX:
                return(new Complex(ReadObject(encoded.Datum),
                                   ReadObject(encoded.Datum + 4)));

            case TC.CONDITIONAL:
                return(Conditional.Make(ReadObject(encoded.Datum),
                                        ReadObject(encoded.Datum + 4),
                                        ReadObject(encoded.Datum + 8)));

            case TC.CONSTANT:
                return(Constant.Decode(encoded.Datum));

            case TC.DEFINITION:
                return(Definition.Make((Symbol)ReadObject(encoded.Datum),
                                       ReadObject(encoded.Datum + 4)));

            case TC.DELAY:
                return(Delay.Make(ReadObject(encoded.Datum)));

            case TC.DISJUNCTION:
                return(Disjunction.Make(ReadObject(encoded.Datum),
                                        ReadObject(encoded.Datum + 4)));

            case TC.EXTENDED_LAMBDA:
                return(ReadExtendedLambda(encoded.Datum));

            case TC.FIXNUM:
                return(encoded.Datum > 0x02000000
                           ? (int)-(0x04000000 - encoded.Datum)
                           : (int)encoded.Datum);

            case TC.INTERNED_SYMBOL:
                return(Symbol.Make(new String((char [])ReadObject(encoded.Datum))));

            case TC.LAMBDA:
                Symbol    name;
                Symbol [] formals;
                ReadFormals(encoded.Datum + 4, out name, out formals);
                return(Lambda.Make(name, formals, SCode.EnsureSCode(ReadObject(encoded.Datum))));

            case TC.LIST:
                object second = ReadObject(encoded.Datum + 4);
                return(new Cons(ReadObject(encoded.Datum),
                                second == sharpF ? null : second));

            case TC.NULL:
                if (encoded.Datum != 0)
                {
                    throw new NotImplementedException();
                }
                return(sharpF);

            case TC.PCOMB0:
                return(PrimitiveCombination0.Make((Primitive0)primSection[encoded.Datum]));

            case TC.PCOMB1:
                return(PrimitiveCombination1.Make((Primitive1)ReadObject(encoded.Datum),
                                                  ReadObject(encoded.Datum + 4)));

            case TC.PCOMB2:
                return(PrimitiveCombination2.Make((Primitive2)ReadObject(encoded.Datum),
                                                  ReadObject(encoded.Datum + 4),
                                                  ReadObject(encoded.Datum + 8)));

            case TC.PCOMB3:
                return(PrimitiveCombination3.Make((Primitive3)ReadObject(encoded.Datum + 4),
                                                  ReadObject(encoded.Datum + 8),
                                                  ReadObject(encoded.Datum + 12),
                                                  ReadObject(encoded.Datum + 16)));

            case TC.PRIMITIVE:
                return(primSection [encoded.Datum]);

            case TC.REFERENCE_TRAP:
                if (encoded.Datum == 0)
                {
                    return(ReferenceTrap.Unassigned);
                }
                else
                {
                    throw new NotImplementedException();
                }
            // return ReferenceTrap.Make (encoded.Datum);

            case TC.RATNUM:
                return(new Ratnum(ReadObject(encoded.Datum),
                                  ReadObject(encoded.Datum + 4)));

            case TC.RETURN_CODE:
                return((ReturnCode)(encoded.Datum));

            case TC.SEQUENCE_2:
                return(Sequence2.Make(ReadObject(encoded.Datum),
                                      ReadObject(encoded.Datum + 4)));

            case TC.SEQUENCE_3:
                // Chains of sequence_3 can be arbitrarily long.
                // Unfortunately, the CLR puts a strict limit on
                // the stack, so we have to do this funky thing.
                Cons sequenceStack = null;
                while (true)
                {
                    // read the first two elements
                    object s1 = ReadObject(encoded.Datum);
                    sequenceStack = new Cons(s1, sequenceStack);
                    object s2 = ReadObject(encoded.Datum + 4);
                    sequenceStack = new Cons(s2, sequenceStack);

                    // peek at the third

                    EncodedObject sencoded =
                        heapSection.Contains(encoded.Datum + 8) ? heapSection [encoded.Datum + 8]
                           : constSection.Contains(encoded.Datum + 8) ? constSection [encoded.Datum + 8]
                           : new EncodedObject(0);

                    if (sencoded.TypeCode == TC.SEQUENCE_3)
                    {
                        encoded = sencoded;
                    }
                    else
                    {
                        // found the end of the chain!
                        object tail = ReadObject(encoded.Datum + 8);
                        while (sequenceStack != null)
                        {
                            object ob2 = sequenceStack.Car;
                            sequenceStack = (Cons)sequenceStack.Cdr;
                            object ob1 = sequenceStack.Car;
                            sequenceStack = (Cons)sequenceStack.Cdr;
                            tail          = Sequence3.Make(ob1, ob2, tail);
                        }
                        return(tail);
                    }
                }


            case TC.THE_ENVIRONMENT:
                return(TheEnvironment.Make());

            case TC.UNINTERNED_SYMBOL:
                // KLUDGE!!  Make sure that all uninterned strings within a file
                // keep their identity when read.
                // Also, postpend a unique number so we can tell these apart.
                first = ReadObject(encoded.Datum);
                if (first is Symbol)
                {
                    return(first);
                }
                else
                {
                    Symbol result = Symbol.MakeUninterned("#:" + new String((char [])first) + "-" + (gensymCounter++).ToString(CultureInfo.InvariantCulture));
                    this.sharingTable.Add(encoded.Datum, result);
                    return(result);
                }

            case TC.VARIABLE:
                return(Variable.Make((Symbol)ReadObject(encoded.Datum)));

            case TC.VECTOR:
                return(ReadVector(encoded.Datum));

            default:
                throw new NotImplementedException();
            }
        }
コード例 #4
0
        public static bool SystemPairCons(out object answer, object acode, object car, object cdr)
        {
            //TC typeCode = (TC) (int) acode; // for debugging porpoises

            switch ((TC)acode)
            {
            case TC.ACCESS:
                answer = Access.Make(car, (Symbol)cdr);
                break;

            case TC.ASSIGNMENT:
                answer = Assignment.Make(car, cdr);
                break;

            case TC.COMBINATION_1:
                answer = Combination1.Make(car, cdr);
                break;

            case TC.COMMENT:
                answer = Comment.Make(car, cdr);
                break;

            case TC.COMPLEX:
                answer = new Complex(car, cdr);
                break;

            case TC.DEFINITION:
                answer = Definition.Make((Symbol)car, cdr);
                break;

            case TC.DELAY:
                answer = new Delay(car, cdr);
                break;

            case TC.DISJUNCTION:
                answer = Disjunction.Make(car, cdr);
                break;

            case TC.ENTITY:
                answer = new Entity(car, cdr);
                break;

            case TC.LAMBDA:
                // passed in backwards.
                object [] names   = (object [])cdr;
                object [] formals = new object [names.Length - 1];
                Array.Copy(names, 1, formals, 0, formals.Length);
                SCode body = SCode.EnsureSCode(car);
                answer = Lambda.Make(names[0], formals, car);
                break;

            case TC.PCOMB1:
                answer = PrimitiveCombination1.Make((Primitive1)car, cdr);
                break;

            case TC.PROCEDURE:
                // Lambda had better be a `StandardLambda' because we are
                // constructing an closureEnvironment that needs to be first-class.

                Environment    env  = Environment.ToEnvironment(cdr);
                Lambda         ulam = (Lambda)car;
                Lambda         plam = (Lambda)ulam.PartialEval(PartialEnvironment.Make((ITopLevelEnvironment)env)).Residual;
                StandardLambda slam = (StandardLambda) new StandardLambda(plam.Name,
                                                                          plam.Formals,
                                                                          plam.Body,
                                                                          ulam.FreeVariables,
                                                                          plam.StaticMapping
                                                                          );
                answer = new StandardClosure(slam, env);
                break;

            case TC.RATNUM:
                answer = new Ratnum(car, cdr);
                break;

            case TC.SCODE_QUOTE:
                answer = Quotation.Make(car);
                break;

            case TC.SEQUENCE_2:
                answer = Sequence2.Make(car, cdr);
                break;

            case TC.UNINTERNED_SYMBOL:
                // What gives?  Uninterned strings are squirrely on the CLR.
                // We put them in a class object to have more control.
                answer = Symbol.MakeUninterned(new String((char [])car));
                break;

            case TC.WEAK_CONS:
                answer = new WeakCons(car, cdr);
                break;

            default:
                throw new NotImplementedException();
            }
            return(false);
        }