/*
* Usage: showexports libName type-expression
* Example: showexports libaldor.al 'List(Integer)'
*/
int
main(int argc, char *argv[])
{
osInit();
sxiInit();
keyInit();
ssymInit();
dbInit();
stabInitGlobal();
tfInit();
foamInit();
optInit();
tinferInit();
pathInit();
sposInit();
ablogInit();
comsgInit();
macexInitFile();
comsgInit();
scobindInitFile();
stabInitFile();
fileAddLibraryDirectory(".");
String archive = argv[1];
String expression = argv[2];
scmdHandleLibrary("LIB", archive);
AbSyn ab = shexpParse(expression);
Stab stab = stabFile();
Syme syme = stabGetArchive(symInternConst("LIB"));
AbSyn arAbSyn = abNewId(sposNone, symInternConst("LIB"));
stabImportTForm(stab, tiGetTForm(stab, arAbSyn));
abPutUse(ab, AB_Use_Value);
scopeBind(stab, ab);
typeInfer(stab, ab);
TForm tf = tiGetTForm(stab, ab);
SymeList list = tfStabGetDomImports(stab, tf);
for (; list != listNil(Syme); list = cdr(list)) {
Syme syme = car(list);
aprintf("%s %d %d %s\n", symeString(syme),
symeDefnNum(syme), symeConstNum(syme), tfPretty(symeType(syme)));
}
scobindFiniFile();
stabFiniFile();
comsgFini();
macexFiniFile();
}
/*
* Create an explicit export: see gen0DefineRhs and gen0Lambda
* for more details on how we do this. The code in gf_fortran may
* also be helpful.
*/
void
gen0ImplicitExport(Syme syme, SymeList context, AbSyn ab)
{
TForm tf;
FoamTag repTag;
Foam lhs, rhs, def;
/* What is the Rep of this domain? */
tf = gen1ImplicitRepValue(context);
/* Get the FOAM type for this Rep */
if (tf)
repTag = gen1ImplicitType(tf);
else
{
/* Raise an error because we can't find Rep */
comsgWarning(ab, ALDOR_E_GenImpNoRep);
/* Non-fatal so continue */
repTag = FOAM_Word;
}
/* Get the rhs of the export definition */
rhs = gen1ImplicitExport(syme, repTag);
if (!rhs) return;
/* Create the FOAM for the lhs */
lhs = gen0ExtendSyme(syme);
/*
* If this is a domain export then record the foam loc/lex
* used to hold the value of this syme.
*/
if (gen0IsDomLevel(gen0State->tag) && gen0State->tag != GF_File)
gen0SymeSetInit(syme, lhs);
/* Create a definition */
def = foamNewDef(lhs, rhs);
/* Not sure if this hackery is needed anymore */
def->foamDef.hdr.defnId = symeDefnNum(syme);
/* Add the definition to the code stream */
gen0AddStmt(def, (AbSyn)NULL);
}
SymeList
genGetSymeInlined(Syme syme)
{
Length dindex;
if (symeExtension(syme)) syme = symeExtension(syme);
dindex = symeDefnNum(syme);
if (dindex < gen0SymeTableC && gen0SymeTableV[dindex])
return symeInlined(gen0SymeTableV[dindex]);
else
return listNil(Syme);
}
/*
* This function may be invoked during genfoam as well as during
* the optimisation phases. During genfoam we never want to change
* the const number associated with a given syme: if we try to do
* so, it means that the syme is conditional with more than one
* implementation and isn't "const". During optimisation however,
* we must allow the const num to be modified.
*
* unique => changing const num means clobber it
* ~unique => changing const num works
*/
void
genSetConstNum(Syme syme, int defineIdx, UShort index, Bool unique)
{
Length dindex = symeDefnNum(syme);
ULong cnum = symeConstNum(syme); /* 0 <= cnum <= 0xffff */
/* Old way */
assert(dindex < gen0SymeTableC);
/*
* Conditional symes with multiple implementations are not
* const. We detect this here if we see a syme whose const
* num is already set and isn't `index', and `unique' is
* true. Conditional symes with one possible implementation
* are okay: if the type checker allowed the call then we
* can inline it.
*/
if (unique && (cnum >= 0) && (cnum <= 0x3fff) && (cnum != index)) {
/*
* Conditional syme with multiple implementations.
* We have to record the fact that we have stomped
* on the stored const num otherwise the next time
* we got here we would think the syme was okay.
*/
symeClrConstNum(syme);
symeSetMultiCond(syme);
gen0SymeTableV[dindex] = (Syme)NULL;
}
else if (!symeIsMultiCond(syme)) {
symeSetConstNum(syme, (int) index);
gen0SymeTableV[dindex] = syme;
}
/* New way */
#if 0
SImpl nimpl;
if (defineIdx != -1) {
gen0DefSymeTableV[defineIdx] = syme;
}
if (symeImpl(syme)) {
implSetConstNum(symeImpl(syme), defineIdx, index);
}
#endif
}
Bool
genHasConstNum(Syme syme)
{
Length dindex;
if (symeExtension(syme))
syme = symeExtension(syme);
if (symeHasConstNum(syme) &&
symeConstLib(syme) != NULL)
return true;
dindex = symeDefnNum(syme);
if (0 < dindex && dindex < gen0SymeTableC && gen0SymeTableV[dindex]) {
symeSetConstNum(syme, symeConstNum(gen0SymeTableV[dindex]));
symeSetHashNum(syme, symeHashNum(gen0SymeTableV[dindex]));
symeSetDVMark(syme, symeDVMark(gen0SymeTableV[dindex]));
}
return symeHasConstNum(syme);
}
/*
* This is a debugging function which allows the contents
* of gen0SymeTable to be seen. This table provides a mapping
* between constant numbers and definition numbers.
*/
void
symeTablePrintDb(void)
{
int i;
Syme syme;
for (i = 0;i < gen0SymeTableC;i++)
{
syme = gen0SymeTableV[i];
if (syme)
{
AInt c = (AInt)-1;
AInt d = symeDefnNum(syme);
if (symeHasConstNum(syme))
c = symeConstNum(syme);
(void)fprintf(dbOut, "[%2d]: ", i);
(void)fprintf(dbOut, " (Const %2d, ", (int)c);
(void)fprintf(dbOut, " Defn %2d) ", (int)d);
symePrintDb(syme);
}
}
}
local Foam
gen1ImplicitExport(Syme syme, FoamTag repTag)
{
TForm tf, tfret;
AInt retfmt, index;
Foam foam, clos;
FoamTag retType;
AbSyn params, oldex, id;
FoamList pars;
Length i, gfTag;
GenFoamState saved;
Hash hash;
/* Paranoia */
assert(syme);
/* Get the type of this syme */
tf = symeType(syme);
assert (tfIsMap(tf));
/* Name of the export */
gen0ProgName = strCopy(symeString(syme));
/* Type hash code */
hash = tfHash(tf);
/* Is this something we know about? */
for (i = gfTag = 0;(i < GFI_LIMIT) && !gfTag; i++)
{
struct gf_impl_info *e = &gfImplicitInfoTable[i];
if (e->type != hash) continue;
if (!strEqual(e->name, gen0ProgName)) continue;
gfTag = i + 1;
}
/* Did we recognise it? */
if (!gfTag)
{
bug("[%s] %s#%ld not recognised\n",
"gen1ImplicitExport", gen0ProgName, hash);
return (Foam)NULL;
}
else
gfTag--;
/* Note the function signature */
tfret = tfMapRet(tf);
retType = gen0Type(tfret, &retfmt);
/* Fake up a bit of absyn */
id = abNewId(sposNone, symIntern(gen0ProgName));
abSetDefineIdx(id, symeDefnNum(syme));
/* Not sure if we need this ... */
oldex = gen0ProgPushExporter(id);
/* Deal with const number */
/* gen0AddConst(symeConstNum(syme), gen0NumProgs); */
genSetConstNum(syme, abDefineIdx(id), (UShort) gen0NumProgs, true);
/* Create a closure for the function */
clos = gen0ProgClosEmpty();
foam = gen0ProgInitEmpty(gen0ProgName, id);
/* What format number are we using? */
index = gen0FormatNum;
/* Save the current state */
saved = gen0ProgSaveState(PT_ExFn);
/*
* Deal with special return types. None of these
* ought to appear at the moment but there is no
* point in creating extra work for the future.
*/
if (tfIsMulti(tfret))
retfmt = gen0MultiFormatNumber(tfret);
if (tfIsGenerator(tfret))
foamProgSetGenerator(foam);
/* Create the parameters for this function */
params = ab0ImplicitExportArgs(tfMapArg(tf));
/* Initialise the program state */
gen0State->type = tf;
gen0State->param = params;
gen0State->program = foam;
/* Not sure if we really need this ... see below */
#ifdef PUSH_FORAMTS
gen0PushFormat(index);
#endif
/* Create the parameter list */
pars = gen0ImplicitExportArgs(tfMapArg(tf));
/* Generate code for the body of this export */
switch (gfTag)
{
case GFI_PackedArrayNew:
gen0ImplicitPANew(pars, repTag);
break;
case GFI_PackedArrayGet:
gen0ImplicitPAGet(pars, repTag);
break;
case GFI_PackedArraySet:
gen0ImplicitPASet(pars, repTag);
break;
case GFI_PackedRecordSet:
gen0ImplicitPRSet(pars, repTag);
break;
case GFI_PackedRecordGet:
gen0ImplicitPRGet(pars, repTag);
break;
case GFI_PackedRepSize:
gen0ImplicitPRSize(pars, repTag);
break;
default:
bug("[%s] GFI tag #%d not recognised\n",
"gen1ImplicitExport", gfTag);
}
#ifdef PUSH_FORAMTS
gen0ProgAddFormat(index);
gen0ProgFiniEmpty(foam, retType, retfmt);
#else
/*
* Finish off the FOAM creation. Note that we want to
* use a basic machine type for the return type of this
* function so that Fortran can understand the result.
* This means we use `rtype' in gen0ProgFiniEmpty()
* rather than `retType' which we would do normally.
*/
gen0UseStackedFormat(int0); /* These two lines provide a format */
gen0ProgPushFormat(int0); /* for the lexical argument `op' */
gen0ProgFiniEmpty(foam, retType, retfmt);
#endif
/* Optimisation bits */
/* foam->foamProg.infoBits = IB_INLINEME; */
foamOptInfo(foam) = inlInfoNew(NULL, foam, NULL, false);
/* Compute side-effects of this foam */
/* gen0ComputeSideEffects(foam); */
/* Restore the saved state before returning */
gen0ProgRestoreState(saved);
return clos;
}
/*
* Usage: showexports libName type-expression
* Example: showexports libaldor.al 'List(Integer)'
*/
int
main(int argc, char *argv[])
{
osInit();
sxiInit();
keyInit();
ssymInit();
dbInit();
stabInitGlobal();
tfInit();
foamInit();
optInit();
tinferInit();
pathInit();
sposInit();
ablogInit();
comsgInit();
macexInitFile();
comsgInit();
scobindInitFile();
stabInitFile();
fileAddLibraryDirectory(".");
String archive = argv[1];
String expression = argv[2];
scmdHandleLibrary("LIB", archive);
AbSyn ab = shexpParse(expression);
Stab stab = stabFile();
Syme syme = stabGetArchive(symInternConst("LIB"));
AbSyn arAbSyn = abNewId(sposNone, symInternConst("LIB"));
AbSyn boolean = abNewId(sposNone, symInternConst("Boolean"));
stabImportTForm(stab, tiGetTForm(stab, arAbSyn));
stabImportTForm(stab, tiGetTForm(stab, boolean));
abPutUse(ab, AB_Use_Value);
scopeBind(stab, ab);
typeInfer(stab, ab);
TForm tf = tiGetTForm(stab, ab);
aprintf("Type: %s Cat: %d\n", tfPretty(tf), tfSatCat(tf));
if (tfSatDom(tf)) {
SymeList list = tfGetCatExports(tf);
aprintf("Category\n");
for (; list != listNil(Syme); list = cdr(list)) {
Syme syme = car(list);
aprintf("%5s %3d %s %pAbSynList\n", symeString(syme), symeHasDefault(syme),
tfPretty(symeType(syme)), symeCondition(syme));
}
}
else {
aprintf(">>> Exports\n");
SymeList list = tfStabGetDomImports(stab, tf);
for (; list != listNil(Syme); list = cdr(list)) {
Syme syme = car(list);
aprintf("%s %d %d %s\n", symeString(syme),
symeDefnNum(syme), symeConstNum(syme), tfPretty(symeType(syme)));
}
TQualList tqList;
aprintf(">>> Cascades\n");
tqList = tfGetDomCascades(tf);
for (; tqList != listNil(TQual); tqList = cdr(tqList)) {
TQual tq = car(tqList);
aprintf("--> %s\n", tfPretty(tqBase(tq)));
}
}
scobindFiniFile();
stabFiniFile();
comsgFini();
macexFiniFile();
}