local Foam
gen0RefSetter(Foam rid, AbSyn id, TForm tf)
{
/* Create the reference setter function */
GenFoamState saved;
Foam foam, clos;
AInt fmt, paridx;
FoamTag type;
Foam param;
/* Create a closure for the function */
type = gen0Type(tf, &fmt);
clos = foamNewClos(foamNewEnv(-1), foamNewConst(gen0NumProgs));
foam = gen0ProgInitEmpty(setterFName(), id);
/* Save the current state and create a new one for us */
saved = gen0ProgSaveState(PT_ExFn);
/* Update the state of this lambda */
gen0State->type = tfMap(tf, tf); /* T -> T */
gen0State->program = foam;
/* Add a parameter */
param = foamNewDecl(type, strCopy("v"), emptyFormatSlot);
paridx = gen0AddParam(param);
/* Generate the code for { free x:T; x := v; return v } */
/* gen0AddStmt(foamNewSet(gen0RefId(id), foamNewPar(paridx)), id); */
gen0AddStmt(foamNewSet(foamCopy(rid), foamNewPar(paridx)), id);
gen0AddStmt(foamNewReturn(foamNewPar(paridx)), id);
/* Standard gubbins ... */
gen0UseStackedFormat(int0);
gen0ProgPushFormat(emptyFormatSlot);
gen0ProgPushFormat(emptyFormatSlot); /* Two lexical levels */
gen0ProgFiniEmpty(foam, type, fmt);
gen0AddLexLevels(foam, 2);
/* 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;
}
Foam
gen0CacheClos(AbSyn ab, int nargs, Foam fnClos)
{
/* ab is just for position... */
Foam *paramv;
RTCacheInfo cache;
Foam var, clos, fnVar, foam;
Foam call;
FoamTag retType = FOAM_Word;
AInt index;
int i;
cache = gen0CacheMakeEmpty(ab);
fnVar = gen0TempLex(FOAM_Word);
paramv = (Foam*) stoAlloc(OB_Other, nargs* sizeof(Foam));
gen0AddStmt(cache->init, cache->ab);
gen0AddStmt(foamNewSet(fnVar, fnClos), ab);
gen0AddLexLevels(fnVar, 1);
clos = gen0ProgClosEmpty();
foam = gen0ProgInitEmpty(gen0ProgName, NULL);
index = gen0FormatNum;
gen0ProgPushState(NULL, GF_Lambda);
gen0State->type = NULL;
gen0State->program = foam;
gen0PushFormat(index);
call = foamNewEmpty(FOAM_CCall, nargs+2);
call->foamCCall.op = foamCopy(fnVar);
call->foamCCall.type = FOAM_Word;
for (i=0; i < nargs; i++) {
paramv[i] = foamNewPar(i);
call->foamCCall.argv[i] = foamNewPar(i);
}
gen0CacheCheck(cache, nargs, paramv);
var = gen0CacheReturn(cache, call);
gen0AddStmt(foamNewReturn(var), ab);
gen0ProgAddFormat(index);
gen0ProgFiniEmpty(foam, retType, int0);
foamOptInfo(foam) = inlInfoNew(NULL, foam, NULL, false);
gen0ProgPopState();
stoFree(paramv);
gen0CacheKill(cache);
return clos;
}
local Foam
gen1ImplicitExportArg(TForm tf, Length i)
{
FoamTag fmtype;
Foam decl;
Symbol sym;
String symstr;
/* What was the name of this parameter? */
sym = gen0ImplicitArgName(i);
symstr = strCopy(symString(sym));
/* What is the type of this argument? */
fmtype = gen0Type(tf, NULL);
/* Create a declaration for this parameter */
decl = foamNewDecl(fmtype, symstr, emptyFormatSlot);
/* Add the new parameter to the FOAM prog */
gen0AddParam(decl);
/* Return the FOAM for this parameter */
return foamNewPar(i);
}
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]));
}