static SCode DistributeDisjunction(Conditional predicate, SCode alternative)
{
//Debug.Write ("\n; Distribute disjunction.");
return(Conditional.Make(predicate.Predicate,
Disjunction.Make(predicate.Consequent, alternative),
Disjunction.Make(predicate.Alternative, alternative)));
}
internal override PartialResult PartialEval(PartialEnvironment environment)
{
PartialResult pred = this.predicate.PartialEval(environment);
PartialResult alt = this.alternative.PartialEval(environment);
return(new PartialResult((pred.Residual == this.predicate &&
alt.Residual == this.alternative) ? this : Disjunction.Make(pred.Residual, alt.Residual)));
}
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();
}
}
static SCode RewriteDisjunction(Sequence2 predicate, SCode alternative)
{
//Debug.Write ("\n; rewrite sequence2 disjunction.");
return(Sequence2.Make(predicate.First,
Disjunction.Make(predicate.Second, alternative)));
}
static SCode RewriteDisjunction(Disjunction predicate, SCode alternative)
{
//Debug.Write ("\n; Flatten disjunction.");
return(Disjunction.Make(predicate.Predicate,
Disjunction.Make(predicate.Alternative, alternative)));
}
public Object GetRealObject(StreamingContext context)
{
return(Disjunction.Make(this.predicate, this.alternative));
}
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);
}
