local Foam
gen0GenerStepFun(AbSyn body, TForm tf)
{
GenFoamState saved;
Foam foam, clos, tmp;
FoamTag yieldType;
AInt startLabel;
AInt fmtSlot;
clos = foamNewClos(foamNewEnv(-1), foamNewConst(gen0NumProgs));
foam = gen0ProgInitEmpty(stepperFName(), body);
saved = gen0ProgSaveState(PT_Gener);
startLabel = gen0State->labelNo++;
gen0State->yieldPlace = gen0State->labelNo++;
tf = tfDefineeType(tf);
yieldType = gen0Type(tf, &fmtSlot);
gen0State->yieldValueVar = gen0TempLocal0(yieldType, fmtSlot);
tmp = foamNewNOp();
gen0AddStmt(tmp, NULL); /* filled by gen0GenerSelect */
gen0AddStmt(foamNewLabel(startLabel), NULL);
gen0AddStmt(foamNewSet(yieldDoneVar, foamNewBool(int0)), NULL);
genFoamStmt(body);
gen0AddStmt(foamNewSet(yieldDoneVar, foamNewBool(1)), NULL);
gen0AddStmt(foamNewReturn(foamNew(FOAM_Values, int0)), NULL);
gen0AddStmt(foamNewLabel(gen0State->yieldPlace), NULL);
gen0AddStmt(foamNewSet(yieldValVar, gen0State->yieldValueVar), NULL);
gen0AddStmt(foamNewReturn(foamNew(FOAM_Values, int0)), NULL);
gen0UseStackedFormat(int0);
gen0ProgPushFormat(emptyFormatSlot);
gen0ProgPushFormat(emptyFormatSlot);
gen0ProgFiniEmpty(foam, FOAM_NOp, int0);
/* fill in the select statement */
foam->foamProg.body->foamSeq.argv[0] = gen0GenerSelect(startLabel);
foamFree(tmp);
gen0AddLexLevels(foam, 2);
foam->foamProg.infoBits = IB_SIDE | IB_INLINEME;
foamOptInfo(foam) = inlInfoNew(gen0State->stab, foam, NULL, true);
gen0ProgRestoreState(saved);
return clos;
}
local void
testTests()
{
Foam foam = foamNewSet(foamNewLoc(1), foamNewLoc(1));
testFalse("", foamIsMultiAssign(foam));
foam = foamNewSet(foamNew(FOAM_Values, 2, foamNewLoc(1), foamNewLoc(2)),
foamNewLoc(3));
testTrue("", foamIsMultiAssign(foam));
}
Foam
genReferenceFrFoam(Foam rid, TForm tf, AbSyn ab)
{
AInt fmt;
Foam getterFn, setterFn;
Foam tmpvar;
GenFoamState saved;
Foam foam, clos;
/* Create a closure for the function */
clos = gen0ProgClosEmpty();
foam = gen0ProgInitEmpty("refBaseFn", ab);
/* Save the current state (WHY?) */
saved = gen0ProgSaveState(PT_ExFn);
/* Create the getter/setter functions */
getterFn = gen0RefGetter(rid, ab, tf);
setterFn = gen0RefSetter(rid, ab, tf);
/*
* Wrap the getter/setter functions in a multi
* which will be returned by a nullary function:
* refBaseFn():Cross(()->T, T->T) == (getter, setter);
*/
fmt = gen0MakeRefFormat();
tmpvar = foamNew(FOAM_Values, 2, getterFn, setterFn);
tmpvar = foamNewReturn(tmpvar);
/* Add this to the current FOAM block */
gen0AddStmt(tmpvar, ab);
/* Standard gubbins ... */
gen0UseStackedFormat(int0);
gen0ProgPushFormat(int0);
gen0ProgFiniEmpty(foam, FOAM_NOp, int0);
foam->foamProg.format = fmt;
gen0AddLexLevels(foam, 1);
/* Optimisation bits */
foam->foamProg.infoBits = IB_SIDE | IB_INLINEME;
foamOptInfo(foam) = inlInfoNew(NULL, foam, NULL, false);
/* Restore the saved state before returning. */
gen0ProgRestoreState(saved);
return clos;
}
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]));
}
local Foam
gen0MakeGenerVars(TForm retType)
{
Foam done, place, value;
FoamTag type;
AInt fmt;
done = gen0Temp(FOAM_Bool);
place = gen0Temp(FOAM_SInt);
/* multi-valued gens not supported yet */
type = gen0Type(retType, &fmt);
assert(!tfIsMulti(retType));
value = gen0Temp0(type, fmt);
return foamNew(FOAM_Values, 3, done, place, value);
}
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);
}
/*
* Construct the body of PackedRepSize: () -> SInt
*/
local void
gen0ImplicitPRSize(FoamList pars, FoamTag repTag)
{
Foam foam;
FoamBValTag bvTag;
/* Check that there are no parameters */
assert(!pars);
#if UseTypeTag
/* Work out which TypeTag* call we ought to use */
switch (repTag)
{
#if 0
case FOAM_Int8 : bvTag = FOAM_BVal_TypeInt8; break;
case FOAM_Int16 : bvTag = FOAM_BVal_TypeInt16; break;
case FOAM_Int32 : bvTag = FOAM_BVal_TypeInt32; break;
case FOAM_Int64 : bvTag = FOAM_BVal_TypeInt64; break;
case FOAM_Int128 : bvTag = FOAM_BVal_TypeInt128; break;
#endif
case FOAM_Nil : bvTag = FOAM_BVal_TypeNil; break;
case FOAM_Char : bvTag = FOAM_BVal_TypeChar; break;
case FOAM_Bool : bvTag = FOAM_BVal_TypeBool; break;
case FOAM_Byte : bvTag = FOAM_BVal_TypeByte; break;
case FOAM_HInt : bvTag = FOAM_BVal_TypeHInt; break;
case FOAM_SInt : bvTag = FOAM_BVal_TypeSInt; break;
case FOAM_BInt : bvTag = FOAM_BVal_TypeBInt; break;
case FOAM_SFlo : bvTag = FOAM_BVal_TypeSFlo; break;
case FOAM_DFlo : bvTag = FOAM_BVal_TypeDFlo; break;
case FOAM_Word : bvTag = FOAM_BVal_TypeWord; break;
case FOAM_Clos : bvTag = FOAM_BVal_TypeClos; break;
case FOAM_Ptr : bvTag = FOAM_BVal_TypePtr; break;
case FOAM_Rec : bvTag = FOAM_BVal_TypeRec; break;
case FOAM_Arr : bvTag = FOAM_BVal_TypeArr; break;
case FOAM_TR : bvTag = FOAM_BVal_TypeTR; break;
default : bvTag = FOAM_BVal_TypeWord; break;
}
/* Create a call to get the type tag */
foam = foamNew(FOAM_BCall, 1, bvTag);
/* Pass this to the builtin size computer */
foam = foamNew(FOAM_BCall, 2, FOAM_BVal_RawRepSize, foam);
#else
/* Work out which SizeOf* call we ought to use */
switch (repTag)
{
#if 0
case FOAM_Int8 : bvTag = FOAM_BVal_SizeOfInt8; break;
case FOAM_Int16 : bvTag = FOAM_BVal_SizeOfInt16; break;
case FOAM_Int32 : bvTag = FOAM_BVal_SizeOfInt32; break;
case FOAM_Int64 : bvTag = FOAM_BVal_SizeOfInt64; break;
case FOAM_Int128 : bvTag = FOAM_BVal_SizeOfInt128; break;
#endif
case FOAM_Nil : bvTag = FOAM_BVal_SizeOfNil; break;
case FOAM_Char : bvTag = FOAM_BVal_SizeOfChar; break;
case FOAM_Bool : bvTag = FOAM_BVal_SizeOfBool; break;
case FOAM_Byte : bvTag = FOAM_BVal_SizeOfByte; break;
case FOAM_HInt : bvTag = FOAM_BVal_SizeOfHInt; break;
case FOAM_SInt : bvTag = FOAM_BVal_SizeOfSInt; break;
case FOAM_BInt : bvTag = FOAM_BVal_SizeOfBInt; break;
case FOAM_SFlo : bvTag = FOAM_BVal_SizeOfSFlo; break;
case FOAM_DFlo : bvTag = FOAM_BVal_SizeOfDFlo; break;
case FOAM_Word : bvTag = FOAM_BVal_SizeOfWord; break;
case FOAM_Clos : bvTag = FOAM_BVal_SizeOfClos; break;
case FOAM_Ptr : bvTag = FOAM_BVal_SizeOfPtr; break;
case FOAM_Rec : bvTag = FOAM_BVal_SizeOfRec; break;
case FOAM_Arr : bvTag = FOAM_BVal_SizeOfArr; break;
case FOAM_TR : bvTag = FOAM_BVal_SizeOfTR; break;
default : bvTag = FOAM_BVal_SizeOfWord; break;
}
/* Create a call to get the type tag */
foam = foamNew(FOAM_BCall, 1, bvTag);
#endif
/* Return the result of the function call */
foam = foamNewReturn(foam);
gen0AddStmt(foam, (AbSyn)NULL);
}
