Hash
symeTypeCode(Syme syme)
{
Hash h = 0;
h = symeHash(syme);
if (h) return h;
tfHashDEBUG(dbOut, "Hash: %s %pSyme %pTForm\n",
symeString(syme), syme, symeType(syme));
if (symeIsExport(syme) || symeIsParam(syme) || symeIsSelf(syme)) {
h = tfHash(symeType(syme));
symeHashArg(h, (Hash) symeKind(syme));
symeHashArg(h, symeDefLevel(syme)->hash);
}
else if (symeIsImport(syme)) {
h = tfHash(symeType(syme));
symeHashArg(h, tfHash(symeExporter(syme)));
}
else {
h = tfHash(symeType(syme));
symeHashArg(h, symeDefLevel(syme)->hash);
}
tfHashDEBUG(dbOut, "Hash: %s %pSyme = %d\n",
symeString(syme), syme, h);
return symeSetHash(syme, h);
}
TForm
symeType(Syme syme)
{
Syme ext;
TForm tf;
/* Use the type of the extension if present. */
ext = symeExtensionFirst(syme);
if (ext) return symeType(ext);
/* Trigger symes from other libraries. */
symeTrigger(syme);
/* Fill types on lazy symbol meanings. */
if (symeIsLazy(syme))
return symeFillType(syme);
/* Follow forward types if present. */
tf = syme->type;
/* BDS: tfIsForward(tf) dereferences tf. Consequently, it will seg
fault if tf is null. If everything works properly, we should
never reach this point without tf pointing to something valid. */
assert(tf != NULL);
if (tfIsForward(tf))
tf = symeSetType(syme, tfFollowOnly(tf));
return tf;
}
/*
* 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();
}
Hash
gen0SymeTypeCode(Syme syme)
{
if (symeExtension(syme))
return gen0SymeTypeCode(symeExtension(syme));
else if (symeIsLazy(syme) && symeIsImport(syme))
return symeHash(syme);
else
return tfHash(symeType(symeOriginal(syme)));
}
TPoss
tpossFrSymes(SymeList symes)
{
TPoss tp = tpossEmpty();
for (; symes; symes = cdr(symes))
{
/*
if (car(symes)->type != NULL)
{
*/
tpossAdd1(tp, symeType(car(symes)));
/*
}
*/
}
return tp;
}
/*
* Extract the value of the Rep syme. Assumes that
* there is only one Rep and that it is a type-valued
* constant.
*/
local TForm
gen1ImplicitRepValue(SymeList symes)
{
Syme syme;
TForm result;
/* Get the Rep syme */
syme = gen1ImplicitRep(symes);
/* Drop out if we failed to find Rep */
if (!syme) return (TForm)NULL;
/* Get the type of the syme */
result = symeType(syme);
/* Probably a define: get its value */
switch (tfTag(result))
{
case TF_Assign:
result = tfAssignVal(result);
break;
case TF_Define:
result = tfDefineVal(result);
break;
default:
break;
}
/* Return the type */
return result;
}
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();
}
