local void
testSymeAddCondition()
{
String B_imp = "import from Boolean";
String C_txt = "C: Category == with";
String D1_txt = "D1: with == add";
String D2_txt = "D2: with == add";
StringList lines = listList(String)(4, B_imp, C_txt, D1_txt, D2_txt);
AbSynList code = listCons(AbSyn)(stdtypes(), abqParseLines(lines));
AbSyn absyn = abNewSequenceL(sposNone, code);
initFile();
Stab stab = stabFile();
abPutUse(absyn, AB_Use_NoValue);
scopeBind(stab, absyn);
typeInfer(stab, absyn);
AbSyn D1 = abFrSyme(uniqueMeaning(stabFile(), "D1"));
AbSyn D2 = abFrSyme(uniqueMeaning(stabFile(), "D2"));
AbSyn C = abFrSyme(uniqueMeaning(stabFile(), "C"));
Syme syme1 = symeNewExport(symInternConst("syme2"), tfNewAbSyn(TF_General, id("D")), car(stab));
symeAddCondition(syme1, sefo(has(D1, C)), true);
testIntEqual("test1", 1, listLength(Sefo)(symeCondition(syme1)));
Syme syme2 = symeNewExport(symInternConst("syme1"),tfNewAbSyn(TF_General, id("D")), car(stab));
symeAddCondition(syme2, sefo(and(has(D1, C),
has(D2, C))), true);
testIntEqual("test2", 2, listLength(Sefo)(symeCondition(syme2)));
finiFile();
}
Bool
symeTop(Syme syme)
{
return (symeIsExport(syme) || symeIsExtend(syme)) &&
symeOriginal(syme) == syme &&
listMemq(StabLevel)(stabFile(), symeDefLevel(syme));
}
Foam
compPhaseLoadFoam(EmitInfo finfo)
{
SymeList symes = 0;
Foam foam;
FileName fn = emitSrcFile(finfo);
int ftype = ftypeNo(fnameType(fn));
phStart(PH_Load);
foam = 0;
if (ftype == FTYPENO_INTERMED) {
Lib lib = libRead(fn);
emitSetFileIdName(libGetFileId(lib));
if (emitIsOutputNeeded(finfo, FTYPENO_SYMEEXPR)) {
symes = libGetSymes(lib);
stabPutMeanings(stabFile(), symes);
}
foam = libGetFoam(lib);
/*!! libClose(lib); */
}
if (ftype == FTYPENO_FOAMEXPR) {
FILE *fin;
fin = fileRdOpen(fn);
foam = foamRdSExpr(fin, &fn, NULL);
fclose(fin);
}
phEnd((PhPrFun) foamPrint, (PhPrFun) 0, (Pointer) foam);
return foam;
}
local void
hfoldProg(Foam prog)
{
Foam body;
int i;
hfoldProgInfo = foamOptInfo(prog);
if (!hfoldProgInfo) return; /* saved files have no foamOptInfo */
hfoldStab = hfoldProgInfo->stab ? hfoldProgInfo->stab : stabFile();
/* No Stab => nothing to do */
if (!hfoldStab)
return;
hfoldNumLocals = foamDDeclArgc(prog->foamProg.locals);
body = prog->foamProg.body;
for (i=0; i<foamArgc(body); i++) {
body->foamSeq.argv[i] = hfoldExpr(body->foamSeq.argv[i]);
}
hfoldStab = NULL;
hfoldProgInfo = NULL;
}
local void
testSymeSExpr()
{
String aSimpleDomain = "+++Comment\nDom: Category == with {f: () -> () ++ f\n}";
StringList lines = listList(String)(1, aSimpleDomain);
AbSynList code = listCons(AbSyn)(stdtypes(), abqParseLines(lines));
AbSyn absyn = abNewSequenceL(sposNone, code);
initFile();
Stab stab = stabFile();
abPutUse(absyn, AB_Use_NoValue);
scopeBind(stab, absyn);
typeInfer(stab, absyn);
testTrue("Declare is sefo", abIsSefo(absyn));
testIntEqual("Error Count", 0, comsgErrorCount());
SymeList symes = stabGetMeanings(stab, ablogFalse(), symInternConst("Dom"));
testIntEqual("unique meaning", 1, listLength(Syme)(symes));
Syme syme = car(symes);
SExpr sx = symeSExprAList(syme);
finiFile();
}
/*
* 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();
}
void
compGLoopEval(FILE * fin, FILE * fout, EmitInfo finfo)
{
Stab stab = stabFile();
AbSyn ab;
Foam foam;
static int lineno = 0;
comsgInit();
while (!osFEof(fin)) {
Bool ok;
intStepNo += 1;
comsgFini();
comsgInit();
car(stab)->isChecked = false;
if (SetJmp(compFintJmpBuf))
if (osFEof(fin))
break;
comsgPromptPrint(fin, fout,
fintHistory ? "%%%d := " : "%%%d >> ",
intStepNo);
osSetBreakHandler(compFintBreakHandler0);
ab = compFileFront(finfo, stab, fin, &lineno);
breakSetRoot(ab);
if (!compIsMoreAfterFront(finfo) ||
abIsEmptySequence(ab))
continue;
ab = (AbSyn) fintWrap(ab, intStepNo);
foam = compFileMiddle(finfo, stab, ab);
if (!foam) continue;
ok = fint(foam);
if (!ok)
fprintf(fout, "Unhandled Exception!\n");
foamFree(foam);
if (fintVerbose && ok)
fintPrintType(fout, ab);
fintDisplayTimings();
}
comsgFini();
}
local void
testAblog()
{
initFile();
ablogDebug = 0;
String Boolean_imp = "import from Boolean";
String C0_def = "C0: Category == with";
String C1_def = "C1: Category == C0 with";
String D0_def = "D0: C0 with == add";
String D1_def = "D1: C1 with == add";
StringList lines = listList(String)(5, Boolean_imp, C0_def, C1_def, D0_def, D1_def);
AbSynList code = listCons(AbSyn)(stdtypes(), abqParseLines(lines));
AbSyn absyn = abNewSequenceL(sposNone, code);
abPutUse(absyn, AB_Use_NoValue);
Stab file = stabFile();
Stab stab = stabPushLevel(file, sposNone, STAB_LEVEL_LARGE);
scopeBind(stab, absyn);
typeInfer(stab, absyn);
testTrue("Declare is sefo", abIsSefo(absyn));
testIntEqual("Error Count", 0, comsgErrorCount());
Syme C0 = uniqueMeaning(stab, "C0");
Syme C1 = uniqueMeaning(stab, "C1");
Syme D0 = uniqueMeaning(stab, "D0");
Syme D1 = uniqueMeaning(stab, "D1");
AbSyn sefo1 = has(abFrSyme(D1), abFrSyme(C1));
AbSyn sefo0 = has(abFrSyme(D1), abFrSyme(C0));
tiSefo(stab, sefo0);
tiSefo(stab, sefo1);
AbLogic cond0 = ablogFrSefo(sefo0);
AbLogic cond1 = ablogFrSefo(sefo1);
afprintf(dbOut, "Implies: %pAbLogic %pAbLogic %d\n", cond1, cond0, ablogImplies(cond1, cond0));
afprintf(dbOut, "Implies: %pAbLogic %pAbLogic %d\n", cond0, cond1, ablogImplies(cond0, cond1));
testTrue("00", ablogImplies(cond0, cond0));
testTrue("10", ablogImplies(cond1, cond0));
testFalse("01",ablogImplies(cond0, cond1));
testTrue("11", ablogImplies(cond1, cond1));
}
/*
* Compile .fm or .ao file, returning error count.
*/
int
compSavedFile(EmitInfo finfo)
{
Foam foam;
Stab stab;
compFileInit(finfo);
stab = stabFile();
foam = compFileLoadFoam(finfo);
compFileSave(finfo, stab, foam);
compFileBack(finfo, foam);
foamFree(foam);
compFileFini(finfo);
return comsgErrorCount();
}
local void
testForeign()
{
String Boolean_imp = "import from Boolean";
String P_def = "Pointer: with == add";
String C_def = "C: with == add";
String F_def = "Foreign(T: Type): with == add";
String R_def = "R == Record(x: Pointer)";
String fn_imp = "import { fn: R -> () } from Foreign C";
String tst_def = "test(p: R): () == fn(p)";
StringList lines = listList(String)(7, Boolean_imp,
P_def, C_def, F_def, R_def,
fn_imp, tst_def);
AbSynList absynList = listCons(AbSyn)(stdtypes(), abqParseLines(lines));
AbSyn absyn = abNewSequenceL(sposNone, absynList);
Stab stab;
Foam foam;
initFile();
stab = stabFile();
abPutUse(absyn, AB_Use_NoValue);
abPrintDb(absyn);
scopeBind(stab, absyn);
typeInfer(stab, absyn);
testIntEqual("Error Count", 0, comsgErrorCount());
foam = generateFoam(stab, absyn, "test");
/* At this point, we should check that the 'test' function
* calls 'fn' with a type of FOAM_Rec. In order to do this
* nicely, there should be a decent way of searching a blob of
* foam for certain properties. */
#if 0
FoamList pcall = foamFind(fmfAnd(fmfFoamTag(FOAM_PCall), fmfPCallProto(FOAM_Proto_C)),
foam);
testAIntEqual(FOAM_Rec, foamExprType(foam, pcall->first->foamPCall.argv[0]))
#endif
}
/*
* Compile .as file, returning error count.
*/
int
compSourceFile(EmitInfo finfo)
{
AbSyn ab;
Stab stab;
Foam foam;
int msgCount;
compFileInit(finfo);
breakSetRoot(NULL);
stab = stabFile();
ab = compFileFront(finfo, stab, NULL, NULL);
breakSetRoot(ab);
if (emitIsOutputNeededOrWarn(finfo, FTYPENO_CPP)) {
/* Need to inspect finfo to get the filename */
FileName fn = emitFileName(finfo, FTYPENO_INTERMED);
genCpp(ab,fnameDir(fn),fnameName(fn));
emitTheCpp();
}
if (compIsMoreAfterFront(finfo)) {
foam = compFileMiddle(finfo, stab, ab);
compFileSave(finfo, stab, foam);
compFileBack(finfo, foam);
foamFree(foam);
}
msgCount = comsgErrorCount();
compFileFini(finfo);
/* abFree(ab); !! ab is seeping into types. */
if (msgCount < 1) breakInterrupt();
return msgCount;
}
Sefo
sefo(AbSyn absyn)
{
tiSefo(stabFile(), absyn);
return (Sefo) absyn;
}
int
compInteractiveLoop(int argc, char **argv, FILE *fin, FILE *fout)
{
int iargc, totErrors, lineno;
FileName fn;
EmitInfo finfo;
AbSyn ab;
Stab stab;
Foam foam;
Bool readingInitFile = true, tmpHistory;
Bool endOfInput = false;
FILE *fin0 = fin;
compInit();
iargc = cmdArguments(1, argc, argv);
argc -= iargc;
argv += iargc;
emitDoneOptions(argc, argv);
if (osFileIsThere(cmdInitFile)) {
FileName fname;
fname = fnameParse(cmdInitFile);
fin = fileMustOpen(fname, osIoRdMode);
fnameFree(fname);
intStepNo = 0;
tmpHistory = fintHistory;
fintHistory = false;
fprintf(fout, "Reading %s...\n", cmdInitFile);
}
else {
intStepNo = 1;
readingInitFile = false;
tmpHistory = fintHistory;
}
fn = fnameStdin();
finfo = emitInfoNew(fn);
lineno = 0;
compFileInit(finfo);
stab = stabFile();
comsgFini();
fintInit();
for (; !endOfInput; intStepNo++) {
comsgInit();
breakSetRoot(NULL);
car(stab)->isChecked = false;
if (SetJmp(compFintJmpBuf)) {
if (feof(fin)) break;
}
comsgPromptPrint(fin, fout,
fintHistory ? "%%%d := " : "%%%d >> ",
intStepNo);
osSetBreakHandler(compFintBreakHandler0);
ab = compFileFront(finfo, stab, fin, &lineno);
breakSetRoot(ab);
if (compIsMoreAfterFront(finfo) &&
!abIsEmptySequence(ab)) {
ab = (AbSyn) fintWrap(ab, intStepNo);
foam = compFileMiddle(finfo, stab, ab);
if (foam) {
Bool ok = fint(foam);
if (ok && fintVerbose)
fintPrintType(fout, ab);
foamFree(foam);
fintDisplayTimings();
}
}
comsgFini();
/* abFree(ab); !! ab is seeping into types. */
if (feof(fin)) {
if (readingInitFile) {
fclose(fin);
fin = fin0;
lineno = 0;
readingInitFile = false;
fintHistory = tmpHistory;
intStepNo = 0;
comsgFini();
}
else
endOfInput = true;
}
}
totErrors = comsgErrorCount();
fintFini();
compFileFini(finfo);
emitAllDone();
emitInfoFree(finfo);
fnameFree(fn);
compFini();
return totErrors;
}
/*
* 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();
}