From f993d7dd9334209dc6ffb0eec76876ab78186402 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sat, 19 Oct 2013 21:58:01 +0100
Subject: [PATCH 01/35] genfoam: Remove support for -Wold-hashcodes.
This was for older versions of axiom; I don't think it makes a massive amount
of sense to retain support for these, especially as the hashcode calculation
has changed. Simplifies the code slightly too.
---
aldor/aldor/src/cmdline.c | 2 -
aldor/aldor/src/gf_add.c | 170 ++++++++++++++------------------------
aldor/aldor/src/of_util.c | 1 -
aldor/aldor/src/of_util.h | 11 ---
4 files changed, 62 insertions(+), 122 deletions(-)
diff --git a/aldor/aldor/src/cmdline.c b/aldor/aldor/src/cmdline.c
index 19cb7879b..7c12fbbd8 100644
--- a/aldor/aldor/src/cmdline.c
+++ b/aldor/aldor/src/cmdline.c
@@ -882,8 +882,6 @@ cmdDoOptDeveloper(String arg)
NoWhereHack = true;
else if (strAEqual("runtime-hashcheck", arg))
genSetHashcheck();
- else if (strAEqual("old-hcodes", arg))
- genResetNewHashCodes();
else if (strAIsPrefix("keyword", arg)) {
String darg = cmdDGetOptArg(arg, "keyword", NULL);
cmdDoKeywordStatus(darg, true);
diff --git a/aldor/aldor/src/gf_add.c b/aldor/aldor/src/gf_add.c
index 684525d20..031413e9d 100644
--- a/aldor/aldor/src/gf_add.c
+++ b/aldor/aldor/src/gf_add.c
@@ -1624,11 +1624,9 @@ gen0RtTypeHash(TForm tf, TForm otf)
tfl = listCons(TForm)(tfMapRetN(tf, i), tfl);
otfl = listCons(TForm)(tfMapRetN(otf, i), otfl);
}
- if (genNewHashCodes()) {
- hashMask = (int)tfTag(otf);
- /* Between argument types and return types */
- hashPoint = tfMapArgc(tf);
- }
+ hashMask = (int)tfTag(otf);
+ /* Between argument types and return types */
+ hashPoint = tfMapArgc(tf);
break;
case TF_RawRecord:
assert(tfTag(tf) == tfTag(otf));
@@ -1707,36 +1705,27 @@ gen0RtTypeHash(TForm tf, TForm otf)
hash = foamNewSInt(code);
tfl = listNReverse(TForm)(tfl);
otfl = listNReverse(TForm)(otfl);
- if (genNewHashCodes()) {
- /* Ensure that we have hash masks */
- if (!gen0RtArgHashMask) gen0RtInitHashMask();
-
- /* Original hash combine with a twist of lime for maps */
- for(i = 0, l = tfl, ol = otfl; l; i++, l = cdr(l), ol = cdr(ol)) {
- /* Extra hash code merged in at the correct moment */
- if (i == hashPoint) {
- twist = foamNewSInt(gen0RtArgHashMask[hashMask]);
- foamPure(twist) = true;
- hash = gen0CombineHash(twist, hash);
- foamPure(hash) = true;
- }
- hash = gen0CombineHash(gen0RtTypeHash(car(l), car(ol)), hash);
- foamPure(hash) = true;
- }
+ /* Ensure that we have hash masks */
+ if (!gen0RtArgHashMask) gen0RtInitHashMask();
- /* Add the lime if not done so already */
- if (!twist && (hashPoint >= 0)) {
+ /* Original hash combine with a twist of lime for maps */
+ for(i = 0, l = tfl, ol = otfl; l; i++, l = cdr(l), ol = cdr(ol)) {
+ /* Extra hash code merged in at the correct moment */
+ if (i == hashPoint) {
twist = foamNewSInt(gen0RtArgHashMask[hashMask]);
foamPure(twist) = true;
hash = gen0CombineHash(twist, hash);
foamPure(hash) = true;
}
+ hash = gen0CombineHash(gen0RtTypeHash(car(l), car(ol)), hash);
+ foamPure(hash) = true;
}
- else {
- for(l = tfl, ol = otfl; l; l = cdr(l), ol = cdr(ol)) {
- hash = gen0CombineHash(gen0RtTypeHash(car(l), car(ol)), hash);
- foamPure(hash) = true;
- }
+ /* Add the lime if not done so already */
+ if (!twist && (hashPoint >= 0)) {
+ twist = foamNewSInt(gen0RtArgHashMask[hashMask]);
+ foamPure(twist) = true;
+ hash = gen0CombineHash(twist, hash);
+ foamPure(hash) = true;
}
return hash;
@@ -1777,11 +1766,9 @@ gen0RtTypeHashAsGeneral(TForm tf)
tfl = listCons(TForm)(tfMapArgN(tf, i), tfl);
for(i = 0; i < tfMapRetc(tf); i += 1)
tfl = listCons(TForm)(tfMapRetN(tf, i), tfl);
- if (genNewHashCodes()) {
- hashMask = (int)tfTag(tf);
- /* Between argument types and return types */
- hashPoint = tfMapArgc(tf);
- }
+ hashMask = (int)tfTag(tf);
+ /* Between argument types and return types */
+ hashPoint = tfMapArgc(tf);
break;
case TF_RawRecord:
for (i = 0; i < tfRawRecordArgc(tf); i += 1) {
@@ -1832,38 +1819,30 @@ gen0RtTypeHashAsGeneral(TForm tf)
tfl = listNReverse(TForm)(tfl);
if (hash == NULL)
hash = foamNewSInt(code);
- if (genNewHashCodes()) {
- /* Ensure that we have hash masks */
- if (!gen0RtArgHashMask) gen0RtInitHashMask();
-
- /* Original hash combine plus a twist of lime */
- for(i = 0; tfl; i++, tfl = cdr(tfl)) {
- /* Extra hash code merged in at the correct moment */
- if (i == hashPoint) {
- twist = foamNewSInt(gen0RtArgHashMask[hashMask]);
- foamPure(twist) = true;
- hash = gen0CombineHash(twist, hash);
- foamPure(hash) = true;
- }
- hash = gen0CombineHash(gen0RtTypeHash(car(tfl),car(tfl)),hash);
- foamPure(hash) = true;
- }
-
- /* Add the lime if not done so already */
- if (!twist && (hashPoint >= 0)) {
+ /* Ensure that we have hash masks */
+ if (!gen0RtArgHashMask) gen0RtInitHashMask();
+
+ /* Original hash combine plus a twist of lime */
+ for(i = 0; tfl; i++, tfl = cdr(tfl)) {
+ /* Extra hash code merged in at the correct moment */
+ if (i == hashPoint) {
twist = foamNewSInt(gen0RtArgHashMask[hashMask]);
foamPure(twist) = true;
hash = gen0CombineHash(twist, hash);
foamPure(hash) = true;
}
+ hash = gen0CombineHash(gen0RtTypeHash(car(tfl),car(tfl)),hash);
+ foamPure(hash) = true;
}
- else {
- while (tfl) {
- hash = gen0CombineHash(gen0RtTypeHash(car(tfl),car(tfl)),hash);
- foamPure(hash) = true;
- tfl = cdr(tfl);
- }
+
+ /* Add the lime if not done so already */
+ if (!twist && (hashPoint >= 0)) {
+ twist = foamNewSInt(gen0RtArgHashMask[hashMask]);
+ foamPure(twist) = true;
+ hash = gen0CombineHash(twist, hash);
+ foamPure(hash) = true;
}
+
return hash;
}
@@ -1977,26 +1956,18 @@ gen0RtSefoHashSpecialExporter(Sefo sf, Sefo osf)
Symbol opsym;
Foam twist = (Foam)NULL;
- if (genNewHashCodes()) {
- op = abApplyOp(sf);
- opsym = op->abId.sym;
- inEnum = (opsym == ssymEnum);
- hashMask = gen0RtSymSpecialTag(opsym);
-
- assert(abTag(sf) == AB_Apply && abTag(abApplyOp(sf)) == AB_Id);
- /* I don't think we ought to ever see this ... */
- if ((opsym == ssymArrow) || (opsym == ssymPackedArrow))
- hashPoint = 1; /* Only insert hash mask for maps */
+ op = abApplyOp(sf);
+ opsym = op->abId.sym;
+ inEnum = (opsym == ssymEnum);
+ hashMask = gen0RtSymSpecialTag(opsym);
- /* Ensure that we have hash masks */
- if (!gen0RtArgHashMask) gen0RtInitHashMask();
- }
- else {
- assert(abTag(sf) == AB_Apply && abTag(abApplyOp(sf)) == AB_Id);
+ assert(abTag(sf) == AB_Apply && abTag(abApplyOp(sf)) == AB_Id);
+ /* I don't think we ought to ever see this ... */
+ if ((opsym == ssymArrow) || (opsym == ssymPackedArrow))
+ hashPoint = 1; /* Only insert hash mask for maps */
- op = abApplyOp(sf);
- inEnum = (op->abId.sym == ssymEnum);
- }
+ /* Ensure that we have hash masks */
+ if (!gen0RtArgHashMask) gen0RtInitHashMask();
GSTAT(GSET(Th,foamNewSInt(gen0StrHash(symString(op->abId.sym)))));
@@ -2015,12 +1986,10 @@ gen0RtSefoHashSpecialExporter(Sefo sf, Sefo osf)
GSTAT(foamNewLabel(TS));
GSTAT(foamNewIf(foamNew(FOAM_BCall, 3, FOAM_BVal_SIntEQ,
foamCopy(Ti), foamCopy(Tn)), TE));
- if (genNewHashCodes()) {
- /* Extra hash code merged in at the correct moment */
- if (hashPoint && (i == hashPoint)) {
- twist = foamNewSInt(gen0RtArgHashMask[hashMask]);
- GSTAT(GSET(Th, gen0CombineHash(twist, foamCopy(Th))));
- }
+ /* Extra hash code merged in at the correct moment */
+ if (hashPoint && (i == hashPoint)) {
+ twist = foamNewSInt(gen0RtArgHashMask[hashMask]);
+ GSTAT(GSET(Th, gen0CombineHash(twist, foamCopy(Th))));
}
val = foamNewAElt(FOAM_Word,
foamCopy(Ti),
@@ -2037,12 +2006,10 @@ gen0RtSefoHashSpecialExporter(Sefo sf, Sefo osf)
GSTAT(foamNewLabel(TE));
}
- if (genNewHashCodes()) {
- /* Add a dash of lime if not done so already */
- if (!twist && hashPoint) {
- twist = foamNewSInt(gen0RtArgHashMask[hashMask]);
- GSTAT(GSET(Th, gen0CombineHash(twist, foamCopy(Th))));
- }
+ /* Add a dash of lime if not done so already */
+ if (!twist && hashPoint) {
+ twist = foamNewSInt(gen0RtArgHashMask[hashMask]);
+ GSTAT(GSET(Th, gen0CombineHash(twist, foamCopy(Th))));
}
foamFree(Tt);
@@ -2365,28 +2332,15 @@ gen0RtSefoHashSpecialApply(Sefo sf)
int argc = abApplyArgc(sf);
int i;
- if (genNewHashCodes()) {
- if (abIsAnyMap(sf))
- return gen0RtSefoHashSpecialMap(sf);
-
- for (i = 0; i < argc; i += 1)
- sfl = listCons(Sefo)(abApplyArg(sf, i), sfl);
- sfl = listNReverse(Sefo)(sfl);
+ if (abIsAnyMap(sf))
+ return gen0RtSefoHashSpecialMap(sf);
- if (sym == ssymEnum)
- return gen0RtSefoHashEnum(sf, sfl);
- }
- else {
- for (i = 0; i < argc; i += 1)
- sfl = listCons(Sefo)(abApplyArg(sf, i), sfl);
- sfl = listNReverse(Sefo)(sfl);
-
- if (sym == ssymEnum)
- return gen0RtSefoHashEnum(sf, sfl);
+ for (i = 0; i < argc; i += 1)
+ sfl = listCons(Sefo)(abApplyArg(sf, i), sfl);
+ sfl = listNReverse(Sefo)(sfl);
- if (abIsAnyMap(sf))
- sfl = gen0RtSefoListUnComma(sfl);
- }
+ if (sym == ssymEnum)
+ return gen0RtSefoHashEnum(sf, sfl);
gen0RtUseDeclares(sfl);
diff --git a/aldor/aldor/src/of_util.c b/aldor/aldor/src/of_util.c
index d1e10762a..00b956019 100644
--- a/aldor/aldor/src/of_util.c
+++ b/aldor/aldor/src/of_util.c
@@ -87,7 +87,6 @@ vpFreeVar(VarPool pool, int var)
Bool gen0IsRuntime = false;
Bool inl0AfterInline = false;
Bool gen0Hashcheck = false;
-Bool gen0NewHashCodes = true;
/*****************************************************************************
*
diff --git a/aldor/aldor/src/of_util.h b/aldor/aldor/src/of_util.h
index 33cc717c2..8e117d184 100644
--- a/aldor/aldor/src/of_util.h
+++ b/aldor/aldor/src/of_util.h
@@ -111,17 +111,6 @@ extern Bool gen0Hashcheck;
#define genHashcheck() (gen0Hashcheck)
#define genSetHashcheck() (gen0Hashcheck = true)
-/*****************************************************************************
- *
- * :: Flags for -W new-hcodes
- *
- ****************************************************************************/
-
-extern Bool gen0NewHashCodes;
-
-#define genNewHashCodes() (gen0NewHashCodes)
-#define genResetNewHashCodes() (gen0NewHashCodes = false)
-
/*****************************************************************************
*
* :: Foam Patching
From bee3969c5432bdc10a34bbae3541e375edec6f85 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sat, 26 Oct 2013 16:19:17 +0100
Subject: [PATCH 02/35] tfGetCatExportsFrParents wasn't dealing with lists
correctly.
---
aldor/aldor/src/tform.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c
index bcb7ae6c4..22396cecb 100644
--- a/aldor/aldor/src/tform.c
+++ b/aldor/aldor/src/tform.c
@@ -4099,7 +4099,7 @@ tfGetCatExportsCond(SymeList symes0, SefoList conds0, Bool pos)
*/
for (symes = symes0; symes; symes = cdr(symes)) {
Syme nsyme = symeCopy(car(symes));
- for (conds = reversedConds0; reversedConds0; reversedConds0 = cdr(reversedConds0)) {
+ for (conds = reversedConds0; conds; conds = cdr(conds)) {
symeAddCondition(nsyme, car(conds), pos);
}
nsymes = listCons(Syme)(nsyme, nsymes);
From 22def9c552f5636d9b1eef0ca8f3cd6676707311 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sun, 27 Oct 2013 11:54:30 +0000
Subject: [PATCH 03/35] dnf/ablogic: DNF now supports simplification of
expressions containing negations. Add test case Plus a formatter for DNFs
for easier debugging.
---
aldor/aldor/src/ablogic.c | 1 +
aldor/aldor/src/dnf.c | 114 ++++++++++++++++++++++++++--
aldor/aldor/src/dnf.h | 2 +
aldor/aldor/src/test/test_ablogic.c | 14 ++++
4 files changed, 125 insertions(+), 6 deletions(-)
diff --git a/aldor/aldor/src/ablogic.c b/aldor/aldor/src/ablogic.c
index f4e899e4d..1a5e80557 100644
--- a/aldor/aldor/src/ablogic.c
+++ b/aldor/aldor/src/ablogic.c
@@ -125,6 +125,7 @@ ablogInit(void)
ablogInitTables();
fmtRegister("AbLogic", ablogFormatter);
+ fmtRegister("DNF", dnfFormatter);
ablogIsInit = true;
}
diff --git a/aldor/aldor/src/dnf.c b/aldor/aldor/src/dnf.c
index 4f7cee393..860d5af3b 100644
--- a/aldor/aldor/src/dnf.c
+++ b/aldor/aldor/src/dnf.c
@@ -28,6 +28,8 @@ local void dnfAndFree (DNF_And);
local Bool dnfAndIsTrue (DNF_And);
local DNF_And dnfAndMerge (DNF_And, DNF_And);
local Bool dnfAndImplies (DNF_And, DNF_And);
+local Bool dnfAndImpliesNegation (DNF_And, DNF_And);
+local DNF_And dnfAndCancelNegation (DNF_And, DNF_And);
local DNF dnfAndNot (DNF_And);
local DNF dnfOrNew (int argc);
@@ -151,7 +153,6 @@ dnfAndMerge(DNF_And xx, DNF_And yy)
* If xx => yy then (xx or yy) == yy.
*/
-
local Bool
dnfAndImplies(DNF_And xx, DNF_And yy)
{
@@ -181,6 +182,73 @@ dnfAndImplies(DNF_And xx, DNF_And yy)
return yyi == yy->argc;
}
+local Bool
+dnfAndImpliesNegation(DNF_And xx, DNF_And yy)
+{
+ int xxi, yyi;
+
+ /* xx implies ~yy if each atom in ~yy can be found in xx. */
+ if (xx->argc < yy->argc)
+ return false;
+
+ xxi = yyi = 0;
+ for (xxi = yyi = 0; xxi < xx->argc && yyi < yy->argc; ) {
+ DNF_Atom xxa = xx->argv[xxi];
+ DNF_Atom yya = yy->argv[yyi];
+
+ if (dnfAtomLT(xxa, yya))
+ xxi += 1; /* Keep looking for yyi. */
+
+ else if (xxa == -yya) {
+ xxi += 1; /* Found yyi. */
+ yyi += 1;
+ }
+ else
+ return false; /* Failed to find yyi. */
+ }
+
+ /* Return true if we found each of the yyi. */
+ return yyi == yy->argc;
+}
+
+local DNF_And
+dnfAndCancelNegation(DNF_And xx, DNF_And yy)
+{
+ DNF_And result;
+ int xxi, yyi, rri;
+
+ /* xx implies ~yy if each atom in ~yy can be found in xx. */
+ assert (xx->argc >= yy->argc);
+
+ xxi = yyi = rri = 0;
+ result = dnfAndNew(xx->argc - yy->argc);
+ for (xxi = yyi = 0; xxi < xx->argc && yyi < yy->argc; ) {
+ DNF_Atom xxa = xx->argv[xxi];
+ DNF_Atom yya = yy->argv[yyi];
+
+ if (dnfAtomLT(xxa, yya)) {
+ result->argv[rri] = xx->argv[xxi];
+ rri += 1;
+ xxi += 1; /* Keep looking for yyi. */
+ yyi += 1;
+ }
+ else if (xxa == -yya) {
+ yyi += 1;
+ xxi += 1;
+ }
+ else {
+ assert(false);
+ }
+ }
+ while (xxi < xx->argc) {
+ result->argv[rri] = xx->argv[xxi];
+ xxi += 1;
+ rri += 1;
+ }
+
+ return result;
+}
+
local DNF
dnfAndNot(DNF_And xx)
{
@@ -261,7 +329,7 @@ dnfOrMerge(DNF xx)
{
int i, j;
- dnfDEBUG(dbOut, ">dnfOrMerge: %p[%d]\n", xx, xx->argc);
+ dnfDEBUG(dbOut, ">dnfOrMerge: %pDNF\n", xx);
/* As we work, terms are merged by replacing them with NULL. */
for (i = 0; i < xx->argc; i += 1) {
@@ -272,6 +340,12 @@ dnfOrMerge(DNF xx)
dnfAndFree(xx->argv[i]);
xx->argv[i] = NULL;
}
+ if (i != j && xx->argv[i] && xx->argv[j] &&
+ dnfAndImpliesNegation(xx->argv[i], xx->argv[j])) {
+ DNF_And xxi = dnfAndCancelNegation(xx->argv[i], xx->argv[j]);
+ dnfAndFree(xx->argv[i]);
+ xx->argv[i] = xxi;
+ }
}
}
@@ -281,7 +355,7 @@ dnfOrMerge(DNF xx)
xx->argv[i++] = xx->argv[j];
xx->argc = i;
- dnfDEBUG(dbOut, "argc);
+ dnfDEBUG(dbOut, "dnfOr: %p[%d] %p[%d]\n",
- xx, xx->argc, yy, yy->argc);
+ dnfDEBUG(dbOut, ">dnfOr: %pDNF %pDNF\n", xx, yy);
rr = dnfOrNew(xx->argc + yy->argc);
rri = 0;
@@ -384,7 +457,7 @@ dnfOr(DNF xx, DNF yy)
dnfOrMerge(rr);
- dnfDEBUG(dbOut, "argc);
+ dnfDEBUG(dbOut, "argv[0] = (DNF_And) new;
}
+
+int
+dnfFormatter(OStream ostream, Pointer p)
+{
+ DNF dnf = (DNF) p;
+ DNF_And xx;
+ int c, i, j;
+
+ if (dnfIsTrue(dnf))
+ c = ostreamWrite(ostream, "[TRUE]", -1);
+ else if (dnfIsFalse(dnf))
+ c = ostreamWrite(ostream, "[FALSE]", -1);
+ else {
+ c = ostreamWrite(ostream, "[", -1);
+ char *sep = "";
+ for (i=0; iargc; i++) {
+ c += ostreamWrite(ostream, sep, -1);
+ sep = " ";
+ DNF_And xx = dnf->argv[i];
+ c = ostreamWrite(ostream, "[", -1);
+ for (j=0; jargc; j++) {
+ c += ostreamPrintf(ostream, "%s%d", j>0?" ": "", xx->argv[j]);
+ }
+ c += ostreamWrite(ostream, "]", -1);
+ }
+ c += ostreamWrite(ostream, "]", -1);
+ }
+ return c;
+}
diff --git a/aldor/aldor/src/dnf.h b/aldor/aldor/src/dnf.h
index 7ec831ab8..35cee7ce5 100644
--- a/aldor/aldor/src/dnf.h
+++ b/aldor/aldor/src/dnf.h
@@ -65,4 +65,6 @@ extern Bool dnfExpandImplies(Bool (*testFn)(void *, DNF_Atom, DNF_Atom),
void *clos,
DNF xx, DNF yy);
+extern int dnfFormatter(OStream ostream, Pointer ptr);
+
#endif /* !_DNF_H_ */
diff --git a/aldor/aldor/src/test/test_ablogic.c b/aldor/aldor/src/test/test_ablogic.c
index c7958f36d..e129eef76 100644
--- a/aldor/aldor/src/test/test_ablogic.c
+++ b/aldor/aldor/src/test/test_ablogic.c
@@ -11,8 +11,10 @@
#include "sefo.h"
#include "ablogic.h"
#include "comsg.h"
+#include "dnf.h"
local void testAblog();
+local void testDnf();
/* XXX: from test_tinfer.c */
void init(void);
@@ -22,6 +24,7 @@ void initFile(void);
void ablogTest()
{
init();
+ testDnf();
testAblog();
fini();
}
@@ -79,3 +82,14 @@ testAblog()
}
+local void
+testDnf()
+{
+ testFalse("true", dnfIsFalse(dnfTrue()));
+ testFalse("false", dnfIsTrue(dnfFalse()));
+
+ DNF a = dnfAtom(1);
+ DNF b = dnfAtom(2);
+
+ afprintf(dbOut, "%pDNF\n", dnfOr(dnfAtom(1), dnfNotAtom(1)));
+}
From cf2e45c6544a57a7f4594ded3f81d2acb4690743 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sun, 27 Oct 2013 12:28:09 +0000
Subject: [PATCH 04/35] dnf/ablogic: Add some extra tests, and improve dnf
debug output.
---
aldor/aldor/src/dnf.c | 22 +++++++++++-----------
aldor/aldor/src/test/test_ablogic.c | 5 ++++-
2 files changed, 15 insertions(+), 12 deletions(-)
diff --git a/aldor/aldor/src/dnf.c b/aldor/aldor/src/dnf.c
index 860d5af3b..bdd2659da 100644
--- a/aldor/aldor/src/dnf.c
+++ b/aldor/aldor/src/dnf.c
@@ -72,7 +72,7 @@ dnfAndNew(int argc)
for (i = 0; i < argc; i += 1)
xx->argv[i] = 0;
- dnfDEBUG(dbOut, ">dnfAndNew: %p[%d]\n", xx, argc);
+ dnfDEBUG(dbOut, ">dnfAndNew: %pDNF\n", xx);
return xx;
}
@@ -83,7 +83,7 @@ dnfAndCopy(DNF_And xx)
int i;
DNF_And yy;
- dnfDEBUG(dbOut, ">dnfAndCopy: %p[%d]\n", xx, (int) xx->argc);
+ dnfDEBUG(dbOut, ">dnfAndCopy: %pDNF\n", xx);
yy = dnfAndNew(xx->argc);
for (i = 0; i < xx->argc; i += 1)
@@ -95,7 +95,7 @@ dnfAndCopy(DNF_And xx)
local void
dnfAndFree(DNF_And xx)
{
- dnfDEBUG(dbOut, ">dnfAndFree: %p[%d]\n", xx, (int) xx->argc);
+ dnfDEBUG(dbOut, ">dnfAndFree: %pDNF\n", xx);
stoFree((Pointer) xx);
}
@@ -282,7 +282,7 @@ dnfOrNew(int argc)
for (i = 0; i < argc; i += 1)
xx->argv[i] = 0;
- dnfDEBUG(dbOut, ">dnfOrNew: %p[%d]\n", xx, argc);
+ dnfDEBUG(dbOut, ">dnfOrNew: %pDNF\n", xx);
return xx;
}
@@ -293,7 +293,7 @@ dnfOrCopy(DNF xx)
int i;
DNF yy;
- dnfDEBUG(dbOut, ">dnfOrCopy: %p[%d]\n", xx, xx->argc);
+ dnfDEBUG(dbOut, ">dnfOrCopy: %pDNF\n", xx);
yy = dnfOrNew(xx->argc);
for (i = 0; i < xx->argc; i += 1)
@@ -307,7 +307,7 @@ dnfOrFree(DNF xx)
{
int i;
- dnfDEBUG(dbOut, ">dnfOrFree: %p[%d]\n", xx, xx->argc);
+ dnfDEBUG(dbOut, ">dnfOrFree: %pDNF\n", xx);
for (i = 0; i < xx->argc; i += 1)
dnfAndFree(xx->argv[i]);
@@ -483,8 +483,8 @@ dnfAnd(DNF xx, DNF yy)
if (dnfIsTrue(yy))
return dnfCopy(xx);
- dnfDEBUG(dbOut, ">dnfAnd: %p[%d] %p[%d]\n",
- xx, xx->argc, yy, yy->argc);
+ dnfDEBUG(dbOut, ">dnfAnd: %pDNF %pDNF\n",
+ xx, yy);
rr = dnfOrNew(xx->argc * yy->argc);
rri = 0;
@@ -495,7 +495,7 @@ dnfAnd(DNF xx, DNF yy)
dnfOrMerge(rr);
- dnfDEBUG(dbOut, "argc);
+ dnfDEBUG(dbOut, "dnfNot: %p[%d]\n", xx, xx->argc);
+ dnfDEBUG(dbOut, ">dnfNot: %pDNF\n", xx);
rr = dnfTrue();
for (i = 0; i < xx->argc; i += 1) {
@@ -530,7 +530,7 @@ dnfNot(DNF xx)
dnfFree(bb);
}
- dnfDEBUG(dbOut, "argc);
+ dnfDEBUG(dbOut, "
Date: Sun, 27 Oct 2013 12:28:48 +0000
Subject: [PATCH 05/35] aldortest: noticed that the float test was failing..
fix is simple, so made it.
---
aldor/aldor/src/float_t.c | 66 +++++++++++++++++++--------------------
1 file changed, 33 insertions(+), 33 deletions(-)
diff --git a/aldor/aldor/src/float_t.c b/aldor/aldor/src/float_t.c
index 70ccfc9b4..95fbabcd9 100644
--- a/aldor/aldor/src/float_t.c
+++ b/aldor/aldor/src/float_t.c
@@ -137,7 +137,7 @@ testSFloParts(FiSFlo sf, BInt integer, FiSFlo frac)
if (strEqual(strOrig, strNew))
return true;
- fprintf(dbOut, "testSFloParts failed: [%s] != [%s]\n", strOrig,strNew);
+ printf("testSFloParts failed: [%s] != [%s]\n", strOrig,strNew);
return false;
}
@@ -162,7 +162,7 @@ testDFloParts(FiDFlo df, BInt integer, FiDFlo frac)
if (strEqual(strOrig, strNew))
return true;
- fprintf(dbOut, "testDFloParts failed: [%s] != [%s]\n", strOrig,strNew);
+ printf("testDFloParts failed: [%s] != [%s]\n", strOrig,strNew);
return false;
}
@@ -172,25 +172,25 @@ testPrevNext()
FiSFlo sf0, sf1;
FiDFlo df0, df1;
- fprintf(dbOut, "Starting prev/next test. (Please, wait!)\n");
+ printf("Starting prev/next test. (Please, wait!)\n");
- fprintf(dbOut, "SFlo Range [0.01, 0.010001]\n");
+ printf("SFlo Range [0.01, 0.010001]\n");
sf0 = 0.01f; sf1 = 0.010001f;
testSFloInRange(&sf0, &sf1);
- fprintf(dbOut, "SFlo Range [100.0, 100.1]\n");
+ printf("SFlo Range [100.0, 100.1]\n");
sf0 = 100.0f; sf1 = 100.1f;
testSFloInRange(&sf0, &sf1);
- fprintf(dbOut, "SFlo Range [2.0e-38, 2.0001e-38]\n");
+ printf("SFlo Range [2.0e-38, 2.0001e-38]\n");
sf0 = 2.0e-38f; sf1 = 2.0001e-38f;
testSFloInRange(&sf0, &sf1);
- fprintf(dbOut, "DFlo Range [0.01, 0.010000000000001]\n");
+ printf("DFlo Range [0.01, 0.010000000000001]\n");
df0 = 0.01; df1 = 0.0100000000001;
testDFloInRange(&df0, &df1);
- fprintf(dbOut, "DFlo Range [100.0, 100.00000000001]\n");
+ printf("DFlo Range [100.0, 100.00000000001]\n");
df0 = 100.0; df1 = 100.000000001;
testDFloInRange(&df0, &df1);
}
@@ -200,45 +200,45 @@ testRound()
{
int i, sign;
- fprintf(dbOut, "------------ Rounding (SFlo): ------------\n");
+ printf("------------ Rounding (SFlo): ------------\n");
for (sign = 0; sign < 2; sign++)
for (i = 0; i < sizeof(fv) / sizeof(FiSFlo); i++) {
FiSFlo sf = (sign? -fv[i] : fv[i]);
- fprintf(dbOut, "Orig: %f \n", sf);
- fprintf(dbOut, " up:\t");
+ printf("Orig: %f \n", sf);
+ printf(" up:\t");
bintPrintDb(fiSFloRound(sf, fiRoundUp()));
- fprintf(dbOut, " down:\t");
+ printf(" down:\t");
bintPrintDb(fiSFloRound(sf, fiRoundDown()));
- fprintf(dbOut, " zero:\t");
+ printf(" zero:\t");
bintPrintDb(fiSFloRound(sf, fiRoundZero()));
- fprintf(dbOut, " nearest:\t");
+ printf(" nearest:\t");
bintPrintDb(fiSFloRound(sf, fiRoundNearest()));
- fprintf(dbOut, " any:\t");
+ printf(" any:\t");
bintPrintDb(fiSFloRound(sf, fiRoundDontCare()));
}
- fprintf(dbOut, "------------ Rounding (DFlo): ------------\n");
+ printf("------------ Rounding (DFlo): ------------\n");
for (sign = 0; sign < 2; sign++)
for (i = 0; i < sizeof(fv) / sizeof(FiSFlo); i++) {
FiDFlo df = (FiDFlo) (sign? -fv[i] : fv[i]);
- fprintf(dbOut, "Orig: %f \n", df);
- fprintf(dbOut, " up:\t");
+ printf("Orig: %f \n", df);
+ printf(" up:\t");
bintPrintDb(fiDFloRound(df, fiRoundUp()));
- fprintf(dbOut, " down:\t");
+ printf(" down:\t");
bintPrintDb(fiDFloRound(df, fiRoundDown()));
- fprintf(dbOut, " zero:\t");
+ printf(" zero:\t");
bintPrintDb(fiDFloRound(df, fiRoundZero()));
- fprintf(dbOut, " nearest:\t");
+ printf(" nearest:\t");
bintPrintDb(fiDFloRound(df, fiRoundNearest()));
- fprintf(dbOut, " no care:\t");
+ printf(" no care:\t");
bintPrintDb(fiDFloRound(df, fiRoundDontCare()));
}
- fprintf(dbOut, "---------- Rounding tests finished. --------------\n");
+ printf("---------- Rounding tests finished. --------------\n");
}
@@ -277,37 +277,37 @@ testInteractive()
while (1) {
- fprintf(dbOut, "\nEnter a single float: ");
+ printf("\nEnter a single float: ");
IgnoreResult(scanf("%f", &sfl));
- fprintf(dbOut, "\ntrunc(%.*g) = ", 9, sfl);
+ printf("\ntrunc(%.*g) = ", 9, sfl);
bi = (BInt) fiSFloTruncate(sfl);
bintPrint(osStdout, bi);
sfrac = fiSFloFraction(sfl);
- fprintf(dbOut, "\nfrac = %g \n", sfrac);
+ printf("\nfrac = %g \n", sfrac);
testSFloParts(sfl, bi, sfrac);
sfl0 = fiSFloNext(sfl);
- fprintf(dbOut, "Next: %.*g (eq = %d)\n", 9, sfl0, sfl == sfl0);
+ printf("Next: %.*g (eq = %d)\n", 9, sfl0, sfl == sfl0);
- fprintf(dbOut, "\nEnter a double float: ");
+ printf("\nEnter a double float: ");
IgnoreResult(scanf("%lf", &dfl));
- fprintf(dbOut, "\ntrunc(%.*g) = ", 50, dfl);
+ printf("\ntrunc(%.*g) = ", 50, dfl);
bi = (BInt) fiDFloTruncate(dfl);
bintPrint(osStdout, bi);
dfrac = fiDFloFraction(dfl);
- fprintf(dbOut, "\nfrac = %g \n", dfrac);
+ printf("\nfrac = %g \n", dfrac);
testDFloParts(dfl, bi, dfrac);
dfl0 = fiDFloNext(dfl);
- fprintf(dbOut, "Next: %.*g (diff = %.*g)\n", 50, dfl0, 50, dfl0 - dfl);
+ printf("Next: %.*g (diff = %.*g)\n", 50, dfl0, 50, dfl0 - dfl);
/* for (i = 0; i < sizeof(FiDFlo) */
}
@@ -320,7 +320,7 @@ testTruncate()
int sign, i;
Bool stateOk = true;
- fprintf(dbOut, "Starting truncate self-test...\n");
+ printf("Starting truncate self-test...\n");
for (sign = 0; sign < 2; sign++)
for (i = 0; i < sizeof(fv)/sizeof(FiSFlo); i++) {
@@ -341,7 +341,7 @@ testTruncate()
fiDFloFraction(df));
}
- fprintf(dbOut, "Truncate self-test finished [%s].\n",
+ printf("Truncate self-test finished [%s].\n",
(stateOk? "success" : "failure"));
return;
From 5070962feef42bf87efceab3f8d98b7964b85ed9 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sun, 27 Oct 2013 14:29:23 +0000
Subject: [PATCH 06/35] absyn.c: Rework hash function to take care of Pretend,
Restrict and Test. Use in ablogic.. This way, conditions like prime?(p) will
be matched with prime?(p)$F
Add confirming assertion in sefo.c, and some tests.
---
aldor/aldor/src/ablogic.c | 4 +--
aldor/aldor/src/absyn.c | 40 +++++++++++++++++++++
aldor/aldor/src/absyn.h | 1 +
aldor/aldor/src/sefo.c | 9 +++++
aldor/aldor/src/test/abquick.c | 3 ++
aldor/aldor/src/test/abquick.h | 3 ++
aldor/aldor/src/test/test_ablogic.c | 54 +++++++++++++++++++++++++++++
7 files changed, 112 insertions(+), 2 deletions(-)
diff --git a/aldor/aldor/src/ablogic.c b/aldor/aldor/src/ablogic.c
index 1a5e80557..3092c9eb7 100644
--- a/aldor/aldor/src/ablogic.c
+++ b/aldor/aldor/src/ablogic.c
@@ -70,8 +70,8 @@ local DNF_Atom ablogNextIx;
local void
ablogInitTables(void)
{
- ablogToTable = tblNew((TblHashFun) abHash, (TblEqFun) sefoEqual);
- ablogFrTable = tblNew((TblHashFun) 0, (TblEqFun) 0);
+ ablogToTable = tblNew((TblHashFun) abHashSefo, (TblEqFun) sefoEqual);
+ ablogFrTable = tblNew((TblHashFun) 0, (TblEqFun) 0);
ablogNextIx = 1;
}
diff --git a/aldor/aldor/src/absyn.c b/aldor/aldor/src/absyn.c
index 533929bcb..e17532d8c 100644
--- a/aldor/aldor/src/absyn.c
+++ b/aldor/aldor/src/absyn.c
@@ -700,6 +700,46 @@ abEqualModDeclares(AbSyn ab1, AbSyn ab2)
h &= 0x3FFFFFFF; \
}
+Hash
+abHashSefo(AbSyn ab)
+{
+ Hash h = 0;
+ Length i;
+
+ if (abHasTag(ab, AB_Declare))
+ return abHashSefo(ab->abDeclare.type);
+ if (abHasTag(ab, AB_Qualify))
+ return abHashSefo(ab->abQualify.what);
+ if (abHasTag(ab, AB_PretendTo))
+ return abHashSefo(ab->abPretendTo.expr);
+ if (abHasTag(ab, AB_RestrictTo))
+ return abHashSefo(ab->abRestrictTo.expr);
+ if (abHasTag(ab, AB_Test))
+ return abHashSefo(ab->abTest.cond);
+
+ if (abIsSymTag(abTag(ab)))
+ h = strHash(symString(abLeafSym(ab)));
+ else if (abIsDocTag(abTag(ab)))
+ h = strHash(docString(abLeafDoc(ab)));
+ else if (abIsStrTag(abTag(ab)))
+ h = strHash(abLeafStr(ab));
+ else if (abHasTag(ab, AB_Define)) {
+ abHashArg(h, abHashSefo(ab->abDefine.lhs));
+ abHashArg(h, abHashSefo(ab->abDefine.rhs));
+ }
+ else if (abTag(ab) == AB_Lambda) {
+ abHashArg(h, abHashSefo(ab->abLambda.param));
+ abHashArg(h, abHashSefo(ab->abLambda.rtype));
+ }
+ else
+ for (i = 0; i < abArgc(ab); i++)
+ abHashArg(h, abHashSefo(abArgv(ab)[i]));
+
+ h += abInfo(abTag(ab)).hash;
+ h &= 0x3FFFFFFF;
+ return h;
+}
+
Hash
abHash(AbSyn ab)
{
diff --git a/aldor/aldor/src/absyn.h b/aldor/aldor/src/absyn.h
index 4dee3c204..dde531cbf 100644
--- a/aldor/aldor/src/absyn.h
+++ b/aldor/aldor/src/absyn.h
@@ -950,6 +950,7 @@ extern Bool abContains (AbSyn, AbSyn);
extern Bool abEqual (AbSyn, AbSyn);
extern Bool abEqualModDeclares (AbSyn, AbSyn);
extern Hash abHash (AbSyn);
+extern Hash abHashSefo (AbSyn);
extern Hash abHashList (AbSynList);
extern Hash abHashModDeclares (AbSyn);
extern void abSubSymbol (AbSyn, Symbol, Symbol);
diff --git a/aldor/aldor/src/sefo.c b/aldor/aldor/src/sefo.c
index eff0b0609..7ee6f6a6e 100644
--- a/aldor/aldor/src/sefo.c
+++ b/aldor/aldor/src/sefo.c
@@ -1432,6 +1432,9 @@ sefoEqual(Sefo sefo1, Sefo sefo2)
eq = sefoEqual0(NULL, sefo1, sefo2);
sstDoneSefo(sefo1);
+ if (eq)
+ assert(abHashSefo(sefo1) == abHashSefo(sefo2));
+
return eq;
}
@@ -2148,6 +2151,12 @@ sefoEqualMods(Sefo sefo)
case AB_Declare:
sefo = sefo->abDeclare.type;
break;
+ case AB_Test: {
+ if (tfEqual(abTUnique(sefo), tfBoolean))
+ sefo = sefo->abTest.cond;
+ break;
+ }
+
default:
changed = false;
break;
diff --git a/aldor/aldor/src/test/abquick.c b/aldor/aldor/src/test/abquick.c
index a5fbb8ca0..06b415903 100644
--- a/aldor/aldor/src/test/abquick.c
+++ b/aldor/aldor/src/test/abquick.c
@@ -32,6 +32,9 @@ ABQK_DEFINE3(apply2, abNewApply2);
ABQK_DEFINE3(lambda, abNewLambda);
ABQK_DEFINE3(_if0, abNewIf);
ABQK_DEFINE2(import, abNewImport);
+ABQK_DEFINE2(qualify, abNewQualify);
+ABQK_DEFINE2(pretend, abNewPretendTo);
+ABQK_DEFINE2(restrictTo, abNewRestrictTo);
ABQK_DEFINE1(test, abNewTest);
ABQK_DEFINE1_Symbol(id, abNewId);
diff --git a/aldor/aldor/src/test/abquick.h b/aldor/aldor/src/test/abquick.h
index bfea7784d..523103f5c 100644
--- a/aldor/aldor/src/test/abquick.h
+++ b/aldor/aldor/src/test/abquick.h
@@ -49,6 +49,9 @@ ABQK_DECLARE3(lambda, abNewLambda);
ABQK_DECLARE3(_if0, abNewIf);
ABQK_DECLARE2(import, abNewImport);
ABQK_DECLARE1(test, abNewTest);
+ABQK_DECLARE2(qualify, abNewQualify);
+ABQK_DECLARE2(pretend, abNewPretendTo);
+ABQK_DECLARE2(restrictTo, abNewRestrictTo);
ABQK_DECLARE1_Symbol(id, abNewId);
diff --git a/aldor/aldor/src/test/test_ablogic.c b/aldor/aldor/src/test/test_ablogic.c
index 32b743209..cc686a118 100644
--- a/aldor/aldor/src/test/test_ablogic.c
+++ b/aldor/aldor/src/test/test_ablogic.c
@@ -14,6 +14,7 @@
#include "dnf.h"
local void testAblog();
+local void testAblogSefo();
local void testDnf();
/* XXX: from test_tinfer.c */
@@ -26,10 +27,12 @@ void ablogTest()
init();
testDnf();
testAblog();
+ testAblogSefo();
fini();
}
extern int ablogDebug;
+extern int sefoEqualDebug;
local void
testAblog()
@@ -81,6 +84,57 @@ testAblog()
testTrue("11", ablogImplies(cond1, cond1));
}
+local Bool testAbLogEqual(String text, Stab stab, Sefo sefo1, Sefo sefo2);
+
+local void
+testAblogSefo()
+{
+ initFile();
+ ablogDebug = 1;
+ sefoEqualDebug = 1;
+ String Boolean_imp = "import from Boolean";
+
+ String D0_def = "D0: with { prime?: % -> Boolean } == add { prime?(a: %): Boolean == never }";
+ String D0_imp = "import from D0";
+ String d0_def = "d0: D0 == never";
+
+ StringList lines = listList(String)(4, Boolean_imp, D0_def, D0_imp, d0_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());
+
+ AbSyn prime = abFrSyme(uniqueMeaning(stab, "prime?"));
+ AbSyn d0 = abFrSyme(uniqueMeaning(stab, "d0"));
+ AbSyn D0 = abFrSyme(uniqueMeaning(stab, "D0"));
+ AbSyn sefo1 = apply1(prime, d0);
+ AbSyn sefo2 = apply1(qualify(prime, D0), d0);
+
+ testAbLogEqual("", stab, apply1(prime, d0), apply1(prime, d0));
+ testAbLogEqual("qual", stab, apply1(qualify(prime, D0), d0), apply1(prime, d0));
+ testAbLogEqual("test", stab, test(apply1(prime, d0)), apply1(prime, d0));
+ testAbLogEqual("pretend", stab, apply1(prime, pretend(d0, D0)), apply1(prime, d0));
+ testAbLogEqual("restrict", stab, apply1(prime, restrictTo(d0, D0)), apply1(prime, d0));
+}
+
+local Bool
+testAbLogEqual(String text, Stab stab, Sefo sefo1, Sefo sefo2)
+{
+ tiSefo(stab, sefo1);
+ tiSefo(stab, sefo2);
+ AbLogic ablog1 = ablogFrSefo(sefo1);
+ AbLogic ablog2 = ablogFrSefo(sefo2);
+ testTrue(text, dnfEqual((DNF) ablog1, (DNF) ablog2));
+
+}
local void
testDnf()
From 758ff382c76a4eb673af72cfa0f58912f501ac60 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sun, 27 Oct 2013 14:55:01 +0000
Subject: [PATCH 07/35] tform.c: Small improvements to debug output.
---
aldor/aldor/src/tform.c | 9 +++------
1 file changed, 3 insertions(+), 6 deletions(-)
diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c
index 22396cecb..15e3eba7b 100644
--- a/aldor/aldor/src/tform.c
+++ b/aldor/aldor/src/tform.c
@@ -4063,9 +4063,8 @@ tfGetCatExportsFrParents(SymeList symes)
if (!symeIsSelfSelf(syme)) continue;
if (DEBUG(tfParent)) {
- fprintf(dbOut, "tfCatExports: %p= expanding: ", syme);
- symePrint(dbOut, syme);
- fnewline(dbOut);
+ afprintf(dbOut, "(tfCatExports: expanding %pTForm %pAbSynList\n",
+ symeType(syme), symeCondition(syme));
}
nsymes = tfGetCatParents(symeType(syme), true);
@@ -4073,9 +4072,7 @@ tfGetCatExportsFrParents(SymeList symes)
if (cond) nsymes = tfGetCatExportsCond(nsymes, cond, true);
if (DEBUG(tfParent)) {
- fprintf(dbOut, "tfCatExports: %p= into: ", syme);
- symeListPrint(dbOut, nsymes);
- fnewline(dbOut);
+ afprintf(dbOut, "tfCatExports: into %pSymeList)\n", nsymes);
}
nsymes = tfGetCatExportsFilter(osymes, nsymes);
From 32f6ff06d488eb32b708b76a1e4f47377ce4280a Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sun, 27 Oct 2013 18:52:51 +0000
Subject: [PATCH 08/35] Showexports.c: include condition in category output
---
aldor/aldor/src/showexports.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/aldor/aldor/src/showexports.c b/aldor/aldor/src/showexports.c
index 35f40cd2e..d9da5c3b3 100644
--- a/aldor/aldor/src/showexports.c
+++ b/aldor/aldor/src/showexports.c
@@ -85,8 +85,8 @@ main(int argc, char *argv[])
aprintf("Category\n");
for (; list != listNil(Syme); list = cdr(list)) {
Syme syme = car(list);
- aprintf("%5s %3d %s\n", symeString(syme), symeHasDefault(syme),
- tfPretty(symeType(syme)));
+ aprintf("%5s %3d %s %pAbSynList\n", symeString(syme), symeHasDefault(syme),
+ tfPretty(symeType(syme)), symeCondition(syme));
}
}
else {
From 7949eb0fe0253cbe00c08dcc375105d3095be84a Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Mon, 28 Oct 2013 14:30:14 +0000
Subject: [PATCH 09/35] syme.c: add missing fieldInfo for
SYFI_ConditionContext. Also, be paranoid and check during initialisation.
---
aldor/aldor/src/syme.c | 1 +
aldor/aldor/src/tform.c | 5 +++++
2 files changed, 6 insertions(+)
diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c
index 4b00ded0b..580c77f57 100644
--- a/aldor/aldor/src/syme.c
+++ b/aldor/aldor/src/syme.c
@@ -1702,4 +1702,5 @@ struct symeFieldInfo symeFieldInfo[] = {
{ SYFI_DefnNum, "defnNum", (AInt) (int) 0 },
{ SYFI_HashNum, "hashNum", (AInt) (int) 0 },
{ SYFI_ExtraBits, "extraBits", (AInt) (int) 0 },
+ { SYFI_ConditionContext,"conditionContext",(AInt) (AbSyn) NULL },
};
diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c
index 15e3eba7b..e69ce48a9 100644
--- a/aldor/aldor/src/tform.c
+++ b/aldor/aldor/src/tform.c
@@ -452,6 +452,11 @@ tfInit(void)
fmtRegister("AInt", aintFormatter);
fmtRegister("AIntList", aintListFormatter);
+ /* syme.c checks */
+
+ for (i=SYME_FIELD_START; i
Date: Fri, 1 Nov 2013 15:29:20 +0000
Subject: [PATCH 10/35] lib/ax0/test: Use $(DBG), cos everything else does.
---
aldor/lib/ax0/test/Makefile.am | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/aldor/lib/ax0/test/Makefile.am b/aldor/lib/ax0/test/Makefile.am
index 2a05e08de..eeed31f65 100644
--- a/aldor/lib/ax0/test/Makefile.am
+++ b/aldor/lib/ax0/test/Makefile.am
@@ -65,8 +65,7 @@ am__v_ALDOR_0 = @echo " ALDOR " $@;
%.ao: %.as $(ALDOR)
@$(MKDIR_P) $(@D)
- $(AM_V_ALDOR)$(ALDOR) $(ALDORFLAGS) -Y$(@D) -Fao=$@ $<
-
+ $(AM_V_ALDOR)$(DBG) $(ALDOR) $(ALDORFLAGS) -Y$(@D) -Fao=$@ $<
TEST_EXTENSIONS = .ao
AO_LOG_COMPILER = $(ALDOR) $(ALDORFLAGS) -Y$(foamlibdir)/al -lax0 -ginterp
From 0cef6639c148fb544f14a0f35a09177f9090906f Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 13:51:09 +0000
Subject: [PATCH 11/35] Set libraryincdir in libfoamlib - makes %.gloop targets
work properly
---
aldor/aldor/lib/libfoamlib/al/Makefile.in | 1 +
1 file changed, 1 insertion(+)
diff --git a/aldor/aldor/lib/libfoamlib/al/Makefile.in b/aldor/aldor/lib/libfoamlib/al/Makefile.in
index 76d72ed62..4655053ce 100644
--- a/aldor/aldor/lib/libfoamlib/al/Makefile.in
+++ b/aldor/aldor/lib/libfoamlib/al/Makefile.in
@@ -50,6 +50,7 @@ libraryname := foamlib
AXLFLAGS := -Z db -Fc -Q8 $(AXLCDB)
include $(top_srcdir)/lib/buildlib.mk
+libraryincdir := $(top_srcdir)/aldor/lib/libfoamlib/al
Libraryname := Axl
From 4983eea2709a482d302f6dcb81ae7ed1373c0aa1 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 15:09:32 +0000
Subject: [PATCH 12/35] build: Make Tests.am depend on Makefile.am
This way, a change in Makefile.am (usually a new test) will filter into
Tests.am. And so the test will run next build.
---
aldor/lib/testprog.am | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/aldor/lib/testprog.am b/aldor/lib/testprog.am
index 4ac9d799b..a3cb8cb03 100644
--- a/aldor/lib/testprog.am
+++ b/aldor/lib/testprog.am
@@ -30,7 +30,7 @@ am__v_ALDOR_0 = @echo " ALDOR " $@;
$(AM_V_ALDOR)$(ALDOR) $(ALDORFLAGS) -Fmain -R $(dir $@) $(abspath $<)
include Tests.am
-$(srcdir)/Tests.am: Makefile.am $(abs_top_srcdir)/lib/testprog.am
+$(srcdir)/Tests.am: $(srcdir)/Makefile.am $(abs_top_srcdir)/lib/testprog.am
truncate -s0 $@
for test in $(AXLTESTS); do \
ctest=`echo $$test | sed -e 's/-/_/g'`; \
From 6fa6abb8b4473f082538fe803f1482c15b55bfe1 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 15:31:31 +0000
Subject: [PATCH 13/35] lib/ax0: axextend.as: ShouldHaveSegmentGenerator's
condition was incorrect.
Basically, it is looking for S has with { coerce: I -> S }. This should
be I -> %, as it is the form actually exported.
---
aldor/lib/ax0/src/axextend.as | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/aldor/lib/ax0/src/axextend.as b/aldor/lib/ax0/src/axextend.as
index 7e59c4689..bb0004f23 100644
--- a/aldor/lib/ax0/src/axextend.as
+++ b/aldor/lib/ax0/src/axextend.as
@@ -587,8 +587,8 @@ extend Matrix(R: Ring): with {
}
ShouldHaveSegmentGenerator(S) ==>
- S has OrderedSet and S has AbelianSemiGroup
- and S has with { coerce: I -> S; }
+ S has OrderedSet and S has AbelianSemiGroup
+ and S has with { coerce: I -> %; }
define GeneratorCategory(S: Type): Category == with {
generator: % -> Generator S;
From 791d31bb874c5b6417d5716c772b44631e3da216 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 13:36:45 +0000
Subject: [PATCH 14/35] genfoam.c: gen0HasImport returns a Word, cast it back
to a boolean
---
aldor/aldor/src/gf_add.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/aldor/aldor/src/gf_add.c b/aldor/aldor/src/gf_add.c
index 031413e9d..746036352 100644
--- a/aldor/aldor/src/gf_add.c
+++ b/aldor/aldor/src/gf_add.c
@@ -2925,7 +2925,7 @@ gen0HasImports(Foam dom, SymeList symes, Foam startTest)
assert(symeIsExport(car(symes)));
nextLabel = gen0State->labelNo++;
- gen0AddStmt(foamNewIf(gen0HasImport(dom, car(symes)),
+ gen0AddStmt(foamNewIf(foamNewCast(FOAM_Bool, gen0HasImport(dom, car(symes))),
nextLabel), NULL);
gen0AddStmt(foamNewGoto(falseLabel), NULL);
gen0AddStmt(foamNewLabel(nextLabel), NULL);
From 16a6fc20748d412ce26cd1a01ba5bcb8223c74c2 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 13:38:13 +0000
Subject: [PATCH 15/35] showexports: category pretty printing wasn't correct.
fix
---
aldor/aldor/src/showexports.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/aldor/aldor/src/showexports.c b/aldor/aldor/src/showexports.c
index d9da5c3b3..f564ed7b8 100644
--- a/aldor/aldor/src/showexports.c
+++ b/aldor/aldor/src/showexports.c
@@ -105,7 +105,7 @@ main(int argc, char *argv[])
for (; tqList != listNil(TQual); tqList = cdr(tqList)) {
TQual tq = car(tqList);
- aprintf("--> %pTForm\n", tfPretty(tqBase(tq)));
+ aprintf("--> %s\n", tfPretty(tqBase(tq)));
}
}
From b12c57bb919644290857d85490b27d25c927a923 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 13:42:17 +0000
Subject: [PATCH 16/35] syme.c: As an optimisation, call tiSefo if possible
before launching into tiGetTopLevelTForm. tiSefo is less heavyweight when
determining the type of an expression.
---
aldor/aldor/src/syme.c | 3 +++
1 file changed, 3 insertions(+)
diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c
index 580c77f57..04de369e1 100644
--- a/aldor/aldor/src/syme.c
+++ b/aldor/aldor/src/syme.c
@@ -1182,6 +1182,9 @@ symeCheckHas(SymeCContext conditionContext, Sefo dom, Sefo cat)
return flg;
tfdom = abGetCategory(dom);
+ if (tiTopFns()->tiCanSefo(cat)) {
+ tiTopFns()->tiSefo(stabFile(), cat);
+ }
tfcat = abTForm(cat) ? abTForm(cat) : tiTopFns()->tiGetTopLevelTForm(NULL, cat);
/* D has C iff typeof(D) satisfies C. */
From c896db13457b347eecb5819b54c21b35d946fa4b Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 13:49:58 +0000
Subject: [PATCH 17/35] sefo.c: track '%' on with expressions across file
boundaries.
When we compile an expression like 'A has with f: %', a reference to % on
the 'with' expression wasn't being copied over across files. So, now we
save it off in the semantics part of the abstract syntax, and ensure it
reappears when the tform for the expression is being computed.
---
aldor/aldor/src/absyn.c | 13 +++++++++++++
aldor/aldor/src/absyn.h | 3 +++
aldor/aldor/src/sefo.c | 28 +++++++++++++++++++++++++++-
aldor/aldor/src/tform.c | 4 ++++
aldor/aldor/src/ti_sef.c | 1 +
5 files changed, 48 insertions(+), 1 deletion(-)
diff --git a/aldor/aldor/src/absyn.c b/aldor/aldor/src/absyn.c
index e17532d8c..cd93e52cd 100644
--- a/aldor/aldor/src/absyn.c
+++ b/aldor/aldor/src/absyn.c
@@ -1665,6 +1665,7 @@ abTransferSemantics(AbSyn from, AbSyn to)
abSetImplicit(to, abImplicit(from));
abSetTContext(to, abTContext(from));
abSetDefineIdx(to, abDefineIdx(from));
+ abSetSelf(to, abSelf(from));
}
switch (abState(from)) {
@@ -1709,6 +1710,7 @@ abNewSemantics(void)
as->embed = 0;
as->defnIdx = -1;
as->impl = NULL;
+ as->self = listNil(Syme);
return as;
}
@@ -1749,6 +1751,17 @@ abSetSyme(AbSyn ab, Syme syme)
return syme;
}
+void
+abSetSelf(AbSyn ab, SymeList symes)
+{
+ /* scobind may hand this a 0 ab */
+ if (ab) {
+ if (! ab->abHdr.seman)
+ ab->abHdr.seman = abNewSemantics();
+ ab->abHdr.seman->self = symes;
+ }
+}
+
void
abSetDefineIdx(AbSyn ab, int idx)
{
diff --git a/aldor/aldor/src/absyn.h b/aldor/aldor/src/absyn.h
index dde531cbf..daf30b6b7 100644
--- a/aldor/aldor/src/absyn.h
+++ b/aldor/aldor/src/absyn.h
@@ -290,6 +290,7 @@ struct abSeman {
AbSyn implicit; /* Implicit operator on expression. */
AbEmbed embed; /* Implicit embedding for product contexts. */
SImpl impl; /* Syme implementation, if any */
+ SymeList self; /* value of '%' for withs */
};
typedef struct abSeman *AbSeman;
@@ -870,6 +871,7 @@ extern struct ab_info abInfoTable[];
# define abTContext(a) ((a)->abHdr.seman ? (a)->abHdr.seman->embed : 0)
# define abDefineIdx(a) ((a)->abHdr.seman ? (a)->abHdr.seman->defnIdx : -1)
# define abSymeImpl(a) ((a)->abHdr.seman ? (a)->abHdr.seman->impl : 0)
+# define abSelf(a) ((a)->abHdr.seman ? (a)->abHdr.seman->self : 0)
# define abRepeatIterc(a) (abArgc(a)-1) /* -1 for body */
# define abCollectIterc(a)(abArgc(a)-1) /* -1 for body */
@@ -977,6 +979,7 @@ extern AbSeman abNewSemantics (void);
extern Doc abSetComment (AbSyn, Doc);
extern Stab abSetStab (AbSyn, Stab);
extern Syme abSetSyme (AbSyn, Syme);
+extern void abSetSelf (AbSyn, SymeList);
extern TForm abSetTForm (AbSyn, TForm);
extern AbSyn abSetImplicit (AbSyn, AbSyn);
extern AbEmbed abSetTContext (AbSyn, AbEmbed);
diff --git a/aldor/aldor/src/sefo.c b/aldor/aldor/src/sefo.c
index 7ee6f6a6e..26613359a 100644
--- a/aldor/aldor/src/sefo.c
+++ b/aldor/aldor/src/sefo.c
@@ -3069,6 +3069,8 @@ sefoSubst0(AbSub sigma, Sefo sefo)
*/
abSetTForm(final, abTForm(sefo));
}
+ if (abSelf(sefo))
+ abSetSelf(final, abSelf(sefo));
#else
if (abState(sefo) == AB_State_HasUnique)
abState(final) = AB_State_AbSyn;
@@ -3718,6 +3720,11 @@ sefoClosure0(Lib lib, Sefo sefo)
}
}
+ if (abTag(sefo) == AB_With) {
+ symeListClosure0(lib, tfSelf(abTForm(sefo)));
+ tformClosure0(lib, abTForm(sefo));
+ }
+
if (DEBUG(sefoClose)) {
fprintf(dbOut, " S)");
sefoPrintDb(sefo);
@@ -4071,6 +4078,12 @@ sefoToBuffer(Lib lib, Buffer buf, Sefo sefo)
sefoToBuffer(lib, buf, sefo->abLambda.param);
sefoToBuffer(lib, buf, sefo->abLambda.rtype);
break;
+
+ case AB_With:
+ sefoToBuffer(lib, buf, sefo->abWith.base);
+ sefoToBuffer(lib, buf, sefo->abWith.within);
+ symeListToBuffer(lib, buf, tfGetCatSelf(abTForm(sefo)));
+ break;
default:
argc = abArgc(sefo);
bufPutHInt(buf, argc);
@@ -4326,6 +4339,15 @@ sefoFrBuffer(Lib lib, Buffer buf)
sefo = abNewLambda(sposNone, sefo1, sefo, body);
}
break;
+ case AB_With: {
+ SymeList list;
+ sefo1 = sefoFrBuffer(lib, buf);
+ sefo = sefoFrBuffer(lib, buf);
+ list = symeListFrBuffer(lib, buf);
+ sefo = abNewWith(sposNone, sefo1, sefo);
+ abSetSelf(sefo, list);
+ break;
+ }
default:
argc = bufGetHInt(buf);
sefo = abNewEmpty(tag, argc);
@@ -4600,7 +4622,11 @@ sefoFrBuffer0(Buffer buf)
sefoFrBuffer0(buf);
sefoFrBuffer0(buf);
break;
-
+ case AB_With:
+ sefoFrBuffer0(buf);
+ sefoFrBuffer0(buf);
+ symeListFrBuffer0(buf);
+ break;
default:
argc = bufGetHInt(buf);
for (i = 0; i < argc; i += 1)
diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c
index e69ce48a9..e267fc0a4 100644
--- a/aldor/aldor/src/tform.c
+++ b/aldor/aldor/src/tform.c
@@ -2886,8 +2886,12 @@ tfGetCatSelf(TForm cat)
wself = tfGetCatSelf(tfw);
tfAddSelf(tfw, wself);
+
tfHasSelf(tfw) = true;
+ if (tfHasExpr(cat))
+ tfAddSelf(cat, abSelf(tfGetExpr(cat)));
+
tfAddSelf(cat, wself);
}
diff --git a/aldor/aldor/src/ti_sef.c b/aldor/aldor/src/ti_sef.c
index fea994fd4..883966e9a 100644
--- a/aldor/aldor/src/ti_sef.c
+++ b/aldor/aldor/src/ti_sef.c
@@ -831,6 +831,7 @@ tisefWith(Stab stab, Sefo sefo)
tf = tfThird(symes);
tfAddSelf(tf, abGetCatSelf(sefo->abWith.base));
tfAddSelf(tf, tfGetThdSelf(wtf));
+ tfAddSelf(tf, abSelf(sefo));
abTUnique(sefo) = tf;
}
From ec47cc3b335817f5f822f2b1616db043c373cf4c Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sat, 2 Nov 2013 13:46:25 +0000
Subject: [PATCH 18/35] Add new test for explicit conditions into aldor test
suite.
Things like 'foo has with { f: A -> B }' should work just fine.
Turns out we were getting this really wrong. So, test it, and we'll know
if it's all good.
---
aldor/lib/aldor/test/Makefile.am | 4 ++++
aldor/lib/aldor/test/Tests.am | 3 +++
aldor/lib/aldor/test/cond/cond.as | 24 ++++++++++++++++++++++++
aldor/lib/aldor/test/cond/cond.ref | 1 +
aldor/lib/aldor/test/cond/cond1.as | 11 +++++++++++
5 files changed, 43 insertions(+)
create mode 100644 aldor/lib/aldor/test/cond/cond.as
create mode 100644 aldor/lib/aldor/test/cond/cond.ref
create mode 100644 aldor/lib/aldor/test/cond/cond1.as
diff --git a/aldor/lib/aldor/test/Makefile.am b/aldor/lib/aldor/test/Makefile.am
index 7fc0baace..a122570e2 100644
--- a/aldor/lib/aldor/test/Makefile.am
+++ b/aldor/lib/aldor/test/Makefile.am
@@ -28,6 +28,7 @@ AXLTESTS = \
removebug2 \
testargs \
type-constant \
+ cond \
#
BROKEN = \
@@ -57,3 +58,6 @@ CLEANFILES = # filled by Tests.am
TESTS = $(check_PROGRAMS)
include ../../testprog.am
+
+cond/cond.c: cond/cond1.c
+cond_cond_SOURCES += cond/cond1.c
diff --git a/aldor/lib/aldor/test/Tests.am b/aldor/lib/aldor/test/Tests.am
index f79df52d7..e5f987cf2 100644
--- a/aldor/lib/aldor/test/Tests.am
+++ b/aldor/lib/aldor/test/Tests.am
@@ -79,3 +79,6 @@ CLEANFILES += testargs/testargs-aldormain.c testargs/testargs.c testargs/testarg
check_PROGRAMS += type-constant/type-constant
type_constant_type_constant_SOURCES = type-constant/type-constant-aldormain.c type-constant/type-constant.c
CLEANFILES += type-constant/type-constant-aldormain.c type-constant/type-constant.c type-constant/type-constant.ao
+check_PROGRAMS += cond/cond
+cond_cond_SOURCES = cond/cond-aldormain.c cond/cond.c
+CLEANFILES += cond/cond-aldormain.c cond/cond.c cond/cond.ao
diff --git a/aldor/lib/aldor/test/cond/cond.as b/aldor/lib/aldor/test/cond/cond.as
new file mode 100644
index 000000000..81e0e2b65
--- /dev/null
+++ b/aldor/lib/aldor/test/cond/cond.as
@@ -0,0 +1,24 @@
+#include "aldor"
+#include "aldorio"
+#library C1 "cond1.ao"
+import from C1;
+
+X: with {
+ Q;
+ coerce: Integer -> %;
+ int: % -> Integer;
+}
+== add {
+ Rep == Integer;
+ coerce(n: Integer): % == per(n+1);
+ int(x: %): Integer == rep x;
+}
+
+test(): () == {
+ import from Seg X;
+ import from Integer;
+ import from X;
+ stdout << "This really should be 13: " << int(foo 12) << newline;
+}
+
+test();
diff --git a/aldor/lib/aldor/test/cond/cond.ref b/aldor/lib/aldor/test/cond/cond.ref
new file mode 100644
index 000000000..4236ee08e
--- /dev/null
+++ b/aldor/lib/aldor/test/cond/cond.ref
@@ -0,0 +1 @@
+This really should be 13: 13
diff --git a/aldor/lib/aldor/test/cond/cond1.as b/aldor/lib/aldor/test/cond/cond1.as
new file mode 100644
index 000000000..6c1689d9c
--- /dev/null
+++ b/aldor/lib/aldor/test/cond/cond1.as
@@ -0,0 +1,11 @@
+#include "aldor"
+
+Q: Category == with;
+
+Seg(X: with): with {
+ if X has with { coerce: Integer -> % } then foo: Integer -> X;
+}
+== add {
+ if X has with { coerce: Integer -> % } then foo(n: Integer): X == coerce(n)$X;
+}
+
From 848f1e824fa619a2c2565cdd9a4408d0a1238505 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 15:19:09 +0000
Subject: [PATCH 19/35] tinfer.c: Implicit imports and conditionals
When matching 'add' bodies against context, look at implicit symes before
conditions. Otherwise implicit symes that have conditions will not be properly
matched.
---
aldor/aldor/src/tinfer.c | 14 +++++++-------
1 file changed, 7 insertions(+), 7 deletions(-)
diff --git a/aldor/aldor/src/tinfer.c b/aldor/aldor/src/tinfer.c
index 9224469df..efa25dd1f 100644
--- a/aldor/aldor/src/tinfer.c
+++ b/aldor/aldor/src/tinfer.c
@@ -464,13 +464,6 @@ tiAddSymes(Stab astab, AbSyn capsule, TForm base, TForm context, SymeList *p)
csymes = listCons(Syme)(syme, csymes);
}
- /* Look for syme in the conditional symes. */
- else if (symeCondition(syme)) {
- tipAddDEBUG(dbOut, " [conditional]\n");
- /*!! if (!symeIsSelfSelf(syme)) */
- usymes = listCons(Syme)(syme, usymes);
- }
-
/* Look for the syme in the implicits */
else if (hasImplicit &&
((xsyme = tfImplicitExport(astab,mods,syme))!=NULL)) {
@@ -478,6 +471,13 @@ tiAddSymes(Stab astab, AbSyn capsule, TForm base, TForm context, SymeList *p)
isymes = listCons(Syme)(xsyme, isymes);
}
+ /* Look for syme in the conditional symes. */
+ else if (symeCondition(syme)) {
+ tipAddDEBUG(dbOut, " [conditional]\n");
+ /*!! if (!symeIsSelfSelf(syme)) */
+ usymes = listCons(Syme)(syme, usymes);
+ }
+
/* The add doesn't satisfy its context. */
else {
tipAddDEBUG(dbOut, " [missing]\n");
From c681a924e3b926e0d14485d4587cba3fb2640732 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 15:19:32 +0000
Subject: [PATCH 20/35] syme.c: Fix case of AB_And in a type expression.
Code that flattens AB_And in a condition (eg. A has B and A as X) was flat
out wrong, discarding most if not all of the actual condition. Fix it.
---
aldor/aldor/src/syme.c | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c
index 04de369e1..dd821ad9c 100644
--- a/aldor/aldor/src/syme.c
+++ b/aldor/aldor/src/syme.c
@@ -587,10 +587,10 @@ symeAddCondition(Syme syme, Sefo cond, Bool pos)
symeAddCondition(syme, abArgv(cond)[--i], pos);
}
}
- else
+ else {
l = listCons(Sefo)(cond, l);
-
- symeSetCondition(syme, l);
+ symeSetCondition(syme, l);
+ }
return syme;
}
From 78e834a7915ead9a91d7c501093ceed0a1bef12f Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 16:56:57 +0000
Subject: [PATCH 21/35] tests: Add better test for symeAddCondition
---
aldor/aldor/src/test/abquick.c | 8 +++++++
aldor/aldor/src/test/abquick.h | 2 ++
aldor/aldor/src/test/test_syme.c | 36 +++++++++++++++++++++++++++++++-
3 files changed, 45 insertions(+), 1 deletion(-)
diff --git a/aldor/aldor/src/test/abquick.c b/aldor/aldor/src/test/abquick.c
index 06b415903..03ffd1dc4 100644
--- a/aldor/aldor/src/test/abquick.c
+++ b/aldor/aldor/src/test/abquick.c
@@ -36,6 +36,7 @@ ABQK_DEFINE2(qualify, abNewQualify);
ABQK_DEFINE2(pretend, abNewPretendTo);
ABQK_DEFINE2(restrictTo, abNewRestrictTo);
ABQK_DEFINE1(test, abNewTest);
+ABQK_DEFINE2(and, abNewAnd);
ABQK_DEFINE1_Symbol(id, abNewId);
@@ -169,3 +170,10 @@ uniqueMeaning(Stab stab, String s)
return d;
}
+
+Sefo
+sefo(AbSyn absyn)
+{
+ tiSefo(stabFile(), absyn);
+ return (Sefo) absyn;
+}
diff --git a/aldor/aldor/src/test/abquick.h b/aldor/aldor/src/test/abquick.h
index 523103f5c..41ba336d7 100644
--- a/aldor/aldor/src/test/abquick.h
+++ b/aldor/aldor/src/test/abquick.h
@@ -52,6 +52,7 @@ ABQK_DECLARE1(test, abNewTest);
ABQK_DECLARE2(qualify, abNewQualify);
ABQK_DECLARE2(pretend, abNewPretendTo);
ABQK_DECLARE2(restrictTo, abNewRestrictTo);
+ABQK_DECLARE2(and, abNewAnd);
ABQK_DECLARE1_Symbol(id, abNewId);
@@ -68,5 +69,6 @@ AbSyn abqParseLinesAsSeq(StringList lines);
AbSyn stdtypes();
Syme uniqueMeaning(Stab stab, String s);
+Sefo sefo(AbSyn absyn);
#endif
diff --git a/aldor/aldor/src/test/test_syme.c b/aldor/aldor/src/test/test_syme.c
index 33053ee75..e490f1f59 100644
--- a/aldor/aldor/src/test/test_syme.c
+++ b/aldor/aldor/src/test/test_syme.c
@@ -11,6 +11,7 @@
#include "ablogic.h"
#include "comsg.h"
#include "symbol.h"
+#include "tform.h"
local void testSymeSExpr();
@@ -33,7 +34,7 @@ extern int stabDebug;
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));
@@ -58,3 +59,36 @@ testSymeSExpr()
finiFile();
}
+
+local void
+testSymeAddCondition()
+{
+ String C_txt = "C: Category == with";
+ String D1_txt = "D1: with == add";
+ String D2_txt = "D2: with == add";
+ StringList lines = listList(String)(3, C_txt, D1_txt, D2_txt);
+ AbSynList code = listCons(AbSyn)(stdtypes(), abqParseLines(lines));
+
+ AbSyn absyn = abNewSequenceL(sposNone, code);
+
+ initFile();
+ Stab stab = stabFile();
+
+ 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();
+}
From 34165185b1266e0fbaa30f2abb555f7775b75514 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 17:22:14 +0000
Subject: [PATCH 22/35] tform.c: Use already existing function to add a
condition to a list of symbols
---
aldor/aldor/src/test/test_syme.c | 6 +++++-
aldor/aldor/src/tform.c | 6 +-----
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/aldor/aldor/src/test/test_syme.c b/aldor/aldor/src/test/test_syme.c
index e490f1f59..1539a8fad 100644
--- a/aldor/aldor/src/test/test_syme.c
+++ b/aldor/aldor/src/test/test_syme.c
@@ -14,6 +14,7 @@
#include "tform.h"
local void testSymeSExpr();
+local void testSymeAddCondition();
/* XXX: from test_tinfer.c */
void init(void);
@@ -26,6 +27,7 @@ symeTest()
{
init();
TEST(testSymeSExpr);
+ TEST(testSymeAddCondition);
fini();
}
@@ -63,10 +65,11 @@ testSymeSExpr()
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)(3, C_txt, D1_txt, D2_txt);
+ 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);
@@ -74,6 +77,7 @@ testSymeAddCondition()
initFile();
Stab stab = stabFile();
+ abPutUse(absyn, AB_Use_NoValue);
scopeBind(stab, absyn);
typeInfer(stab, absyn);
diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c
index e267fc0a4..d1f471c30 100644
--- a/aldor/aldor/src/tform.c
+++ b/aldor/aldor/src/tform.c
@@ -3292,11 +3292,7 @@ tfGetCatParentsFrIf(TForm cat)
}
tsymes = tfGetCatParentsFrInner(tfIfThen(cat));
- tsymes = listCopy(Syme)(tsymes);
- for (symes = tsymes; symes; symes=cdr(symes)) {
- car(symes) = symeCopy(car(symes));
- symeAddCondition(car(symes), cond, true);
- }
+ tsymes = symeListAddCondition(tsymes, cond, true);
esymes = tfGetCatParentsFrInner(tfIfElse(cat));
esymes = listCopy(Syme)(esymes);
From 0ac9d878901d7999fa8e2c951c125fbc712138dc Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 17:25:43 +0000
Subject: [PATCH 23/35] aldor/test: Add -Wcheck to argument list.
---
aldor/aldor/test/Makefile.in | 1 +
1 file changed, 1 insertion(+)
diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in
index 85cfbce67..e9fc08c9f 100644
--- a/aldor/aldor/test/Makefile.in
+++ b/aldor/aldor/test/Makefile.in
@@ -99,6 +99,7 @@ $(patsubst %, out/ap/%.ap, $(_aptests)): out/ap/%.ap: $(srcdir)/%.as
define aldor_args
$(nfile) \
+ -Wcheck \
-Y$(foamlibdir)/al \
-I$(foamsrclibdir)/al \
-lAxlLib=foamlib \
From 80bef0f972f83a9048d329d58cc4ce1ed7a18c0f Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 17:28:51 +0000
Subject: [PATCH 24/35] absyn.c: Add abNewAndAll to get a conjuction from a
list of tests
To be used when gathering conditions from syntax
---
aldor/aldor/src/absyn.c | 9 +++++++++
aldor/aldor/src/absyn.h | 2 ++
2 files changed, 11 insertions(+)
diff --git a/aldor/aldor/src/absyn.c b/aldor/aldor/src/absyn.c
index cd93e52cd..8e4af279f 100644
--- a/aldor/aldor/src/absyn.c
+++ b/aldor/aldor/src/absyn.c
@@ -208,6 +208,15 @@ abNewOfOpAndList(AbSynTag abtag, SrcPos pos, AbSyn op, AbSynList args)
return ab;
}
+AbSyn
+abNewAndAll(SrcPos pos, AbSynList absyn)
+{
+ if (cdr(absyn) == listNil(AbSyn))
+ return car(absyn);
+ return abNewAnd(pos, car(absyn), abNewAndAll(pos, cdr(absyn)));
+
+}
+
void
abFree(AbSyn ab)
{
diff --git a/aldor/aldor/src/absyn.h b/aldor/aldor/src/absyn.h
index daf30b6b7..67c20d924 100644
--- a/aldor/aldor/src/absyn.h
+++ b/aldor/aldor/src/absyn.h
@@ -945,6 +945,8 @@ extern AbSyn abNewOfList (AbSynTag t, SrcPos, AbSynList);
extern AbSyn abNewOfOpAndList (AbSynTag t, SrcPos,AbSyn op,AbSynList);
extern AbSyn abNewOfToken (AbSynTag t, Token);
+extern AbSyn abNewAndAll (SrcPos, AbSynList);
+
extern AbSyn abCopy (AbSyn);
extern AbSyn abReposition (AbSyn, SrcPos pos, SrcPos end);
extern AbSyn abMarkAsMacroExpanded (AbSyn);
From d032a3f9ee7a85de703094afdbfb0b84fa5cdbfb Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 23:03:22 +0000
Subject: [PATCH 25/35] absyn.c: New abNewOrAll function.
---
aldor/aldor/src/absyn.c | 9 ++++++++-
aldor/aldor/src/absyn.h | 1 +
2 files changed, 9 insertions(+), 1 deletion(-)
diff --git a/aldor/aldor/src/absyn.c b/aldor/aldor/src/absyn.c
index 8e4af279f..3754261a1 100644
--- a/aldor/aldor/src/absyn.c
+++ b/aldor/aldor/src/absyn.c
@@ -213,8 +213,15 @@ abNewAndAll(SrcPos pos, AbSynList absyn)
{
if (cdr(absyn) == listNil(AbSyn))
return car(absyn);
- return abNewAnd(pos, car(absyn), abNewAndAll(pos, cdr(absyn)));
+ return abNewAnd(pos, car(absyn), abNewAndAll(pos, cdr(absyn)));
+}
+AbSyn
+abNewOrAll(SrcPos pos, AbSynList absyn)
+{
+ if (cdr(absyn) == listNil(AbSyn))
+ return car(absyn);
+ return abNewOr(pos, car(absyn), abNewAndAll(pos, cdr(absyn)));
}
void
diff --git a/aldor/aldor/src/absyn.h b/aldor/aldor/src/absyn.h
index 67c20d924..1ec6f5695 100644
--- a/aldor/aldor/src/absyn.h
+++ b/aldor/aldor/src/absyn.h
@@ -946,6 +946,7 @@ extern AbSyn abNewOfOpAndList (AbSynTag t, SrcPos,AbSyn op,AbSynList);
extern AbSyn abNewOfToken (AbSynTag t, Token);
extern AbSyn abNewAndAll (SrcPos, AbSynList);
+extern AbSyn abNewOrAll (SrcPos, AbSynList);
extern AbSyn abCopy (AbSyn);
extern AbSyn abReposition (AbSyn, SrcPos pos, SrcPos end);
From 20e7b7080c070a1cf09e2dd7365d3950e9326fa0 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 17:45:20 +0000
Subject: [PATCH 26/35] syme.c: Check that conditions can be type inferred
before adding them to symes.
---
aldor/aldor/src/syme.c | 2 ++
1 file changed, 2 insertions(+)
diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c
index dd821ad9c..ba9f3ed58 100644
--- a/aldor/aldor/src/syme.c
+++ b/aldor/aldor/src/syme.c
@@ -578,6 +578,8 @@ symeAddCondition(Syme syme, Sefo cond, Bool pos)
{
SefoList l = symeCondition(syme);
+ assert(tiTopFns()->tiCanSefo(cond));
+
if (abTag(cond) == AB_Test)
cond = cond->abTest.cond;
From 534083a826e0bba29fe27ea75f995c45feb45267 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 17:56:26 +0000
Subject: [PATCH 27/35] scobind.c: Dump the information about conditional
context in which an identifier is defined onto the symbol.
---
aldor/aldor/src/scobind.c | 25 ++++++++++++++++++++++++-
aldor/aldor/src/syme.c | 1 +
aldor/aldor/src/syme.h | 3 +++
3 files changed, 28 insertions(+), 1 deletion(-)
diff --git a/aldor/aldor/src/scobind.c b/aldor/aldor/src/scobind.c
index d60757a51..a7903b72c 100644
--- a/aldor/aldor/src/scobind.c
+++ b/aldor/aldor/src/scobind.c
@@ -197,6 +197,7 @@ local DefnPos defposTail (DefnPos pos);
local Bool defposEqual (DefnPos a, DefnPos b);
local Bool defposIsRoot (DefnPos pos);
local void defposFree (DefnPos pos);
+local AbSynList defposToAbSyn(AIntList defnPos);
/* (ToDo: Rename above functions to defnposXXX) */
/******************************************************************************
@@ -392,7 +393,6 @@ local Bool scobindNeedsMeaning (AbSyn, TForm);
local void scobindSetMeaning (AbSyn, Syme);
local Syme scobindDefMeaning (Stab, SymeTag, Symbol,
TForm, AInt);
-
/*
* scobindReconcile
*/
@@ -3518,6 +3518,25 @@ scobindCheckDefnPos(DeclInfo declInfo, DefnPos posn)
return scobindCheckDefnPos(declInfo, defposTail(posn));
}
+AbSynList
+scobindDefnPosToList(DefnPosList defnPosList)
+{
+ AbSynList conditionList = listNil(AbSyn);
+ while (defnPosList != listNil(DefnPos)) {
+ AbSynList absynList = defposToAbSyn(car(defnPosList));
+ defnPosList = cdr(defnPosList);
+
+ if (absynList == listNil(AbSyn))
+ conditionList = listCons(AbSyn)(NULL, conditionList);
+ else {
+ AbSyn absyn = (cdr(absynList) == listNil(AbSyn))
+ ? car(absynList) : abNewAndAll(sposNone, absynList);
+ conditionList = listCons(AbSyn)(absyn, conditionList);
+ }
+ }
+ return listNReverse(AbSyn)(conditionList);
+}
+
/******************************************************************************
*
* :: scobindAddMeaning
@@ -3896,6 +3915,10 @@ scobindReconcileDecl(Stab stab, AbSynTag context, Symbol sym, IdInfo idInfo,
scobindAddMeaning(declInfo->id,
sym, stab, SYME_Export,
tf, (AInt) declInfo->doc);
+ assert(abSyme(declInfo->id));
+ Syme syme = abSyme(declInfo->id);
+ AbSynList defConditions = scobindDefnPosToList(declInfo->defpos);
+ symeSetDefinitionConditions(syme, defConditions);
}
else {
checkOuterUseOfLexicalConstant(stab, declInfo->id);
diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c
index ba9f3ed58..83f758f18 100644
--- a/aldor/aldor/src/syme.c
+++ b/aldor/aldor/src/syme.c
@@ -1708,4 +1708,5 @@ struct symeFieldInfo symeFieldInfo[] = {
{ SYFI_HashNum, "hashNum", (AInt) (int) 0 },
{ SYFI_ExtraBits, "extraBits", (AInt) (int) 0 },
{ SYFI_ConditionContext,"conditionContext",(AInt) (AbSyn) NULL },
+ { SYFI_DefinitionConditions,"definedConditions",(AInt) listNil(AbSyn) },
};
diff --git a/aldor/aldor/src/syme.h b/aldor/aldor/src/syme.h
index f2e948c4f..0d06c0df6 100644
--- a/aldor/aldor/src/syme.h
+++ b/aldor/aldor/src/syme.h
@@ -101,6 +101,7 @@ enum symeField {
SYFI_HashNum, /* Runtime hash code */
SYFI_ExtraBits, /* More syme bits */
SYFI_ConditionContext, /* Context in which to infer condition */
+ SYFI_DefinitionConditions, /* Contexts in which this symbol is defined */
SYME_FIELD_LIMIT
};
@@ -340,6 +341,7 @@ extern Lib symeConstLib (Syme);
#define symeImpl(s) ((SImpl) symeGetField(s, SYFI_SImpl))
#define symeExtraBits(s) ((AInt) symeGetField(s, SYFI_ExtraBits))
#define symeConditionContext(s) ((SymeCContext) symeGetField(s, SYFI_ConditionContext))
+#define symeDefinitionConditions(s) ((AbSynList) symeGetField (s, SYFI_DefinitionConditions))
#define symeIsLabel(s) (symeKind(s) == SYME_Label)
#define symeIsParam(s) (symeKind(s) == SYME_Param)
@@ -434,6 +436,7 @@ extern void symeSetConstNumX (Syme, AInt);
#define symeSetImpl(s,v) symeSetField(s, SYFI_SImpl, v)
#define symeSetExtraBits(s,v) symeSetField(s, SYFI_ExtraBits, v)
#define symeSetConditionContext(s,v) symeSetField(s, SYFI_ConditionContext, v)
+#define symeSetDefinitionConditions(s, v) symeSetField (s, SYFI_DefinitionConditions, v)
#define symeSetBit(s,b) (symeBits(s) |= (b))
#define symeClrBit(s,b) (symeBits(s) &= ~(b))
From c6c56585464fbcabb7df47cafafb3a6ef94b7edf Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sat, 2 Nov 2013 10:52:43 +0000
Subject: [PATCH 28/35] foamlib: ~=$List was missing in the case where S isn't
a BasicType.
---
aldor/aldor/lib/libfoamlib/al/list.as | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/aldor/aldor/lib/libfoamlib/al/list.as b/aldor/aldor/lib/libfoamlib/al/list.as
index 3b8ce50e8..fa92fa234 100644
--- a/aldor/aldor/lib/libfoamlib/al/list.as
+++ b/aldor/aldor/lib/libfoamlib/al/list.as
@@ -307,12 +307,16 @@ List(S: Type): ListCategory S with == FakedConditionalOperations S add {
-- on conditionals
FakedConditionalOperations(S: Type): with {
=: (%, %) -> Boolean;
+ ~=: (%, %) -> Boolean;
<<: (TextWriter, %) -> TextWriter;
member?: (S, %) -> Boolean;
} == add {
(a: %) = (b: %): Boolean == {
error "no equality on this object";
}
+ (a: %) ~= (b: %): Boolean == {
+ error "no equality on this object";
+ }
member?(a: S, b: %): Boolean == {
error "no member? on this object";
}
From 78cdd0419a13a176b60f25d0f5acf19c4cce6be9 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sat, 2 Nov 2013 10:54:03 +0000
Subject: [PATCH 29/35] aldor_gloop.as - define << when not X has OutputType,
instead of PrimitiveType.
---
aldor/lib/aldor/src/aldor_gloop.as | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/aldor/lib/aldor/src/aldor_gloop.as b/aldor/lib/aldor/src/aldor_gloop.as
index d00069fae..ebe2b5fff 100644
--- a/aldor/lib/aldor/src/aldor_gloop.as
+++ b/aldor/lib/aldor/src/aldor_gloop.as
@@ -25,7 +25,7 @@ extend Union(T:Tuple Type):with { <<: (TextWriter, %) -> TextWriter } == add {
}
extend List(T:Type): with { <<: (TextWriter, %) -> TextWriter } == add {
- if not(T has PrimitiveType) then {
+ if not(T has OutputType) then {
(p:TextWriter) << (a:%):TextWriter == {
import from String, MachineInteger;
empty? a => p << "[]";
From f8a9ee951b0d4d8598ee3803423b0269b89de14c Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sat, 2 Nov 2013 10:55:14 +0000
Subject: [PATCH 30/35] complex.as: Define ^ in terms of binary powering when R
is not a Floating point field.
---
aldor/lib/aldor/src/arith/sal_complex.as | 7 +++++++
1 file changed, 7 insertions(+)
diff --git a/aldor/lib/aldor/src/arith/sal_complex.as b/aldor/lib/aldor/src/arith/sal_complex.as
index 9ca8f928c..65dfe31b7 100644
--- a/aldor/lib/aldor/src/arith/sal_complex.as
+++ b/aldor/lib/aldor/src/arith/sal_complex.as
@@ -270,6 +270,13 @@ is not commutative.}
imag a * real b - real a * imag b, d);
}
}
+ else {
+ (a:%)^(n:MachineInteger):% == {
+ import from BinaryPowering(%, MachineInteger);
+ n > 0 => binaryExponentiation(a, n);
+ never;
+ }
+ }
if R has SerializableType then {
(p:BinaryWriter) << (a:%):BinaryWriter == p << real a << imag a;
From 6e0d9a931dfca5774e1b6a9df1ac60e7dc8b8a09 Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sat, 2 Nov 2013 10:56:50 +0000
Subject: [PATCH 31/35] algebra/sit_quotby.as: Mark normalize on FractionBy as
broken for non-GcdDomain arguments. Not entirely sure what the right thing
to do is here. All ideas welcomed.
---
aldor/lib/algebra/src/fraction/sit_quotby.as | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/aldor/lib/algebra/src/fraction/sit_quotby.as b/aldor/lib/algebra/src/fraction/sit_quotby.as
index 8ad331ce3..15adeb560 100644
--- a/aldor/lib/algebra/src/fraction/sit_quotby.as
+++ b/aldor/lib/algebra/src/fraction/sit_quotby.as
@@ -41,6 +41,7 @@ FractionBy(R: IntegralDomain, p:R, irr?:Boolean): FractionByCategory R == {
-- Keeps normalized, ie exactQuotient(Numerator, p) = failed
-- value is Numer p^Order
Rep == Record(Numer:R, Order:Z);
+ import from String;
local gcd?:Boolean == R has GcdDomain;
local mkquot(a:R, n:Z):% == { import from Rep; per [a, n]; }
@@ -92,7 +93,7 @@ FractionBy(R: IntegralDomain, p:R, irr?:Boolean): FractionByCategory R == {
-- b p^m divides a p^n if and only if b divides a p^k for some k >= 0
exactQuotient(x:%, y:%):Partial % == {
TRACE("fractionby::exactQuotient, p = ", p);
- import from String, Z, Partial R;
+ import from Z, Partial R;
(a, n) := numord x;
TRACE("a = ", a); TRACE("n = ", n);
(b, m) := numord y;
@@ -128,6 +129,9 @@ FractionBy(R: IntegralDomain, p:R, irr?:Boolean): FractionByCategory R == {
(h * qq^(next k), next k);
}
}
+ else {
+ normalize(x:%): % == error "Normalize on non GCD Domain";
+ }
shift(x:%, n:Z):% == {
(a, m) := numord x;
From cf41895c9a868cb80a1358c755e845881ffcd69c Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sat, 2 Nov 2013 10:58:12 +0000
Subject: [PATCH 32/35] sit_sercat: Definition of monicNewtonSeries and
tryExpandFraction depend only on CommutativeRing, not GcdDoman. So, tweak.
---
aldor/lib/algebra/src/series/sit_sercat.as | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/aldor/lib/algebra/src/series/sit_sercat.as b/aldor/lib/algebra/src/series/sit_sercat.as
index 836705080..9df9c6bd2 100644
--- a/aldor/lib/algebra/src/series/sit_sercat.as
+++ b/aldor/lib/algebra/src/series/sit_sercat.as
@@ -353,7 +353,7 @@ where $s = \sum_{n \ge 0} a_n x^n$.}
}
}
- if R has GcdDomain then {
+ if R has CommutativeRing then {
monicNewtonSeries(p:RX):RXX == {
import from Z, R, RX, Partial RXX;
assert(~zero? p);
From 1c6c420253491b007d87d0fb6c4ddd8050639a9f Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Fri, 1 Nov 2013 18:16:18 +0000
Subject: [PATCH 33/35] Verify that when an export is required from an add
body, make sure that as well as the symbol being defined, it is defined in
contexts matching the condition on the export. So: A category like 'with {if
A then { b: % }} should not be matched by 'add { if X then { b: % }}', unless
A implies X. Replace 'A' with Ring and 'X' with Field to get the idea.
---
aldor/aldor/src/tinfer.c | 73 +++++++++++++++++++++++++++++++++++++---
1 file changed, 68 insertions(+), 5 deletions(-)
diff --git a/aldor/aldor/src/tinfer.c b/aldor/aldor/src/tinfer.c
index efa25dd1f..d30c6dfc4 100644
--- a/aldor/aldor/src/tinfer.c
+++ b/aldor/aldor/src/tinfer.c
@@ -20,6 +20,7 @@
#include "ti_tdn.h"
#include "ti_top.h"
#include "tinfer.h"
+#include "syme.h"
#include "sefo.h"
#include "lib.h"
#include "tqual.h"
@@ -200,8 +201,9 @@ local Bool tiTopEqual (TFormUses, TFormUses);
*
****************************************************************************/
-local Bool tqShouldImport (TQual);
-local TForm tiGetTopLevelTForm(SymeCContext context, AbSyn type);
+local Bool tqShouldImport (TQual);
+local TForm tiGetTopLevelTForm(SymeCContext context, AbSyn type);
+local Bool tiCheckSymeConditionalImplementation(Stab stab, Syme syme, Syme implSyme);
void
tinferInit()
@@ -319,6 +321,7 @@ tiWithSymes(Stab stab, TForm context)
SymeList mods;
SymeList symes;
SymeList csymes = listNil(Syme);
+ SymeList esymes = listNil(Syme);
Stab wstab = stab;
while (wstab && stabGetSelf(wstab) == NULL) wstab = cdr(wstab);
tipAddDEBUG(dbOut, ">>tiWithSymes:\n");
@@ -338,8 +341,13 @@ tiWithSymes(Stab stab, TForm context)
}
/* Look for syme in the capsule. */
- if ((xsyme = stabGetExportMod(wstab, mods, sym, tf)) != NULL) {
- tipAddDEBUG(dbOut, " [export]\n");
+ if ((xsyme = stabGetExportMod(wstab, mods, sym, tf))) {
+ if (tiCheckSymeConditionalImplementation(wstab, syme, xsyme))
+ tipAddDEBUG(dbOut, " [export]\n");
+ else {
+ tipAddDEBUG(dbOut, " [conditional override]\n");
+ esymes = listCons(Syme)(syme, esymes);
+ }
}
else {
@@ -348,6 +356,23 @@ tiWithSymes(Stab stab, TForm context)
}
}
+ for (; esymes != listNil(Syme); esymes = cdr(esymes)) {
+ Syme esyme = car(esymes);
+ Symbol sym = symeId(esyme);
+ TForm tf = symeType(esyme);
+ Syme xsyme = stabGetExportMod(wstab, mods, sym, tf);
+ if (symeCondition(esyme) == listNil(Sefo)) {
+ symeSetDefinitionConditions(xsyme, listNil(AbSyn));
+ }
+ else {
+ symeSetDefinitionConditions(xsyme,
+ listCons(AbSyn)(abNewAndAll(sposNone,
+ (AbSynList) symeCondition(esyme)),
+ symeDefinitionConditions(xsyme)));
+ }
+ }
+
+
symes = symeListSubstCat(wstab, mods, context, csymes);
symes = symeListCheckWithCondition(symes);
@@ -393,6 +418,43 @@ symeListSetImplicit(Stab stab, SymeList symes)
return result;
}
+local Bool
+tiCheckSymeConditionalImplementation(Stab stab, Syme syme, Syme implSyme)
+{
+ SefoList condition = symeCondition(syme);
+ AbSynList implCondition = symeDefinitionConditions(implSyme);
+ AbSynList tmp;
+ SefoList tmpSefo;
+
+ if (implCondition == listNil(AbSyn))
+ return true;
+ /* Need to check that implCondition implies condition */
+ /* First, unconditional implies it does */
+ for (tmp = implCondition; tmp != listNil(AbSyn); tmp = cdr(tmp)) {
+ if (car(tmp) == NULL)
+ return true;
+ }
+
+ for (tmp = implCondition; tmp != listNil(AbSyn); tmp = cdr(tmp)) {
+ tiBottomUp(stab, car(tmp), tfUnknown);
+ tiTopDown(stab, car(tmp), tfUnknown);
+ }
+
+ AbLogic implAbLog = ablogFalse();
+ for (tmp = implCondition; tmp != listNil(AbSyn); tmp = cdr(tmp)) {
+ implAbLog = ablogOr(ablogFrSefo(car(tmp)), implAbLog);
+ }
+ AbLogic conditionAbLog = ablogTrue();
+ for (tmpSefo = condition; tmpSefo != listNil(Sefo); tmpSefo = cdr(tmpSefo)) {
+ conditionAbLog = ablogAnd(ablogFrSefo(car(tmpSefo)), conditionAbLog);
+ }
+
+ Bool result = ablogImplies(conditionAbLog,
+ ablogAnd(abCondKnown != NULL ? abCondKnown : ablogTrue(), implAbLog));
+
+ return result;
+}
+
/*
* Make sure that the category exports of context are visible in capsule.
* Return the symes which could not be found in the add. Tell the caller
@@ -444,7 +506,8 @@ tiAddSymes(Stab astab, AbSyn capsule, TForm base, TForm context, SymeList *p)
tipAddDEBUG(dbOut, " looking for: %pSyme %pAbSynList ", syme, symeCondition(syme));
/* Look for syme in the capsule. */
- if ((xsyme = stabGetDomainExportMod(astab, mods, sym, tf)) != NULL) {
+ if ((xsyme = stabGetDomainExportMod(astab, mods, sym, tf)) != NULL
+ && tiCheckSymeConditionalImplementation(astab, syme, xsyme)) {
tipAddDEBUG(dbOut, " [export]\n");
symeImplAddInherit(xsyme, base, syme);
}
From 7547146b87ea88889ffbf842421f36609e7d2bbb Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sat, 2 Nov 2013 11:47:21 +0000
Subject: [PATCH 34/35] terror.c: Warnings on conditionally missing exports
Add more complex error printer for partially implemented exports.
---
aldor/aldor/src/terror.c | 118 +++++++++++++++++++++++++++++++++------
aldor/aldor/src/terror.h | 2 +-
aldor/aldor/src/ti_bup.c | 3 +-
3 files changed, 103 insertions(+), 20 deletions(-)
diff --git a/aldor/aldor/src/terror.c b/aldor/aldor/src/terror.c
index f0f7096a0..95c2c1c25 100644
--- a/aldor/aldor/src/terror.c
+++ b/aldor/aldor/src/terror.c
@@ -71,7 +71,9 @@ local void trInfoFrSymes (TRejectInfo, SymeList);
local void trInfoFrTPoss (TRejectInfo, TPoss);
local void trInfoFrTUnique (TRejectInfo, TForm);
-local void bputCondition(Buffer buf, SefoList conds);
+local void bputCondition (Buffer buf, SefoList conds);
+local void terrorPrintSymeList(Buffer obuf, String prefix, SymeList msymes);
+local void terrorPutConditionallyDefinedExports(Buffer obuf, Stab stab, SymeList mods, AbSyn ab, SymeList symes);
/**************************************************************************
* TReject / TRejectInfo utility
@@ -344,7 +346,7 @@ terror (Stab stab, AbSyn absyn, TForm type)
* occurred.
*/
assert(abState(absyn) != AB_State_HasUnique);
- terrorNotEnoughExports(absyn, abTPoss(absyn), false);
+ terrorNotEnoughExports(stab, absyn, abTPoss(absyn), false);
tpossFree(abTPoss(absyn));
abTPoss(absyn) = tpossEmpty();
break;
@@ -1901,7 +1903,7 @@ terrorAssign(AbSyn ab, TForm type, TPoss tposs)
/**************************************************************************/
local void
-terrorPutConditionalExports(Buffer buf, SymeList csymes)
+terrorPutConditionalExports(Stab stab, Buffer buf, SymeList csymes)
{
SefoList conds;
SymeList gsymes, symes, nsymes, hsyme;
@@ -1945,49 +1947,70 @@ terrorPutConditionalExports(Buffer buf, SymeList csymes)
String s;
s = fmtTForm(symeType(car(gsymes)));
bufPrintf(buf , "\n\t\t");
+
bufPrintf(buf, fmt,
symeString(car(gsymes)), s);
strFree(s);
gsymes = listFreeCons(Syme)(gsymes);
}
}
-
}
void
-terrorNotEnoughExports(AbSyn ab, TPoss tposs, Bool onlyWarning)
+terrorNotEnoughExports(Stab stab, AbSyn ab, TPoss tposs, Bool onlyWarning)
{
- String fmt, s;
- Buffer obuf;
+ TForm base;
SymeList symes;
SymeList csymes;
+ SymeList isymes;
+ SymeList msymes;
+ SymeList mods;
+ SymeList aself;
+ Buffer obuf;
terrorClip = comsgOkAbbrev() ? CLIP : ABPP_UNCLIPPED;
obuf = bufNew();
- fmt = comsgString(ALDOR_D_TinMissingExports);
- bufPrintf(obuf, "%s", fmt);
-
if (!comsgOkDetails()) goto done;
+ base = abTForm(ab->abAdd.base);
assert(tpossIsUnique(tposs));
symes = tfGetCatExports(tpossUnique(tposs));
+
+ aself = tfGetSelfFrStab(stab);
+ mods = listCopy(Syme)(tfGetCatSelf(tpossUnique(tposs)));
+ mods = listNConcat(Syme)(listCopy(Syme)(tfGetDomSelf(base)), mods);
+ mods = listNConcat(Syme)(aself, mods);
+
csymes = listNil(Syme);
- fmt = comsgString(ALDOR_D_TinMissingExport);
+ isymes = listNil(Syme);
+ msymes = listNil(Syme);
for (; symes; symes = cdr(symes)) {
- if (symeCondition(car(symes)))
- csymes = listCons(Syme)(car(symes), csymes);
+ Syme syme = car(symes);
+ Syme isyme = stabGetDomainExportMod(stab, mods, symeId(syme), symeType(syme));
+ if (isyme != NULL) {
+ isymes = listCons(Syme)(syme, isymes);
+ }
+ else if (symeCondition(car(symes)))
+ csymes = listCons(Syme)(syme, csymes);
else {
- s = fmtTForm(symeType(car(symes)));
- bufPrintf(obuf , "\n\t");
- bufPrintf(obuf, fmt, symeString(car(symes)), s);
- strFree(s);
+ msymes = listCons(Syme)(syme, msymes);
}
}
- if (csymes) terrorPutConditionalExports(obuf, csymes);
+ if (msymes != listNil(Syme)) {
+ String fmt = comsgString(ALDOR_D_TinMissingExports);
+ bufPrintf(obuf, "%s", fmt);
+ terrorPrintSymeList(obuf, "", msymes);
+ }
+ if (csymes) {
+ terrorPutConditionalExports(stab, obuf, csymes);
+ }
+ if (isymes) {
+ terrorPutConditionallyDefinedExports(obuf, stab, mods, ab, isymes);
+ }
done:
if (onlyWarning)
comsgWarning(ab, ALDOR_E_ExplicitMsg, bufChars(obuf));
@@ -1997,6 +2020,65 @@ terrorNotEnoughExports(AbSyn ab, TPoss tposs, Bool onlyWarning)
}
+local void
+terrorPrintSymeList(Buffer obuf, String prefix, SymeList msymes)
+{
+ String fmt = comsgString(ALDOR_D_TinMissingExport);
+
+ for (; msymes != listNil(Syme); msymes = listFreeCons(Syme)(msymes)) {
+ Syme syme = car(msymes);
+ String s = fmtTForm(symeType(syme));
+ bufPrintf(obuf , "\n\t%s", prefix);
+ bufPrintf(obuf, fmt, symeString(syme), s);
+ strFree(s);
+ }
+}
+
+local void
+terrorPutConditionallyDefinedExports(Buffer obuf, Stab stab, SymeList mods, AbSyn ab, SymeList symes)
+{
+ SymeList usymes;
+ SymeList iter;
+
+ iter = listCopy(Syme)(symes);
+ while (iter != listNil(Syme)) {
+ Syme syme = car(iter);
+ SymeList msymes, nsymes;
+ SefoList condition = symeCondition(syme);
+ Syme implSyme = stabGetDomainExportMod(stab, mods, symeId(syme), symeType(syme));
+ AbSynList defCondition = symeDefinitionConditions(implSyme);
+
+ nsymes = listNil(Syme);
+ msymes = listCons(Syme)(syme, listNil(Syme));
+ iter = listFreeCons(Syme)(iter);
+ while (iter != listNil(Syme)) {
+ Syme iterSyme = car(iter);
+ Syme implSyme = stabGetDomainExportMod(stab, mods, symeId(iterSyme), symeType(iterSyme));
+ if (sefoListEqual(condition, symeCondition(iterSyme))
+ && sefoListEqual((SefoList) defCondition,
+ (SefoList) symeDefinitionConditions(implSyme)))
+ msymes = listCons(Syme)(iterSyme, msymes);
+ else
+ nsymes = listCons(Syme)(iterSyme, nsymes);
+ iter = listFreeCons(Syme)(iter);
+ }
+ iter = nsymes;
+ bufPrintf(obuf, "\n");
+ if (condition == listNil(Sefo)) {
+ AbSyn expr = abNewNot(sposNone, abNewOrAll(sposNone, defCondition));
+ bufPrintf(obuf, "\tMissing where %s", abPretty(expr));
+ terrorPrintSymeList(obuf, "\t", msymes);
+ }
+ else {
+ AbSyn expr = abNewNot(sposNone, abNewOrAll(sposNone, defCondition));
+ bufPrintf(obuf, "\tMissing where %s\n", abPretty(abNewAndAll(sposNone,
+ (AbSynList) condition)));
+ bufPrintf(obuf, "\t\t and %s", abPretty(expr));
+ terrorPrintSymeList(obuf, "\t", msymes);
+ }
+ }
+}
+
/***************************************************************************/
/* Specific error msg for Identifier without meaning. */
/***************************************************************************/
diff --git a/aldor/aldor/src/terror.h b/aldor/aldor/src/terror.h
index c8dbcdae0..ce59db096 100644
--- a/aldor/aldor/src/terror.h
+++ b/aldor/aldor/src/terror.h
@@ -18,7 +18,7 @@ extern void terrorNotUniqueType (Msg, AbSyn, TForm, TPoss);
extern void terrorNotUniqueMeaning (Msg, AbSyn, SymeList, SymeList, String,
TForm);
-extern void terrorNotEnoughExports (AbSyn, TPoss, Bool);
+extern void terrorNotEnoughExports (Stab, AbSyn, TPoss, Bool);
extern void terrorAssign (AbSyn, TForm, TPoss);
extern void terrorSetBang (Stab, AbSyn, Length, AbSynGetter);
extern void terrorTypeConstFailed (TConst);
diff --git a/aldor/aldor/src/ti_bup.c b/aldor/aldor/src/ti_bup.c
index c41b0604e..c21db3557 100644
--- a/aldor/aldor/src/ti_bup.c
+++ b/aldor/aldor/src/ti_bup.c
@@ -2112,13 +2112,14 @@ tibupAdd(Stab stab, AbSyn absyn, TForm type)
if (symes) {
if (tiIsSoftMissing()) {
- terrorNotEnoughExports(absyn,
+ terrorNotEnoughExports(stab, absyn,
tpossSingleton(tfWithFrSymes(symes)), true);
tfw = tfWithFrAbSyn(absyn);
}
else {
abState(absyn) = AB_State_Error;
tfw = tfWithFrSymes(symes);
+ tfSetSelf(tfw, tfGetCatSelf(type));
}
}
else
From 087ff8860e1d932cef40306731746af08cb0423e Mon Sep 17 00:00:00 2001
From: Peter Broadbery
Date: Sat, 2 Nov 2013 13:34:15 +0000
Subject: [PATCH 35/35] algebra library: remove debug flag in build
---
aldor/lib/algebra/src/multpoly/multpolypkg/Makefile.in | 2 --
1 file changed, 2 deletions(-)
diff --git a/aldor/lib/algebra/src/multpoly/multpolypkg/Makefile.in b/aldor/lib/algebra/src/multpoly/multpolypkg/Makefile.in
index 862d79dc3..474fc188c 100644
--- a/aldor/lib/algebra/src/multpoly/multpolypkg/Makefile.in
+++ b/aldor/lib/algebra/src/multpoly/multpolypkg/Makefile.in
@@ -17,6 +17,4 @@ subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir))
# Build starts here
library = alg_bivarpk alg_disolve alg_expo alg_ezgcd alg_mhensel alg_mresbiv alg_ZpUVres
-alg_ezgcd_AXLFLAGS=-WD+tipBup -WD+tipTdn
-
include $(abs_top_srcdir)/lib/algebra/src/common.mk