public static bool NewFileOpenOutputChannel(out object answer, object arg0, object arg1)
{
char [] filename = (char [])arg0;
WeakCons holder = (WeakCons)arg1;
int channel = Channel.MakeFileChannel(new FileStream(new String(filename), System.IO.FileMode.CreateNew, System.IO.FileAccess.Write, System.IO.FileShare.None));
holder.Cdr = channel;
answer = true;
return(false);
}
public static bool NewFileOpenInputChannel(out object answer, object arg0, object arg1)
{
char [] filename = (char [])arg0;
WeakCons holder = (WeakCons)arg1;
#if DEBUG
// don't benchmark the file system.
SCode.location = "-";
#endif
int channel = Channel.MakeFileChannel(new FileStream(new String(filename), System.IO.FileMode.Open, System.IO.FileAccess.Read, System.IO.FileShare.Read));
holder.Cdr = channel;
answer = true;
return(false);
}
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;
}
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);
}
public static bool ObjectSetType(out object answer, object arg0, object arg1)
{
TC newType = (TC) (int) arg0;
// kludge!!!!
if ((int) arg0 == 0 && (int) arg1 == 1)
answer = new NullEnvironment ();
else
switch (newType)
{
case TC.COMBINATION_2:
answer = Combination2.Make ((Hunk3) arg1);
break;
case TC.CONDITIONAL:
answer = Conditional.Make ((Hunk3) arg1);
break;
case TC.CONSTANT:
answer = Constant.Decode ((uint) (int) arg1);
break;
case TC.HUNK3_A:
// Probably someone trying to mark a history object.
answer = arg1;
break;
case TC.HUNK3_B:
answer = arg1;
break;
case TC.ENVIRONMENT:
object [] args = (object[]) arg1;
StandardClosure closure = (StandardClosure) args [0];
object [] actualArgs = new object [args.Length - 1];
for (int i = 0; i < actualArgs.Length; i++)
actualArgs [i] = args [i + 1];
answer = new StandardEnvironment<StandardLambda,StandardClosure> (closure, actualArgs);
break;
// throw new NotImplementedException ();
// // answer = (new InterpreterEnvironment ((object []) arg1));
case TC.EXTENDED_LAMBDA:
answer = ExtendedLambda.Make ((Hunk3) arg1);
break;
case TC.PCOMB0:
answer = PrimitiveCombination0.Make ((Primitive0) arg1);
break;
case TC.PCOMB2:
answer = PrimitiveCombination2.Make ((Hunk3) arg1);
break;
case TC.PRIMITIVE:
if (!(arg1 is PrimitiveCombination0))
throw new NotImplementedException ("Object-set-type on primitive");
answer = ((PrimitiveCombination0) arg1).Operator;
break;
case TC.RECORD:
answer = new Record ((object []) arg1);
return false;
case TC.SEQUENCE_3:
answer = new Sequence3 ((Hunk3) arg1);
break;
case TC.THE_ENVIRONMENT:
answer = TheEnvironment.Make();
break;
case TC.VARIABLE:
answer = Variable.Make ((Hunk3) arg1);
break;
case TC.VECTOR:
// Someone wants to see what endian we are!
char [] source = (char []) arg1;
object [] result = new object [source.Length / 4];
result [1] = ((((((byte) source [3]) * 256)
+ ((byte) source [2])) * 256)
+ ((byte) source [1])) * 256
+ ((byte) source [0]);
result [0] = ((((((byte) source [7]) * 256)
+ ((byte) source [6])) * 256)
+ ((byte) source [5])) * 256
+ ((byte) source [4]);
answer = result;
break;
case TC.WEAK_CONS:
answer = new WeakCons (((Cons) arg1).Car, ((Cons) arg1).Cdr);
break;
default:
throw new NotImplementedException ();
}
return false;
}
public static bool ObjectSetType(out object answer, object arg0, object arg1)
{
TC newType = (TC)(int)arg0;
// kludge!!!!
if ((int)arg0 == 0 && (int)arg1 == 1)
{
answer = new NullEnvironment();
}
else
{
switch (newType)
{
case TC.COMBINATION_2:
answer = Combination2.Make((Hunk3)arg1);
break;
case TC.CONDITIONAL:
answer = Conditional.Make((Hunk3)arg1);
break;
case TC.CONSTANT:
answer = Constant.Decode((uint)(int)arg1);
break;
case TC.HUNK3_A:
// Probably someone trying to mark a history object.
answer = arg1;
break;
case TC.HUNK3_B:
answer = arg1;
break;
case TC.ENVIRONMENT:
object [] args = (object[])arg1;
StandardClosure closure = (StandardClosure)args [0];
object [] actualArgs = new object [args.Length - 1];
for (int i = 0; i < actualArgs.Length; i++)
{
actualArgs [i] = args [i + 1];
}
answer = new StandardEnvironment <StandardLambda, StandardClosure> (closure, actualArgs);
break;
// throw new NotImplementedException ();
// // answer = (new InterpreterEnvironment ((object []) arg1));
case TC.EXTENDED_LAMBDA:
answer = ExtendedLambda.Make((Hunk3)arg1);
break;
case TC.PCOMB0:
answer = PrimitiveCombination0.Make((Primitive0)arg1);
break;
case TC.PCOMB2:
answer = PrimitiveCombination2.Make((Hunk3)arg1);
break;
case TC.PRIMITIVE:
if (!(arg1 is PrimitiveCombination0))
{
throw new NotImplementedException("Object-set-type on primitive");
}
answer = ((PrimitiveCombination0)arg1).Operator;
break;
case TC.RECORD:
answer = new Record((object [])arg1);
return(false);
case TC.SEQUENCE_3:
answer = new Sequence3((Hunk3)arg1);
break;
case TC.THE_ENVIRONMENT:
answer = TheEnvironment.Make();
break;
case TC.VARIABLE:
answer = Variable.Make((Hunk3)arg1);
break;
case TC.VECTOR:
// Someone wants to see what endian we are!
char [] source = (char [])arg1;
object [] result = new object [source.Length / 4];
result [1] = ((((((byte)source [3]) * 256)
+ ((byte)source [2])) * 256)
+ ((byte)source [1])) * 256
+ ((byte)source [0]);
result [0] = ((((((byte)source [7]) * 256)
+ ((byte)source [6])) * 256)
+ ((byte)source [5])) * 256
+ ((byte)source [4]);
answer = result;
break;
case TC.WEAK_CONS:
answer = new WeakCons(((Cons)arg1).Car, ((Cons)arg1).Cdr);
break;
default:
throw new NotImplementedException();
}
}
return(false);
}
