Foam
gen0TupleElt(Foam tuple, int index)
{
return foamNewAElt(FOAM_Word,
foamNewSInt(index),
gen0NewTupleValsRef(tuple));
}
local Foam
gen0GenerBoundFun(AbSyn bound, GenBoundCalc calc)
{
if (calc)
return gen0ComputeBoundFunction(calc);
else if (!bound || abTag(bound) == AB_Nothing)
return gen0BuildFunFromFoam(boundFName(), FOAM_SInt,
foamNewSInt(-1));
else {
GenFoamState saved;
Foam foam, clos, ret;
clos = foamNewClos(foamNewEnv(-1), foamNewConst(gen0NumProgs));
foam = gen0ProgInitEmpty(boundFName(), bound);
saved = gen0ProgSaveState(PT_ExFn);
ret = genFoamVal(bound);
if (ret) gen0AddStmt(foamNewReturn(ret), bound);
gen0UseStackedFormat(int0);
gen0ProgPushFormat(emptyFormatSlot);
gen0ProgPushFormat(emptyFormatSlot);
gen0ProgFiniEmpty(foam, gen0Type(gen0AbType(bound), NULL), int0);
gen0AddLexLevels(foam, 2);
foamOptInfo(foam) = inlInfoNew(NULL, foam, NULL, false);
foam->foamProg.infoBits |= IB_INLINEME;
gen0ProgRestoreState(saved);
return clos;
}
}
/*
* Construct the body of PackedRecordSet: (Ptr, %) -> %
*/
local void
gen0ImplicitPRSet(FoamList pars, FoamTag repTag)
{
Foam parPtr, parVal, foam, cast;
/* Get the pointer and cast to Arr */
assert(pars);
parPtr = foamCopy(car(pars)); pars = cdr(pars);
parPtr = foamNewCast(FOAM_Arr, parPtr);
/* Get the value */
assert(pars);
parVal = foamCopy(car(pars)); pars = cdr(pars);
assert(!pars);
/* Cast to raw type */
cast = foamNewCast(repTag, foamCopy(parVal));
/* Construct an array access */
foam = foamNewAElt(repTag, foamNewSInt(int0), parPtr);
/* Create the update */
foam = foamNewSet(foam, cast);
gen0AddStmt(foam, (AbSyn)NULL);
/* Return the value inserted */
foam = foamNewReturn(parVal);
gen0AddStmt(foam, (AbSyn)NULL);
}
Foam
genYield(AbSyn absyn)
{
/* set the place variable */
gen0AddStmt(foamNewSet(yieldPlaceVar,
foamNewSInt(++gen0State->yieldCount)), absyn);
gen0AddStmt(foamNewSet(foamCopy(gen0State->yieldValueVar),
genFoamVal(absyn->abYield.value)), absyn);
gen0AddStmt(foamNewGoto(gen0State->yieldPlace), absyn);
gen0AddStmt(foamNewLabel(gen0State->labelNo), absyn);
gen0State->yieldLabels = listCons(AInt)(gen0State->labelNo++,
gen0State->yieldLabels);
return 0;
}
Foam
gen0MakeTupleFromFoam(int argc, Foam *argv)
{
Foam t1, t2;
int i, format;
t1 = gen0TempLocal0(FOAM_Arr, FOAM_Word);
gen0AddStmt(gen0ANew(t1, FOAM_Word, argc), NULL);
for (i=0; i < argc; i++) {
gen0AddStmt(gen0ASet(t1, (AInt) i, FOAM_Word, argv[i]), NULL);
}
/*!! This should be a callout to tuple$Tuple(S) */
format = gen0MakeTupleFormat();
t2 = gen0TempLocal0(FOAM_Rec, format);
gen0AddStmt(gen0RNew(t2, format), NULL);
gen0AddStmt(gen0RSet(t2, format, (AInt) 0, foamNewSInt(argc)), NULL);
gen0AddStmt(gen0RSet(t2, format, (AInt) 1, foamCopy(t1)), NULL);
return t2;
}
local void
testCall()
{
Foam foam;
foam = foamNew(FOAM_OCall, 3, FOAM_Clos, foamNewNil(), foamNewNil());
testIntEqual("foamOCallArgc", 0, foamOCallArgc(foam));
foam = foamNew(FOAM_OCall, 4, FOAM_Clos, foamNewNil(), foamNewNil(), foamNewSInt(1));
testIntEqual("foamOCallArgc", 1, foamOCallArgc(foam));
foam = foamNewPCall(FOAM_Proto_C, FOAM_NOp, foamNewGlo(int0), NULL);
testIntEqual("argc", 0, foamPCallArgc(foam));
testIntEqual("protocol", FOAM_Proto_C, foam->foamPCall.protocol);
foam = foamNewCCall(FOAM_Word, foamNewGlo(int0), NULL);
testIntEqual("argc", 0, foamCCallArgc(foam));
testTrue("op", foamEqual(foamNewGlo(int0), foam->foamCCall.op));
foam = foamNewCCall(FOAM_Word, foamNewGlo(int0), foamNewPar(1), NULL);
testIntEqual("argc", 1, foamCCallArgc(foam));
testTrue("op", foamEqual(foamNewPar(1), foam->foamCCall.argv[0]));
}
/*
* Construct the body of PackedRecordGet: Ptr -> %
*/
local void
gen0ImplicitPRGet(FoamList pars, FoamTag repTag)
{
Foam par, foam;
/* Get the pointer */
assert(pars);
par = foamCopy(car(pars)); pars = cdr(pars);
assert(!pars);
/* Construct an array access */
foam = foamNewAElt(repTag, foamNewSInt(int0), par);
/* Cast to uniform type */
foam = foamNewCast(FOAM_Word, foam);
/* Return the value extracted */
foam = foamNewReturn(foam);
gen0AddStmt(foam, (AbSyn)NULL);
}
local Foam
gen0GenerBodyFun(AbSyn iter, TForm tf)
{
Scope("genBody0");
FoamList topLines;
Bool flag;
GenerGenInfo fluid(gen0GenInfo);
GenBoundCalc calc = NULL;
AbSyn body = iter->abGenerate.body;
AbSyn bound = iter->abGenerate.count;
FoamTag retType = gen0Type(tf, NULL);
Foam fluid(gen0GenVars);
GenFoamState saved;
Foam foam, clos, stmt;
Foam done, step, bnd, value;
gen0GenInfo = NULL;
#ifdef GenerBetterGuesses
if (!bound || abTag(bound) == AB_Nothing) {
calc = gen0MakeBoundInit(body);
gen0ComputeGeners();
}
#endif
flag = gen0AddImportPlace(&topLines);
clos = gen0ProgClosEmpty();
foam = gen0ProgInitEmpty("generBaseFn", body);
saved = gen0ProgSaveState(PT_Gener);
gen0GenVars = gen0MakeGenerVars(tf);
step = gen0GenerStepFun(body, tf);
done = gen0GenerDoneFun();
value = gen0GenerValueFun(retType, tf);
bnd = gen0GenerBoundFun(bound, calc);
stmt = foamNewReturn(foamNew(FOAM_Values, 4, done, step, value, bnd));
gen0AddStmt(stmt, body);
gen0UseStackedFormat(int0);
gen0ProgPushFormat(int0);
gen0ProgFiniEmpty(foam, FOAM_NOp, int0);
foam->foamProg.format = gen0MakeGenerRetFormat();
gen0AddLexLevels(foam, 1);
foam->foamProg.infoBits = IB_SIDE | IB_INLINEME;
foamOptInfo(foam) = inlInfoNew(NULL, foam, NULL, false);
if (gen0GenInfo) stoFree(gen0GenInfo);
gen0ProgRestoreState(saved);
if (flag) gen0ResetImportPlace(topLines);
stmt = foamNewSet(yieldPlaceVar, foamNewSInt(int0));
gen0AddStmt(stmt, iter);
foamFree(gen0GenVars);
gen0GenVars = NULL;
Return(clos);
}
hashCombinePair(hUTS_FI, hMapping)))));
/* Clash: UTS_FI/ULS_FI */
testIntEqual("(X, X) -> X", 898414238,
hashCombinePair(134808007,
hashCombinePair(twist, hashCombinePair(134808007,
hashCombinePair(134808007, hMapping)))));
}
local void
testSIntReduce()
{
IF_LongOver32Bits(
Foam foam;
Foam reduced;
foam = foamNewSInt(1L<<40);
reduced = foamSIntReduce(foam);
testFalse("t0", foam == reduced);
foam = foamNewSInt(-(1L<<40));
reduced = foamSIntReduce(foam);
testFalse("t0", foam == reduced);
testFalse("t0", foamEqual(foamSIntReduce(foamNewSInt(1L<<40)), reduced));
testTrue("t1", foamTag(reduced) == FOAM_BCall && reduced->foamBCall.op == FOAM_BVal_SIntNegate);
)
/* Really need a working foam interpreter to test this properly */
/* .. probably easier to do as library tests */
}
local Buffer tFoamToBuffer(Foam foam);