From 895cb16e332988ff4a220253c2b86f0091f708f7 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 22 Sep 2014 20:31:03 +0100 Subject: [PATCH 001/352] automake: Missed this use of non-local .c files --- aldor/aldor/lib/libfoam/Makefile.am | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/aldor/aldor/lib/libfoam/Makefile.am b/aldor/aldor/lib/libfoam/Makefile.am index 94972ec02..72e5ac624 100644 --- a/aldor/aldor/lib/libfoam/Makefile.am +++ b/aldor/aldor/lib/libfoam/Makefile.am @@ -34,10 +34,10 @@ $(runtime_CSOURCES): %.c: $(aldorsrcdir)/%.c lib_LIBRARIES += libfoam.a -libfoam_a_SOURCES = \ - $(aldorsrcdir)/bigint.c \ - $(aldorsrcdir)/foam_i.c \ - $(runtime_ALDOR) \ +libfoam_a_SOURCES = \ + bigint.c \ + foam_i.c \ + $(runtime_ALDOR) \ $(runtime_CSOURCES) bigint.c: $(aldorsrcdir)/bigint.c @@ -57,7 +57,7 @@ endif # TODO: get rid of bigint.c in here libfoam_gmp_a_SOURCES = \ ../../contrib/gmp/fm_gmp.c \ - $(aldorsrcdir)/bigint.c \ + bigint.c \ $(runtime_ALDOR) \ $(runtime_CSOURCES) From b95b9854879a03515fc7a4328efb93f4cded8be0 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 31 May 2014 16:07:57 +0100 Subject: [PATCH 002/352] aldor: Move Boolean and Primitive type out of sal_base.as. This is a workaround for occasional bad inlining by the compiler - to do with when extends and categories are present in the same file (in this case '=' on primitive type and its implementation in MachineInteger. --- aldor/lib/aldor/src/Makefile.am | 1 + aldor/lib/aldor/src/base/Makefile.deps | 3 +- aldor/lib/aldor/src/base/Makefile.in | 7 +-- aldor/lib/aldor/src/base/sal_base.as | 57 +---------------------- aldor/lib/aldor/src/base/sal_base0.as | 62 ++++++++++++++++++++++++++ 5 files changed, 70 insertions(+), 60 deletions(-) create mode 100644 aldor/lib/aldor/src/base/sal_base0.as diff --git a/aldor/lib/aldor/src/Makefile.am b/aldor/lib/aldor/src/Makefile.am index 8e2a261ce..95e60e0c7 100644 --- a/aldor/lib/aldor/src/Makefile.am +++ b/aldor/lib/aldor/src/Makefile.am @@ -25,6 +25,7 @@ libaldor_a_SOURCES = \ arith/sal_sfloat.c \ base/ald_pfunc.c \ base/sal_base.c \ + base/sal_base0.c \ base/sal_bstream.c \ base/sal_byte.c \ base/sal_char.c \ diff --git a/aldor/lib/aldor/src/base/Makefile.deps b/aldor/lib/aldor/src/base/Makefile.deps index 357dee6ae..977f48dba 100644 --- a/aldor/lib/aldor/src/base/Makefile.deps +++ b/aldor/lib/aldor/src/base/Makefile.deps @@ -1,4 +1,5 @@ -sal_base_deps := +sal_base0_deps := +sal_base_deps := sal_base0 sal_tstream_deps := sal_base sal_bstream_deps := sal_base sal_serial_deps := sal_base sal_bstream diff --git a/aldor/lib/aldor/src/base/Makefile.in b/aldor/lib/aldor/src/base/Makefile.in index 42c743cc9..6339509de 100644 --- a/aldor/lib/aldor/src/base/Makefile.in +++ b/aldor/lib/aldor/src/base/Makefile.in @@ -15,9 +15,10 @@ abs_top_srcdir := @abs_top_srcdir@ subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) # Build starts here -library = ald_pfunc sal_base sal_bstream sal_byte sal_char sal_copy \ - sal_gener sal_htype sal_itype sal_manip sal_order sal_otype \ - sal_partial sal_serial sal_syntax sal_torder sal_tstream +library = ald_pfunc sal_base sal_base0 sal_bstream sal_byte sal_char \ + sal_copy sal_gener sal_htype sal_itype sal_manip sal_order \ + sal_otype sal_partial sal_serial sal_syntax sal_torder \ + sal_tstream \ @BUILD_JAVA_TRUE@javalibrary := $(library) diff --git a/aldor/lib/aldor/src/base/sal_base.as b/aldor/lib/aldor/src/base/sal_base.as index 1a1227172..fa829af75 100644 --- a/aldor/lib/aldor/src/base/sal_base.as +++ b/aldor/lib/aldor/src/base/sal_base.as @@ -67,38 +67,6 @@ in {\em a}. Note that both functions are 0-indexed.} #endif } -#if ALDOC -\thistype{PrimitiveType} -\History{Manuel Bronstein}{28/9/98}{created} -\Usage{\this: Category} -\Descr{\this~is the category of the most basic types.} -\begin{exports} -\alexp{$=$}: & (\%, \%) $\to$ \altype{Boolean} & equality test\\ -\alalias{\this}{$=$}{$\sim=$}: -& (\%, \%) $\to$ \altype{Boolean} & inequality test\\ -\end{exports} -#endif - -define PrimitiveType: Category == with { - =: (%, %) -> Boolean; - ~=: (%, %) -> Boolean; -#if ALDOC -\alpage{$=$} -\Usage{a = b\\ a $\sim=$ b} -\Signatures{ -$=$: & (\%,\%) $\to$ \altype{Boolean}\\ -$\sim=$: & (\%,\%) $\to$ \altype{Boolean}\\ -} -\Params{ {\em a, b} & \% & elements of the type\\ } -\Retval{ If $a = b$ returns \true, then $a$ and $b$ are guaranteed to -represent the same element of the type. The behavior if $a = b$ returns -\false~depends on the type, since a full equality test might not be -available. At least, it is guaranteed that $a$ and $b$ do not share the -same memory location in that case. The semantics of $a~\sim= b$ is -the boolean negation of $a = b$.} -#endif - default { (a:%) ~= (b:%):Boolean == ~(a = b); } -} +++ Union(T) is the disjoint union type former. +++ Union values are not mutable. @@ -109,29 +77,6 @@ the boolean negation of $a = b$.} -- The 'export from Boolean' is needed so that 'u case foo' compiles ok Union(T: Tuple Type): with { export from Boolean } == add; -+++ The Boolean data type supports logical operations. -+++ Both arguments of the binary operations are always evaluated. -+++ The Boolean type is "magic" for the compiler which expects -+++ Boolean values for such things as if statements. -Boolean: PrimitiveType with { - ~: % -> %; - coerce: Bool -> %; - coerce: % -> Bool; - false:%; - true:%; -} == add { - Rep == Bool; - - coerce(b:%):Bool == rep b; - coerce(b:Bool):% == per b; - false:% == false@Bool :: %; - true:% == true@Bool :: %; - ~(x:%):% == (~(x::Bool))::%; - (a:%) = (b:%):% == (rep a = rep b)::%; - - -- THOSE ARE BETTER THAN THE CORRESPONDING CATEGORY DEFAULTS - (a:%) ~= (b:%):% == (rep a ~= rep b)::%; -} +++ MachineInteger implements machine full-word integers. MachineInteger: PrimitiveType with { @@ -148,7 +93,7 @@ MachineInteger: PrimitiveType with { zero?: % -> Boolean; } == add { Rep == SInt; - + 0:% == per 0; 1:% == per 1; coerce(n:%):SInt == rep n; diff --git a/aldor/lib/aldor/src/base/sal_base0.as b/aldor/lib/aldor/src/base/sal_base0.as new file mode 100644 index 000000000..6146b9f48 --- /dev/null +++ b/aldor/lib/aldor/src/base/sal_base0.as @@ -0,0 +1,62 @@ +#assert DoNotImportBoolean + +#include "aldor" + +import from Machine; + +#if ALDOC +\thistype{PrimitiveType} +\History{Manuel Bronstein}{28/9/98}{created} +\Usage{\this: Category} +\Descr{\this~is the category of the most basic types.} +\begin{exports} +\alexp{$=$}: & (\%, \%) $\to$ \altype{Boolean} & equality test\\ +\alalias{\this}{$=$}{$\sim=$}: +& (\%, \%) $\to$ \altype{Boolean} & inequality test\\ +\end{exports} +#endif + +define PrimitiveType: Category == with { + =: (%, %) -> Boolean; + ~=: (%, %) -> Boolean; +#if ALDOC +\alpage{$=$} +\Usage{a = b\\ a $\sim=$ b} +\Signatures{ +$=$: & (\%,\%) $\to$ \altype{Boolean}\\ +$\sim=$: & (\%,\%) $\to$ \altype{Boolean}\\ +} +\Params{ {\em a, b} & \% & elements of the type\\ } +\Retval{ If $a = b$ returns \true, then $a$ and $b$ are guaranteed to +represent the same element of the type. The behavior if $a = b$ returns +\false~depends on the type, since a full equality test might not be +available. At least, it is guaranteed that $a$ and $b$ do not share the +same memory location in that case. The semantics of $a~\sim= b$ is +the boolean negation of $a = b$.} +#endif + default { (a:%) ~= (b:%):Boolean == ~(a = b); } +} + ++++ The Boolean data type supports logical operations. ++++ Both arguments of the binary operations are always evaluated. ++++ The Boolean type is "magic" for the compiler which expects ++++ Boolean values for such things as if statements. +Boolean: PrimitiveType with { + ~: % -> %; + coerce: Bool -> %; + coerce: % -> Bool; + false:%; + true:%; +} == add { + Rep == Bool; + + coerce(b:%):Bool == rep b; + coerce(b:Bool):% == per b; + false:% == false@Bool :: %; + true:% == true@Bool :: %; + ~(x:%):% == (~(x::Bool))::%; + (a:%) = (b:%):% == (rep a = rep b)::%; + + -- THOSE ARE BETTER THAN THE CORRESPONDING CATEGORY DEFAULTS + (a:%) ~= (b:%):% == (rep a ~= rep b)::%; +} From 9f00adb60bda76e005554f82a95ff02b49ddbc36 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 4 Jun 2014 20:15:01 +0100 Subject: [PATCH 003/352] tinfer: strip out automatic generation of << and equality operations from record; they are not handled by genfoam, and make assumptions about the downstream library. Also, the way it's done here (by explicitly expanding the argument types) breaks inlining for anything using Record(x: %, ...). Following patch will introduce a slightly nicer way of implementing the operations. --- aldor/aldor/src/test/test_tform.c | 45 +++++++ aldor/aldor/src/tform.c | 190 ++---------------------------- 2 files changed, 56 insertions(+), 179 deletions(-) diff --git a/aldor/aldor/src/test/test_tform.c b/aldor/aldor/src/test/test_tform.c index 36246b5be..53fe307c1 100644 --- a/aldor/aldor/src/test/test_tform.c +++ b/aldor/aldor/src/test/test_tform.c @@ -6,9 +6,16 @@ #include "strops.h" #include "testlib.h" +#include "stab.h" +#include "debug.h" +#include "tinfer.h" +#include "tqual.h" +#include "spesym.h" + local void testTFormFormat(void); local void testTFormSyntaxConditions(void); local void testTFormFormatOne(String name, String expect, TForm tf); +local void testDependentExport(void); local void testEnum(); /* XXX: from test_tinfer.c */ @@ -24,6 +31,7 @@ tformTest(void) TEST(testTFormFormat); TEST(testTFormSyntaxConditions); TEST(testEnum); + TEST(testDependentExport); fini(); } @@ -100,5 +108,42 @@ testEnum() e_y2 = tfEnum(stabFile(), id("x")); testTrue("teq", tformEqual(e_y, e_y2)); + finiFile(); +} + +extern int tipBupDebug; +extern int tipTdnDebug; +extern int tfsDebug; +local void +testDependentExport() +{ + TForm tf, map, decl, e_x; + AbSyn pair, defn; + Syme freeVar; + Stab newLvl; + + initFile(); + stdscope(stabFile()); + + tipBupDebug = 1; + tipTdnDebug = 1; + tfsDebug=1; + /* + */ + tfqTypeInfer(stabFile(), "f: () -> (T: Type, T)"); + + newLvl = stabPushLevel(stabFile(), sposNone, 0); + freeVar = symeNewParam(symInternConst("?"), tfType, car(newLvl)); + decl = tfDeclare(abFrSyme(freeVar), tfType); + tf = tfMulti(2, decl, tfFrSyme(newLvl, freeVar)); + map = tfMap(tfMulti(0), tf); + tfMeaning(stabFile(), tfExpr(tf), tf); + + afprintf(dbOut, "Map is: %pTForm %pAbSyn\n", map, tfExpr(map)); + tipBupDebug = 0; + tipTdnDebug = 0; + tfsDebug=0; + + finiFile(); } diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 4fac3aa8c..b3393eb87 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -135,8 +135,6 @@ local SymeList tfSymesFrRawRecord (Stab, TForm, Sefo); local SymeList tfSymesFrRecord (Stab, TForm, Sefo); local SymeList tfSymesFrUnion (Stab, TForm, Sefo); local SymeList tfSymesFrTrailingArray (Stab, TForm, Sefo); -local void tfSymesTestCompoundType (Stab, TForm, Bool *); -local SymeList tfSymesFrCompoundType (Stab, TForm, Bool *,SymeList); local SymeList tfSymesFrAdd (Sefo); local SymeList tfSymesFrDefault (Sefo); @@ -183,21 +181,6 @@ local TForm tfIsIdempotent (TForm); local void tfForwardIdempotent (TForm, TForm); local void tfExtendFinishTwins (Stab, Syme); -/****************************************************************************** - * - * :: Compound ops - * - *****************************************************************************/ - -enum tfCompoundOps { - TFC_START, - TFC_HasEq = TFC_START, - TFC_HasNeq, - TFC_HasPrint, - TFC_LIMIT -}; - - /****************************************************************************** * * :: Debugging facilities @@ -4992,8 +4975,6 @@ tfSymesFrRawRecord(Stab stab, TForm tf, Sefo sefo) Length i, argc = abApplyArgc(sefo); TForm tfc, tfm, me = tfFrSelf(stab, tf); Hash code = abHash(sefo); - Bool ops[TFC_LIMIT]; - /* * First ensure that all types have DenseStorageCategory. @@ -5005,12 +4986,6 @@ tfSymesFrRawRecord(Stab stab, TForm tf, Sefo sefo) if ((argc != 1) || !tfIsTypeTuple(tfCatFrDom(tfArgv(tf)[0]))) tfCheckDenseArgs(tf, sefo); - - /* These ought to be all true ... */ - ops[TFC_HasEq] = false; - ops[TFC_HasNeq] = false; - ops[TFC_HasPrint] = false; - /* * [ ... ]: (T1, T2, ... TN) -> % * rawrecord: (T1, T2, ... TN) -> % @@ -5078,9 +5053,6 @@ tfSymesFrRawRecord(Stab stab, TForm tf, Sefo sefo) if (!si || !argi) continue; assert(abTag(argi) == AB_Id); - if (!tfEqual(me, tfit)) - tfSymesTestCompoundType(stab, tfit, ops); - /* apply: (%, Enumerate(ti: Type)) -> Ti */ tfe = tfEnum(stab, argi); tfm = tfMap(tfMulti(2, me, tfe), tfi); @@ -5096,7 +5068,6 @@ tfSymesFrRawRecord(Stab stab, TForm tf, Sefo sefo) } symes = tfSymesFrDepGroup(stab, me, tfc, symes); - symes = tfSymesFrCompoundType(stab, me, ops, symes); symes = listNReverse(Syme)(symes); stabSetSubstable(stab); @@ -5112,11 +5083,6 @@ tfSymesFrRecord(Stab stab, TForm tf, Sefo sefo) TForm tfc, tfm, me = tfFrSelf(stab, tf); Hash code = abHash(sefo); - Bool ops[TFC_LIMIT]; - ops[TFC_HasEq] = true; - ops[TFC_HasNeq] = true; - ops[TFC_HasPrint] = true; - /* * [ ]: (A1, ..., AN) -> me * record: (A1, ..., AN) -> me @@ -5164,9 +5130,6 @@ tfSymesFrRecord(Stab stab, TForm tf, Sefo sefo) if (!si || !argi) continue; assert(abTag(argi) == AB_Id); - if (!tfEqual(me, tfit)) - tfSymesTestCompoundType(stab, tfit, ops); - /* * apply: (me, Enumerate(ni: Type)) -> Ai * set!: (me, Enumerate(ni: Type), Ai) -> Ai @@ -5186,7 +5149,6 @@ tfSymesFrRecord(Stab stab, TForm tf, Sefo sefo) } symes = tfSymesFrDepGroup(stab, me, tfc, symes); - symes = tfSymesFrCompoundType(stab, me, ops, symes); symes = listNReverse(Syme)(symes); stabSetSubstable(stab); @@ -5210,15 +5172,9 @@ tfSymesFrTrailingArray(Stab stab, TForm tf, Sefo sefo) Sefo isefo, asefo; Hash code = abHash(sefo); - Bool ops[TFC_LIMIT]; - /* We might have an invalid TForm here... */ if (tfArgc(tf) != 2) return listNil(Syme); - ops[TFC_HasEq] = false; - ops[TFC_HasNeq] = false; - ops[TFC_HasPrint] = false; - /* * TrailingArray((i1: I1, i2: I2..., IN), (A1,A2,...AN)) * [ ]: (I1, ..., IN) -> Tuple Cross A -> me @@ -5314,7 +5270,6 @@ tfSymesFrTrailingArray(Stab stab, TForm tf, Sefo sefo) } } - symes = tfSymesFrCompoundType(stab, me, ops, symes); symes = listNReverse(Syme)(symes); stabSetSubstable(stab); @@ -5335,11 +5290,6 @@ tfSymesFrUnion(Stab stab, TForm tf, Sefo sefo) TForm me = tfFrSelf(stab, tf), tfm, tfc; Hash code = abHash(sefo); - Bool ops[TFC_LIMIT]; - ops[TFC_HasEq] = true; - ops[TFC_HasNeq] = true; - ops[TFC_HasPrint] = true; - /* * dispose!: me -> () */ @@ -5360,9 +5310,6 @@ tfSymesFrUnion(Stab stab, TForm tf, Sefo sefo) if (! argi) continue; assert(abTag(argi) == AB_Id); - if (! tfEqual(me, tfit)) - tfSymesTestCompoundType(stab, tfit, ops); - /* * [ ]: Ai -> me * union: Ai -> me @@ -5414,146 +5361,31 @@ tfSymesFrUnion(Stab stab, TForm tf, Sefo sefo) symes = listCons(Syme)(syme, symes); } - symes = tfSymesFrCompoundType(stab, me, ops, symes); symes = listNReverse(Syme)(symes); stabSetSubstable(stab); return symes; } -/* - * Test if the following symes should be generated by seeing if the - * the constituent types have them: - * = : (me, me) -> Boolean - * ~= : (me, me) -> Boolean - * << : (TextWriter, me) -> TextWriter - */ -local void -tfSymesTestCompoundType(Stab stab, TForm tfi, Bool *ops) -{ - TForm tfm = NULL, me = tfFrSelf(stab, tfi); - SymeList mods = tfGetDomSelf(tfi); - - /* - * An unfixed compiler bug means that parts of Salli programs - * tinfered with (tfBoolean == tfUnknown). We want to catch - * this problem as soon as possible. - */ - - if (ops[TFC_HasEq]) { - /* - * An unfixed compiler bug means that parts of Salli - * programs (and thus libAldor) are tinfered with - * (tfBoolean == tfUnknown). The correct fix is to - * ensure that tfBoolean has been imported into every - * scope that needs it before we get this far. - */ - tfm = tfMulti(2, me, me); - if (tfBoolean == tfUnknown) { - AbSyn ab = tfGetExpr(me); - comsgFatal(ab, ALDOR_F_BugNoBoolean); - } - tfm = tfMap(tfm, tfBoolean); - if (!tfHasDomExportMod(tfi, mods, ssymEquals, tfm)) - ops[TFC_HasEq] = false; - } - - if (ops[TFC_HasNeq]) { - if (!tfm) { - tfm = tfMulti(2, me, me); - if (tfBoolean == tfUnknown) { - AbSyn ab = tfGetExpr(me); - comsgFatal(ab, ALDOR_F_BugNoBoolean); - } - tfm = tfMap(tfm, tfBoolean); - } - if (!tfHasDomExportMod(tfi, mods, ssymNotEquals, tfm)) - ops[TFC_HasNeq] = false; - } - - if (ops[TFC_HasPrint]) { - tfm = tfMap(tfMulti(2, tfTextWriter, me), tfTextWriter); - if (!tfHasDomExportMod(tfi, mods, ssymPrint, tfm)) - ops[TFC_HasPrint] = false; - } -} - local SymeList -tfSymesFrCompoundType(Stab stab, TForm me, Bool *ops, SymeList symes) +tfSymesFrAdd(Sefo sefo) { - TForm tfm = NULL; - Symbol sym; - Syme syme; - - /* - * An unfixed compiler bug means that parts of Salli - * programs (and thus libAldor) are tinfered with - * (tfBoolean == tfUnknown). The correct fix is to - * ensure that tfBoolean has been imported into every - * scope that needs it before we get this far. - */ - if (ops[TFC_HasEq]) { - tfm = tfMulti(2, me, me); - if (tfBoolean == tfUnknown) { - AbSyn ab = tfGetExpr(me); - comsgFatal(ab, ALDOR_F_BugNoBoolean); - } - tfm = tfMap(tfm, tfBoolean); - - sym = ssymEquals; - syme = symeNewExport(sym, tfm, car(stab)); - symes = listCons(Syme)(syme, symes); - } - - if (ops[TFC_HasNeq]) { - if (!tfm) { - tfm = tfMulti(2, me, me); - if (tfBoolean == tfUnknown) { - AbSyn ab = tfGetExpr(me); - comsgFatal(ab, ALDOR_F_BugNoBoolean); - } - tfm = tfMap(tfm, tfBoolean); - } - - sym = ssymNotEquals; - syme = symeNewExport(sym, tfm, car(stab)); - symes = listCons(Syme)(syme, symes); - } - - if (ops[TFC_HasPrint]) { - tfm = tfMap(tfMulti(2, tfTextWriter, me), tfTextWriter); - - sym = ssymPrint; - syme = symeNewExport(sym, tfm, car(stab)); - symes = listCons(Syme)(syme, symes); - } - - return symes; + assert(abStab(sefo)); + return stabGetExportedSymes(abStab(sefo)); } Bool -tfHasPrint(Stab stab, TForm dom) +tfHasPrint(Stab stab, TForm tf) { - Bool ops[TFC_LIMIT]; - ops[TFC_HasEq] = false; - ops[TFC_HasNeq] = false; - ops[TFC_HasPrint] = true; - - /* Why do we need this test? */ - if (tfIsRecord(dom) || tfIsRawRecord(dom)) - return false; + TForm tfm; + TForm me = tfFrSelf(stab, tf); + SymeList mods = tfGetDomSelf(tf); + Syme thePrint; - tfHasSelf(dom) = false; - tfSymesTestCompoundType(stab, dom, ops); - - return ops[TFC_HasPrint]; -} + tfm = tfMap(tfMulti(2, tfTextWriter, me), tfTextWriter); + thePrint = tfHasDomExportMod(tf, mods, ssymPrint, tfm); -local SymeList -tfSymesFrAdd(Sefo sefo) -{ - assert(abStab(sefo)); - return stabGetExportedSymes(abStab(sefo)); + return thePrint != NULL; } /* tfSymesFrDefault handles conditionals spectacularly badly. From cfc2ff723e51feebabc260a1ea511fac1b1b24b5 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 5 Jun 2014 00:50:47 +0100 Subject: [PATCH 004/352] aldor: Remove union-print from tests (this is temporary, until union learns how to print things nicely). --- aldor/lib/aldor/test/Makefile.am | 2 +- aldor/lib/aldor/test/Tests.am | 3 --- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/aldor/lib/aldor/test/Makefile.am b/aldor/lib/aldor/test/Makefile.am index 25cbbd725..dd8086208 100644 --- a/aldor/lib/aldor/test/Makefile.am +++ b/aldor/lib/aldor/test/Makefile.am @@ -34,7 +34,6 @@ AXLTESTS = \ hang \ ret-exit \ tst_integer \ - union-print \ trec \ pol2 \ iter \ @@ -42,6 +41,7 @@ AXLTESTS = \ # BROKEN = \ + union-print \ RepRecordError \ avl-set \ avl-set2 \ diff --git a/aldor/lib/aldor/test/Tests.am b/aldor/lib/aldor/test/Tests.am index ee53e1265..23ab0de6e 100644 --- a/aldor/lib/aldor/test/Tests.am +++ b/aldor/lib/aldor/test/Tests.am @@ -97,9 +97,6 @@ CLEANFILES += ret-exit/ret-exit-aldormain.c ret-exit/ret-exit.c ret-exit/ret-exi check_PROGRAMS += tst_integer/tst_integer tst_integer_tst_integer_SOURCES = tst_integer/tst_integer-aldormain.c tst_integer/tst_integer.c CLEANFILES += tst_integer/tst_integer-aldormain.c tst_integer/tst_integer.c tst_integer/tst_integer.ao -check_PROGRAMS += union-print/union-print -union_print_union_print_SOURCES = union-print/union-print-aldormain.c union-print/union-print.c -CLEANFILES += union-print/union-print-aldormain.c union-print/union-print.c union-print/union-print.ao check_PROGRAMS += trec/trec trec_trec_SOURCES = trec/trec-aldormain.c trec/trec.c CLEANFILES += trec/trec-aldormain.c trec/trec.c trec/trec.ao From e1905cf12cfdcd2a9fa8d578e917029b0d918519 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 7 Jun 2014 11:53:12 +0100 Subject: [PATCH 005/352] Library: Rename SingleInteger to MachineInteger in the compiler. Use a macro in libfoamlib to deal with the rename without a massive patch. --- aldor/aldor/lib/libfoamlib/al/foamlib.as | 3 +++ aldor/aldor/src/spesym.c | 4 ++-- aldor/aldor/src/spesym.h | 2 +- aldor/aldor/src/tform.c | 18 ++++++++++-------- aldor/aldor/src/tform.h | 4 ++-- 5 files changed, 18 insertions(+), 13 deletions(-) diff --git a/aldor/aldor/lib/libfoamlib/al/foamlib.as b/aldor/aldor/lib/libfoamlib/al/foamlib.as index c3dbd0dfe..6e5f4fc7f 100644 --- a/aldor/aldor/lib/libfoamlib/al/foamlib.as +++ b/aldor/aldor/lib/libfoamlib/al/foamlib.as @@ -141,6 +141,8 @@ macro { #endif +SingleInteger ==> MachineInteger; + #if LibraryAxlLib #if BuildAxlLib #else @@ -193,3 +195,4 @@ macro { import from FormattedOutput; } #endif + diff --git a/aldor/aldor/src/spesym.c b/aldor/aldor/src/spesym.c index 3755febcb..a28cafd4f 100644 --- a/aldor/aldor/src/spesym.c +++ b/aldor/aldor/src/spesym.c @@ -36,6 +36,7 @@ Symbol ssymBoolean, ssymGenerator, ssymJoin, ssymLiteral, + ssymMachineInteger, ssymMap, ssymMeet, ssymPackedMap, @@ -46,7 +47,6 @@ Symbol ssymBoolean, ssymReference, ssymSelf, ssymSelfSelf, - ssymSingleInteger, ssymTest, ssymTextWriter, ssymTrailingArray, @@ -176,6 +176,7 @@ ssymInit(void) ssymGenerator = symIntern("Generator"); ssymJoin = symIntern("Join"); ssymLiteral = symIntern("Literal"); + ssymMachineInteger= symIntern("MachineInteger"); ssymMap = symIntern("Map"); ssymMeet = symIntern("Meet"); ssymPackedMap = symIntern("PackedMap"); @@ -186,7 +187,6 @@ ssymInit(void) ssymReference = symIntern("Ref"); ssymSelf = symIntern("%"); ssymSelfSelf = symIntern("%%"); - ssymSingleInteger= symIntern("SingleInteger"); ssymTest = symIntern("Test"); ssymTextWriter = symIntern("TextWriter"); ssymTrailingArray= symIntern("TrailingArray"); diff --git a/aldor/aldor/src/spesym.h b/aldor/aldor/src/spesym.h index 77b123ce0..07319bd6c 100644 --- a/aldor/aldor/src/spesym.h +++ b/aldor/aldor/src/spesym.h @@ -42,6 +42,7 @@ extern Symbol ssymBoolean, ssymGenerator, ssymJoin, ssymLiteral, + ssymMachineInteger, ssymMap, ssymMeet, ssymPackedMap, @@ -52,7 +53,6 @@ extern Symbol ssymBoolean, ssymRecord, ssymSelf, ssymSelfSelf, - ssymSingleInteger, ssymTest, ssymTextWriter, ssymThird, diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index b3393eb87..4544025ad 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -366,7 +366,7 @@ tfInitBasicTypes(TForm tf) tfBoolean = tfNewBuiltin(tf, ssymBoolean); tfTextWriter = tfNewBuiltin(tf, ssymTextWriter); - tfSingleInteger = tfNewBuiltin(tf, ssymSingleInteger); + tfMachineInteger= tfNewBuiltin(tf, ssymMachineInteger); isInit = true; } @@ -393,7 +393,7 @@ tfInit(void) tfBoolean = tfUnknown; tfTextWriter = tfUnknown; - tfSingleInteger = tfUnknown; + tfMachineInteger = tfUnknown; for (i = TF_START; i < TF_LIMIT; i++) tformInfo(i).hash = strHash(tformInfo(i).str); @@ -874,6 +874,8 @@ tfpId(Stab stab, AbSyn ab) tfBoolean = tf; if (sym == ssymTextWriter && tfTextWriter == tfUnknown) tfTextWriter = tf; + if (sym == ssymMachineInteger && tfMachineInteger == tfUnknown) + tfMachineInteger = tf; return tf; } @@ -5193,7 +5195,7 @@ tfSymesFrTrailingArray(Stab stab, TForm tf, Sefo sefo) if (!tfIsMulti(itf)) itf = tfMulti(1, itf); if (!tfIsMulti(atf)) atf = tfMulti(1, atf); tfc = tfNewEmpty(TF_Multiple, 3); - tfc->argv[0] = tfSingleInteger; + tfc->argv[0] = tfMachineInteger; tfc->argv[1] = tfCrossFrMulti(itf); tfc->argv[2] = tfCrossFrMulti(atf); tfSetStab(tfc, abStab(sefo)); @@ -5254,17 +5256,17 @@ tfSymesFrTrailingArray(Stab stab, TForm tf, Sefo sefo) if (!si || !argi) continue; assert(abTag(argi) == AB_Id); /* - * apply: (me, SingleInteger, 'ni') -> Ai - * set!: (me, SingleInteger, 'ni', Ii) -> Ai + * apply: (me, MachineInteger, 'ni') -> Ai + * set!: (me, MachineInteger, 'ni', Ii) -> Ai */ tfe = tfEnum(stab, argi); - tfm = tfMap(tfMulti(3, me, tfSingleInteger, tfe), tfi); + tfm = tfMap(tfMulti(3, me, tfMachineInteger, tfe), tfi); syme = tfNewRepSyme(stab, ssymApply, tfm, code); symes = listCons(Syme)(syme, symes); if (!listMemq(Syme)(tfSymes(tf), si)) { - tfm = tfMap(tfMulti(4, me, tfSingleInteger, tfe, tfi), tfi); + tfm = tfMap(tfMulti(4, me, tfMachineInteger, tfe, tfi), tfi); syme = tfNewRepSyme(stab, ssymSetBang, tfm, code); symes = listCons(Syme)(syme, symes); } @@ -5859,7 +5861,7 @@ TForm tfCategory; TForm tfDomain; TForm tfBoolean; TForm tfTextWriter; -TForm tfSingleInteger; +TForm tfMachineInteger; /* Is tf the type of a domain? */ Bool diff --git a/aldor/aldor/src/tform.h b/aldor/aldor/src/tform.h index e818b6016..9789365cd 100644 --- a/aldor/aldor/src/tform.h +++ b/aldor/aldor/src/tform.h @@ -497,9 +497,9 @@ extern Bool tfIsBooleanFn (TForm); extern TForm tfTextWriter; /* - * tfSingleInteger Type used in trailing arrays (and elsewhere) + * tfMachineInteger Type used in trailing arrays (and elsewhere) */ -extern TForm tfSingleInteger; +extern TForm tfMachineInteger; /* * tfGeneral Type form with no special structure. From e2b33a66fefbafc9157fb580e77e2268896dc8e2 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 5 Jun 2014 20:28:08 +0100 Subject: [PATCH 006/352] tests: Add a check that machineInteger is set appropriately --- aldor/aldor/src/test/test_tform.c | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/aldor/aldor/src/test/test_tform.c b/aldor/aldor/src/test/test_tform.c index 53fe307c1..48fd19f82 100644 --- a/aldor/aldor/src/test/test_tform.c +++ b/aldor/aldor/src/test/test_tform.c @@ -17,6 +17,7 @@ local void testTFormSyntaxConditions(void); local void testTFormFormatOne(String name, String expect, TForm tf); local void testDependentExport(void); local void testEnum(); +local void testMachineInt(); /* XXX: from test_tinfer.c */ void init(void); @@ -32,6 +33,7 @@ tformTest(void) TEST(testTFormSyntaxConditions); TEST(testEnum); TEST(testDependentExport); + TEST(testMachineInt); fini(); } @@ -147,3 +149,13 @@ testDependentExport() finiFile(); } + +local void +testMachineInt() +{ + initFile(); + stdscope(stabFile()); + + tfqTypeInfer(stabFile(), "MachineInteger: with == add; default x: MachineInteger"); + testTrue("xx", tfMachineInteger != tfUnknown); +} From 0cb1de4657add7139e7d63abe78259a3a2435d33 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 5 Jun 2014 21:01:41 +0100 Subject: [PATCH 007/352] Library: Rename 'print' to 'stdout' to reflect the aldor library convention. --- aldor/aldor/lib/libfoamlib/al/foamlib.as | 1 + aldor/aldor/src/fintphase.c | 4 ++-- aldor/aldor/src/spesym.c | 4 ++-- aldor/aldor/src/spesym.h | 2 +- 4 files changed, 6 insertions(+), 5 deletions(-) diff --git a/aldor/aldor/lib/libfoamlib/al/foamlib.as b/aldor/aldor/lib/libfoamlib/al/foamlib.as index 6e5f4fc7f..4da3b7feb 100644 --- a/aldor/aldor/lib/libfoamlib/al/foamlib.as +++ b/aldor/aldor/lib/libfoamlib/al/foamlib.as @@ -161,6 +161,7 @@ SingleInteger ==> MachineInteger; } #endif +print ==> stdout; #if ImportString { import { diff --git a/aldor/aldor/src/fintphase.c b/aldor/aldor/src/fintphase.c index 3399cb5f7..26d556f4d 100644 --- a/aldor/aldor/src/fintphase.c +++ b/aldor/aldor/src/fintphase.c @@ -287,11 +287,11 @@ fintWrapVerbose(AbSyn ab) /* Definitions are printed specially. */; else if ((tfHasPrintFlag = tfHasPrint(stab, type)) == true) { - /* (print << ab)$type */ + /* (stdout << ab)$type */ op = abNewQualify(sposNone, abNewId(sposNone, ssymPrint), tfExpr(type)); ab = abNewApply2(sposNone, op, - abNewId(sposNone, ssymThePrint), ab); + abNewId(sposNone, ssymTheStdout), ab); (void)typeInferAs(stab, ab, tfUnknown); abState(ab) = AB_State_HasUnique; diff --git a/aldor/aldor/src/spesym.c b/aldor/aldor/src/spesym.c index a28cafd4f..cfde34c8a 100644 --- a/aldor/aldor/src/spesym.c +++ b/aldor/aldor/src/spesym.c @@ -77,7 +77,7 @@ Symbol ssymArrow, ssymTheJava, ssymTheJavaDecoder, ssymTheGenerator, - ssymThePrint, + ssymTheStdout, ssymTheNew, ssymTheRawRecord, ssymTheRecord, @@ -217,10 +217,10 @@ ssymInit(void) ssymTheJava = symIntern("java"); ssymTheJavaDecoder = symIntern("avaj"); ssymTheGenerator = symIntern("generator"); - ssymThePrint = symIntern("print"); ssymTheNew = symIntern("new"); ssymTheRawRecord = symIntern("rawrecord"); ssymTheRecord = symIntern("record"); + ssymTheStdout = symIntern("stdout"); ssymTheString = symIntern("string"); ssymTheTest = symIntern("test"); ssymTheTrailingArray = symIntern("trailing"); diff --git a/aldor/aldor/src/spesym.h b/aldor/aldor/src/spesym.h index 07319bd6c..d9717f284 100644 --- a/aldor/aldor/src/spesym.h +++ b/aldor/aldor/src/spesym.h @@ -84,10 +84,10 @@ extern Symbol ssymArrow, ssymTheInteger, ssymTheJava, ssymTheJavaDecoder, - ssymThePrint, ssymTheNew, ssymTheRawRecord, ssymTheRecord, + ssymTheStdout, ssymTheString, ssymTheTest, ssymTheTrailingArray, From 88090390c9315a76b99a0081fcaea2930c1e8167 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 10 Jun 2014 20:16:10 +0100 Subject: [PATCH 008/352] aldor tests: Confirm that inclusion of a file only happens once. --- aldor/lib/aldor/test/Makefile.am | 1 + aldor/lib/aldor/test/Tests.am | 3 +++ aldor/lib/aldor/test/incl/addone.as | 1 + aldor/lib/aldor/test/incl/incl.as | 9 +++++++++ 4 files changed, 14 insertions(+) create mode 100644 aldor/lib/aldor/test/incl/addone.as create mode 100644 aldor/lib/aldor/test/incl/incl.as diff --git a/aldor/lib/aldor/test/Makefile.am b/aldor/lib/aldor/test/Makefile.am index dd8086208..b1a272acb 100644 --- a/aldor/lib/aldor/test/Makefile.am +++ b/aldor/lib/aldor/test/Makefile.am @@ -38,6 +38,7 @@ AXLTESTS = \ pol2 \ iter \ iter2 \ + incl \ # BROKEN = \ diff --git a/aldor/lib/aldor/test/Tests.am b/aldor/lib/aldor/test/Tests.am index 23ab0de6e..4a0fc2332 100644 --- a/aldor/lib/aldor/test/Tests.am +++ b/aldor/lib/aldor/test/Tests.am @@ -109,3 +109,6 @@ CLEANFILES += iter/iter-aldormain.c iter/iter.c iter/iter.ao check_PROGRAMS += iter2/iter2 iter2_iter2_SOURCES = iter2/iter2-aldormain.c iter2/iter2.c CLEANFILES += iter2/iter2-aldormain.c iter2/iter2.c iter2/iter2.ao +check_PROGRAMS += incl/incl +incl_incl_SOURCES = incl/incl-aldormain.c incl/incl.c +CLEANFILES += incl/incl-aldormain.c incl/incl.c incl/incl.ao diff --git a/aldor/lib/aldor/test/incl/addone.as b/aldor/lib/aldor/test/incl/addone.as new file mode 100644 index 000000000..2a18c6cde --- /dev/null +++ b/aldor/lib/aldor/test/incl/addone.as @@ -0,0 +1 @@ +x := x + 1; diff --git a/aldor/lib/aldor/test/incl/incl.as b/aldor/lib/aldor/test/incl/incl.as new file mode 100644 index 000000000..05adc30cd --- /dev/null +++ b/aldor/lib/aldor/test/incl/incl.as @@ -0,0 +1,9 @@ +#include "aldor" +#include "aldorio" + +x: Integer :=0; +#include "addone" +#include "addone" + +import from Assert Integer; +assertEquals(x, 1); From da4bc8080ffee8b507aa6a4ac8e3bf8d24cce65c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 10 Jun 2014 20:21:00 +0100 Subject: [PATCH 009/352] libaldor: Add union print operation. Mark union-print test as working. Also, added domain name and related functions from foamlib. Note that the dispatch vector interface is not cast in stone. --- aldor/lib/aldor/src/Makefile.am | 2 + aldor/lib/aldor/src/datastruc/Makefile.deps | 3 + aldor/lib/aldor/src/datastruc/Makefile.in | 2 +- aldor/lib/aldor/src/datastruc/sal_langx.as | 142 ++++++++++++++++++ aldor/lib/aldor/src/datastruc/sal_union.as | 32 ++++ aldor/lib/aldor/test/Makefile.am | 3 +- aldor/lib/aldor/test/Tests.am | 3 + .../lib/aldor/test/union-print/union-print.as | 21 ++- 8 files changed, 203 insertions(+), 5 deletions(-) create mode 100644 aldor/lib/aldor/src/datastruc/sal_langx.as create mode 100644 aldor/lib/aldor/src/datastruc/sal_union.as diff --git a/aldor/lib/aldor/src/Makefile.am b/aldor/lib/aldor/src/Makefile.am index 95e60e0c7..bd9312fad 100644 --- a/aldor/lib/aldor/src/Makefile.am +++ b/aldor/lib/aldor/src/Makefile.am @@ -54,6 +54,7 @@ libaldor_a_SOURCES = \ datastruc/sal_fold.c \ datastruc/sal_hash.c \ datastruc/sal_kntry.c \ + datastruc/sal_langx.c \ datastruc/sal_list.c \ datastruc/sal_lstruc.c \ datastruc/sal_memblk.c \ @@ -66,6 +67,7 @@ libaldor_a_SOURCES = \ datastruc/sal_stream.c \ datastruc/sal_string.c \ datastruc/sal_table.c \ + datastruc/sal_union.c \ lang/sal_lang.c \ test/tst_assert.c \ util/ald_trace.c \ diff --git a/aldor/lib/aldor/src/datastruc/Makefile.deps b/aldor/lib/aldor/src/datastruc/Makefile.deps index c1a045909..3d5cb45e6 100644 --- a/aldor/lib/aldor/src/datastruc/Makefile.deps +++ b/aldor/lib/aldor/src/datastruc/Makefile.deps @@ -34,3 +34,6 @@ ald_symtab_deps := ald_symbol sal_hash sal_fold_deps := sal_list ald_flags_deps := sal_list sal_barray + +sal_langx_deps := sal_list sal_string +sal_union_deps := sal_string sal_langx diff --git a/aldor/lib/aldor/src/datastruc/Makefile.in b/aldor/lib/aldor/src/datastruc/Makefile.in index 11dc5c5da..248fd789f 100644 --- a/aldor/lib/aldor/src/datastruc/Makefile.in +++ b/aldor/lib/aldor/src/datastruc/Makefile.in @@ -19,7 +19,7 @@ library = ald_symbol ald_symtab sal_array sal_barray sal_bdata \ sal_bstruc sal_data sal_ddata sal_fstruc sal_hash sal_kntry \ sal_list sal_lstruc sal_memblk sal_parray sal_pkarray \ sal_set sal_slist sal_sortas sal_sset sal_stream sal_string \ - sal_table sal_fold ald_flags + sal_table sal_fold ald_flags sal_langx sal_union @BUILD_JAVA_TRUE@javalibrary := $(library) diff --git a/aldor/lib/aldor/src/datastruc/sal_langx.as b/aldor/lib/aldor/src/datastruc/sal_langx.as new file mode 100644 index 000000000..1b26c4082 --- /dev/null +++ b/aldor/lib/aldor/src/datastruc/sal_langx.as @@ -0,0 +1,142 @@ +#include "aldor" + +DomNameType ==> 'ID, APPLY, TUPLE, OTHER'; + +local ListUtil(T: with): with { + tails: List T -> List List T; +} == add { + tails(l: List T): List List T == { + if empty? l then empty else cons(l, tails rest l); + } +} + +DomainName: with { + type: % -> DomNameType; + name: % -> String; + args: % -> List %; + tuple: % -> List %; + <<: (TextWriter, %) -> TextWriter; + noName: () -> %; + new: String -> %; + other: Pointer -> %; + + combine: (Boolean, List %) -> %; + combine: (Boolean, Tuple %) -> %; + + export from DomNameType; +} == add { + -- untagged union + -- !would like Union(a: X, b: X) to work! + Rep ==> Record(tag: DomNameType, p: Pointer); + import from Rep, 'l', 's', 't', 'o'; + import from MachineInteger; + import from List %; + import from String; + import from ListUtil %; + import from List List %; + + default nm: %; + + local apply(x: Rep, l: 's'): String == x.p pretend String; + local apply(x: Rep, l: 'l'): List % == x.p pretend List %; + local apply(x: Rep, l: 't'): List % == x.p pretend List %; + local apply(x: Rep, l: 'o'): Pointer == x.p; + + local (x: Rep) case (l: 's'): Boolean == x.tag = ID; + local (x: Rep) case (l: 'l'): Boolean == x.tag = APPLY; + local (x: Rep) case (l: 't'): Boolean == x.tag = TUPLE; + local (x: Rep) case (l: 'o'): Boolean == x.tag = OTHER; + + local [s: String]: Rep == [ID, s pretend Pointer]; + local [v:'l', x: List %]: Rep == [APPLY, x pretend Pointer]; + local [v:'t', l: List %]: Rep == [TUPLE, l pretend Pointer]; + local [o: Pointer]: Rep == [OTHER, o]; + + type nm: DomNameType == rep(nm).tag; + + name nm: String == rep(nm).s; + args nm: List % == rep(nm).l; + tuple nm: List % == rep(nm).t; + + (out: TextWriter) << nm: TextWriter == { + type nm = ID => out << name nm; + type nm = OTHER => out << "??"; + isTuple := type nm = TUPLE; + lst := if isTuple then tuple nm else args nm; + if not isTuple then { + out << first lst; + lst := rest lst; + } + out << "("; + for tail in tails lst repeat { + arg := first tail; + out << arg; + not empty? rest tail => out << ", "; + } + out << ")"; + } + + new(s: String): % == per [s]; + other(p: Pointer): % == per [p]; + combine(isTuple: Boolean, tup: Tuple %): % == { + if isTuple then per [t, [tup]] + else per [l, [tup]]; + } + combine(isTuple: Boolean, lst: List %): % == { + if isTuple then per [t, lst] + else per [l, lst]; + } + + noName(): % == new "Dunno"; +} + +-- Nasty implementation details... + +DomNamer ==> DomainRep -> DomainName; +DomainRep ==> Pointer; +Reserved ==> Pointer; +Int ==> MachineInteger; + +local Dom, DispatchVector; + +Dom: with { + getName: %->DomainName; + ++ getName(dom) returns the name of a domain +} +== add { + Rep ==> Record (dispatcher: DispatchVector, + domainRep: DomainRep); + import from Rep; + domainRep (td: %): DomainRep == rep(td).domainRep; + dispatcher (td: %): DispatchVector == rep(td).dispatcher; + + getName(td: %): DomainName == + (namer dispatcher td)(domainRep td); +} + +DispatchVector: with { + namer: %-> DomNamer; +} +== add { + Rep ==> Record(tag: Int, + namer: DomNamer, + noname: Reserved, + getter: Reserved, + hasher: Reserved, + inheriter: Reserved); + + import from Rep; + + namer(dv: %) : DomNamer == rep(dv).namer; +} + +TypeUtils: with { + typeName: Type -> DomainName; +} == add { + + typeName(T: Type): DomainName == { + import from Dom; + getName(T pretend Dom); + } +} + diff --git a/aldor/lib/aldor/src/datastruc/sal_union.as b/aldor/lib/aldor/src/datastruc/sal_union.as new file mode 100644 index 000000000..4c8366e4f --- /dev/null +++ b/aldor/lib/aldor/src/datastruc/sal_union.as @@ -0,0 +1,32 @@ +#include "aldor" + +extend Union(T: Tuple Type): with { + OutputType; +} +== add { + import from Machine; + import from MachineInteger; + Rep == Record(n: SInt, p: Pointer); + import from String; + import from Rep; + + (<<)(tw: TextWriter, v: %): TextWriter == { + display(v: Pointer, t: Type, i: MachineInteger): () == { + import from TypeUtils; + import from DomainName; + import from t; + if t has OutputType then + tw << (v pretend t); + else + tw << "?"; + tw << "@" << typeName(t); + } + + type := element(T, rep(v).n::MachineInteger+1); + tw << "["; + display(rep(v).p, type, rep(v).n::MachineInteger + 1); + tw << "]"; + tw; + } + +} diff --git a/aldor/lib/aldor/test/Makefile.am b/aldor/lib/aldor/test/Makefile.am index b1a272acb..6faf17919 100644 --- a/aldor/lib/aldor/test/Makefile.am +++ b/aldor/lib/aldor/test/Makefile.am @@ -39,10 +39,10 @@ AXLTESTS = \ iter \ iter2 \ incl \ + union-print \ # BROKEN = \ - union-print \ RepRecordError \ avl-set \ avl-set2 \ @@ -61,7 +61,6 @@ GC_XFAIL_TESTS=issue2/issue2 endif XFAIL_TESTS = \ - union-print/union-print \ bugExtend1/bugExtend1 \ bugFree/bugFree \ bugreport_5/bugreport_5 \ diff --git a/aldor/lib/aldor/test/Tests.am b/aldor/lib/aldor/test/Tests.am index 4a0fc2332..c206ef7c6 100644 --- a/aldor/lib/aldor/test/Tests.am +++ b/aldor/lib/aldor/test/Tests.am @@ -112,3 +112,6 @@ CLEANFILES += iter2/iter2-aldormain.c iter2/iter2.c iter2/iter2.ao check_PROGRAMS += incl/incl incl_incl_SOURCES = incl/incl-aldormain.c incl/incl.c CLEANFILES += incl/incl-aldormain.c incl/incl.c incl/incl.ao +check_PROGRAMS += union-print/union-print +union_print_union_print_SOURCES = union-print/union-print-aldormain.c union-print/union-print.c +CLEANFILES += union-print/union-print-aldormain.c union-print/union-print.c union-print/union-print.ao diff --git a/aldor/lib/aldor/test/union-print/union-print.as b/aldor/lib/aldor/test/union-print/union-print.as index e014a3f11..7b2566868 100644 --- a/aldor/lib/aldor/test/union-print/union-print.as +++ b/aldor/lib/aldor/test/union-print/union-print.as @@ -3,5 +3,22 @@ U ==> Union(a: Integer, b: String); -u: U := [12]; -stdout << u << newline; +test1(): () == { + u: U := [12]; + stdout << u << newline; +} + +test2(): () == { + import from Assert String; + import from String; + + u: U := [12]; + buf: StringBuffer := new(); + out: TextWriter := buf::TextWriter; + + out << u; + + assertEquals("[12@AldorInteger]", string buf); +} +test1(); +test2(); From 004af501ec902d3324e26d0edd7cd41407ad1081 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 10 Jun 2014 19:52:29 +0100 Subject: [PATCH 010/352] tests: Generate .fm file as well. It's only spinning rust, doesn't cost anything. --- 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 f220b28aa..16cc0759f 100644 --- a/aldor/lib/testprog.am +++ b/aldor/lib/testprog.am @@ -34,7 +34,7 @@ am__v_ALDOR_0 = @echo " ALDOR " $@; %.c: %.as $(ALDOR) @$(MKDIR_P) $(@D) - $(AM_V_ALDOR)$(DBG) $(ALDOR) $(ALDORFLAGS) $($(*F)_AXLFLAGS) -Y$(@D) -Fao=$(@:.c=.ao) -Fc=$@ $< + $(AM_V_ALDOR)$(DBG) $(ALDOR) $(ALDORFLAGS) $($(*F)_AXLFLAGS) -Y$(@D) -Fao=$(@:.c=.ao) -Ffm=$(@:.c=.fm) -Fc=$@ $< %-aldormain.c: %.as $(ALDOR) @$(MKDIR_P) $(@D) From 8a123b1f9a393c666205e4524aa959d3c7247664 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 8 Sep 2014 20:19:21 +0100 Subject: [PATCH 011/352] GCC warnings: Declare a few functions. Tried compiling with --Wstrict-prototypes.. these got mentioned, might as well fix. --- aldor/aldor/src/cfgfile.c | 5 ++++- aldor/aldor/src/foam.h | 2 +- aldor/aldor/src/format.h | 2 +- 3 files changed, 6 insertions(+), 3 deletions(-) diff --git a/aldor/aldor/src/cfgfile.c b/aldor/aldor/src/cfgfile.c index 9d8a5bc29..f742094c1 100644 --- a/aldor/aldor/src/cfgfile.c +++ b/aldor/aldor/src/cfgfile.c @@ -402,6 +402,8 @@ cstrParseCommaified(char *opts, int *pargc, char ***pargv) static int (*cfgCondFn)(String); +local void cfgFreeConfPath(void); + void cfgSetCondFunc(int (*check)(String)) { @@ -469,7 +471,8 @@ void cfgSetConfPath(char *path) } } -void cfgFreeConfPath() +local void +cfgFreeConfPath(void) { if (cfgPath) strFree(car(cfgPath)); listFree(String)(cfgPath); diff --git a/aldor/aldor/src/foam.h b/aldor/aldor/src/foam.h index 1d27edefa..833537da3 100644 --- a/aldor/aldor/src/foam.h +++ b/aldor/aldor/src/foam.h @@ -644,7 +644,7 @@ struct foamRRec { (AInt)(ib), (AInt)0, (AInt)0, (AInt)0 , p, l, fl, le, b) #endif -extern Foam foamNewProgEmpty(); +extern Foam foamNewProgEmpty(void); struct foamProg { struct foamHdr hdr; diff --git a/aldor/aldor/src/format.h b/aldor/aldor/src/format.h index 3df19de66..21f866e21 100644 --- a/aldor/aldor/src/format.h +++ b/aldor/aldor/src/format.h @@ -59,5 +59,5 @@ extern void fmtRegisterI(const char *name, IFormatFn fn); extern void fmtRegisterFull(const char *name, PFormatFn fn, Bool nullOk); extern Format fmtMatch(const char *fmtTxt); extern void fmtUnregister(Format format); -extern void fmtUnregisterAll(); +extern void fmtUnregisterAll(void); #endif From 0ae194aa57cdc1df598bc9fd2dbe58e095b236d9 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 21 Sep 2014 18:33:09 +0100 Subject: [PATCH 012/352] genjava: It is possible for a (Values (...)) statement to be left lying around by optimisation passes. Generate no code for it and move on. --- aldor/aldor/src/java/genjava.c | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index 7d369ffcb..491ef5dbd 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -1443,6 +1443,7 @@ local void gj0SeqGenDefault(GjSeqStore store, Foam foam); local void gj0SeqSelectMulti(GjSeqStore store, Foam foam); local void gj0SeqIf(GjSeqStore store, Foam foam); local void gj0SeqBCall(GjSeqStore store, Foam foam); +local void gj0SeqValues(GjSeqStore store, Foam foam); local JavaCode gj0SeqSwitchId(); @@ -1535,6 +1536,9 @@ gj0SeqGen(GjSeqStore seqs, Foam foam) case FOAM_Cast: gj0SeqGen(seqs, foam->foamCast.expr); break; + case FOAM_Values: + gj0SeqValues(seqs, foam); + break; default: gj0SeqGenDefault(seqs, foam); break; @@ -1656,6 +1660,17 @@ gj0SeqBCall(GjSeqStore seqs, Foam foam) gj0SeqStoreAddHalt(seqs, jc); } +local void +gj0SeqValues(GjSeqStore store, Foam foam) +{ + int i; + for (i=0; i < foamArgc(foam); i++) { + FoamTag tag = foamTag(foam->foamValues.argv[i]); + if (tag != FOAM_Loc && tag != FOAM_Lex) + bug("Odd foam found"); + } +} + local void gj0SeqGenDefault(GjSeqStore store, Foam foam) { From 0a9ddff0f5768f2195ce5f43dd069e3045d8f612 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 21 Sep 2014 18:39:16 +0100 Subject: [PATCH 013/352] algebra/matrix: Added some additional tests. Turns out that the matrix [[...], ...] style construction is column ordered not row ordered. This is quite annoying. --- .../lib/algebra/src/mat/linalg/sit_linalg.as | 4 +++ aldor/lib/algebra/src/mat/modular/Makefile.in | 1 + .../lib/algebra/src/mat/modular/sit_halfge.as | 1 + .../algebra/src/mat/modular/sit_modpoge.as | 34 +++++++++++++++++-- aldor/lib/algebra/src/mat/sit_dnsemat.as | 22 ++++++++++++ 5 files changed, 60 insertions(+), 2 deletions(-) diff --git a/aldor/lib/algebra/src/mat/linalg/sit_linalg.as b/aldor/lib/algebra/src/mat/linalg/sit_linalg.as index 2157cc219..8e7893e51 100644 --- a/aldor/lib/algebra/src/mat/linalg/sit_linalg.as +++ b/aldor/lib/algebra/src/mat/linalg/sit_linalg.as @@ -5,6 +5,7 @@ ----------------------------------------------------------------------------- #include "algebra" +#include "aldorio" macro { B == Boolean; @@ -368,6 +369,9 @@ and generate the full kernel if $ker?$ is \true.} import from I; (ra, ca) := dimensions a; (rb, cb) := dimensions b; + ra ~= rb => { + error("Number of rows must match"); + } assert(ra = rb); if zero? ra then { a := zero(1, ca); b := zero(1, cb) } laring? => lasolve(a, b); diff --git a/aldor/lib/algebra/src/mat/modular/Makefile.in b/aldor/lib/algebra/src/mat/modular/Makefile.in index 05532ef21..82a59671e 100644 --- a/aldor/lib/algebra/src/mat/modular/Makefile.in +++ b/aldor/lib/algebra/src/mat/modular/Makefile.in @@ -16,5 +16,6 @@ subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) # Build starts here library = sit_modpoge sit_zcrtla +sit_modpoge.ao: $(srcdir)/sit_halfge.as include $(abs_top_srcdir)/lib/algebra/src/common.mk diff --git a/aldor/lib/algebra/src/mat/modular/sit_halfge.as b/aldor/lib/algebra/src/mat/modular/sit_halfge.as index 524c27a94..456bd4075 100644 --- a/aldor/lib/algebra/src/mat/modular/sit_halfge.as +++ b/aldor/lib/algebra/src/mat/modular/sit_halfge.as @@ -126,6 +126,7 @@ d:Z := 1; st:A := new(n, next ca); r:Z := 0; + r1 := 0; ca1 := prev ca; cb1 := prev cb; n1 := prev n; p1 := prev p; loops:Z := 0; diff --git a/aldor/lib/algebra/src/mat/modular/sit_modpoge.as b/aldor/lib/algebra/src/mat/modular/sit_modpoge.as index 3298953d2..ff4ba244d 100644 --- a/aldor/lib/algebra/src/mat/modular/sit_modpoge.as +++ b/aldor/lib/algebra/src/mat/modular/sit_modpoge.as @@ -5,6 +5,7 @@ -- Copyright (c) Swiss Federal Polytechnic Institute Zurich, 1996 ----------------------------------------------------------------------------- #include "algebra" +#include "aldorio" #if ALDOC \thistype{ModulopGaussElimination} @@ -631,10 +632,39 @@ local bug():() == { assertEquals(3, numberOfRows K); assertEquals(1, numberOfColumns K); assertEquals(1, K(1,1)); - assertEquals(0, K(1,2)); - assertEquals(0, K(1,3)); + assertEquals(0, K(2,1)); + assertEquals(0, K(3,1)); } bug(); +local test(r: Z, c: Z, p: I): () == { + import from Assert MachineInteger; + Fp ==> SmallPrimeField p; + import from Assert Fp; + import from Vector Fp; + import from Fp, LinearAlgebra(Fp, M Fp); + for j in 1..10@Z repeat { + m: M Fp := random(5,5); + K := kernel m; + (nrk, nck) := dimensions K; + for i in 1..10@Z repeat { + v: M Fp := random(nck, 1); + assertTrue(zero?(m * (K * v))); + } + } +} + +tt(): () == { + import from AldorInteger; + test(5,5,3::I); + test(10,10,3::I); + test(7,8,3::I); + + test(5,5,19::I); + test(10,10,19::I); + test(7,8,19::I) +} +tt(); + #endif diff --git a/aldor/lib/algebra/src/mat/sit_dnsemat.as b/aldor/lib/algebra/src/mat/sit_dnsemat.as index 922597ab4..c89522c0b 100644 --- a/aldor/lib/algebra/src/mat/sit_dnsemat.as +++ b/aldor/lib/algebra/src/mat/sit_dnsemat.as @@ -7,6 +7,7 @@ ----------------------------------------------------------------------------- #include "algebra" +#include "aldorio" macro { I == MachineInteger; @@ -532,6 +533,25 @@ macro { M == DenseMatrix Z; } +local testConstruction(): () == { + import from Assert Integer; + import from Assert MachineInteger; + import from MachineInteger; + import from Z, V; + m: M := [[1,2,3]]; + (nr, nc) := dimensions m; + stdout << "Rows: " << nr << " Cols: " << nc << " --> " << m << newline; +-- assertEquals(1, nr); +-- assertEquals(3, nc); + + m := [[1,2,3],[4,5,6]]; + (nr, nc) := dimensions m; + stdout << "Rows: " << nr << " Cols: " << nc << " --> " << m << newline; +-- assertEquals(2, nr); +-- assertEquals(3, nc); + +} + local basic():Boolean == { import from Z, V, M, MachineInteger; @@ -558,6 +578,8 @@ local kernel():Boolean == { r = 2 and zero?(a * ns); } +testConstruction(); + stdout << "Testing sit__dnsemat..." << endnl; aldorTest("basic operations", basic); aldorTest("kernel", kernel); From 1eec9580bd08d094504990af0d8612fb718fa008 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 30 Sep 2014 21:31:08 +0100 Subject: [PATCH 014/352] spesym.c: Format long lists of things. --- aldor/aldor/src/spesym.c | 106 +++++++++++++++++++-------------------- 1 file changed, 53 insertions(+), 53 deletions(-) diff --git a/aldor/aldor/src/spesym.c b/aldor/aldor/src/spesym.c index cfde34c8a..9fa408691 100644 --- a/aldor/aldor/src/spesym.c +++ b/aldor/aldor/src/spesym.c @@ -167,64 +167,64 @@ ssymInit(void) /* * Symbols for Aldor types we care about. */ - ssymBoolean = symIntern("Boolean"); - ssymCategory = symIntern("Category"); - ssymCross = symIntern("Cross"); - ssymDelayed = symIntern("Delayed"); - ssymEnum = symIntern("Enumeration"); - ssymExit = symIntern("Exit"); - ssymGenerator = symIntern("Generator"); - ssymJoin = symIntern("Join"); - ssymLiteral = symIntern("Literal"); + ssymBoolean = symIntern("Boolean"); + ssymCategory = symIntern("Category"); + ssymCross = symIntern("Cross"); + ssymDelayed = symIntern("Delayed"); + ssymEnum = symIntern("Enumeration"); + ssymExit = symIntern("Exit"); + ssymGenerator = symIntern("Generator"); + ssymJoin = symIntern("Join"); + ssymLiteral = symIntern("Literal"); ssymMachineInteger= symIntern("MachineInteger"); - ssymMap = symIntern("Map"); - ssymMeet = symIntern("Meet"); - ssymPackedMap = symIntern("PackedMap"); - ssymPointer = symIntern("Pointer"); - ssymRaw = symIntern("Raw"); - ssymRawRecord = symIntern("RawRecord"); - ssymRecord = symIntern("Record"); - ssymReference = symIntern("Ref"); - ssymSelf = symIntern("%"); - ssymSelfSelf = symIntern("%%"); - ssymTest = symIntern("Test"); - ssymTextWriter = symIntern("TextWriter"); - ssymTrailingArray= symIntern("TrailingArray"); - ssymThird = symIntern("Third"); - ssymTuple = symIntern("Tuple"); - ssymType = symIntern("Type"); - ssymUnion = symIntern("Union"); - ssymVariable = symIntern("?"); + ssymMap = symIntern("Map"); + ssymMeet = symIntern("Meet"); + ssymPackedMap = symIntern("PackedMap"); + ssymPointer = symIntern("Pointer"); + ssymRaw = symIntern("Raw"); + ssymRawRecord = symIntern("RawRecord"); + ssymRecord = symIntern("Record"); + ssymReference = symIntern("Ref"); + ssymSelf = symIntern("%"); + ssymSelfSelf = symIntern("%%"); + ssymTest = symIntern("Test"); + ssymTextWriter = symIntern("TextWriter"); + ssymTrailingArray = symIntern("TrailingArray"); + ssymThird = symIntern("Third"); + ssymTuple = symIntern("Tuple"); + ssymType = symIntern("Type"); + ssymUnion = symIntern("Union"); + ssymVariable = symIntern("?"); /* * Symbols for operation names we care about. */ - ssymArrow = symIntern("->"); - ssymApply = symIntern("apply"); - ssymBrace = symIntern("brace"); - ssymBracket = symIntern("bracket"); - ssymCoerce = symIntern("coerce"); - ssymEquals = symIntern("="); - ssymNotEquals = symIntern("~="); - ssymPackedArrow = symIntern("->*"); - ssymPrint = symIntern("<<"); - ssymSetBang = symIntern("set!"); - ssymTheCase = symIntern("case"); - ssymTheDispose = symIntern("dispose!"); - ssymTheExplode = symIntern("explode"); - ssymTheFloat = symIntern("float"); - ssymTheInteger = symIntern("integer"); - ssymTheJava = symIntern("java"); - ssymTheJavaDecoder = symIntern("avaj"); - ssymTheGenerator = symIntern("generator"); - ssymTheNew = symIntern("new"); - ssymTheRawRecord = symIntern("rawrecord"); - ssymTheRecord = symIntern("record"); - ssymTheStdout = symIntern("stdout"); - ssymTheString = symIntern("string"); - ssymTheTest = symIntern("test"); - ssymTheTrailingArray = symIntern("trailing"); - ssymTheUnion = symIntern("union"); + ssymArrow = symIntern("->"); + ssymApply = symIntern("apply"); + ssymBrace = symIntern("brace"); + ssymBracket = symIntern("bracket"); + ssymCoerce = symIntern("coerce"); + ssymEquals = symIntern("="); + ssymNotEquals = symIntern("~="); + ssymPackedArrow = symIntern("->*"); + ssymPrint = symIntern("<<"); + ssymSetBang = symIntern("set!"); + ssymTheCase = symIntern("case"); + ssymTheDispose = symIntern("dispose!"); + ssymTheExplode = symIntern("explode"); + ssymTheFloat = symIntern("float"); + ssymTheInteger = symIntern("integer"); + ssymTheJava = symIntern("java"); + ssymTheJavaDecoder= symIntern("avaj"); + ssymTheGenerator = symIntern("generator"); + ssymTheNew = symIntern("new"); + ssymTheRawRecord = symIntern("rawrecord"); + ssymTheRecord = symIntern("record"); + ssymTheStdout = symIntern("stdout"); + ssymTheString = symIntern("string"); + ssymTheTest = symIntern("test"); + ssymTheTrailingArray= symIntern("trailing"); + ssymTheUnion = symIntern("union"); /* * Symbols naming function interfaces. From 999bd9519245cce01579083a0487ea08f142fdb7 Mon Sep 17 00:00:00 2001 From: jandt Date: Thu, 8 Dec 2016 12:10:35 +0100 Subject: [PATCH 015/352] fix comparison in line 112 !somebool == 2 is always false, as !somebool can only be 0 or 1. changed to the obviously intended comparison. --- aldor/aldor/src/macex.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/macex.c b/aldor/aldor/src/macex.c index 0a3224830..513fa60ff 100644 --- a/aldor/aldor/src/macex.c +++ b/aldor/aldor/src/macex.c @@ -109,7 +109,7 @@ macexFiniFile() local void initMacDef(void) { - if (!fintMode == FINT_LOOP) macDefs = 0; + if (!(fintMode == FINT_LOOP)) macDefs = 0; } From 56f6f2f1371afb94c06c6bec66331a7dc794779d Mon Sep 17 00:00:00 2001 From: Ingolf Jandt Date: Thu, 8 Dec 2016 19:59:01 +0100 Subject: [PATCH 016/352] Fix comparisons !x == y --> x != y --- aldor/aldor/src/foam.c | 2 +- aldor/aldor/src/foam_c.h | 4 ++-- aldor/aldor/src/macex.c | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/aldor/aldor/src/foam.c b/aldor/aldor/src/foam.c index 78fb8f269..31958ca3b 100644 --- a/aldor/aldor/src/foam.c +++ b/aldor/aldor/src/foam.c @@ -1188,7 +1188,7 @@ foamAuditTypeCheck(Foam foam) lhs = foam->foamSet.lhs; rhs = foam->foamSet.rhs; - if (!foamIsRef(lhs) && !foamTag(lhs) == FOAM_Values) { + if (!foamIsRef(lhs) && (foamTag(lhs) != FOAM_Values)) { faTypeCheckingFailure(foam, "lhs is not an l-value"); return false; } diff --git a/aldor/aldor/src/foam_c.h b/aldor/aldor/src/foam_c.h index d67ab77b2..e8c9507b8 100644 --- a/aldor/aldor/src/foam_c.h +++ b/aldor/aldor/src/foam_c.h @@ -769,7 +769,7 @@ extern void fiRegisterStateFns (void *(*)(), void (*)(void *)); } \ else { /* should look for additional protects */ \ fiRestoreState(state); \ - if (!state->target == (FiWord) state) { \ + if (state->target != (FiWord) state) { \ fiUnwind(state->target, state->value); \ } \ exn = state->value; \ @@ -789,7 +789,7 @@ extern void fiRegisterStateFns (void *(*)(), void (*)(void *)); } \ else { /* should look for additional protects */ \ fiRestoreState(state); \ - if (!state->target == (FiWord) state) { \ + if (state->target != (FiWord) state) { \ fiUnwind(state->target, state->value); \ } \ exn = state->value; \ diff --git a/aldor/aldor/src/macex.c b/aldor/aldor/src/macex.c index 513fa60ff..a7e9e5682 100644 --- a/aldor/aldor/src/macex.c +++ b/aldor/aldor/src/macex.c @@ -109,7 +109,7 @@ macexFiniFile() local void initMacDef(void) { - if (!(fintMode == FINT_LOOP)) macDefs = 0; + if (fintMode != FINT_LOOP) macDefs = 0; } From b0afa1d0a1b332320fa2d7fea8bf49f33ff0e04c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 22 May 2015 21:44:21 +0100 Subject: [PATCH 017/352] algebra: remove src/logic/Makefile.deps Shouldn't have been committed in the first place --- aldor/lib/algebra/src/logic/Makefile.deps | 6 ------ 1 file changed, 6 deletions(-) delete mode 100644 aldor/lib/algebra/src/logic/Makefile.deps diff --git a/aldor/lib/algebra/src/logic/Makefile.deps b/aldor/lib/algebra/src/logic/Makefile.deps deleted file mode 100644 index ff576a62c..000000000 --- a/aldor/lib/algebra/src/logic/Makefile.deps +++ /dev/null @@ -1,6 +0,0 @@ -collector_deps := -logic_deps := collector -bool_deps := logic - -library_deps := util numbers extree extree/operators extree/parser \ - categories basic From e7fb735fca6137971a90c9f89c80426f083bcb75 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 8 May 2015 19:36:09 +0100 Subject: [PATCH 018/352] opsys.c: Newer gcc in Ubuntu 15.4 whines about struct sigaction x = { 0 }; Initialise in a more portable way. --- aldor/aldor/src/opsys.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/opsys.c b/aldor/aldor/src/opsys.c index 7798f875f..4b7d5f62b 100644 --- a/aldor/aldor/src/opsys.c +++ b/aldor/aldor/src/opsys.c @@ -891,8 +891,10 @@ osSetSignalHandlers(OsSignalHandler *posigfn,int *sigv,OsSignalHandler nsigfn) OsSignalHandler osSetSignalHandlers(OsSignalHandler *posigfn,int *sigv,OsSignalHandler nsigfn) { - struct sigaction oldaction = { 0 }; - struct sigaction newaction = { 0 }; + struct sigaction oldaction; + struct sigaction newaction; + memset(&oldaction, 0, sizeof(oldaction)); + memset(&newaction, 0, sizeof(newaction)); newaction.sa_handler = nsigfn ? nsigfn : SIG_DFL; From ab2a210e6d66a49d0cb5a8c584aec8734b61ad9b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 1 Jan 2017 20:59:41 +0000 Subject: [PATCH 019/352] tools/unix/Makefile: add a gdb-aldor script. --- aldor/aldor/tools/unix/.gitignore | 1 + aldor/aldor/tools/unix/Makefile.am | 2 +- aldor/aldor/tools/unix/gdb-aldor.in | 29 +++++++++++++++++++++++++++++ aldor/configure.ac | 1 + 4 files changed, 32 insertions(+), 1 deletion(-) create mode 100644 aldor/aldor/tools/unix/gdb-aldor.in diff --git a/aldor/aldor/tools/unix/.gitignore b/aldor/aldor/tools/unix/.gitignore index 0798ac5b6..3893d4ac3 100644 --- a/aldor/aldor/tools/unix/.gitignore +++ b/aldor/aldor/tools/unix/.gitignore @@ -6,3 +6,4 @@ /zaccgram.c /zaccgram.h /zaccscan.c +/gdb-aldor diff --git a/aldor/aldor/tools/unix/Makefile.am b/aldor/aldor/tools/unix/Makefile.am index c59f134b3..7d3b9dd88 100644 --- a/aldor/aldor/tools/unix/Makefile.am +++ b/aldor/aldor/tools/unix/Makefile.am @@ -1,5 +1,5 @@ # Install aldor wrapper script. -bin_SCRIPTS = aldor +bin_SCRIPTS = aldor gdb-aldor #tooldir= $(abs_top_builddir)/build/tools diff --git a/aldor/aldor/tools/unix/gdb-aldor.in b/aldor/aldor/tools/unix/gdb-aldor.in new file mode 100644 index 000000000..64283283f --- /dev/null +++ b/aldor/aldor/tools/unix/gdb-aldor.in @@ -0,0 +1,29 @@ +#!/bin/sh + +prefix=@prefix@ +exec_prefix=@exec_prefix@ +libexecdir=@libexecdir@ +includedir=@includedir@ +datadir=@datadir@ + +EXEEXT=@EXEEXT@ + +if [ x$1 = x--print-confvar ]; then + eval "echo \${$2}" + exit +fi + +if [ x$PRINT_CONFVAR != x ]; then + eval "echo \${$PRINT_CONFVAR}" + exit +fi + +ALDOR=$libexecdir/aldor$EXEEXT +if test ! -f $ALDOR; then + echo "Error: unable to locate Aldor installation" + exit 1 +fi + +export ALDORROOT=$prefix + +gdb --args $ALDOR "$@" diff --git a/aldor/configure.ac b/aldor/configure.ac index ae5963290..21af2e5ec 100644 --- a/aldor/configure.ac +++ b/aldor/configure.ac @@ -98,6 +98,7 @@ AC_CONFIG_FILES( aldor/tools/Makefile aldor/tools/unix/Makefile aldor/tools/unix/aldor + aldor/tools/unix/gdb-aldor lib/Makefile dnl Aldor base library. From aa6b3307facf87de1c987fda1f5577fc7c1bd167 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 9 Oct 2016 21:23:30 +0100 Subject: [PATCH 020/352] store.c: Kill warnings about %p format strings --- aldor/aldor/src/store.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/store.c b/aldor/aldor/src/store.c index 7138194e5..cbe789380 100644 --- a/aldor/aldor/src/store.c +++ b/aldor/aldor/src/store.c @@ -3054,7 +3054,7 @@ stoShowMixedSizeSections(void) if (!pc->isFirst) fprintf(osStderr, "(%ld)\n", pc->nbytesPrev/qmsize); - fprintf(osStderr, "%p=(%d){", pc, nq); + fprintf(osStderr, "%p=(%d){", (void*) pc, nq); if (pc->isFree) fprintf(osStderr, "F/"); else @@ -4315,7 +4315,7 @@ stoShowDetail(int stoDetail) if (stoDetail & STO_SHOW_MEMMAP) { fprintf(osStderr, "| Heap....... [%p..%p) %ldK\n", - heapStart, heapEnd, + (void *) heapStart, (void *) heapEnd, ptrDiff(heapEnd, heapStart)/1024); for (mm=osMemMap(OSMEM_DDATA); (*mm)->use != OSMEM_END; mm++) From 4b54ad1c1d28d8f0a9adf8cce6558554a8b54508 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 2 Jan 2017 21:04:18 +0000 Subject: [PATCH 021/352] fint.c: Deal with clang format warnings --- aldor/aldor/src/fint.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/fint.c b/aldor/aldor/src/fint.c index 174ba2878..d00ca4ec7 100644 --- a/aldor/aldor/src/fint.c +++ b/aldor/aldor/src/fint.c @@ -3643,7 +3643,7 @@ fintEval_(DataObj retDataObj) prog0->name, prog0->unit->name); for (k = 0; k < argc; k++) - (void)fprintf(dbOut, "%p ", parValue(k).fiPtr); + (void)fprintf(dbOut, "%p ", (void *) parValue(k).fiPtr); (void)fprintf(dbOut, ")\n"); } From ac67f0ec57004f684029d329d9f2e2371f4fe7ad Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 2 Jan 2017 21:04:40 +0000 Subject: [PATCH 022/352] foam_c.c: Deal with clang format warnings --- aldor/aldor/src/foam_c.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/foam_c.c b/aldor/aldor/src/foam_c.c index 98c3b5190..10f5d472e 100644 --- a/aldor/aldor/src/foam_c.c +++ b/aldor/aldor/src/foam_c.c @@ -2281,7 +2281,7 @@ fiExportGlobalFun(String name, Ptr p, int size) { GlobalLinkInfo glInfo; - linkDEBUG(stdout, "Exporting %s %p %d\n", name, p, size); + linkDEBUG(stdout, "Exporting %s %p %d\n", name, (void *) p, size); tblGlobalsInit(); From 43281b4eeea0078b2e9f0519aed17852e4611621 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 26 Nov 2015 22:17:36 +0000 Subject: [PATCH 023/352] foam_c.c: Remove a couple of warnings --- aldor/aldor/src/foam_c.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/foam_c.c b/aldor/aldor/src/foam_c.c index 10f5d472e..81b35ec20 100644 --- a/aldor/aldor/src/foam_c.c +++ b/aldor/aldor/src/foam_c.c @@ -2335,7 +2335,7 @@ fiImportGlobalFun(String name, Ptr * p) } else if (glInfo->size > -1) { /* already exported */ *p = glInfo->data; - linkDEBUG(stdout, "resolved with (%p) %p\n", glInfo, glInfo->data); + linkDEBUG(stdout, "resolved with (%p) %p\n", (void*) glInfo, (void*) glInfo->data); } else { FiLinkList l = (FiLinkList) FI_ALLOC(sizeof(fiConsCell), CENSUS_GlobalInfo); From 3a574064ac0daecf2242381c40640f35f89a47f0 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 4 Dec 2015 17:26:53 +0000 Subject: [PATCH 024/352] fint.c: Warning fixes --- aldor/aldor/src/fint.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/fint.c b/aldor/aldor/src/fint.c index d00ca4ec7..80e45144a 100644 --- a/aldor/aldor/src/fint.c +++ b/aldor/aldor/src/fint.c @@ -6068,7 +6068,7 @@ fintWhere(int level) if (prog) (void)fprintf(dbOut, "#%d %8p in <%s> at unit [%s]\n", int0, - bp, prog->name, prog->unit->name); + (void*) bp, prog->name, prog->unit->name); else (void)fprintf(dbOut, "(Unknown current prog)\n"); From a8ae7803c8635f0eff871bdaefdbfa0d3be6e52a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 4 Dec 2015 17:24:53 +0000 Subject: [PATCH 025/352] genjava.c: Warning fixup --- aldor/aldor/src/java/genjava.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index 491ef5dbd..c8c201065 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -4155,7 +4155,7 @@ gj0NameInit() while (p->c != '\0') { /* Identifiers must never contain UTF-8 encoded unicode * characters or extended ASCII. */ - assert(p->c >= 0 && p->c <= STDCHAR_MAX); + assert(p->c <= STDCHAR_MAX); gjCharIds[p->c] = p->s; p++; } From 82d74cf6eacee0e68beac5e91c796023cd4698be Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 4 Dec 2015 17:25:10 +0000 Subject: [PATCH 026/352] loops.c: Warning fixup --- aldor/aldor/src/loops.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/loops.c b/aldor/aldor/src/loops.c index dbc903cd6..8292e16bb 100644 --- a/aldor/aldor/src/loops.c +++ b/aldor/aldor/src/loops.c @@ -732,7 +732,7 @@ void lpLoopPrintDb(Loop loop) { fprintf(dbOut, "Loop (%p): headerBlock = %d\n", - loop, loop->header->label); + (void*) loop, loop->header->label); assert(loop->bitvClass); assert(bitvClassSize(loop->bitvClass) >= listLength(BBlock)(loop->blockList)); From 2b55cdcda2d2b8b00fc91d89a3e6a9bb719b207d Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 23 Nov 2016 23:25:29 +0000 Subject: [PATCH 027/352] src/cport.c: Remove ebcdic/ascii conversions. - this might eventually be replaced with some UTF-8 shinanigans, but cross that bridge when we get to it. --- aldor/aldor/src/buffer.c | 8 ++- aldor/aldor/src/cport.c | 100 -------------------------------------- aldor/aldor/src/cport.h | 36 -------------- aldor/aldor/src/cport_t.c | 18 ------- aldor/aldor/src/file.c | 5 +- aldor/aldor/src/fint.c | 3 +- aldor/aldor/src/foam.c | 12 ----- aldor/aldor/src/foam_c.c | 2 +- aldor/aldor/src/strops.c | 42 ++-------------- 9 files changed, 10 insertions(+), 216 deletions(-) diff --git a/aldor/aldor/src/buffer.c b/aldor/aldor/src/buffer.c index b69bff44a..f4e314520 100644 --- a/aldor/aldor/src/buffer.c +++ b/aldor/aldor/src/buffer.c @@ -469,7 +469,6 @@ bufRdChars(Buffer buf, int cc) s = strAlloc(cc); bufGetChars(buf, s, cc); - s = strnFrAscii(s,cc); return s; } @@ -477,7 +476,7 @@ bufRdChars(Buffer buf, int cc) int bufWrChars(Buffer buf, int cc, String s) { - bufPutChars(buf, strnToAsciiStatic(s,cc), cc); + bufPutChars(buf, s, cc); return cc; } @@ -498,7 +497,6 @@ bufRdString(Buffer buf) cc = bufGetSInt(buf); s = strAlloc(cc); bufGetChars(buf, s, cc); - s = strnFrAscii(s,cc); return s; } @@ -509,7 +507,7 @@ bufWrString(Buffer buf, String s) int cc = strLength(s) + 1; bufPutSInt(buf, cc); - bufPutChars(buf, strnToAsciiStatic(s,cc), cc); + bufPutChars(buf, s, cc); return SINT_BYTES + cc; } @@ -518,7 +516,7 @@ String bufGetString(Buffer buf) { String s = strCopy(bufGets(buf)); - return strnFrAscii(s, strLength(s) + 1); + return s; } diff --git a/aldor/aldor/src/cport.c b/aldor/aldor/src/cport.c index 0595b5ae5..89343e5d6 100644 --- a/aldor/aldor/src/cport.c +++ b/aldor/aldor/src/cport.c @@ -74,104 +74,4 @@ ptrFrLong(long l) #endif /* CC_noncanonical_pointer && OS_MS_DOS && CC_BORLAND */ -/***************************************************************************** - * - * 18. Character set conversion - * - ****************************************************************************/ - -# ifdef CC_ebcdic_chars - -short __ebcdic[] = { - 0x00, 0x01, 0x02, 0x03, 0x37, 0x2d, 0x2e, 0x2f, - 0x16, 0x05, 0x25, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, - 0x10, 0x11, 0x12, 0x13, 0x3c, 0x3d, 0x32, 0x26, - 0x18, 0x19, 0x3f, 0x27, 0x1c, 0x1d, 0x1e, 0x1f, - 0x40, 0x5a, 0x7f, 0x7b, 0x5b, 0x6c, 0x50, 0x7d, - 0x4d, 0x5d, 0x5c, 0x4e, 0x6b, 0x60, 0x4b, 0x61, - 0xf0, 0xf1, 0xf2, 0xf3, 0xf4, 0xf5, 0xf6, 0xf7, - 0xf8, 0xf9, 0x7a, 0x5e, 0x4c, 0x7e, 0x6e, 0x6f, - 0x7c, 0xc1, 0xc2, 0xc3, 0xc4, 0xc5, 0xc6, 0xc7, - 0xc8, 0xc9, 0xd1, 0xd2, 0xd3, 0xd4, 0xd5, 0xd6, - 0xd7, 0xd8, 0xd9, 0xe2, 0xe3, 0xe4, 0xe5, 0xe6, - 0xe7, 0xe8, 0xe9, 0xad, 0xe0, 0xbd, 0x5f, 0x6d, - 0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, - 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, - 0x97, 0x98, 0x99, 0xa2, 0xa3, 0xa4, 0xa5, 0xa6, - 0xa7, 0xa8, 0xa9, 0xc0, 0x4f, 0xd0, 0xa1, 0x07, - 0x20, 0x21, 0x22, 0x23, 0x24, 0x15, 0x06, 0x17, - 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x09, 0x0a, 0x1b, - 0x30, 0x31, 0x1a, 0x33, 0x34, 0x35, 0x36, 0x08, - 0x38, 0x39, 0x3a, 0x3b, 0x04, 0x14, 0x3e, 0xe1, - 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, - 0x49, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, - 0x58, 0x59, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, - 0x68, 0x69, 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, - 0x76, 0x77, 0x78, 0x80, 0x8a, 0x8b, 0x8c, 0x8d, - 0x8e, 0x8f, 0x90, 0x6a, 0x9b, 0x9c, 0x9d, 0x9e, - 0x9f, 0xa0, 0xaa, 0xab, 0xac, 0x4a, 0xae, 0xaf, - 0xb0, 0xb1, 0xb2, 0xb3, 0xb4, 0xb5, 0xb6, 0xb7, - 0xb8, 0xb9, 0xba, 0xbb, 0xbc, 0x9a, 0xbe, 0xbf, - 0xca, 0xcb, 0xcc, 0xcd, 0xce, 0xcf, 0xda, 0xdb, - 0xdc, 0xdd, 0xde, 0xdf, 0xea, 0xeb, 0xec, 0xed, - 0xee, 0xef, 0xfa, 0xfb, 0xfc, 0xfd, 0xfe, 0xff -}; - -short __ascii[] = { - 0x00, 0x01, 0x02, 0x03, 0x9c, 0x09, 0x86, 0x7f, - 0x97, 0x8d, 0x8e, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, - 0x10, 0x11, 0x12, 0x13, 0x9d, 0x85, 0x08, 0x87, - 0x18, 0x19, 0x92, 0x8f, 0x1c, 0x1d, 0x1e, 0x1f, - 0x80, 0x81, 0x82, 0x83, 0x84, 0x0a, 0x17, 0x1b, - 0x88, 0x89, 0x8a, 0x8b, 0x8c, 0x05, 0x06, 0x07, - 0x90, 0x91, 0x16, 0x93, 0x94, 0x95, 0x96, 0x04, - 0x98, 0x99, 0x9a, 0x9b, 0x14, 0x15, 0x9e, 0x1a, - 0x20, 0xa0, 0xa1, 0xa2, 0xa3, 0xa4, 0xa5, 0xa6, - 0xa7, 0xa8, 0xd5, 0x2e, 0x3c, 0x28, 0x2b, 0x7c, - 0x26, 0xa9, 0xaa, 0xab, 0xac, 0xad, 0xae, 0xaf, - 0xb0, 0xb1, 0x21, 0x24, 0x2a, 0x29, 0x3b, 0x5e, - 0x2d, 0x2f, 0xb2, 0xb3, 0xb4, 0xb5, 0xb6, 0xb7, - 0xb8, 0xb9, 0xcb, 0x2c, 0x25, 0x5f, 0x3e, 0x3f, - 0xba, 0xbb, 0xbc, 0xbd, 0xbe, 0xbf, 0xc0, 0xc1, - 0xc2, 0x60, 0x3a, 0x23, 0x40, 0x27, 0x3d, 0x22, - 0xc3, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, - 0x68, 0x69, 0xc4, 0xc5, 0xc6, 0xc7, 0xc8, 0xc9, - 0xca, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f, 0x70, - 0x71, 0x72, 0xe5, 0xcc, 0xcd, 0xce, 0xcf, 0xd0, - 0xd1, 0x7e, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, - 0x79, 0x7a, 0xd2, 0xd3, 0xd4, 0x5b, 0xd6, 0xd7, - 0xd8, 0xd9, 0xda, 0xdb, 0xdc, 0xdd, 0xde, 0xdf, - 0xe0, 0xe1, 0xe2, 0xe3, 0xe4, 0x5d, 0xe6, 0xe7, - 0x7b, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, - 0x48, 0x49, 0xe8, 0xe9, 0xea, 0xeb, 0xec, 0xed, - 0x7d, 0x4a, 0x4b, 0x4c, 0x4d, 0x4e, 0x4f, 0x50, - 0x51, 0x52, 0xee, 0xef, 0xf0, 0xf1, 0xf2, 0xf3, - 0x5c, 0x9f, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, - 0x59, 0x5a, 0xf4, 0xf5, 0xf6, 0xf7, 0xf8, 0xf9, - 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, - 0x38, 0x39, 0xfa, 0xfb, 0xfc, 0xfd, 0xfe, 0xff -}; - -String -strToAscii(String e, String a, int cc) -{ - int i; - - for ( i = 0; i < cc; i += 1 ) - a[i] = charToAscii(e[i]); - return a; -} - -String -strFrAscii(String a, String e, int cc) -{ - int i; - - for ( i = 0; i < cc; i += 1 ) - e[i] = charFrAscii(a[i]); - return e; -} - -#endif /* CC_ebcdic_chars */ - ThatsAll diff --git a/aldor/aldor/src/cport.h b/aldor/aldor/src/cport.h index 3920f234f..2c579b7af 100644 --- a/aldor/aldor/src/cport.h +++ b/aldor/aldor/src/cport.h @@ -593,42 +593,6 @@ extern Pointer ptrFrLong(long); # define UNBYTE2(b0,b1) (BYTE0(b0) | (BYTE0(b1)< %d\n", '^', charToAscii('^')); - printf("~ : %d -> %d\n", '~', charToAscii('~')); - printf("| : %d -> %d\n", '|', charToAscii('|')); -} - /* * Main test function for C portability code. */ @@ -60,7 +43,6 @@ void testCPort(void) { testBytes(); - testCharacterTables(); } #endif /* TEST_CPORT || TEST_ALL */ diff --git a/aldor/aldor/src/file.c b/aldor/aldor/src/file.c index 6981c470f..44488fe79 100644 --- a/aldor/aldor/src/file.c +++ b/aldor/aldor/src/file.c @@ -270,7 +270,6 @@ fileRdChars(FILE *file, int cc) s = strAlloc(cc); FILE_GET_CHARS(file, s, cc); - s = strnFrAscii(s,cc); return s; } @@ -278,7 +277,7 @@ fileRdChars(FILE *file, int cc) int fileWrChars(FILE *file, int cc, String s) { - FILE_PUT_CHARS(file, strnToAsciiStatic(s,cc), cc); + FILE_PUT_CHARS(file, s, cc); return cc; } @@ -294,7 +293,7 @@ fileGetChars(FILE *file, String s, int ssize) /* Convert from ASCII to the native char. set. */ c = fgetc(file); for( k = 0; (k < ssize) && (c != EOF) && (c != 0); k += 1 ) { - s[k] = charFrAscii(c); + s[k] = c; c = fgetc(file); } diff --git a/aldor/aldor/src/fint.c b/aldor/aldor/src/fint.c index 80e45144a..f0c366de7 100644 --- a/aldor/aldor/src/fint.c +++ b/aldor/aldor/src/fint.c @@ -4216,7 +4216,7 @@ fintEval_(DataObj retDataObj) for (n = 0; n < argc; n++) { fintGetSInt(i); /* fintASetElem(type, retDataObj, n, expr); !!*/ - ((char *)(retDataObj->fiArr))[n] = charFrAscii(i); + ((char *)(retDataObj->fiArr))[n] = i; } ((char *)(retDataObj->fiArr))[argc] = '\0'; @@ -5987,7 +5987,6 @@ fintRdChars(int cc) s = strAlloc(cc); (void)fintGetChars(s, cc); - s = strnFrAscii(s,cc); return s; } diff --git a/aldor/aldor/src/foam.c b/aldor/aldor/src/foam.c index 31958ca3b..f2019d99a 100644 --- a/aldor/aldor/src/foam.c +++ b/aldor/aldor/src/foam.c @@ -2213,10 +2213,6 @@ foamFrBuffer(Buffer buf) break; case 'w': n = bufGetSInt(buf); - if (isArr) { - if (foam->foamArr.baseType == FOAM_Char) - n = charFrAscii(n); - } foamArgv(foam)[si].data = n; break; case 'X': @@ -2343,10 +2339,6 @@ foamProgHdrFrBuffer(Buffer buf) break; case 'w': n = bufGetSInt(buf); - if (isArr) { - if (foam->foamArr.baseType == FOAM_Char) - n = charFrAscii(n); - } foamArgv(foam)[si].data = n; break; case 'X': @@ -2549,10 +2541,6 @@ foamToBuffer(Buffer buf, Foam foam) case 'w': assert(bufIsSInt(foamArgv(foam)[si].data)); n = foamArgv(foam)[si].data; - if (isArr) { - if (foam->foamArr.baseType == FOAM_Char) - n = charToAscii(n); - } bufPutSInt(buf, n); break; case 'X': diff --git a/aldor/aldor/src/foam_c.c b/aldor/aldor/src/foam_c.c index 81b35ec20..412e0a8fe 100644 --- a/aldor/aldor/src/foam_c.c +++ b/aldor/aldor/src/foam_c.c @@ -2199,7 +2199,7 @@ localStrHash(register String s) while ((c = *s++) != 0) { h ^= (h << 8); - h += (charToAscii(c) + 200041); + h += (c + 200041); h &= 0x3FFFFFFF; } return h; diff --git a/aldor/aldor/src/strops.c b/aldor/aldor/src/strops.c index 39392ca64..1518c17c0 100644 --- a/aldor/aldor/src/strops.c +++ b/aldor/aldor/src/strops.c @@ -259,7 +259,7 @@ strHash(register String s) while ((c = *s++) != 0) { h ^= (h << 8); - h += (charToAscii(c) + 200041); + h += (c + 200041); h &= 0x3FFFFFFF; } return h; @@ -273,7 +273,7 @@ strSmallHash(register String s) while ((c = *s++) != 0) { h ^= (h << 8); - h += (charToAscii(c) + 200041); + h += (c + 200041); h &= 0x5FFFFCB; } return h; @@ -287,7 +287,7 @@ strAHash(register String s) while ((c = *s++) != 0) { h ^= (h << 8); - h += (toupper(charToAscii(c)) + 200041); + h += (toupper(c) + 200041); h &= 0x3FFFFFFF; } return h; @@ -343,42 +343,6 @@ strReplace(String txt, String orig, String repl) return s; } -/* - * Convert a string to Ascii from the native character set. - * - * The result may share memory with either the first argument, - * or with a static buffer internal to this function. - * As a result, the result should be copied to some more stable - * storage area by the caller, if necessary. - */ - -String -strnToAsciiStatic(String s, Length sz) -{ - static Buffer buf = 0; - - if (!buf) buf = bufNew(); bufNeed(buf, sz); - return strToAscii(s, bufChars(buf), sz); -} - -/* - * Convert a string from Ascii to the native character set. - * - * The result may share memory with either the first argument, - * or with a static buffer internal to this function. - * As a result, the result should be copied to some more stable - * storage area by the caller, if necessary. - */ - -String -strnFrAsciiStatic(String s, Length sz) -{ - static Buffer buf = 0; - - if (!buf) buf = bufNew(); bufNeed(buf, sz); - return strFrAscii(s, bufChars(buf), sz); -} - int strPrint(FILE *fout, String s, int oq, int cq, int esc, const char *fmt) { From f957ce85cea4e253a0b7b9b81c4e099aa044136c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 23 Nov 2016 23:26:40 +0000 Subject: [PATCH 028/352] opsys&store.c: Use DEFAULT_SOURCE to get various low level functions. Really should be using configure.ac for these, I guess. --- aldor/aldor/src/opsys.c | 2 +- aldor/aldor/src/store.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/opsys.c b/aldor/aldor/src/opsys.c index 4b7d5f62b..a0a68a100 100644 --- a/aldor/aldor/src/opsys.c +++ b/aldor/aldor/src/opsys.c @@ -9,7 +9,7 @@ #define _ALL_SOURCE 1 /* For RS/6000 - should come before cport.h include. */ #define _POSIX_SOURCE 1 /* For Linux/BSD. */ -#define _BSD_SOURCE 1 /* sbrk */ +#define _DEFAULT_SOURCE 1 /* sbrk */ #include "cport.h" #include "editlevels.h" diff --git a/aldor/aldor/src/store.c b/aldor/aldor/src/store.c index cbe789380..d7f31e796 100644 --- a/aldor/aldor/src/store.c +++ b/aldor/aldor/src/store.c @@ -47,7 +47,7 @@ * penalty of a 48K table in static data. */ -#define _BSD_SOURCE 1 /* strncasecmp */ +#define _DEFAULT_SOURCE 1 /* strncasecmp */ #include "debug.h" #include "opsys.h" From 1762fe0b79dae28deed8b262e813ef438073ab13 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 23 Nov 2016 23:27:18 +0000 Subject: [PATCH 029/352] sexpr.c: cleanup some confusing indentation --- aldor/aldor/src/sexpr.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/aldor/aldor/src/sexpr.c b/aldor/aldor/src/sexpr.c index 16f892faf..d9b02aea0 100644 --- a/aldor/aldor/src/sexpr.c +++ b/aldor/aldor/src/sexpr.c @@ -1195,10 +1195,11 @@ void sxiCommentChk(void) sxiCommentBufStart(); str = sxiCommentBufChars(); if (!strIsPrefix("line", str)) - return; if (DEBUG(sexpr)) { - if (strIsPrefix("line", str)) - fprintf(dbOut, "!!! %s\n", str); - } + return; + if (DEBUG(sexpr)) { + if (strIsPrefix("line", str)) + fprintf(dbOut, "!!! %s\n", str); + } blno = bufNew(); bglno = bufNew(); bfn = bufNew(); From dc4c14d8e3d96bdf4094b59d1cd50a1b525cd3b7 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 4 Dec 2015 15:46:35 +0000 Subject: [PATCH 030/352] sefo.c:Printf warning cleanup --- aldor/aldor/src/sefo.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/sefo.c b/aldor/aldor/src/sefo.c index b68706eb0..dad8538d1 100644 --- a/aldor/aldor/src/sefo.c +++ b/aldor/aldor/src/sefo.c @@ -2535,7 +2535,7 @@ sefoFreeVars0(TForm *pa, TForm parent, Sefo sefo) if (DEBUG(sefoFree)) { sfvPrint(dbOut); - fprintf(dbOut, " sefoFree[%d]: %p)\n", (int) serial, *pa); + fprintf(dbOut, " sefoFree[%d]: %p)\n", (int) serial, (void*) *pa); } } From e9ce5b095f61131ed082ae2f74c2d432bb0594f4 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 19 Jan 2017 20:33:42 +0000 Subject: [PATCH 031/352] .gitignore: ignore copied/generated files. --- aldor/.gitignore | 2 ++ aldor/aldor/subcmd/unitools/.gitignore | 22 ++++++++++++++++++++++ 2 files changed, 24 insertions(+) diff --git a/aldor/.gitignore b/aldor/.gitignore index bd82b88ec..d1a6c4ce9 100644 --- a/aldor/.gitignore +++ b/aldor/.gitignore @@ -19,6 +19,8 @@ Makefile *.class *.al *.ao +*.asy +*.abn *.dep *.fm *.log diff --git a/aldor/aldor/subcmd/unitools/.gitignore b/aldor/aldor/subcmd/unitools/.gitignore index 134797d85..76979ddf2 100644 --- a/aldor/aldor/subcmd/unitools/.gitignore +++ b/aldor/aldor/subcmd/unitools/.gitignore @@ -1,3 +1,25 @@ /Makefile.in /platform /unicl +/bigint.c +/btree.c +/buffer.c +/cfgfile.c +/compopt.c +/debug.c +/dword.c +/file.c +/fluid.c +/fname.c +/format.c +/int.c +/list.c +/memclim.c +/opsys.c +/ostream.c +/stdc.c +/store.c +/strops.c +/timer.c +/util.c +/xfloat.c From 51f807e6fe7c2cb149121d6e4bf0a03459096484 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 30 Mar 2015 19:49:59 +0100 Subject: [PATCH 032/352] m4: Right, let's get with the 90s C standard at least. Too much of a pain to switch between dialects for very minor gain. --- aldor/m4/strict_compile.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/m4/strict_compile.m4 b/aldor/m4/strict_compile.m4 index 3869d198a..94df7f8fc 100644 --- a/aldor/m4/strict_compile.m4 +++ b/aldor/m4/strict_compile.m4 @@ -2,7 +2,7 @@ AC_DEFUN([ALDOR_STRICT_COMPILE], [AC_MSG_CHECKING(Strict options for C compiler) - cfgSTRICTCFLAGS="-pedantic -std=c89 -Wall -Wextra -Werror -Wno-empty-body -Wno-enum-compare -Wno-missing-field-initializers -Wno-sign-compare -Wno-unused -Wno-unused-parameter -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing" + cfgSTRICTCFLAGS="-pedantic -std=c99 -Wall -Wextra -Werror -Wno-empty-body -Wno-enum-compare -Wno-missing-field-initializers -Wno-sign-compare -Wno-unused -Wno-unused-parameter -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing" if test "${CC}x" = gccx then From 6857e7e19eda5b399966166aaf755e618764b8db Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 23 Nov 2016 23:29:33 +0000 Subject: [PATCH 033/352] m4: Add gcc 6 warnings --- aldor/m4/error-on-warn.m4 | 2 +- aldor/m4/strict_compile.m4 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/aldor/m4/error-on-warn.m4 b/aldor/m4/error-on-warn.m4 index 7b43c7bb4..c44bff2de 100644 --- a/aldor/m4/error-on-warn.m4 +++ b/aldor/m4/error-on-warn.m4 @@ -3,7 +3,7 @@ AC_DEFUN([ALDOR_ERROR_ON_WARN], ALDOR_STRICT_COMPILE [AC_MSG_CHECKING(what extra warning flags to pass to the C compiler) warnFLAGS= - STRICTCFLAGS="${CFLAGS} -Wno-unused" + STRICTCFLAGS="${CFLAGS}" error_on_warning_as_default="yes" diff --git a/aldor/m4/strict_compile.m4 b/aldor/m4/strict_compile.m4 index 94df7f8fc..2d2dce652 100644 --- a/aldor/m4/strict_compile.m4 +++ b/aldor/m4/strict_compile.m4 @@ -2,11 +2,11 @@ AC_DEFUN([ALDOR_STRICT_COMPILE], [AC_MSG_CHECKING(Strict options for C compiler) - cfgSTRICTCFLAGS="-pedantic -std=c99 -Wall -Wextra -Werror -Wno-empty-body -Wno-enum-compare -Wno-missing-field-initializers -Wno-sign-compare -Wno-unused -Wno-unused-parameter -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing" + cfgSTRICTCFLAGS="-pedantic -std=c99 -Wall -Wextra -Werror -Wno-empty-body -Wno-enum-compare -Wno-missing-field-initializers -Wno-sign-compare -Wno-unused -Wno-unused-parameter -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing -Wno-error=shift-negative-value -Wno-unused" if test "${CC}x" = gccx then - cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -Wno-error=clobbered" + cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -Wno-error=clobbered -Wno-unused" elif test "${CC}x" = clangx then cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -fcolor-diagnostics -Wno-error=enum-conversion -Wno-error=tautological-compare -Wno-parentheses-equality" From df8e0a9e6d5f2963b6ff9f7f7ad73ee5c1e6c90c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 5 Jan 2017 21:19:18 +0000 Subject: [PATCH 034/352] m4: Add a function to test if CC supports an option. Use to hide -Wno-sign-compare in gcc 5.4.0 and lower. --- aldor/m4/strict_compile.m4 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/aldor/m4/strict_compile.m4 b/aldor/m4/strict_compile.m4 index 2d2dce652..3592461dc 100644 --- a/aldor/m4/strict_compile.m4 +++ b/aldor/m4/strict_compile.m4 @@ -1,8 +1,18 @@ # Define warnings based on compiler (and version) +AC_DEFUN([ALDOR_CC_OPTION], +[AC_MSG_CHECKING($CC supports $1); echo > conftest$1.c; + res=no + if $CC $1 -c conftest$1.c > /dev/null 2>&1; then $2="$1"; res=yes; fi; + AC_MSG_RESULT($res)]) + AC_DEFUN([ALDOR_STRICT_COMPILE], - [AC_MSG_CHECKING(Strict options for C compiler) - cfgSTRICTCFLAGS="-pedantic -std=c99 -Wall -Wextra -Werror -Wno-empty-body -Wno-enum-compare -Wno-missing-field-initializers -Wno-sign-compare -Wno-unused -Wno-unused-parameter -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing -Wno-error=shift-negative-value -Wno-unused" + + [ALDOR_CC_OPTION(-Wno-error=shift-negative-value,cfg_no_shift_negative_value) + ALDOR_CC_OPTION(-Wno-sign-compare,cfg_no_sign_compare) + AC_MSG_CHECKING(Strict options for C compiler) + + cfgSTRICTCFLAGS="-pedantic -std=c99 -Wall -Wextra -Werror -Wno-empty-body -Wno-enum-compare -Wno-missing-field-initializers -Wno-unused -Wno-unused-parameter -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing -Wno-unused $cfg_no_sign_compare $cfg_no_shift_negative_value " if test "${CC}x" = gccx then From a200399f41a0e22a2e3802f9f670b8b537875bc1 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 6 Jun 2015 09:09:44 +0100 Subject: [PATCH 035/352] build: enable DBG=1 --- aldor/lib/buildlib.mk | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index c0d24059e..bb6efd385 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -80,10 +80,10 @@ aldor_common_args := \ -Mno-ALDOR_W_WillObsolete \ -Wcheck -Waudit -DBG := $(if $(filter 1,$(DBG)), gdb --args, $(DBG)) +AM_DBG := $(if $(filter 1,$(DBG)), gdb --args, $(DBG)) $(addsuffix .c, $(library)): %.c: %.ao %.dep $(AM_V_AO2C) \ - $(DBG) $(aldorexedir)/aldor \ + $(AM_DBG) $(aldorexedir)/aldor \ $(aldor_common_args) \ -Fc=$(builddir)/$@ \ $< @@ -114,7 +114,7 @@ $(addsuffix .ao, $(alldomains)): %.ao: $(SUBLIB_DEPEND).al rm -f $*.c $*.ao; \ cp $(SUBLIB_DEPEND).al lib$(libraryname)_$*.al; \ ar r lib$(libraryname)_$*.al $(addsuffix .ao, $(shell $(UNIQ) $*.dep)); \ - $(DBG) $(aldorexedir)/aldor $(aldor_args); \ + $(AM_DBG) $(aldorexedir)/aldor $(aldor_args); \ rm lib$(libraryname)_$*.al $(SUBLIB_DEPEND).al: $(foreach l,$(library_deps),$(librarylibdir)/$l/$(SUBLIB).al) @@ -142,7 +142,7 @@ $(addsuffix .gloop, $(alldomains)): %.gloop: rm -f $*.c $*.ao; \ cp $(SUBLIB_DEPEND).al lib$(libraryname)_$*.al; \ ar r lib$(libraryname)_$*.al $(addsuffix .ao, $(shell $(UNIQ) $*.dep)); \ - $(DBG) $(aldorexedir)/aldor -gloop \ + $(AM_DBG) $(aldorexedir)/aldor -gloop \ $(aldor_common_args) \ -Y. \ -Y$(aldorlibdir)/libfoam/al \ @@ -205,7 +205,7 @@ ifneq ($(javalibrary),) _javalibrary = $(filter-out $(java_blacklist), $(javalibrary)) $(addsuffix .java, $(_javalibrary)): %.java: %.ao - $(AM_V_FOAMJ)$(DBG) \ + $(AM_V_FOAMJ)$(AM_DBG) \ $(aldorexedir)/aldor $(aldor_common_args) -Fjava $*.ao $(addsuffix .class, $(_javalibrary)): %.class: $(libraryname).classlib @@ -238,7 +238,7 @@ $(aldortests): %.aldortest-exec-interp: Makefile (if ! grep -q '^#if ALDORTEST' $(srcdir)/$*.as; then exit 0; fi; \ echo " ALDORTEST $*.as"; \ sed -n -e '/^#if ALDORTEST/,/^#endif/p' < $(srcdir)/$*.as > $*_test.as; \ - $(DBG) $(aldorexedir)/aldor $(aldor_common_args) -Y$(aldorlibdir)/libfoam/al \ + $(AM_DBG) $(aldorexedir)/aldor $(aldor_common_args) -Y$(aldorlibdir)/libfoam/al \ -I$(top_srcdir)/lib/aldor/include -Y$(top_builddir)/lib/aldor/src \ -Y$(librarylibdir) -I$(libraryincdir) -ginterp -DALDORTEST \ $*_test.as; \ @@ -266,7 +266,7 @@ $(aldortestexecs): %.aldortest.exe: Makefile (if ! grep -q '^#if ALDORTEST' $(srcdir)/$*.as; then touch $@; fi; \ echo " ALDORTEST $*.as"; \ sed -n -e '/^#if ALDORTEST/,/^#endif/p' < $(srcdir)/$*.as > $*_test.as; \ - $(DBG) $(aldorexedir)/aldor $(aldor_common_args) -Y$(aldorlibdir)/libfoam/al \ + $(AM_DBG) $(aldorexedir)/aldor $(aldor_common_args) -Y$(aldorlibdir)/libfoam/al \ -Ccc=$(aldortooldir)/unicl \ -Y$(foamdir) -Y \ -Y$(foamlibdir) -l$(libraryname) $(patsubst %,-l%,$(librarydeps)) \ @@ -283,7 +283,7 @@ $(aldortestjavas): %.aldortest-exec-java: Makefile %.as (if grep -q '^#if ALDORTEST' $(srcdir)/$*.as; then \ echo " ALDORTESTJ $*"; \ sed -n -e '/^#if ALDORTEST/,/^#endif/p' < $(srcdir)/$*.as > $*_jtest.as; \ - $(DBG) $(aldorexedir)/aldor $(aldor_common_args) -Y$(aldorlibdir)/libfoam/al \ + $(AM_DBG) $(aldorexedir)/aldor $(aldor_common_args) -Y$(aldorlibdir)/libfoam/al \ -Y$(foamdir) -Y$(foamlibdir) -l$(libraryname) $(patsubst %,-l%,$(librarydeps)) \ -I$(top_srcdir)/lib/aldor/include -Y$(top_builddir)/lib/aldor/src \ -Y$(librarylibdir) -I$(libraryincdir) -DALDORTEST $$(cat $*_jtest.as | grep ^aldoroptions: | sed -e 's/aldoroptions://') \ From b632438aebef4f765fd9fb26d5c64336cf83b627 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 16 Jan 2017 21:43:24 +0000 Subject: [PATCH 036/352] testprog.am: Enable DBG=1 --- aldor/lib/testprog.am | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/aldor/lib/testprog.am b/aldor/lib/testprog.am index 16cc0759f..edd5e1812 100644 --- a/aldor/lib/testprog.am +++ b/aldor/lib/testprog.am @@ -32,9 +32,11 @@ AM_V_ALDOR = $(am__v_ALDOR_$(V)) am__v_ALDOR_ = $(am__v_ALDOR_$(AM_DEFAULT_VERBOSITY)) am__v_ALDOR_0 = @echo " ALDOR " $@; +AM_DBG := $(if $(filter 1,$(DBG)), gdb --args, $(DBG)) + %.c: %.as $(ALDOR) @$(MKDIR_P) $(@D) - $(AM_V_ALDOR)$(DBG) $(ALDOR) $(ALDORFLAGS) $($(*F)_AXLFLAGS) -Y$(@D) -Fao=$(@:.c=.ao) -Ffm=$(@:.c=.fm) -Fc=$@ $< + $(AM_V_ALDOR)$(AM_DBG) $(ALDOR) $(ALDORFLAGS) $($(*F)_AXLFLAGS) -Y$(@D) -Fao=$(@:.c=.ao) -Ffm=$(@:.c=.fm) -Fc=$@ $< %-aldormain.c: %.as $(ALDOR) @$(MKDIR_P) $(@D) From 563e3e951d83e8970ddcb27d9a4ecfb568f22a80 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 19 Jan 2017 20:36:16 +0000 Subject: [PATCH 037/352] libalgebra: multpoly/exponent directory listed twice. Remove second --- aldor/lib/algebra/src/Makefile.am | 1 - 1 file changed, 1 deletion(-) diff --git a/aldor/lib/algebra/src/Makefile.am b/aldor/lib/algebra/src/Makefile.am index 74825b869..ff9ba2305 100644 --- a/aldor/lib/algebra/src/Makefile.am +++ b/aldor/lib/algebra/src/Makefile.am @@ -27,7 +27,6 @@ SUBDIRS = \ polyfactorp \ ffield \ polyfactor0 \ - multpoly/exponent \ multpoly/multpolycat \ multpoly/multpolydom \ multpoly/multpolypkg \ From bca7aee061620e346ce96cb8d9e72a1e949bb8f4 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 20 Jan 2017 19:42:44 +0000 Subject: [PATCH 038/352] buildlib.am: Be less chatty when making .jar files. --- aldor/lib/buildlib.am | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/aldor/lib/buildlib.am b/aldor/lib/buildlib.am index f0c2106ca..dba91f6bd 100644 --- a/aldor/lib/buildlib.am +++ b/aldor/lib/buildlib.am @@ -1,6 +1,10 @@ aldorsrcdir = $(abs_top_srcdir)/aldor/src aldorexedir = $(top_builddir)/aldor/src +AM_V_LIBJAR = $(am__v_LIBJAR_$(V)) +am__v_LIBJAR_ = $(am__v_LIBJAR_$(AM_DEFAULT_VERBOSITY)) +am__v_LIBJAR_0 = @echo " LIBJAR " $@; + AM_CFLAGS = -I$(aldorsrcdir) lib$(libraryname).al: $(foreach i,$(SUBDIRS),$i/_sublib_$(libraryname).al) @@ -12,7 +16,7 @@ lib$(libraryname).al: $(foreach i,$(SUBDIRS),$i/_sublib_$(libraryname).al) done $(libraryname).jar: $(foreach i, $(JAVA_SUBDIRS),$i/$(libraryname).jar) - $(AM_V_JAR) set -x; \ + $(AM_V_LIBJAR) \ rm -rf jar; \ mkdir jar; \ for i in $(foreach j, $(JAVA_SUBDIRS),$j/$(libraryname).jar); \ From 81c8162b7a977596d957677345a8ac262ce7ad39 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 24 Aug 2015 20:27:53 +0100 Subject: [PATCH 039/352] buildlib.mk: Add per-test AXLFLAGS variable. Can be used in tests to tailor options. --- aldor/lib/buildlib.mk | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index bb6efd385..752062c22 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -241,6 +241,7 @@ $(aldortests): %.aldortest-exec-interp: Makefile $(AM_DBG) $(aldorexedir)/aldor $(aldor_common_args) -Y$(aldorlibdir)/libfoam/al \ -I$(top_srcdir)/lib/aldor/include -Y$(top_builddir)/lib/aldor/src \ -Y$(librarylibdir) -I$(libraryincdir) -ginterp -DALDORTEST \ + $($*_test_AXLFLAGS) \ $*_test.as; \ $(CHECK_TEST_STATUS) \ ) @@ -287,7 +288,9 @@ $(aldortestjavas): %.aldortest-exec-java: Makefile %.as -Y$(foamdir) -Y$(foamlibdir) -l$(libraryname) $(patsubst %,-l%,$(librarydeps)) \ -I$(top_srcdir)/lib/aldor/include -Y$(top_builddir)/lib/aldor/src \ -Y$(librarylibdir) -I$(libraryincdir) -DALDORTEST $$(cat $*_jtest.as | grep ^aldoroptions: | sed -e 's/aldoroptions://') \ - -Fjava -fc -Ffm -Jmain $*_jtest.as; \ + -Fjava -fc -Ffm -Jmain \ + $($*_test_AXLFLAGS) \ + $*_jtest.as; \ javac -g -cp $(aldorlibdir)/java/src/foamj.jar $*_jtest.java; \ java -cp .:$(aldorlibdir)/java/src/foamj.jar:$(aldorlibdir)/libfoam/al/foam.jar:$(top_builddir)/lib/$(libraryname)/src/$(libraryname).jar:$(top_builddir)/lib/aldor/src/aldor.jar $*_jtest; \ $(CHECK_TEST_STATUS) \ From 2072888a5c0498aee8dd101eada7afc1d2d5c2e3 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 24 Aug 2015 20:28:13 +0100 Subject: [PATCH 040/352] buildlib.mk: Remove .exe files as well --- aldor/lib/buildlib.mk | 1 + 1 file changed, 1 insertion(+) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index 752062c22..91aa5d107 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -317,6 +317,7 @@ mostlyclean: rm -f $(addsuffix .fm,$(alldomains)) rm -f *.java rm -f *.class + rm -f *.exe clean: mostlyclean rm -f $(SUBLIB).al From da3f1ad766931296696524853a10b3558a0f7d61 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 21 Oct 2015 23:43:57 +0100 Subject: [PATCH 041/352] buildlib.mk: Correct behaviour on diff exit status --- aldor/lib/buildlib.mk | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index 91aa5d107..f4a1e55f1 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -177,9 +177,9 @@ $(addsuffix .dep,$(alldomains) $(SUBLIB)): if test ! -f $@; then \ mv $@_tmp $@; \ elif diff $@ $@_tmp > /dev/null; then \ - mv $@_tmp $@; \ - else \ rm $@_tmp; \ + else \ + mv $@_tmp $@; \ fi $(foreach l,$(alldomains), $(eval $(call dep_template,$(l)))) From 43d4de4fb4688883411c1e457fc13aaeed3c2ff0 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 28 Jul 2015 20:25:32 +0100 Subject: [PATCH 042/352] build: Add ability to blacklist java tests --- aldor/lib/buildlib.mk | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index f4a1e55f1..500bee1c7 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -277,7 +277,8 @@ $(aldortestexecs): %.aldortest.exe: Makefile $*_test.as; ) ifneq ($(BUILD_JAVA),) ifneq ($(javalibrary),) -aldortestjavas := $(patsubst %,%.aldortest-exec-java,$(_javalibrary)) +aldortestjavas := $(patsubst %,%.aldortest-exec-java, \ + $(filter-out $(java_test_blacklist), $(_javalibrary))) $(aldortestjavas): %.aldortest-exec-java: Makefile %.as $(AM_V_ALDORTESTJ) \ From 4304491ab68658e5972f0e58948b2f9479e5920d Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 17 May 2015 22:38:17 +0100 Subject: [PATCH 043/352] buildlib.mk: Exe's depend on .as files, obviously. --- aldor/lib/buildlib.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index 500bee1c7..d70490486 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -262,7 +262,7 @@ aldortooldir = $(abs_top_builddir)/aldor/subcmd/unitools foamdir = $(abs_top_builddir)/aldor/lib/libfoam foamlibdir = $(abs_top_builddir)/aldor/lib/libfoamlib -$(aldortestexecs): %.aldortest.exe: Makefile +$(aldortestexecs): %.aldortest.exe: Makefile %.as $(AM_V_ALDORTEST) \ (if ! grep -q '^#if ALDORTEST' $(srcdir)/$*.as; then touch $@; fi; \ echo " ALDORTEST $*.as"; \ From 80388dcbc2947816e4322227f74287f1446ef980 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 24 Oct 2015 22:07:32 +0100 Subject: [PATCH 044/352] buildlib.mk: Use .al dependencies for .ao files This avoids out of date compilation. --- aldor/lib/buildlib.mk | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index d70490486..3b6823520 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -106,6 +106,8 @@ $(addsuffix .dep,$(axdomains)): %.dep: %.ax Makefile.in Makefile.deps $(addsuffix .ao, $(asdomains)): %.ao: %.as $(addsuffix .ao, $(axdomains)): %.ao: %.ax +$(addsuffix .ao, $(alldomains)): %.ao: $(foreach x,$(librarydeps),$(top_builddir)/lib/$(x)/src/lib$(x).al) + SUBLIB := _sublib_$(libraryname) SUBLIB_DEPEND := _sublib_depend_$(libraryname) From 5266a205294164cd356497a817ff39fa854d96c0 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 15 Jan 2017 17:58:23 +0000 Subject: [PATCH 045/352] buildlib.mk: Don't generate C when creating java files - Creates a race condition in a parallel build. --- aldor/lib/buildlib.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index 3b6823520..338fd4e76 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -291,7 +291,7 @@ $(aldortestjavas): %.aldortest-exec-java: Makefile %.as -Y$(foamdir) -Y$(foamlibdir) -l$(libraryname) $(patsubst %,-l%,$(librarydeps)) \ -I$(top_srcdir)/lib/aldor/include -Y$(top_builddir)/lib/aldor/src \ -Y$(librarylibdir) -I$(libraryincdir) -DALDORTEST $$(cat $*_jtest.as | grep ^aldoroptions: | sed -e 's/aldoroptions://') \ - -Fjava -fc -Ffm -Jmain \ + -Fjava -Ffm -Jmain \ $($*_test_AXLFLAGS) \ $*_jtest.as; \ javac -g -cp $(aldorlibdir)/java/src/foamj.jar $*_jtest.java; \ From 7bf01fe12d33ab972ec47958ecc30dd900fba4fd Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 14 Jan 2017 23:27:52 +0000 Subject: [PATCH 046/352] libfoam: Don't generate .c by default as it's a silly thing to do. --- aldor/aldor/lib/libfoamlib/al/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/lib/libfoamlib/al/Makefile.in b/aldor/aldor/lib/libfoamlib/al/Makefile.in index 4655053ce..6f73393e8 100644 --- a/aldor/aldor/lib/libfoamlib/al/Makefile.in +++ b/aldor/aldor/lib/libfoamlib/al/Makefile.in @@ -47,7 +47,7 @@ library = \ libraryname := foamlib #AXLCDB := -W check -Csmax=0 -Fc -Zdb -Qno-cc -AXLFLAGS := -Z db -Fc -Q8 $(AXLCDB) +AXLFLAGS := -Z db -Q8 $(AXLCDB) include $(top_srcdir)/lib/buildlib.mk libraryincdir := $(top_srcdir)/aldor/lib/libfoamlib/al From de09c449858ff8f597b64ecebcd975ee014feb4b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 19 Jan 2017 20:37:33 +0000 Subject: [PATCH 047/352] unitools: Make clean should remove copied sources. --- aldor/aldor/subcmd/unitools/Makefile.am | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/aldor/subcmd/unitools/Makefile.am b/aldor/aldor/subcmd/unitools/Makefile.am index da4ac66ce..ac14ae9f7 100644 --- a/aldor/aldor/subcmd/unitools/Makefile.am +++ b/aldor/aldor/subcmd/unitools/Makefile.am @@ -43,3 +43,5 @@ unicl_CFLAGS = -I $s $(AM_CFLAGS) noinst_PROGRAMS = platform platform_CFLAGS = -I $s $(AM_CFLAGS) + +CLEANFILES=$(libport_a_SOURCES) From 727464650ef6d047bc1d6dcf57787c46f15975b0 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 20 Jan 2017 19:42:01 +0000 Subject: [PATCH 048/352] configure.ac: Don't warn on left shift of negative value. Gcc works that way, and we'll know pretty quick if it changes. --- aldor/m4/strict_compile.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/m4/strict_compile.m4 b/aldor/m4/strict_compile.m4 index 3592461dc..2b6c55119 100644 --- a/aldor/m4/strict_compile.m4 +++ b/aldor/m4/strict_compile.m4 @@ -8,7 +8,7 @@ AC_DEFUN([ALDOR_CC_OPTION], AC_DEFUN([ALDOR_STRICT_COMPILE], - [ALDOR_CC_OPTION(-Wno-error=shift-negative-value,cfg_no_shift_negative_value) + [ALDOR_CC_OPTION(-Wno-shift-negative-value,cfg_no_shift_negative_value) ALDOR_CC_OPTION(-Wno-sign-compare,cfg_no_sign_compare) AC_MSG_CHECKING(Strict options for C compiler) From 485187062ea4ca3e2d00238913b193c330bb668a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 13 Jan 2017 21:47:43 +0000 Subject: [PATCH 049/352] Generate .asy files by default --- aldor/lib/buildlib.mk | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index 338fd4e76..9867d6c86 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -97,6 +97,7 @@ aldor_args = $(aldor_common_args) \ -l$(Libraryname)Lib=$(libraryname)_$* \ -DBuild$(Libraryname)Lib \ $(AXLFLAGS) $($*_AXLFLAGS) \ + -Fasy=$*.asy \ -Fao=$*.ao \ $(filter %$*.as,$^) \ $(filter %$*.ax,$^) @@ -321,6 +322,7 @@ mostlyclean: rm -f *.java rm -f *.class rm -f *.exe + rm -f *.asy clean: mostlyclean rm -f $(SUBLIB).al From 87e657be69c40930065b4dfb93704acdb6ef4261 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 13 Jan 2017 21:49:03 +0000 Subject: [PATCH 050/352] aldor/test: Enable DBG=1 --- aldor/aldor/test/Makefile.in | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 693aa3c28..d7822bec6 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -21,6 +21,9 @@ Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ ;; \ esac; +AM_DBG := $(if $(filter 1,$(DBG)), gdb --args, $(DBG)) +AM_DBG_J := $(if $(filter 1,$(DBG_J)), gdb --args, $(DBG_J)) + aldorsrcdir = $(abs_top_srcdir)/aldor/src aldorexedir = $(abs_top_builddir)/aldor/src aldortooldir = $(abs_top_builddir)/aldor/subcmd/unitools @@ -77,7 +80,7 @@ $(patsubst %, out/c/%.c, $(_ctests)): out/c/%.c: out/ao/%.ao $(patsubst %, out/java/%.java, $(_jtests)): $(aldorexedir)/javagen $(patsubst %, out/java/%.java, $(_jtests)): out/java/%.java: out/fm/%.fm mkdir -p $$(dirname $@) - $(DBG_J) $(aldorexedir)/aldor $(nfile) \ + $(AM_DBG_J) $(aldorexedir)/aldor $(nfile) \ $(if $(filter $(_jruntests), $*), -Jmain,) \ -Fjava=$(builddir)/$@ $< @@ -97,7 +100,7 @@ $(patsubst %, %.o, $(_otests)): %.o: out/ao/%.ao $(patsubst %, out/ap/%.ap, $(_aptests)): out/ap/%.ap: $(srcdir)/%.as mkdir -p $$(dirname $@) - $(aldorexedir)/aldor $(nfile) -I$(foamsrclibdir)/al \ + $(AM_DBG) $(aldorexedir)/aldor $(nfile) -I$(foamsrclibdir)/al \ -Fap=$(builddir)/$@ $< define aldor_args @@ -116,7 +119,7 @@ $(patsubst %, out/ap/%.ap, $(_aotests)): out/ap/%.ap: %.as $(patsubst %, out/ao/%.ao, $(_aotests)): out/ao/%.ao: %.as mkdir -p $$(dirname $@) - $(DBG) $(aldorexedir)/aldor $($*_opts) $(aldor_args) + $(AM_DBG) $(aldorexedir)/aldor $($*_opts) $(aldor_args) $(patsubst %, out/ao/%.cmd, $(_aotests)): out/ao/%.cmd: %.as mkdir -p $$(dirname $@) @@ -124,7 +127,7 @@ $(patsubst %, out/ao/%.cmd, $(_aotests)): out/ao/%.cmd: %.as $(patsubst %, %.exe, $(_xtests)): %.exe: %.o rtexns.o rm -f $@ - $(DBG) $(aldorexedir)/aldor $(nfile) \ + $(AM_DBG) $(aldorexedir)/aldor $(nfile) \ -Ccc=$(aldortooldir)/unicl \ -Y$(foamdir) \ -Y$(foamlibdir) \ From d5ea5279cc7c05b71d4c2932708f456a55ba2ebf Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 24 Aug 2015 11:47:46 +0100 Subject: [PATCH 051/352] aldor/test: Makefile.in: Use _ versions of variables throughout, always generate .fm if other codegen is required. --- aldor/aldor/test/Makefile.in | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index d7822bec6..4915e66ab 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -62,7 +62,7 @@ _ctests := $(sort $(ctests) $(otests)) _jruntests := $(sort $(jruntests)) _jtests := $(sort $(jtests) $(_jruntests)) _xtests := $(sort $(xtests)) -_fmtests := $(sort $(fmtests) $(_jtests)) +_fmtests := $(sort $(fmtests) $(_jtests) $(_ctests)) _otests := $(sort $(otests) $(x_extra)) _ctests := $(sort $(ctests) $(_otests)) _aotests := $(sort $(_fmtests) $(_ctests) $(_xtests)) @@ -137,10 +137,10 @@ $(patsubst %, %.exe, $(_xtests)): %.exe: %.o rtexns.o # -Fmain=bobthebuilder.c \ -$(patsubst %, %-javatest,$(jruntests)): %-javatest: out/java/%.class +$(patsubst %, %-javatest,$(_jruntests)): %-javatest: out/java/%.class java -cp out/java:$(abs_top_builddir)/aldor/lib/java/src/foamj.jar:$(abs_top_builddir)/aldor/lib/libfoam/al/foam.jar:$(abs_top_builddir)/aldor/lib/libfoamlib/al/foamlib.jar: $* -check-java: $(patsubst %,%-javatest,$(jruntests)) +check-java: $(patsubst %,%-javatest,$(_jruntests)) .PHONY: check-java @@ -149,13 +149,13 @@ check: check-java really-all: \ $(patsubst %,out/ap/%.ap,$(_aptests)) \ $(patsubst %,out/ao/%.cmd,$(_aotests)) \ - $(patsubst %,out/fm/%.fm,$(fmtests)) \ - $(patsubst %,out/c/%.c,$(ctests)) \ - $(patsubst %,out/java/%.java,$(jtests)) \ - $(patsubst %,out/java/%.class,$(jtests)) \ - $(patsubst %,out/java/%.class,$(jruntests)) \ - $(patsubst %,%.o,$(otests)) \ - $(patsubst %,%.exe,$(xtests)) + $(patsubst %,out/fm/%.fm,$(_fmtests)) \ + $(patsubst %,out/c/%.c,$(_ctests)) \ + $(patsubst %,out/java/%.java,$(_jtests)) \ + $(patsubst %,out/java/%.class,$(_jtests)) \ + $(patsubst %,out/java/%.class,$(_jruntests)) \ + $(patsubst %,%.o,$(_otests)) \ + $(patsubst %,%.exe,$(_xtests)) .PHONY: all From 2053c937c402850991622c8b81c535973726779b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 20 Jan 2017 20:22:24 +0000 Subject: [PATCH 052/352] aldor/test: Add verbosity switches to most steps. --- aldor/aldor/test/Makefile.in | 74 +++++++++++++++++++++++++++++++----- 1 file changed, 64 insertions(+), 10 deletions(-) diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 4915e66ab..97c310d36 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -1,6 +1,9 @@ # ..From autoconf @SET_MAKE@ +# For AM_V_* +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ + VPATH = @srcdir@ abs_top_builddir = @abs_top_builddir@ srcdir = @srcdir@ @@ -9,6 +12,46 @@ builddir = @builddir@ abs_top_srcdir = @abs_top_srcdir@ subdir = aldor/test +AM_V_ALDOR = $(am__v_ALDOR_$(V)) +am__v_ALDOR_ = $(am__v_ALDOR_$(AM_DEFAULT_VERBOSITY)) +am__v_ALDOR_0 = @echo " ALDOR " $@; + +AM_V_ALDOR_AP = $(am__v_ALDOR_AP_$(V)) +am__v_ALDOR_AP_ = $(am__v_ALDOR_AP_$(AM_DEFAULT_VERBOSITY)) +am__v_ALDOR_AP_0 = @echo " ALDOR-AP " $@; + +AM_V_ALDOR_EXE = $(am__v_ALDOR_EXE_$(V)) +am__v_ALDOR_EXE_ = $(am__v_ALDOR_EXE_$(AM_DEFAULT_VERBOSITY)) +am__v_ALDOR_EXE_0 = @echo " ALDOR-EXE " $@; + +AM_V_ALDOR_OBJ = $(am__v_ALDOR_OBJ_$(V)) +am__v_ALDOR_OBJ_ = $(am__v_ALDOR_OBJ_$(AM_DEFAULT_VERBOSITY)) +am__v_ALDOR_OBJ_0 = @echo " ALDOR-OBJ " $@; + +AM_V_ALDOR_GENC = $(am__v_ALDOR_GENC_$(V)) +am__v_ALDOR_GENC_ = $(am__v_ALDOR_GENC_$(AM_DEFAULT_VERBOSITY)) +am__v_ALDOR_GENC_0 = @echo " ALDOR-GENC " $@; + +AM_V_ALDOR_FM = $(am__v_ALDOR_FM_$(V)) +am__v_ALDOR_FM_ = $(am__v_ALDOR_GENC_$(AM_DEFAULT_VERBOSITY)) +am__v_ALDOR_FM_0 = @echo " ALDOR-FM " $@; + +AM_V_ALDOR_CMD = $(am__v_ALDOR_CMD_$(V)) +am__v_ALDOR_CMD_ = $(am__v_ALDOR_CMD_$(AM_DEFAULT_VERBOSITY)) +am__v_ALDOR_CMD_0 = @echo " ALDOR-CMD " $@; + +AM_V_ALDOR_JAVA = $(am__v_ALDOR_JAVA_$(V)) +am__v_ALDOR_JAVA_ = $(am__v_ALDOR_JAVA_$(AM_DEFAULT_VERBOSITY)) +am__v_ALDOR_JAVA_0 = @echo " ALDOR-JAVA " $@; + +AM_V_JAVAC = $(am__v_JAVAC_$(V)) +am__v_JAVAC_ = $(am__v_JAVAC_$(AM_DEFAULT_VERBOSITY)) +am__v_JAVAC_0 = @echo " JAVAC " $@; + +AM_V_ALDOR_JAVATEST = $(am__v_ALDOR_JAVATEST_$(V)) +am__v_ALDOR_JAVATEST = $(am__v_ALDOR_JAVATEST_$(AM_DEFAULT_VERBOSITY)) +am__v_ALDOR_JAVATEST_0 = @echo " ALDOR-JAVATEST " $@; + all: really-all .PRECIOUS: Makefile @@ -70,16 +113,19 @@ _aotests := $(sort $(_fmtests) $(_ctests) $(_xtests)) nfile := -Nfile=$(aldorsrcdir)/aldor.conf $(patsubst %, out/fm/%.fm, $(_fmtests)): out/fm/%.fm: out/ao/%.ao - mkdir -p $$(dirname $@) + $(AM_V_ALDOR_FM) \ + mkdir -p $$(dirname $@); \ $(aldorexedir)/aldor $(nfile) -Ffm=$(builddir)/$@ $< $(patsubst %, out/c/%.c, $(_ctests)): out/c/%.c: out/ao/%.ao - mkdir -p $$(dirname $@) + $(AM_V_ALDOR_GENC) \ + mkdir -p $$(dirname $@); \ $(aldorexedir)/aldor $(nfile) -Fc=$(builddir)/$@ $< $(patsubst %, out/java/%.java, $(_jtests)): $(aldorexedir)/javagen $(patsubst %, out/java/%.java, $(_jtests)): out/java/%.java: out/fm/%.fm - mkdir -p $$(dirname $@) + $(AM_V_ALDOR_JAVA) \ + mkdir -p $$(dirname $@); \ $(AM_DBG_J) $(aldorexedir)/aldor $(nfile) \ $(if $(filter $(_jruntests), $*), -Jmain,) \ -Fjava=$(builddir)/$@ $< @@ -87,19 +133,22 @@ $(patsubst %, out/java/%.java, $(_jtests)): out/java/%.java: out/fm/%.fm javaopts=-cp $(abs_top_builddir)/aldor/lib/java/src/foamj.jar $(patsubst %, out/java/%.class, $(_jtests)): out/java/%.class: out/java/%.java + $(AM_V_JAVAC) \ (cd $(builddir)/out/java; javac $(javaopts) $*.java) # Create .o files locally as unicl creates files in the # current directory... $(patsubst %, %.o, $(_otests)): %.o: out/ao/%.ao - mkdir -p $$(dirname $@) + $(AM_V_ALDOR_OBJ) \ + mkdir -p $$(dirname $@); \ $(aldorexedir)/aldor $(nfile) \ -Ccc=$(aldortooldir)/unicl \ -Cargs="-Wconfig=$(aldorsrcdir)/aldor.conf $(UNICLFLAGS) -I$(aldorsrcdir)" \ -Fo=$(builddir)/$@ $< $(patsubst %, out/ap/%.ap, $(_aptests)): out/ap/%.ap: $(srcdir)/%.as - mkdir -p $$(dirname $@) + $(AM_V_ALDOR_AP) \ + mkdir -p $$(dirname $@); \ $(AM_DBG) $(aldorexedir)/aldor $(nfile) -I$(foamsrclibdir)/al \ -Fap=$(builddir)/$@ $< @@ -114,20 +163,24 @@ define aldor_args endef $(patsubst %, out/ap/%.ap, $(_aotests)): out/ap/%.ap: %.as - mkdir -p $$(dirname $@) + $(AM_V_ALDOR_AP) \ + mkdir -p $$(dirname $@); \ $(aldorexedir)/aldor $(nfile) -Fap=$@ $(srcdir)/$*.as $(patsubst %, out/ao/%.ao, $(_aotests)): out/ao/%.ao: %.as - mkdir -p $$(dirname $@) + $(AM_V_ALDOR) \ + mkdir -p $$(dirname $@); \ $(AM_DBG) $(aldorexedir)/aldor $($*_opts) $(aldor_args) $(patsubst %, out/ao/%.cmd, $(_aotests)): out/ao/%.cmd: %.as - mkdir -p $$(dirname $@) + $(AM_V_ALDOR_CMD) \ + mkdir -p $$(dirname $@); \ echo run '$(aldor_args)' > $@ $(patsubst %, %.exe, $(_xtests)): %.exe: %.o rtexns.o - rm -f $@ - $(AM_DBG) $(aldorexedir)/aldor $(nfile) \ + $(AM_V_ALDOR_EXE) \ + rm -f $@; \ + $(AM_DBG) $(aldorexedir)/aldor $(nfile) \ -Ccc=$(aldortooldir)/unicl \ -Y$(foamdir) \ -Y$(foamlibdir) \ @@ -138,6 +191,7 @@ $(patsubst %, %.exe, $(_xtests)): %.exe: %.o rtexns.o # -Fmain=bobthebuilder.c \ $(patsubst %, %-javatest,$(_jruntests)): %-javatest: out/java/%.class + $(AM_V_ALDOR_JAVATEST) \ java -cp out/java:$(abs_top_builddir)/aldor/lib/java/src/foamj.jar:$(abs_top_builddir)/aldor/lib/libfoam/al/foam.jar:$(abs_top_builddir)/aldor/lib/libfoamlib/al/foamlib.jar: $* check-java: $(patsubst %,%-javatest,$(_jruntests)) From a8e0dd68496c039e680a2cf23b376f2c24cc3c73 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 5 Aug 2016 20:21:22 +0100 Subject: [PATCH 053/352] Build: Remove LDFLAGS and add per test directory LDADD in makefiles. LDFLAGS doesn't work as its arguments come before the thing being built. --- aldor/lib/aldor/test/Tests.am | 1 + aldor/lib/algebra/test/Tests.am | 1 + aldor/lib/axldem/test/Tests.am | 1 + aldor/lib/axllib/test/Tests.am | 1 + aldor/lib/testprog.am | 3 ++- 5 files changed, 6 insertions(+), 1 deletion(-) diff --git a/aldor/lib/aldor/test/Tests.am b/aldor/lib/aldor/test/Tests.am index c206ef7c6..a215b68a3 100644 --- a/aldor/lib/aldor/test/Tests.am +++ b/aldor/lib/aldor/test/Tests.am @@ -1,3 +1,4 @@ +LDADD= /home/pab/Work/aldorgit/build/lib/aldor/src/libaldor.a /home/pab/Work/aldorgit/build/aldor/lib/libfoam/libfoam.a /home/pab/Work/aldorgit/build/aldor/lib/libfoamlib/libfoamlib.a -lm check_PROGRAMS += bug1332/bug1332 bug1332_bug1332_SOURCES = bug1332/bug1332-aldormain.c bug1332/bug1332.c CLEANFILES += bug1332/bug1332-aldormain.c bug1332/bug1332.c bug1332/bug1332.ao diff --git a/aldor/lib/algebra/test/Tests.am b/aldor/lib/algebra/test/Tests.am index 9e96fde10..2379f6333 100644 --- a/aldor/lib/algebra/test/Tests.am +++ b/aldor/lib/algebra/test/Tests.am @@ -1,3 +1,4 @@ +LDADD= /home/pab/Work/aldorgit/build/lib/algebra/src/libalgebra.a /home/pab/Work/aldorgit/build/lib/aldor/src/libaldor.a /home/pab/Work/aldorgit/build/aldor/lib/libfoam/libfoam.a /home/pab/Work/aldorgit/build/aldor/lib/libfoamlib/libfoamlib.a -lm check_PROGRAMS += Trandom/Trandom Trandom_Trandom_SOURCES = Trandom/Trandom-aldormain.c Trandom/Trandom.c CLEANFILES += Trandom/Trandom-aldormain.c Trandom/Trandom.c Trandom/Trandom.ao diff --git a/aldor/lib/axldem/test/Tests.am b/aldor/lib/axldem/test/Tests.am index 85733a338..bd8c491a3 100644 --- a/aldor/lib/axldem/test/Tests.am +++ b/aldor/lib/axldem/test/Tests.am @@ -1,3 +1,4 @@ +LDADD= /home/pab/Work/aldorgit/build/lib/axldem/src/libaxldem.a /home/pab/Work/aldorgit/build/lib/axllib/src/libaxllib.a /home/pab/Work/aldorgit/build/aldor/lib/libfoam/libfoam.a /home/pab/Work/aldorgit/build/aldor/lib/libfoamlib/libfoamlib.a -lm check_PROGRAMS += bug1089/bug1089 bug1089_bug1089_SOURCES = bug1089/bug1089-aldormain.c bug1089/bug1089.c CLEANFILES += bug1089/bug1089-aldormain.c bug1089/bug1089.c bug1089/bug1089.ao diff --git a/aldor/lib/axllib/test/Tests.am b/aldor/lib/axllib/test/Tests.am index e472633fc..8d68c4896 100644 --- a/aldor/lib/axllib/test/Tests.am +++ b/aldor/lib/axllib/test/Tests.am @@ -1,3 +1,4 @@ +LDADD= /home/pab/Work/aldorgit/build/lib/axllib/src/libaxllib.a /home/pab/Work/aldorgit/build/aldor/lib/libfoam/libfoam.a /home/pab/Work/aldorgit/build/aldor/lib/libfoamlib/libfoamlib.a -lm check_PROGRAMS += 1test/1test 1test_1test_SOURCES = 1test/1test-aldormain.c 1test/1test.c CLEANFILES += 1test/1test-aldormain.c 1test/1test.c 1test/1test.ao diff --git a/aldor/lib/testprog.am b/aldor/lib/testprog.am index edd5e1812..ffbc18c09 100644 --- a/aldor/lib/testprog.am +++ b/aldor/lib/testprog.am @@ -48,7 +48,9 @@ TESTS = $(check_PROGRAMS) include Tests.am $(srcdir)/Tests.am: $(srcdir)/Makefile.am $(abs_top_srcdir)/lib/testprog.am + echo $(libraries) $(foreach i,$(libraries), $(abs_top_builddir)/lib/src/$(i)/lib$(i).a) truncate -s0 $@ + echo "LDADD=$(foreach i,$(libraries), $(abs_top_builddir)/lib/$(i)/src/lib$(i).a) $(abs_top_builddir)/aldor/lib/libfoam/libfoam.a $(abs_top_builddir)/aldor/lib/libfoamlib/libfoamlib.a -lm" >> $@ for test in $(AXLTESTS); do \ ctest=`echo $$test | sed -e 's/-/_/g'`; \ echo "check_PROGRAMS += $$test/$$test" >> $@; \ @@ -57,4 +59,3 @@ $(srcdir)/Tests.am: $(srcdir)/Makefile.am $(abs_top_srcdir)/lib/testprog.am done AM_CPPFLAGS = -I$(aldorsrcdir) -AM_LDFLAGS = -L$(foamlibdir) $(addprefix -L,$(librarylibdirs)) $(addprefix -l,$(libraries)) -lfoam -lm From 962b438b4bdd723f4ca3706e135b2f9bebceb737 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 11 Jan 2017 08:24:33 +0000 Subject: [PATCH 054/352] buildlib.c: Move AXLFLAGS into common args --- aldor/lib/buildlib.mk | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index 9867d6c86..d50c10c53 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -78,7 +78,7 @@ Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status aldor_common_args := \ -Nfile=$(aldorsrcdir)/aldor.conf \ -Mno-ALDOR_W_WillObsolete \ - -Wcheck -Waudit + -Wcheck -Waudit $(AXLFLAGS) AM_DBG := $(if $(filter 1,$(DBG)), gdb --args, $(DBG)) $(addsuffix .c, $(library)): %.c: %.ao %.dep @@ -96,7 +96,7 @@ aldor_args = $(aldor_common_args) \ -I$(libraryincdir) \ -l$(Libraryname)Lib=$(libraryname)_$* \ -DBuild$(Libraryname)Lib \ - $(AXLFLAGS) $($*_AXLFLAGS) \ + $($*_AXLFLAGS) \ -Fasy=$*.asy \ -Fao=$*.ao \ $(filter %$*.as,$^) \ @@ -152,7 +152,7 @@ $(addsuffix .gloop, $(alldomains)): %.gloop: -I$(libraryincdir) \ -l$(Libraryname)Lib=$(libraryname)_$* \ -DBuild$(Libraryname)Lib \ - $(AXLFLAGS) $($*_AXLFLAGS) \ + $($*_AXLFLAGS) \ .PHONY: help help: From f55c673f91f9536c209fbab9956c2b61d47d09f4 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 25 Jan 2017 20:49:42 +0000 Subject: [PATCH 055/352] foam.c: Small fix for type checking Env format 0 is used as "there but not touched" in a few places. --- aldor/aldor/src/foam.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/foam.c b/aldor/aldor/src/foam.c index f2019d99a..e46a191da 100644 --- a/aldor/aldor/src/foam.c +++ b/aldor/aldor/src/foam.c @@ -1373,7 +1373,8 @@ faTypeCheckingFmtIsEnv(Foam foam, AInt format) return true; if (faFormatsv[format]->foamDDecl.usage != FOAM_DDecl_LocalEnv && - faFormatsv[format]->foamDDecl.usage != FOAM_DDecl_NonLocalEnv) { + faFormatsv[format]->foamDDecl.usage != FOAM_DDecl_NonLocalEnv && + format != envUsedSlot) { faTypeCheckingFailure(foam, "NOT environment format used in environment context"); return false; From 0ccfe54d916f02e5e01cfafd618d814d88831a63 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 13 Dec 2014 22:18:15 +0000 Subject: [PATCH 056/352] sefo.c: sefoEqualMods: set changed to false if no progress made. Not quite sure how one can get to this point, but best to avoid getting stuck. --- aldor/aldor/src/sefo.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/aldor/src/sefo.c b/aldor/aldor/src/sefo.c index dad8538d1..70bd9eb1a 100644 --- a/aldor/aldor/src/sefo.c +++ b/aldor/aldor/src/sefo.c @@ -2158,6 +2158,8 @@ sefoEqualMods(Sefo sefo) case AB_Test: { if (tfEqual(abTUnique(sefo), tfBoolean)) sefo = sefo->abTest.cond; + else + changed = false; break; } From 25d3d18b91f8a3d7b4b9dd99a49f6817265620c3 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 13 Dec 2014 22:19:29 +0000 Subject: [PATCH 057/352] types: tiBupIf/tiTfnIf: If we can't get a sensible meaning for the test, don't extend abCondKnown, as it won't help. --- aldor/aldor/src/ti_bup.c | 19 ++++++++++++------- aldor/aldor/src/ti_tdn.c | 19 +++++++++++++------ 2 files changed, 25 insertions(+), 13 deletions(-) diff --git a/aldor/aldor/src/ti_bup.c b/aldor/aldor/src/ti_bup.c index 9c3b447dd..f037f9907 100644 --- a/aldor/aldor/src/ti_bup.c +++ b/aldor/aldor/src/ti_bup.c @@ -2269,15 +2269,20 @@ tibupIf(Stab stab, AbSyn absyn, TForm type) */ nTest = abExpandDefs(stab, test); + if (abIsSefo(nTest)) { + ablogAndPush(&abCondKnown, &saveCond, nTest, true); /* test, true); */ + tibup(stab, thenAlt, type); + ablogAndPop (&abCondKnown, &saveCond); + ablogAndPush(&abCondKnown, &saveCond, nTest, false); /* test, false); */ + tibup(stab, elseAlt, abIsNothing(elseAlt) ? tfUnknown : type); + ablogAndPop (&abCondKnown, &saveCond); + } + else { + tibup(stab, thenAlt, type); + tibup(stab, elseAlt, abIsNothing(elseAlt) ? tfUnknown : type); + } /* Analyze the branches in the presence of the condition. */ - ablogAndPush(&abCondKnown, &saveCond, nTest, true); /* test, true); */ - tibup(stab, thenAlt, type); - ablogAndPop (&abCondKnown, &saveCond); - - ablogAndPush(&abCondKnown, &saveCond, nTest, false); /* test, false); */ - tibup(stab, elseAlt, abIsNothing(elseAlt) ? tfUnknown : type); - ablogAndPop (&abCondKnown, &saveCond); /* No value required. */ if (abUse(absyn) == AB_Use_NoValue) diff --git a/aldor/aldor/src/ti_tdn.c b/aldor/aldor/src/ti_tdn.c index 91f3346f5..f5f098f85 100644 --- a/aldor/aldor/src/ti_tdn.c +++ b/aldor/aldor/src/ti_tdn.c @@ -23,6 +23,7 @@ #include "ablogic.h" #include "abpretty.h" #include "comsg.h" +#include "sefo.h" /* * To do: @@ -1484,13 +1485,19 @@ titdnIf(Stab stab, AbSyn absyn, TForm type) else /* Normalise the test for other contexts */ nTest = abExpandDefs(stab, test); - ablogAndPush(&abCondKnown, &saveCond, nTest, true); /* test, true); */ - titdn(stab, thenAlt, type); - ablogAndPop (&abCondKnown, &saveCond); + if (abIsSefo(nTest)) { + ablogAndPush(&abCondKnown, &saveCond, nTest, true); /* test, true); */ + titdn(stab, thenAlt, type); + ablogAndPop (&abCondKnown, &saveCond); - ablogAndPush(&abCondKnown, &saveCond, nTest, false); /* test, false); */ - titdn(stab, elseAlt, type); - ablogAndPop (&abCondKnown, &saveCond); + ablogAndPush(&abCondKnown, &saveCond, nTest, false); /* test, false); */ + titdn(stab, elseAlt, type); + ablogAndPop (&abCondKnown, &saveCond); + } + else { + titdn(stab, thenAlt, type); + titdn(stab, elseAlt, type); + } /* * We can't use tpossUnique(abtposs) here because otherwise we From 4a5ae06d9be98f12b11c232b076bd622b4338d48 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 27 Jul 2015 20:19:16 +0100 Subject: [PATCH 058/352] gf_add.c: Enum: Need to cast arrays into words before using as parameters --- 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 ba80cbaa9..a0109f131 100644 --- a/aldor/aldor/src/gf_add.c +++ b/aldor/aldor/src/gf_add.c @@ -2658,7 +2658,7 @@ gen0Enum(AbSyn absyn) for (i = 0; i < argc; i += 1) { AbSyn arg = abDefineeId(argv[i]); - elt = gen0CharArray(arg->abId.sym->str); + elt = foamNewCast(FOAM_Word, gen0CharArray(arg->abId.sym->str)); gen0AddStmt(gen0ASet(elts, (AInt) i, FOAM_Word, elt), absyn); } From 361e08198d00fae6757f771e8a610af3f3d5bf66 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 16 Jan 2017 21:53:32 +0000 Subject: [PATCH 059/352] gf_prog.c: Remove commented out code --- aldor/aldor/src/gf_prog.c | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/aldor/aldor/src/gf_prog.c b/aldor/aldor/src/gf_prog.c index 9cf9b058b..0cdb914d3 100644 --- a/aldor/aldor/src/gf_prog.c +++ b/aldor/aldor/src/gf_prog.c @@ -60,13 +60,9 @@ gen0BuildFunction(ProgType pt, String name, AbSyn expr) gen0ProgPushFormat(emptyFormatSlot); gen0IssueDCache(); -#ifdef ORIGINAL_WORKING_VERSION - /* Delete this version */ - tag = gen0Type(gen0AbType(expr), &fmt); -#else - /* This fixes a bug with embeddings */ + tag = gen0Type(gen0AbContextType(expr), &fmt); -#endif + gen0ProgFiniEmpty(foam, tag, fmt); gen0AddLexLevels(foam, 1); From 7a994782d21326153a6ce428d5b6d85e08c6f518 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 14 Jan 2017 22:07:39 +0000 Subject: [PATCH 060/352] formatters.c: Add a formatter for tconsts --- aldor/aldor/src/formatters.c | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/aldor/aldor/src/formatters.c b/aldor/aldor/src/formatters.c index 5981cd490..05fb48627 100644 --- a/aldor/aldor/src/formatters.c +++ b/aldor/aldor/src/formatters.c @@ -10,6 +10,7 @@ #include "tposs.h" #include "strops.h" #include "errorset.h" +#include "tconst.h" local int tfFormatter(OStream stream, Pointer p); local int tfListFormatter(OStream stream, Pointer p); @@ -17,6 +18,8 @@ local int tfListFormatter(OStream stream, Pointer p); local int tpossFormatter(OStream stream, Pointer p); local int fvFormatter(OStream stream, Pointer p); +local int tconstFormatter(OStream stream, Pointer p); + local int symeFormatter(OStream stream, Pointer p); local int symeListFormatter(OStream stream, Pointer p); local int symeListListFormatter(OStream stream, Pointer p); @@ -38,6 +41,7 @@ local int symbolFormatter(OStream stream, Pointer p); local int errorSetFormatter(OStream stream, Pointer p); + void fmttsInit() { @@ -47,6 +51,8 @@ fmttsInit() fmtRegister("FreeVar", fvFormatter); fmtRegister("TPoss", tpossFormatter); + fmtRegister("TConst", tconstFormatter); + fmtRegister("Syme", symeFormatter); fmtRegister("SymeList", symeListFormatter); fmtRegister("SymeListList", symeListListFormatter); @@ -192,6 +198,16 @@ errorSetFormatter(OStream ostream, Pointer p) return i; } +local int +tconstFormatter(OStream ostream, Pointer p) +{ + TConst tc = (TConst) p; + int i; + + i = ostreamPrintf(ostream, "[TC: %pTForm %pTForm]", tc->argv[0], tc->argv[1]); + + return i; +} local int tfListFormatter(OStream ostream, Pointer p) From 1ed7776c2b0f985dbaaf662f27a39a7c164f88cb Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 27 Jul 2015 20:20:03 +0100 Subject: [PATCH 061/352] terror.c: Need to ensure we have a map before asking for its return type --- aldor/aldor/src/terror.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/terror.c b/aldor/aldor/src/terror.c index 5e5bb49eb..58db88bae 100644 --- a/aldor/aldor/src/terror.c +++ b/aldor/aldor/src/terror.c @@ -1513,7 +1513,7 @@ bputBadFnType0(TRejectInfo trInfo, Buffer obuf, TForm type, String fmtOp) for ( i = 0; i < trInfo->argc && trWhy(trInfo->argv[i]) == TR_BadFnType; i++) { - TForm tfRet = tfMapRet(trType(trInfo->argv[i])); + TForm tfRet = tfMapRet(tfDefineeType(trType(trInfo->argv[i]))); tfRet = tfDefineeType(tfRet); tpossAdd1(retTypes, tfRet); } From 41d2589247e62db6a966aeaf5bd5641d688d3240 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 27 Jul 2015 20:23:51 +0100 Subject: [PATCH 062/352] ti_sef: tfType is a special case for Sefo (similar to Record/Union) --- aldor/aldor/src/tform.c | 6 ++++++ aldor/aldor/src/tform.h | 1 + aldor/aldor/src/ti_sef.c | 4 ++++ 3 files changed, 11 insertions(+) diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 4544025ad..94f9565ee 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -647,6 +647,12 @@ tf0MapRetFrPending(Stab stab, TForm tf) return tf; } +Syme +tfpIdSyme(Stab stab, Symbol sym) +{ + return tfp0IdSyme(stab, NULL, sym); +} + local Syme tfp0IdSyme(Stab stab, Syme syme, Symbol sym) { diff --git a/aldor/aldor/src/tform.h b/aldor/aldor/src/tform.h index 9789365cd..263a1bbfe 100644 --- a/aldor/aldor/src/tform.h +++ b/aldor/aldor/src/tform.h @@ -275,6 +275,7 @@ extern TForm tfMeaning (Stab, AbSyn, TForm); extern void tfSetMeaningArgs (TForm); extern Syme tfpOpSyme (Stab, Symbol, Length); +extern Syme tfpIdSyme (Stab, Symbol); /* * Type form syntax. diff --git a/aldor/aldor/src/ti_sef.c b/aldor/aldor/src/ti_sef.c index 883966e9a..a50c9a04b 100644 --- a/aldor/aldor/src/ti_sef.c +++ b/aldor/aldor/src/ti_sef.c @@ -129,6 +129,10 @@ tiCanSefo(Sefo sefo) Bool result = true; Length i; + if (abIsId(sefo) && abIdSym(sefo) == ssymType && abSyme(sefo) == NULL) { + abSetSyme(sefo, tfpIdSyme(stabFile(), abIdSym(sefo))); + } + if (abIsApply(sefo)) tisef0ApplySpecialSyme(stabFile(), sefo); From 6a6475c9356ae630f61a8fa82bac6f903ad70cd9 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 27 Jul 2015 20:25:26 +0100 Subject: [PATCH 063/352] tform.c::tfGetDomExports: Move getting domain cascades to after the point where we set exports. Things probably work better that way. --- 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 94f9565ee..a1e5669b4 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -3806,7 +3806,6 @@ tfGetDomExports(TForm tf) tfIsTrailingArray(tf) || tfIsUnion(tf)) tfSetDomExports(tf, listCopy(Syme)(tfSymes(tf))); tfGetDomSelf(tf); - tfGetDomCascades(tf); cat = tfGetCategory(tf); tfFollow(cat); @@ -3828,6 +3827,7 @@ tfGetDomExports(TForm tf) exps = tfMangleSymes(tf, cat, exps, vexps); } tfAddDomExports(tf, exps); + tfGetDomCascades(tf); } /* From df9927482ae22b735d6375bb89922f7b0e94f7e2 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 1 Oct 2014 21:18:54 +0100 Subject: [PATCH 064/352] archive.c: allow archive to be specified by path. --- aldor/aldor/src/Makefile.am | 1 + aldor/aldor/src/archive.c | 14 +++++++++++- aldor/aldor/src/test/test_archive.c | 34 +++++++++++++++++++++++++++++ aldor/aldor/src/test/testall.c | 1 + aldor/aldor/src/test/testall.h | 1 + 5 files changed, 50 insertions(+), 1 deletion(-) create mode 100644 aldor/aldor/src/test/test_archive.c diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index cdb468ae8..ec328fa3a 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -266,6 +266,7 @@ testsuite = \ test/test_ablogic.c \ test/test_abnorm.c \ test/test_absyn.c \ + test/test_archive.c \ test/test_bigint.c \ test/test_bitv.c \ test/test_errorset.c \ diff --git a/aldor/aldor/src/archive.c b/aldor/aldor/src/archive.c index 46311e4e0..cad3b3fc6 100644 --- a/aldor/aldor/src/archive.c +++ b/aldor/aldor/src/archive.c @@ -787,6 +787,15 @@ arEqual(Archive ar1, Archive ar2) return fnameEqual(ar1->name, ar2->name); } +local FileName arFileNameFrPath(String name); +local FileName +arFileNameFrPath(String name) +{ + FileName fname = fnameParse(name); + fnameSetType(fname, FTYPE_AR_INT); + return fname; +} + Archive arFrString(String name) { @@ -804,7 +813,10 @@ arFrString(String name) if ((fn = fileRdFind(libSearchPath(), name, FTYPE_AR_INT)) != 0) ar = arRead(fn); - else { + else if (fileIsOpenable((fn = arFileNameFrPath(name)), "r")) { + ar = arRead(fn); + } + else { comsgWarning(NULL, ALDOR_W_CantUseArchive, name); ar = 0; } diff --git a/aldor/aldor/src/test/test_archive.c b/aldor/aldor/src/test/test_archive.c new file mode 100644 index 000000000..f7b0d9f47 --- /dev/null +++ b/aldor/aldor/src/test/test_archive.c @@ -0,0 +1,34 @@ +#include "archive.h" +#include "testlib.h" +#include +#include +#include + +local void testArchive(void); + +void +archiveTestSuite() +{ + init(); + TEST(testArchive); + fini(); +} + +local void +testArchive() +{ + Archive ar; + FileName fname = fnameParse("arch-test/foo.al"); + int status; + status = system("mkdir arch-test"); + testIntEqual("", 0, status); + status = system("ar r arch-test/foo.al Makefile"); + testIntEqual("", 0, status); + + ar = arFrString("arch-test/foo.al"); + testIsNotNull("t0", ar); + + status = system("rm -rf arch-test"); + testIntEqual("", 0, status); +} + diff --git a/aldor/aldor/src/test/testall.c b/aldor/aldor/src/test/testall.c index df25de821..711a6d4c2 100644 --- a/aldor/aldor/src/test/testall.c +++ b/aldor/aldor/src/test/testall.c @@ -41,6 +41,7 @@ main(int argc, char *argv[]) if (testShouldRun("bitv")) bitvTestSuite(); if (testShouldRun("list")) listTestSuite(); if (testShouldRun("fname")) fnameTest(); + if (testShouldRun("archive")) archiveTestSuite(); if (testShouldRun("foam")) foamTest(); if (testShouldRun("format")) formatTest(); if (testShouldRun("flog")) flogTest(); diff --git a/aldor/aldor/src/test/testall.h b/aldor/aldor/src/test/testall.h index 7d15d53fe..1fe4e27ea 100644 --- a/aldor/aldor/src/test/testall.h +++ b/aldor/aldor/src/test/testall.h @@ -5,6 +5,7 @@ void abcheckTest(void); void ablogTest(void); void abnormTest(void); void absynTest(void); +void archiveTestSuite(void); void bigintTestSuite(void); void bintTestSuite(void); void bitvTestSuite(void); From 2070b6d73b2aceb4baf5266422b468e3f6f4e851 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 5 Dec 2014 17:10:58 +0000 Subject: [PATCH 065/352] syme.c: Add srcpos attribute to indicate where in a file the symbol is created. --- aldor/aldor/src/scobind.c | 1 + aldor/aldor/src/syme.c | 12 +++++++++++- aldor/aldor/src/syme.h | 3 +++ aldor/aldor/src/tform.c | 2 ++ aldor/aldor/src/ti_bup.c | 1 + aldor/aldor/src/ti_sef.c | 1 + 6 files changed, 19 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/scobind.c b/aldor/aldor/src/scobind.c index b3141c89e..854eed184 100644 --- a/aldor/aldor/src/scobind.c +++ b/aldor/aldor/src/scobind.c @@ -3551,6 +3551,7 @@ scobindAddMeaning(AbSyn ab, Symbol sym, Stab stab, SymeTag kind, if (scobindNeedsMeaning(ab, tf)) { Syme syme = scobindDefMeaning(stab,kind,sym,tf,data); scobindSetMeaning(ab, syme); + symeSetSrcPos(syme, abPos(ab)); } } diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c index 16fe356ee..89b820510 100644 --- a/aldor/aldor/src/syme.c +++ b/aldor/aldor/src/syme.c @@ -654,7 +654,7 @@ symeTransferImplInfo(Syme to, Syme from) /* If no const info, then why bother? */ symeSetConstInfo(to, symeConstInfo(from)); symeSetConstLib(to, symeConstLib(from)); - + symeSetSrcPos(to, symeSrcPos(from)); symeDEBUG(dbOut, "Transfer: %d %d %d [%pSyme --> %pSyme]\n", symeHashNum(from), symeDefnNum(from), symeConstNum(from), from, to); @@ -1599,6 +1599,15 @@ symeSExprAList(Syme syme) al = sxiACons("condition", sxi, al); } + /* 8. Position */ + if (symeSrcPos(syme) != sposNone) { + al = sxiACons("srcpos", sxiFrInteger(sposLine(symeSrcPos(syme))), al); + } + + if (symeConstNum(syme) != -1) { + al = sxiACons("constNum", sxiFrInteger(sposLine(symeConstNum(syme))), al); + } + return sxNReverse(al); } @@ -1854,4 +1863,5 @@ struct symeFieldInfo symeFieldInfo[] = { { SYFI_ExtraBits, "extraBits", (AInt) (int) 0 }, { SYFI_ConditionContext,"conditionContext",(AInt) (AbSyn) NULL }, { SYFI_DefinitionConditions,"definedConditions",(AInt) listNil(AbSyn) }, + { SYFI_SrcPos,"srcpos",(SrcPos) listNil(AbSyn) }, }; diff --git a/aldor/aldor/src/syme.h b/aldor/aldor/src/syme.h index 28bb0cf26..f13403a88 100644 --- a/aldor/aldor/src/syme.h +++ b/aldor/aldor/src/syme.h @@ -103,6 +103,7 @@ enum symeField { SYFI_ExtraBits, /* More syme bits */ SYFI_ConditionContext, /* Context in which to infer condition */ SYFI_DefinitionConditions, /* Contexts in which this symbol is defined */ + SYFI_SrcPos, SYME_FIELD_LIMIT }; @@ -343,6 +344,7 @@ extern Lib symeConstLib (Syme); #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 symeSrcPos(s) ((SrcPos) symeGetField (s, SYFI_SrcPos)) #define symeIsLabel(s) (symeKind(s) == SYME_Label) #define symeIsParam(s) (symeKind(s) == SYME_Param) @@ -447,6 +449,7 @@ extern void symeSetCondition(Syme syme, SefoList sefoList); #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 symeSetSrcPos(s, v) symeSetField (s, SYFI_SrcPos, v) #define symeSetBit(s,b) (symeBits(s) |= (b)) #define symeClrBit(s,b) (symeBits(s) &= ~(b)) diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index a1e5669b4..e36fe74c9 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -3091,6 +3091,7 @@ abGetCatParents(Sefo sefo) if (symeEqual(car(symes), dsyme)) { xsyme = car(symes); symeSetDefault(xsyme); + symeSetSrcPos(xsyme, symeSrcPos(dsyme)); } /* If the default is inherited, use the default syme. */ @@ -4315,6 +4316,7 @@ tfGetCatImportsFrWith(Sefo sefo, SymeList bsymes) if (symeEqual(car(symes), dsyme)) { xsyme = car(symes); symeSetDefault(xsyme); + symeSetSrcPos(xsyme, symeSrcPos(dsyme)); } /* If the default is inherited, use the default syme. */ diff --git a/aldor/aldor/src/ti_bup.c b/aldor/aldor/src/ti_bup.c index f037f9907..d5a53088c 100644 --- a/aldor/aldor/src/ti_bup.c +++ b/aldor/aldor/src/ti_bup.c @@ -430,6 +430,7 @@ tibup0Within(Stab stab, AbSyn absyn, SymeList bsymes, Bool doDefault) if (symeEqual(car(symes), dsyme)) { xsyme = car(symes); symeSetDefault(xsyme); + symeSetSrcPos(xsyme, symeSrcPos(dsyme)); } /* If the default is inherited, use the default syme. */ diff --git a/aldor/aldor/src/ti_sef.c b/aldor/aldor/src/ti_sef.c index a50c9a04b..68da09864 100644 --- a/aldor/aldor/src/ti_sef.c +++ b/aldor/aldor/src/ti_sef.c @@ -329,6 +329,7 @@ tisef0Within(Stab stab, Sefo sefo, SymeList bsymes) if (symeEqual(car(symes), dsyme)) { xsyme = car(symes); symeSetDefault(xsyme); + symeSetSrcPos(xsyme, symeSrcPos(dsyme)); } /* If the default is inherited, use the default syme. */ From fff85c8621c533dd0e90c105b174137e4e8518a9 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 13 Jan 2017 21:51:01 +0000 Subject: [PATCH 066/352] Add a small test class (mostly for srcpos stuff) to test library. --- aldor/aldor/test/Makefile.in | 4 ++-- aldor/aldor/test/simple.as | 16 ++++++++++++++++ 2 files changed, 18 insertions(+), 2 deletions(-) create mode 100644 aldor/aldor/test/simple.as diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 97c310d36..0208daaf6 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -76,7 +76,7 @@ foamsrcdir = $(abs_top_srcdir)/aldor/lib/libfoam foamdir = $(abs_top_builddir)/aldor/lib/libfoam aptests := exquo -fmtests := rectest enumtest clos strtable1 +fmtests := rectest enumtest clos strtable1 simple ctests := rectest enumtest otests := enumtest xtests := enumtest @@ -96,8 +96,8 @@ jimport_opts := -Q3 opt1_AXLFLAGS=-Y$(foamdir)/al -I $(foamsrcdir)/al -lRuntimeLib=foam -Q9 strtable1_AXLFLAGS=-Y$(foamdir)/al -I $(foamsrcdir)/al -lRuntimeLib=foam -Q9 - clos_AXLFLAGS := -Q2 +simple_AXLFLAGS=-O _aptests := $(sort $(aptests)) _ctests := $(sort $(ctests) $(otests)) diff --git a/aldor/aldor/test/simple.as b/aldor/aldor/test/simple.as new file mode 100644 index 000000000..5769a802b --- /dev/null +++ b/aldor/aldor/test/simple.as @@ -0,0 +1,16 @@ +#include "foamlib" + +SimpleInt: with { + +: (%, %) -> %; +} == add { + (a: %) + (b: %): % == a; +} + +define SimpleGroup: Category == with { + +: (%, %) -> %; + -: % -> %; + -: (%, %) -> %; + default { + (a: %) - (b: %): % == a + (-b); + } +} \ No newline at end of file From 887e94b8fd39f4b57ec4e50a817d2dae18c6bc1e Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 20 Oct 2015 21:20:51 +0100 Subject: [PATCH 067/352] ti_tdn.c: Remove an unused variable. --- aldor/aldor/src/ti_tdn.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/aldor/aldor/src/ti_tdn.c b/aldor/aldor/src/ti_tdn.c index f5f098f85..ace7b65de 100644 --- a/aldor/aldor/src/ti_tdn.c +++ b/aldor/aldor/src/ti_tdn.c @@ -384,7 +384,7 @@ titdn0ApplyFType(Stab stab, AbSyn absyn, TForm type, AbSyn op, SatMask mask = tfSatBupMask(); Length nopc, popc, parmc; TForm nopt, popt, opType; - TPoss opTypes, nopTypes, fopTypes; + TPoss opTypes, nopTypes; TPossIterator it; Bool result; @@ -395,7 +395,6 @@ titdn0ApplyFType(Stab stab, AbSyn absyn, TForm type, AbSyn op, opTypes = abReferTPoss(op); /* Original list of possible types */ nopTypes = tpossEmpty(); /* Possible (non-pending) types */ - fopTypes = tpossEmpty(); /* Possible unconditional types */ nopc = 0; /* Number of non-pending matches */ popc = 0; /* Number of all possible matches */ nopt = tfUnknown; /* Non-pending op type */ From d8cb70266dcdc1f4f5280cfa637e0cb5a33b2a15 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 20 Oct 2015 21:37:31 +0100 Subject: [PATCH 068/352] tposs.c: Add a function for testing if a given tposs contains a non-map --- aldor/aldor/src/Makefile.am | 3 ++- aldor/aldor/src/test/test_tposs.c | 34 +++++++++++++++++++++++++++++++ aldor/aldor/src/test/testall.c | 1 + aldor/aldor/src/test/testall.h | 1 + aldor/aldor/src/tposs.c | 17 ++++++++++++++++ aldor/aldor/src/tposs.h | 5 +++++ 6 files changed, 60 insertions(+), 1 deletion(-) create mode 100644 aldor/aldor/src/test/test_tposs.c diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index ec328fa3a..fb984a4f7 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -290,7 +290,8 @@ testsuite = \ test/test_tform.c \ test/test_tibup.c \ test/test_tfsat.c \ - test/test_tinfer.c + test/test_tinfer.c \ + test/test_tposs.c testall_SOURCES = \ $(testsuite) \ diff --git a/aldor/aldor/src/test/test_tposs.c b/aldor/aldor/src/test/test_tposs.c new file mode 100644 index 000000000..f0047f630 --- /dev/null +++ b/aldor/aldor/src/test/test_tposs.c @@ -0,0 +1,34 @@ +#include "abquick.h" +#include "testlib.h" +#include "testall.h" +#include "tposs.h" +#include "tform.h" + +local void testMapType(); + +void +tpossTest() +{ + init(); + TEST(testMapType); + fini(); +} + +local void +testMapType() +{ + TPoss tp = tpossEmpty(); + + testFalse("", tpossHasMapType(tp)); + testFalse("", tpossHasNonMapType(tp)); + + tpossAdd1(tp, tfMap(tfNone(), tfNone())); + testTrue("", tpossHasMapType(tp)); + testFalse("", tpossHasNonMapType(tp)); + + tpossAdd1(tp, tfNone()); + testTrue("", tpossHasMapType(tp)); + testTrue("", tpossHasNonMapType(tp)); + +} + diff --git a/aldor/aldor/src/test/testall.c b/aldor/aldor/src/test/testall.c index 711a6d4c2..e18f030a8 100644 --- a/aldor/aldor/src/test/testall.c +++ b/aldor/aldor/src/test/testall.c @@ -61,6 +61,7 @@ main(int argc, char *argv[]) if (testShouldRun("tfsat")) tfsatTest(); if (testShouldRun("retype")) retypeTest(); if (testShouldRun("genfoam")) genfoamTestSuite(); + if (testShouldRun("tposs")) tpossTest(); testIntEqual("fluidlevel", 0, fluidLevel); diff --git a/aldor/aldor/src/test/testall.h b/aldor/aldor/src/test/testall.h index 1fe4e27ea..e66f48c7a 100644 --- a/aldor/aldor/src/test/testall.h +++ b/aldor/aldor/src/test/testall.h @@ -31,5 +31,6 @@ void tformTest(void); void tfsatTest(void); void tibupTest(void); void tinferTest(void); +void tpossTest(void); #endif diff --git a/aldor/aldor/src/tposs.c b/aldor/aldor/src/tposs.c index 93ad2aa11..2ecf9d166 100644 --- a/aldor/aldor/src/tposs.c +++ b/aldor/aldor/src/tposs.c @@ -493,6 +493,23 @@ tpossHasMapType(TPoss tp) return false; } +Bool +tpossHasNonMapType(TPoss tp) +{ + TPossIterator tit; + + if (tp == NULL) + return false; + + for (tpossITER(tit, tp); tpossMORE(tit); tpossSTEP(tit)) { + TForm tf = tpossELT(tit); + tf = tfDefineeType(tf); + if (!tfIsAnyMap(tf) && !tfIsMapSyntax(tf)) + return true; + } + return false; +} + TPoss tpossGeneratorArg(TPoss tpit) { diff --git a/aldor/aldor/src/tposs.h b/aldor/aldor/src/tposs.h index f00d39daa..9583d2a1e 100644 --- a/aldor/aldor/src/tposs.h +++ b/aldor/aldor/src/tposs.h @@ -75,6 +75,11 @@ extern Bool tpossHasMapType (TPoss); /* * Does the type possibility set contain a mapping type? */ +extern Bool tpossHasNonMapType (TPoss); + /* + * Does the type possibility set contain a non-mapping type? + */ + extern TPoss tpossGeneratorArg (TPoss tp); /* From 8347e0c29dce6896dbc12fb1dde78cc37694dca9 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 21 Oct 2015 20:49:21 +0100 Subject: [PATCH 069/352] tinfer: Do not ignore implicit uses of apply if any maps are found. This allows implicit functions to behave much more like real ones. --- aldor/aldor/src/test/test_tibup.c | 77 +++++++++++++ aldor/aldor/src/ti_bup.c | 184 +++++++++++++++++++++--------- aldor/aldor/src/ti_tdn.c | 132 +++++++++++++++++++-- aldor/aldor/test/Makefile.in | 2 +- aldor/aldor/test/apply.as | 18 +++ 5 files changed, 348 insertions(+), 65 deletions(-) create mode 100644 aldor/aldor/test/apply.as diff --git a/aldor/aldor/src/test/test_tibup.c b/aldor/aldor/src/test/test_tibup.c index 8dc74ddff..f40d3fc16 100644 --- a/aldor/aldor/src/test/test_tibup.c +++ b/aldor/aldor/src/test/test_tibup.c @@ -16,6 +16,8 @@ local void testTiBupCollect1(); local void testTiBupCollect2(); local void testTiTdnPretend(); local void testTiTdnMultiToCrossEmbed(); +local void testTiBupApplyMixed(); +local void testTiBupApplyImplicit(); /* XXX: from test_tinfer.c */ void init(void); @@ -31,6 +33,8 @@ tibupTest() TEST(testTiBupCollect2); TEST(testTiTdnPretend); TEST(testTiTdnMultiToCrossEmbed); + TEST(testTiBupApplyMixed); + TEST(testTiBupApplyImplicit); fini(); } @@ -177,6 +181,79 @@ testTiTdnPretend() finiFile(); } +extern int tipBupDebug; +extern int tfsDebug; + +local void +testTiBupApplyMixed() +{ + String Boolean_imp = "import from Boolean"; + String E_def = "E: with == add"; + String F_def = "F: with { apply: (%, %) -> () } == add { apply(f: %, g: %): () == never }"; + String f1_def = "f: F == never"; + String f2_def = "f(): E == never"; + + StringList lines = listList(String)(5, Boolean_imp, E_def, F_def, f1_def, f2_def); + AbSynList absynList = listCons(AbSyn)(stdtypes(), abqParseLines(lines)); + AbSyn absyn = abNewSequenceL(sposNone, absynList); + + AbSyn case1 = abqParse("f(f)"); + Stab stab; + + initFile(); + stab = stabFile(); + + abPutUse(absyn, AB_Use_NoValue); + scopeBind(stab, absyn); + typeInfer(stab, absyn); + + tfsDebug = tipBupDebug = 1; + scopeBind(stab, case1); + tiBottomUp(stab, case1, tfUnknown); + + testIntEqual("fn", 1, tpossCount(abTPoss(case1))); + + tiTopDown(stab, case1, tfNone()); + testIntEqual("Unique", AB_State_HasUnique, abState(case1)); +} + + + +local void +testTiBupApplyImplicit() +{ + String Boolean_imp = "import from Boolean"; + String E_def = "E: with == add"; + String S_def = "S: with { apply: (%, E) -> () } == add { apply(f: %, e: E): () == never }"; + String s_def = "s: S == never"; + String e_def = "e: E == never"; + + StringList lines = listList(String)(5, Boolean_imp, E_def, S_def, s_def, e_def); + AbSynList absynList = listCons(AbSyn)(stdtypes(), abqParseLines(lines)); + AbSyn absyn = abNewSequenceL(sposNone, absynList); + + AbSyn case1 = abqParse("s e"); + Stab stab; + + initFile(); + stab = stabFile(); + + abPutUse(absyn, AB_Use_NoValue); + scopeBind(stab, absyn); + typeInfer(stab, absyn); + + tfsDebug = tipBupDebug = 1; + scopeBind(stab, case1); + tiBottomUp(stab, case1, tfUnknown); + + testIntEqual("fn", 1, tpossCount(abTPoss(case1))); + + tiTopDown(stab, case1, tfNone()); + testIntEqual("Unique", AB_State_HasUnique, abState(case1)); + +} + + /* This should really work, but at the moment a4 and a8 give incorrect results. D: with == add diff --git a/aldor/aldor/src/ti_bup.c b/aldor/aldor/src/ti_bup.c index d5a53088c..c9b77c23b 100644 --- a/aldor/aldor/src/ti_bup.c +++ b/aldor/aldor/src/ti_bup.c @@ -535,6 +535,10 @@ tibup0DefaultBody(Stab stab, AbSyn absyn, Bool doDef) * ***************************************************************************/ +local Bool tibup0ApplyGiveMessage(AbSyn absyn, Length argc, AbSynGetter argf); +local void tibup0ApplyFilter(Stab stab, AbSyn absyn, TForm type, TPoss opTypes, + AbSyn op, Length argc, AbSynGetter argf, + TPoss *nopTypes, TPoss *retTypes); /* * ab ==> m(i,...) -> tibup0Apply(stab, ab, 'apply, n+1, [m,i,...]) * ab ==> m(i,...) := x -> tibup0Apply(stab, ab, 'set!, n+2, [m,i,...,x]) @@ -653,12 +657,11 @@ local void tibup0ApplyFType(Stab stab, AbSyn absyn, TForm type, AbSyn op, Length argc, AbSynGetter argf) { - SatMask mask = tfSatBupMask(), result; Length i; TPossIterator it; TPoss opTypes = abReferTPoss(op); - TPoss nopTypes = tpossEmpty(); - TPoss retTypes = tpossEmpty(); + TPoss nopTypes; + TPoss retTypes; if (abIsTheId(op, ssymJoin) && tpossIsUnique(opTypes) && tfSatisfies(tfMapRet(tpossUnique(opTypes)), tfCategory)) { @@ -670,6 +673,57 @@ tibup0ApplyFType(Stab stab, AbSyn absyn, TForm type, for (i = 0; i < argc; i += 1) tibup(stab, argf(absyn, i), tfUnknown); + tibup0ApplyFilter(stab, absyn, type, opTypes, op, argc, argf, &nopTypes, &retTypes); + + /* If the op and the parts had meaning, then give an error. */ + if (tpossCount(nopTypes) == 0) { + Bool giveMsg = tpossCount(opTypes) > 0 + || tibup0ApplyGiveMessage(absyn, argc, argf); + + if (giveMsg) { + abState(absyn) = AB_State_Error; + abState(op) = AB_State_Error; + } + else { + if (tpossCount( opTypes ) == 0) + abState(absyn) = AB_State_Error; + + abResetTPoss(op, nopTypes); + } + } + else + abResetTPoss(op, nopTypes); + + abResetTPoss(absyn, retTypes); + tpossFree(opTypes); +} + +local Bool +tibup0ApplyGiveMessage(AbSyn absyn, Length argc, AbSynGetter argf) +{ + Bool giveMsg = true; + int i; + + for (i = 0; giveMsg && i < argc; i += 1) { + AbSyn argi = argf(absyn, i); + if (abState(argi) == AB_State_Error || + (abState(argi) == AB_State_HasPoss && + tpossCount(abTPoss(argi)) == 0)) + giveMsg = false; + } + + return giveMsg; +} + +local void +tibup0ApplyFilter(Stab stab, AbSyn absyn, TForm type, TPoss opTypes, + AbSyn op, Length argc, AbSynGetter argf, TPoss *pnopTypes, TPoss *pretTypes) +{ + SatMask mask = tfSatBupMask(), result; + TPossIterator it; + TPoss nopTypes = tpossEmpty(); + TPoss retTypes = tpossEmpty(); + /* Filter opTypes based on the argument and return types. */ for (tpossITER(it, opTypes); tpossMORE(it); tpossSTEP(it)) { TForm opType = tpossELT(it), retType; @@ -694,35 +748,8 @@ tibup0ApplyFType(Stab stab, AbSyn absyn, TForm type, absFreeDeeply(sigma); } - - /* If the op and the parts had meaning, then give an error. */ - if (tpossCount(nopTypes) == 0) { - Bool giveMsg = (tpossCount(opTypes) > 0); - - for (i = 0; giveMsg && i < argc; i += 1) { - AbSyn argi = argf(absyn, i); - if (abState(argi) == AB_State_Error || - (abState(argi) == AB_State_HasPoss && - tpossCount(abTPoss(argi)) == 0)) - giveMsg = false; - } - - if (giveMsg) { - abState(absyn) = AB_State_Error; - abState(op) = AB_State_Error; - } - else { - if (tpossCount( opTypes ) == 0) - abState(absyn) = AB_State_Error; - - abResetTPoss(op, nopTypes); - } - } - else - abResetTPoss(op, nopTypes); - - abResetTPoss(absyn, retTypes); - tpossFree(opTypes); + *pnopTypes = nopTypes; + *pretTypes = retTypes; } /**************************************************************************** @@ -1136,21 +1163,81 @@ tibupComma(Stab stab, AbSyn absyn, TForm type) local void tibupApply(Stab stab, AbSyn absyn, TForm type) { - AbSyn op = abApplyOp(absyn); - TPoss tp; + AbSyn op = abApplyOp(absyn); + AbSyn imp = NULL; + TPoss opTypes; + TPoss nopTypes; + TPoss retTypes; + TPoss impOpTypes; + TPoss impRetTypes; + int i; - tibup(stab, op, tfUnknown); + tibup(stab, abApplyOp(absyn), tfUnknown); - tp = abReferTPoss(op); + opTypes = abReferTPoss(op); - if (tpossHasMapType(tp) || tpossCount(tp) == 0) - tibup0ApplyFType(stab, absyn, type, - op, abApplyArgc(absyn), abApplyArgf); - else - tibup0ApplySym(stab, absyn, type, - ssymApply, abArgc(absyn), abArgf, NULL); + if (abIsTheId(op, ssymJoin) && tpossIsUnique(opTypes) && + tfSatisfies(tfMapRet(tpossUnique(opTypes)), tfCategory)) { + tibup0ApplyJoin(stab, absyn, type, op, abApplyArgc(absyn), abApplyArgf); + tpossFree(opTypes); + return; + } - tpossFree(tp); + for (i = 0; i < abApplyArgc(absyn); i += 1) + tibup(stab, abApplyArg(absyn, i), tfUnknown); + + tibup0ApplyFilter(stab, absyn, type, opTypes, + op, abApplyArgc(absyn), abApplyArgf, &nopTypes, &retTypes); + + if (tpossHasNonMapType(opTypes)) { + imp = abNewId(abPos(absyn), ssymApply); + + abSetImplicit(absyn, imp); + tibup(stab, imp, tfUnknown); + + tibup0ApplyFilter(stab, absyn, type, abTPoss(imp), + imp, abArgc(absyn), abArgf, &impOpTypes, &impRetTypes); + + if (tpossCount(impOpTypes) > 0) { + TPoss tmp2 = retTypes; + retTypes = tpossUnion(retTypes, impRetTypes); + tpossFree(tmp2); + } + else { + abFree(imp); + imp = NULL; + abSetImplicit(absyn, NULL); + } + } + + /* If the op and the parts had meaning, then give an error. */ + if (tpossCount(retTypes) == 0) { + Bool giveMsg = tpossCount(opTypes) > 0 + || tibup0ApplyGiveMessage(absyn, abApplyArgc(absyn), abApplyArgf); + + if (giveMsg) { + abState(absyn) = AB_State_Error; + abState(op) = AB_State_Error; + } + else { + if (tpossCount( opTypes ) == 0) + abState(absyn) = AB_State_Error; + + if (!imp) + abResetTPoss(op, nopTypes); + if (imp) + abResetTPoss(imp, impOpTypes); + } + } + else { + if (!imp) + abResetTPoss(op, nopTypes); + if (imp) + abResetTPoss(imp, impOpTypes); + } + + abResetTPoss(absyn, retTypes); + tpossFree(opTypes); } /**************************************************************************** @@ -2060,15 +2147,8 @@ tibup0RefImps(Stab stab, AbSyn absyn, TForm type) */ /* If the op and the parts had no meaning, then give an error. */ if (tpossCount(nopTypes) == 0) { - Bool giveMsg = (tpossCount(opTypes) > 0); - - for (i = 0; giveMsg && i < abArgc(absyn); i += 1) { - AbSyn argi = abArgf(absyn, i); - if (abState(argi) == AB_State_Error || - (abState(argi) == AB_State_HasPoss && - tpossCount(abTPoss(argi)) == 0)) - giveMsg = false; - } + Bool giveMsg = tpossCount(opTypes) > 0 + || tibup0ApplyGiveMessage(absyn, abArgc(absyn), abApplyArgf); if (giveMsg) { abState(absyn) = AB_State_Error; diff --git a/aldor/aldor/src/ti_tdn.c b/aldor/aldor/src/ti_tdn.c index ace7b65de..839269506 100644 --- a/aldor/aldor/src/ti_tdn.c +++ b/aldor/aldor/src/ti_tdn.c @@ -831,24 +831,132 @@ titdnComma(Stab stab, AbSyn absyn, TForm type) local Bool titdnApply(Stab stab, AbSyn absyn, TForm type) { - AbSyn op = abApplyOp(absyn); - TPoss tp; - - tipApplyDEBUG(dbOut, "Entering titdnApply\n"); - + SatMask mask = tfSatBupMask(); + AbSyn op = abApplyOp(absyn); + TPoss opTypes, nopTypes; + TPossIterator it; + Bool isImplicit = false; + Length nopc, popc, parmc; + TForm nopt, popt, opType; + Bool result; if (abState(op) == AB_State_Error) return false; - tp = abTPoss(op); + nopc = 0; /* Number of non-pending matches */ + popc = 0; /* Number of all possible matches */ + nopt = tfUnknown; /* Non-pending op type */ + popt = tfUnknown; /* Any possible op type */ + opType = NULL; - if (tpossHasMapType(tp) || tpossCount(tp) == 0) - return titdn0ApplyFType(stab, absyn, type, op, - abApplyArgc(absyn), abApplyArgf); - else - return titdn0ApplySym(stab, absyn, type, ssymApply, - abArgc(absyn), abArgf, NULL); + opTypes = abReferTPoss(op); + nopTypes = tpossEmpty(); + if (abIsTheId(op, ssymJoin) && tpossIsUnique(opTypes) && + tfSatisfies(tfMapRet(tpossUnique(opTypes)), tfCategory)) + return titdn0ApplyJoin(stab, absyn, type, op, abArgc(absyn), abApplyArgf); + + /* At this point, the mapping is either in the implicit part, + * or in the operator position. Let's look at the operator + * first. + */ + for (tpossITER(it, opTypes); tpossMORE(it); tpossSTEP(it)) { + TForm opType = tpossELT(it); + SatMask result; + + opType = tfDefineeType(opType); + if (!tfIsAnyMap(opType)) + continue; + + result = tfSatMap(mask, stab, opType, type, absyn, abApplyArgc(absyn), abApplyArgf); + if (tfSatSucceed(result)) { + if (!tfSatPending(result)) { + nopc += 1; + nopt = opType; + nopTypes = tpossAdd1(nopTypes, opType); + } + popc += 1; + popt = opType; + } + } + /* And now the implicit part */ + if (abImplicit(absyn) != NULL) { + AbSyn implicitApply = abImplicit(absyn); + TPoss implicitOpTypes = abTPoss(implicitApply); + isImplicit = true; + for (tpossITER(it, implicitOpTypes); tpossMORE(it); tpossSTEP(it)) { + TForm opType = tpossELT(it); + SatMask result; + + opType = tfDefineeType(opType); + assert(tfIsAnyMap(opType)); + + result = tfSatMap(mask, stab, opType, type, absyn, abArgc(absyn), abArgf); + if (tfSatSucceed(result)) { + if (!tfSatPending(result)) { + nopc += 1; + nopt = opType; + nopTypes = tpossAdd1(nopTypes, opType); + } + popc += 1; + popt = opType; + } + } + } + + if (popc == 1) { + /* We found one thing.. must be this one */ + opType = popt; + result = true; + } + else if (nopc == 1) { + /* We found one non-pending one, and possibly some others. Let's use it */ + opType = nopt; + result = true; + } + else if (nopc == 0 && popc > 0) { + /* All pending, and more than one of them. Error - not analyzed */ + terrorApplyNotAnalyzed(absyn, op, popt); + result = false; + } + else { + /* Anything else - error */ + terrorApplyFType(absyn, type, nopTypes, op, stab, abApplyArgc(absyn), abApplyArgf); + result = false; + } + + tpossFree(opTypes); + tpossFree(nopTypes); + + if (!result) return false; + + if (isImplicit) { + AbSyn imp = abImplicit(absyn); + int parmc; + titdn(stab, imp, opType); + + parmc = tfMapHasDefaults(opType) ? tfMapArgc(opType) : abArgc(absyn); + abAddTContext(imp, tfMapMultiArgEmbed(opType, parmc)); + + mask = tfSatTdnMask(); + result = tfSatMap(mask, stab, opType, type, absyn, abArgc(absyn), abArgf); + } + else { + int parmc; + abFree(abImplicit(absyn)); + abSetImplicit(absyn, NULL); + titdn(stab, op, opType); + + parmc = tfMapHasDefaults(opType) ? tfMapArgc(opType) : abApplyArgc(absyn); + abAddTContext(op, tfMapMultiArgEmbed(opType, parmc)); + + mask = tfSatTdnMask(); + result = tfSatMap(mask, stab, opType, type, absyn, abApplyArgc(absyn), abApplyArgf); + } + /* We return false rarely (eg titdn0FarValue failure). */ + return tfSatSucceed(result); } + + /**************************************************************************** * * :: Define: a == e diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 0208daaf6..88823c134 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -76,7 +76,7 @@ foamsrcdir = $(abs_top_srcdir)/aldor/lib/libfoam foamdir = $(abs_top_builddir)/aldor/lib/libfoam aptests := exquo -fmtests := rectest enumtest clos strtable1 simple +fmtests := rectest enumtest clos strtable1 simple apply ctests := rectest enumtest otests := enumtest xtests := enumtest diff --git a/aldor/aldor/test/apply.as b/aldor/aldor/test/apply.as new file mode 100644 index 000000000..b6a5092e0 --- /dev/null +++ b/aldor/aldor/test/apply.as @@ -0,0 +1,18 @@ +#include "foamlib" +#pile + +F: with + apply: (%, %) -> % + f: % + g: % +== add + Rep == MachineInteger + import from Rep + + apply(a: %, b: %): % == per(rep a+rep b) + g: % == per 1 + f: % == per 2 + +test(): () == + import from F + f g; From 615845d463729e05962fe1171ac1ca8ea1ad090b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 20 Oct 2015 21:57:35 +0100 Subject: [PATCH 070/352] Docs: Reflect less restrictive use of implicit apply in documentation. --- aldor/aldorug/langties.tex | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/aldor/aldorug/langties.tex b/aldor/aldorug/langties.tex index 6874cafbe..d9c05aabd 100644 --- a/aldor/aldorug/langties.tex +++ b/aldor/aldorug/langties.tex @@ -162,11 +162,10 @@ \head{section}{Apply}{asugLangTiesApply} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -In the absence of an explicit function named \ttin{a}, the application -\ttin{a(b)} is treated as a call to the function \ttin{apply} with the -first argument being taken to be \ttin{a}, and the remaining arguments -being taken from the arguments to the original application. -Example: +The application \ttin{a(b)} may be treated as a call to the function +\ttin{apply} with the first argument being taken to be \ttin{a}, and +the remaining arguments being taken from the arguments to the original +application. Example: \verb^ ^{\tt f(a,b,c)} becomes {\tt apply(f,a,b,c)} @@ -187,7 +186,9 @@ \end{verbatim} \end{small} -The function is defined in the normal way. +The function is defined in the normal way. This use of apply is +treated as a normal function call, so for example if an export 'mat' +is in scope, then the one matching the function call context will be selected. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \head{section}{Set!}{asugLangTiesSetBang} From 096ee8d0867701a7a481d48ad3e19ee86260d8fe Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 29 Aug 2015 21:47:47 +0100 Subject: [PATCH 071/352] src/fint.c: Dump a backtrace on a call to Halt in the interpreter --- aldor/aldor/src/fint.c | 1 + 1 file changed, 1 insertion(+) diff --git a/aldor/aldor/src/fint.c b/aldor/aldor/src/fint.c index f0c366de7..62a13951d 100644 --- a/aldor/aldor/src/fint.c +++ b/aldor/aldor/src/fint.c @@ -3190,6 +3190,7 @@ fintEvalBCall(DataObj retDataObj) case FOAM_BVal_Halt: (void)fintEval(&expr1); + fintWhere(0); switch ((int)expr1.fiSInt) { case FOAM_Halt_BadDependentType: fiRaiseException((FiWord)"(Aldor error) Bad use of a dependent type"); From 94a861ee172590f3561e942186214a2097358081 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 15 May 2016 11:56:00 +0100 Subject: [PATCH 072/352] whitespace fixup (sal_string.as) --- aldor/lib/aldor/src/datastruc/sal_string.as | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/lib/aldor/src/datastruc/sal_string.as b/aldor/lib/aldor/src/datastruc/sal_string.as index de26013bf..1e315b17e 100644 --- a/aldor/lib/aldor/src/datastruc/sal_string.as +++ b/aldor/lib/aldor/src/datastruc/sal_string.as @@ -635,4 +635,4 @@ testBasics(); testIterate(); -#endif \ No newline at end of file +#endif From 0aef97896eb156c1b7eeb11348cdb3fb67917c44 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 31 Aug 2015 09:58:55 +0100 Subject: [PATCH 073/352] libaldor:Remove equality conditional on cross.. no idea where this came from. --- aldor/lib/aldor/src/datastruc/sal_hash.as | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/aldor/lib/aldor/src/datastruc/sal_hash.as b/aldor/lib/aldor/src/datastruc/sal_hash.as index 142b967d6..395f28a14 100644 --- a/aldor/lib/aldor/src/datastruc/sal_hash.as +++ b/aldor/lib/aldor/src/datastruc/sal_hash.as @@ -256,9 +256,9 @@ returns \emph{t} after the removal.} } -- TEMPORARY: COMPILER INSISTS ON THAT FUNCTION (WHY?) - if Cross(K, V) has HashType then { - (t:%) = (s:%):Boolean == never; - } +-- if Cross(K, V) has HashType then { +-- (t:%) = (s:%):Boolean == never; +-- } } #if ALDORTEST From 3d6be7d16b38a045cba48d71f0f20d4f3c9bd3b5 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 13 Dec 2014 22:22:26 +0000 Subject: [PATCH 074/352] tests: Add assertNotEquals functions. --- aldor/lib/aldor/src/test/tst_assert.as | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/aldor/lib/aldor/src/test/tst_assert.as b/aldor/lib/aldor/src/test/tst_assert.as index d8093288e..c901f4b3e 100644 --- a/aldor/lib/aldor/src/test/tst_assert.as +++ b/aldor/lib/aldor/src/test/tst_assert.as @@ -31,6 +31,8 @@ Assert(T: with): with { if T has PrimitiveType then { assertEquals: (T, T) -> (); assertEquals: (String, T, T) -> (); + assertNotEquals: (T, T) -> (); + assertNotEquals: (String, T, T) -> (); } export from GeneralAssert; @@ -49,6 +51,13 @@ Assert(T: with): with { assertEquals(s: String, a: T, b: T): () == if not(a = b) then { fail(s + ": expected " + string(T)(a) + " got " + string(T)(b) + " " + string(Boolean)(a=b)); } + assertNotEquals(a: T, b: T): () == if (a = b) then { + fail("didn't expect " + string(T)(a) + " got " + string(T)(b) + " " + string(Boolean)(a=b)); + } + + assertNotEquals(s: String, a: T, b: T): () == if (a = b) then { + fail(s + ": didn't expect " + string(T)(a) + " got " + string(T)(b) + " " + string(Boolean)(a=b)); + } } string(T: PrimitiveType)(t: T): String == { From 64021436f55d9490464894cf98a71990df4fad40 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 11 Jan 2017 21:05:15 +0000 Subject: [PATCH 075/352] libaldor: Add 'equalityAxioms'.. tests sufficient to show that = is an equivalence relation on its arguments. --- aldor/lib/aldor/src/test/tst_assert.as | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/aldor/lib/aldor/src/test/tst_assert.as b/aldor/lib/aldor/src/test/tst_assert.as index c901f4b3e..f17eb1d3c 100644 --- a/aldor/lib/aldor/src/test/tst_assert.as +++ b/aldor/lib/aldor/src/test/tst_assert.as @@ -33,6 +33,7 @@ Assert(T: with): with { assertEquals: (String, T, T) -> (); assertNotEquals: (T, T) -> (); assertNotEquals: (String, T, T) -> (); + equalityAxioms: (T, T, T) -> (); } export from GeneralAssert; @@ -58,6 +59,18 @@ Assert(T: with): with { assertNotEquals(s: String, a: T, b: T): () == if (a = b) then { fail(s + ": didn't expect " + string(T)(a) + " got " + string(T)(b) + " " + string(Boolean)(a=b)); } + + equalityAxioms(a: T, b: T, c: T): () == { + import from List List T, List T; + import from Integer; + toString := string(List T); + for l in [[a], [b], [c]] repeat + if not (l.0 = l.0) then fail("reflexive"); + for l in [[a, b], [a, c], [b, c]] repeat + ( (l.1 = l.2) ~= (l.2 = l.1) ) => fail("commutative"); + for l in [[a,b,c], [a,c,b], [b,a,c], [b,c,a], [c,a,b],[c,b,a]] repeat + (l.1 = l.2) and (l.2 = l.3) and not (l.1=l.3) => fail("transitive"); + } } string(T: PrimitiveType)(t: T): String == { From 5dae29765f95c0c127034b87ecbd78d8dc77150f Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 11 Jan 2017 20:16:01 +0000 Subject: [PATCH 076/352] aldor: Add a Fold2 package, so (+, 5)/(x for x in 1..3) will be 5+1+2+3. And BooleanFold, along with some tests --- aldor/lib/aldor/src/datastruc/sal_fold.as | 136 ++++++++++++++++++++++ 1 file changed, 136 insertions(+) diff --git a/aldor/lib/aldor/src/datastruc/sal_fold.as b/aldor/lib/aldor/src/datastruc/sal_fold.as index d89c00620..e39784f79 100644 --- a/aldor/lib/aldor/src/datastruc/sal_fold.as +++ b/aldor/lib/aldor/src/datastruc/sal_fold.as @@ -38,3 +38,139 @@ Fold(T: with): FoldingTransformationCategory(T) with { } } +FoldingTransformationCategory2(T: with, R: with): Category == with { + /: (%, List T) -> R; + /: (%, Generator T) -> R; +} + +Fold2(T: with, R: with): FoldingTransformationCategory2(T, R) with { + /: (Cross(f: (T,R) -> R, R), List T) -> R; + /: (Cross(f: (T,R) -> R, R), Generator T) -> R; + /: (Cross(f: (R, T) -> R, R), List T) -> R; + /: (Cross(f: (R, T) -> R, R), Generator T) -> R; + folder: ((T, R) -> R, R) -> % +} == add { + Rep ==> Cross((T, R) -> R, R); + local fper(f: (T, R) -> R, init: R): % == { c:=(f,init); per c} + folder(f: (T, R) -> R, init: R): % == fper(f, init); + + (c: Cross((T,R) -> R, R)) / (l: List T): R == { (f, init) := c; fper(f, init)/l } + (c: Cross((T,R) -> R, R)) / (g: Generator T): R == { (f, init) := c; fper(f, init)/g } + (c: Cross((R,T) -> R, R)) / (l: List T): R == { (f, r) := c; (swapArgs f, r)/l } + (c: Cross((R,T) -> R, R)) / (g: Generator T): R == { (f, r) := c; (swapArgs f, r)/g } + + local swapArgs(f: (R, T) -> R)(t: T, r: R): R == f(r, t); + + (folder: %) / (l: List T): R == { + (f, init) := rep folder; + acc := init; + for elt in l repeat { + acc := f(elt, acc); + } + return acc; + } + + (folder: %) / (g: Generator T): R == { + (f, init) := rep folder; + local acc: R := init; + for elt in g repeat { + acc := f(elt, acc); + } + return acc; + } +} + +BooleanFold: with { + /: ('_and', List Boolean) -> Boolean; + /: ('_and', Generator Boolean) -> Boolean; + + /: ('_or', List Boolean) -> Boolean; + /: ('_or', Generator Boolean) -> Boolean; + export from '_and', '_or'; +} +== add { + (/)(x: '_and', l: List Boolean): Boolean == _and/(generator l); + (/)(x: '_and', l: Generator Boolean): Boolean == { + for b in l repeat if not b then return false; + return true; + } + + (/)(x: '_or', l: List Boolean): Boolean == _or/(generator l); + (/)(x: '_or', l: Generator Boolean): Boolean == { + for b in l repeat if b then return true; + return false; + } + +} + + +#if ALDORTEST +#include "aldor" +#include "aldorio" + +testSum(): () == { + import from Assert Integer; + import from Integer; + import from Fold Integer; + for n in 1..10 repeat + assertEquals(n * (n+1) quo 2, (+)/(x for x in 1..n)); +} + + +testFold(): () == { + import from Fold Integer; + import from List Integer; + import from Integer; + import from Assert Integer; + assertEquals(6, (+)/[1,2,3]); + assertEquals(6, (+)/(x for x in 1..3)); +} + +testFold2(): () == { + import from Fold2(Integer, SortedSet Integer); + import from SortedSet Integer; + import from List Integer; + import from Integer; + import from Assert SortedSet Integer; + assertEquals([1,2,3,55], (insert, [55])/[3,2,1]); + assertEquals([55], (insert, [55])/[]); + assertEquals([2,3,4,55], (insert, [55])/(n for n in 2..4)); + assertEquals([55], (insert, [55])/(n for n in 1..2 | n<0)); +} + +testBoolean(): () == { + import from BooleanFold; + import from Assert Boolean; + import from List Boolean; + + assertTrue(_and/[]); + assertTrue(_and/[true]); + assertTrue(_and/[true, true]); + assertTrue(_and/[true, true, true]); + assertFalse(_and/[true, false, true]); + + assertFalse(_or/[]); + assertFalse(_or/[false]); + assertTrue(_or/[false, true]); + assertTrue(_or/[true, false, true]); +} + +testLazyBoolean(): () == { + import from BooleanFold; + import from Assert Boolean; + import from Integer; + + local qq := 0; + _or/((qq := qq + 1; even?(x) ) for x in 1..10); + assertTrue(qq = 2); + qq := 0; + _and/((qq := qq + 1; x rem 3 > 0 ) for x in 1..10); + assertTrue(qq = 3); +} + +testSum(); +testFold(); +testFold2(); +testLazyBoolean(); +testBoolean(); +#endif From 9c109a5cd774365ba3930c82bdb27fdd557c9888 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 30 Apr 2016 16:50:17 +0100 Subject: [PATCH 077/352] lib/aldor/sal_fold: Add Fold2 with a single argument --- aldor/lib/aldor/src/datastruc/sal_fold.as | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/aldor/lib/aldor/src/datastruc/sal_fold.as b/aldor/lib/aldor/src/datastruc/sal_fold.as index e39784f79..a776350ee 100644 --- a/aldor/lib/aldor/src/datastruc/sal_fold.as +++ b/aldor/lib/aldor/src/datastruc/sal_fold.as @@ -43,6 +43,21 @@ FoldingTransformationCategory2(T: with, R: with): Category == with { /: (%, Generator T) -> R; } +Fold2(T: with): FoldingTransformationCategory2(T, T) with { + /: (Cross((T,T) -> T, T), List T) -> T; + /: (Cross((T,T) -> T, T), Generator T) -> T; + folder: ((T,T) -> T, T) -> % +} +== add { + Rep == Fold2(T, T); + import from Rep; + (/)(c: Cross((T,T) -> T, T), l: List T): T == folder(c)@%/l; + (/)(c: Cross((T,T) -> T, T), g: Generator T): T == folder(c)@%/g; + folder(f: (T,T) -> T, init: T): % == per folder(f, init); + (/)(f: %, l: List T): T == rep(f)/l; + (/)(f: %, g: Generator T): T == rep(f)/g; +} + Fold2(T: with, R: with): FoldingTransformationCategory2(T, R) with { /: (Cross(f: (T,R) -> R, R), List T) -> R; /: (Cross(f: (T,R) -> R, R), Generator T) -> R; @@ -116,6 +131,14 @@ testSum(): () == { assertEquals(n * (n+1) quo 2, (+)/(x for x in 1..n)); } +testFoldInit(): () == { + import from List Integer; + import from Fold2(Integer, Integer); + import from Assert Integer; + import from Integer; + assertEquals(22, (+, 22)/[]); + assertEquals(23, (+, 22)/[1]); +} testFold(): () == { import from Fold Integer; From e1e3fb25e65422ae6ec4bb6abdd1007c6ca067c4 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 13 Jan 2017 20:46:04 +0000 Subject: [PATCH 078/352] libaldor: Add equality and bracket(generator) method to table --- aldor/lib/aldor/src/datastruc/Makefile.deps | 4 +-- aldor/lib/aldor/src/datastruc/sal_hash.as | 30 +++++++++++++++++ aldor/lib/aldor/src/datastruc/sal_table.as | 36 +++++++++++++++++++++ 3 files changed, 68 insertions(+), 2 deletions(-) diff --git a/aldor/lib/aldor/src/datastruc/Makefile.deps b/aldor/lib/aldor/src/datastruc/Makefile.deps index 3d5cb45e6..ea1e14372 100644 --- a/aldor/lib/aldor/src/datastruc/Makefile.deps +++ b/aldor/lib/aldor/src/datastruc/Makefile.deps @@ -13,8 +13,8 @@ sal_parray_deps := sal_fstruc sal_list sal_array_deps :=sal_bstruc sal_parray sal_pkarray_deps := sal_parray sal_string_deps := sal_data sal_list sal_parray sal_pkarray sal_array -sal_table_deps := sal_bdata sal_string -sal_hash_deps := sal_table sal_list sal_kntry +sal_table_deps := sal_bdata sal_string sal_fold +sal_hash_deps := sal_table sal_list sal_kntry sal_barray_deps := sal_pkarray sal_memblk_deps := sal_array sal_barray diff --git a/aldor/lib/aldor/src/datastruc/sal_hash.as b/aldor/lib/aldor/src/datastruc/sal_hash.as index 395f28a14..bb4fd9085 100644 --- a/aldor/lib/aldor/src/datastruc/sal_hash.as +++ b/aldor/lib/aldor/src/datastruc/sal_hash.as @@ -300,7 +300,37 @@ testIteration(): () == { stdout << tk << ", " << tv << " " << (-n*(n+1) quo 2) << newline; assertEquals(tv, (-n*(n+1)) quo 2); } + +testCreation(): () == { + import from Assert Integer; + import from Integer; + t1: HashTable(Integer, Integer) := [(n, n*2) for n in 1..3]; + + assertEquals(2, t1.1); + assertEquals(4, t1.2); + assertEquals(6, t1.3); +} + +testEquality(): () == { + C ==> Cross(Integer, String); + import from Integer; + import from HashTable(Integer, String); + import from Assert HashTable(Integer, String); + local tbl1, tbl2, tbl3: HashTable(Integer, String); + tbl1 := [(1, "hello")@C]; + tbl2 := [(1, "bye")@C]; + tbl3 := [(1, "hello"), (2, "bye")]; + assertNotEquals(tbl1, tbl2); + assertNotEquals(tbl1, tbl3); + equalityAxioms(table(), tbl1, tbl2); + equalityAxioms(table(), tbl1, tbl3); +} + + + test(); testIteration(); +testCreation(); +testEquality(); #endif diff --git a/aldor/lib/aldor/src/datastruc/sal_table.as b/aldor/lib/aldor/src/datastruc/sal_table.as index d015bd093..32a0afd5f 100644 --- a/aldor/lib/aldor/src/datastruc/sal_table.as +++ b/aldor/lib/aldor/src/datastruc/sal_table.as @@ -72,6 +72,10 @@ slot is given by a unique key from {\em K}.} then] \category{\altype{SerializableType}}\\ \end{exports} +\begin{exports} +[if $V$ has \altype{PrimitiveType} then] +\category{\altype{PrimitiveType}}\\ +\end{exports} #endif define TableType(K:PrimitiveType, V:Type): Category == @@ -80,6 +84,7 @@ define TableType(K:PrimitiveType, V:Type): Category == if K has OutputType and V has OutputType then OutputType; if K has SerializableType and V has SerializableType then SerializableType; + if V has PrimitiveType then PrimitiveType; bracket: Tuple Cross(K, V) -> %; #if ALDOC \alpage{[]} @@ -170,6 +175,17 @@ and returns {\em v}.} That space grows when needed as elements are inserted in the table.} \alseealso{\alexp{[]}} #endif +#if ALDOC +\alpage{bracket} +\Usage{\name()\\ \name~n} +\Signature{\altype{Generator} \altype{Cross}(K, V)}{\%} +\Params{{\em g} & \% & a generator of key-value pairs\\} +} +\Retval{Returns a new table containing the specified pairs} +\alseealso{\alexp{[]}} +#endif + bracket: Generator Cross(K, V) -> %; + default { local leftBracket:Ch == { import from String; char "[" } local rightBracket:Ch == { import from String; char "]" } @@ -185,6 +201,14 @@ That space grows when needed as elements are inserted in the table.} t; } + [g: Generator Cross(K, V)]: % == { + t := table(); + for (k, v) in g repeat { + t.k := v; + } + t + } + apply(t:%, k:K):V == { import from Partial V; retract find(k, t); @@ -266,5 +290,17 @@ That space grows when needed as elements are inserted in the table.} p << rightBracket; } } + if V has PrimitiveType then { + (a: %) = (b: %): Boolean == { + import from BooleanFold; + import from Partial V; + import from K, V, MachineInteger; + check(k: K): Boolean == { + failed? find(k, b) => false; + a.k = b.k + } + numberOfEntries a = numberOfEntries b and (_and)/(check k for k in keys a) + } + } } } From c5dc8f053e9c1a30a6c78c48efc9b5c8e7757a69 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 11 Jan 2017 21:02:40 +0000 Subject: [PATCH 079/352] sal_hash: Fix for empty? on HashTable. --- aldor/lib/aldor/src/datastruc/sal_hash.as | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/aldor/lib/aldor/src/datastruc/sal_hash.as b/aldor/lib/aldor/src/datastruc/sal_hash.as index bb4fd9085..bec440bb0 100644 --- a/aldor/lib/aldor/src/datastruc/sal_hash.as +++ b/aldor/lib/aldor/src/datastruc/sal_hash.as @@ -90,8 +90,8 @@ returns \emph{t} after the removal.} table(n:Z):% == newTable(0, n); remember(f:K -> V):% == { import from Z; newTable(0, 8, 1, f); } forget(f:K -> V):% == { import from Z; newTable(0, 8, -1, f); } - empty?(t:%):Boolean == { import from Z; zero?(#t) } - #(t:%):Z == { import from A L KV; #(htable t) } + empty?(t:%):Boolean == { import from Z; zero? numberOfEntries t } + #(t:%):Z == { import from A L KV; #(htable t) } -- NOTE: THIS DOES NOT DO WHAT YOU EXPECT! (array size, not numberOfEntries) numberOfEntries(t:%):Z == { import from Rep; rep(t).nentr; } local htable(t:%):A L KV== { import from Rep; rep(t).tbl; } local index(t:%, k:K):Z == hash(k) mod (#t); @@ -327,10 +327,26 @@ testEquality(): () == { } +testSizing(): () == { + import from HashTable(MachineInteger, String); + import from MachineInteger, String; + import from Assert MachineInteger; + tbl := table(); + assertTrue(empty? tbl); + assertEquals(0, numberOfEntries tbl); + tbl.1 := "hello"; + assertEquals(1, numberOfEntries tbl); + tbl.1 := "bye"; + assertEquals(1, numberOfEntries tbl); + remove!(1, tbl); + assertEquals(0, numberOfEntries tbl); + assertTrue(empty? tbl); +} test(); testIteration(); testCreation(); testEquality(); +testSizing(); #endif From 61d4af3222310048018b712d45f1d4911ec166d1 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 12 Jan 2017 23:14:01 +0000 Subject: [PATCH 080/352] libaldor: list.as: Small optimisation for bracket.. small tuples will inline better if we do a bit of manual loop unrolling. --- aldor/lib/aldor/src/datastruc/sal_list.as | 26 +++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/aldor/lib/aldor/src/datastruc/sal_list.as b/aldor/lib/aldor/src/datastruc/sal_list.as index c6b5c1a62..88d20330c 100644 --- a/aldor/lib/aldor/src/datastruc/sal_list.as +++ b/aldor/lib/aldor/src/datastruc/sal_list.as @@ -148,6 +148,8 @@ List(T:Type): ListType T == add { bracket(t:Tuple T):% == { import from Z; + length(t) = 0 => empty; + length(t) = 1 => cons(element(t, 1), empty); l := empty; for n in length(t)..1 by -1 repeat l := cons(element(t, n), l); l; @@ -692,3 +694,27 @@ local CompilerBugWorkAround(T:Type):with { } } +#if ALDORTEST +#include "aldor" +#include "aldortest" + +testSmallLists(): () == { + import from Assert List Integer; + import from Assert Integer; + import from List Integer; + import from Integer; + none: List Integer := []; + assertTrue(empty? none); + one := [1]; + assertFalse(empty? one); + assertEquals(1, first one); + two := [2,1]; + assertFalse(empty? two); + assertEquals(2, first two); + assertEquals(one, rest two); +} + + +testSmallLists(); + +#endif From 5dbedad2a130e12a6e7fb6fffbd08bbf77df10e0 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 17 May 2015 20:55:43 +0100 Subject: [PATCH 081/352] libaldor: Add Map type. Can't really give it much more behaviour, so this will do. --- aldor/lib/aldor/src/Makefile.am | 1 + aldor/lib/aldor/src/datastruc/Makefile.deps | 2 ++ aldor/lib/aldor/src/datastruc/Makefile.in | 2 +- aldor/lib/aldor/src/datastruc/sal_map.as | 33 +++++++++++++++++++++ 4 files changed, 37 insertions(+), 1 deletion(-) create mode 100644 aldor/lib/aldor/src/datastruc/sal_map.as diff --git a/aldor/lib/aldor/src/Makefile.am b/aldor/lib/aldor/src/Makefile.am index bd9312fad..2a881811b 100644 --- a/aldor/lib/aldor/src/Makefile.am +++ b/aldor/lib/aldor/src/Makefile.am @@ -68,6 +68,7 @@ libaldor_a_SOURCES = \ datastruc/sal_string.c \ datastruc/sal_table.c \ datastruc/sal_union.c \ + datastruc/sal_map.c \ lang/sal_lang.c \ test/tst_assert.c \ util/ald_trace.c \ diff --git a/aldor/lib/aldor/src/datastruc/Makefile.deps b/aldor/lib/aldor/src/datastruc/Makefile.deps index ea1e14372..465bd94ff 100644 --- a/aldor/lib/aldor/src/datastruc/Makefile.deps +++ b/aldor/lib/aldor/src/datastruc/Makefile.deps @@ -37,3 +37,5 @@ ald_flags_deps := sal_list sal_barray sal_langx_deps := sal_list sal_string sal_union_deps := sal_string sal_langx + +sal_map_deps := sal_list diff --git a/aldor/lib/aldor/src/datastruc/Makefile.in b/aldor/lib/aldor/src/datastruc/Makefile.in index 248fd789f..784e055ec 100644 --- a/aldor/lib/aldor/src/datastruc/Makefile.in +++ b/aldor/lib/aldor/src/datastruc/Makefile.in @@ -19,7 +19,7 @@ library = ald_symbol ald_symtab sal_array sal_barray sal_bdata \ sal_bstruc sal_data sal_ddata sal_fstruc sal_hash sal_kntry \ sal_list sal_lstruc sal_memblk sal_parray sal_pkarray \ sal_set sal_slist sal_sortas sal_sset sal_stream sal_string \ - sal_table sal_fold ald_flags sal_langx sal_union + sal_table sal_fold ald_flags sal_langx sal_union sal_map @BUILD_JAVA_TRUE@javalibrary := $(library) diff --git a/aldor/lib/aldor/src/datastruc/sal_map.as b/aldor/lib/aldor/src/datastruc/sal_map.as new file mode 100644 index 000000000..7a4562a00 --- /dev/null +++ b/aldor/lib/aldor/src/datastruc/sal_map.as @@ -0,0 +1,33 @@ +#include "aldor.as" + +MapperCategory(T: with, R: with): Category == with { + apply: (%, T) -> R; +} + +ListMapper(T: with, R: with): MapperCategory(List T, List R) with { + map: (T -> R) -> %; +} +== add { + Rep ==> (T -> R); + map(f: T -> R): % == per f; + apply(m: %, l: List T): List R == [(rep m)(x) for x in l]; +} + +#if ALDORTEST +#include "aldor" +#include "aldorio" + +test(): () == { + import from MachineInteger; + import from List MachineInteger; + import from ListMapper(MachineInteger, Integer); + import from ListMapper(Integer, MachineInteger); + import from Assert List MachineInteger; + l: List MachineInteger := [1,2,3,4]; + l2 := map(coerce)(map(coerce)(l)); + assertEquals(l, l2); +} + + +#endif + From cb3810fc10d2bff060b9547b28383e50b2493ef5 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 1 Aug 2015 14:35:18 +0100 Subject: [PATCH 082/352] libaldor: Add valueOr function to convert partial to a value with default. --- aldor/lib/aldor/src/base/sal_partial.as | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/aldor/lib/aldor/src/base/sal_partial.as b/aldor/lib/aldor/src/base/sal_partial.as index 9c203fcec..8215ae922 100644 --- a/aldor/lib/aldor/src/base/sal_partial.as +++ b/aldor/lib/aldor/src/base/sal_partial.as @@ -77,6 +77,15 @@ Partial(T:Type): with { \Signature{\%}{T} \Params{{\em x} & \% & a partial element\\ } \Retval{Returns the element x converted to an element of T, provided that +x is not \failed.} + valueOr: (%, T) -> T; +#endif +#if ALDOC +\alpage{valueOr} +\Usage{\name~x} +\Signature{\%}{T} +\Params{{\em x} & \% & a partial element\\ } +\Retval{Returns the element x converted to an element of T, provided that x is not \failed.} #endif } == add { @@ -95,6 +104,8 @@ x is not \failed.} rep(x).val; } + valueOr(x: %, def: T): T == if failed? x then def else retract x; + if T has PrimitiveType then { (x:%) = (y:%):Boolean == { import from T; From c21f615545229f87d19c8f6e06b8d307e11c779b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 12 Jan 2017 23:23:02 +0000 Subject: [PATCH 083/352] libaldor: Add toString method exported by all OutputTypes. Really should add a corresponding "fromString"... --- aldor/lib/aldor/src/base/sal_otype.as | 3 +++ aldor/lib/aldor/src/datastruc/sal_string.as | 19 +++++++++++++++++++ 2 files changed, 22 insertions(+) diff --git a/aldor/lib/aldor/src/base/sal_otype.as b/aldor/lib/aldor/src/base/sal_otype.as index 70931528f..3396fc151 100644 --- a/aldor/lib/aldor/src/base/sal_otype.as +++ b/aldor/lib/aldor/src/base/sal_otype.as @@ -55,8 +55,11 @@ f(stdout) << space; \end{ttyout} \end{alex} #endif + export from OutputTypeFunctions %; default { (<<)(a:%)(port:TextWriter):TextWriter == port << a; } } +OutputTypeFunctions(T: with): with == add + diff --git a/aldor/lib/aldor/src/datastruc/sal_string.as b/aldor/lib/aldor/src/datastruc/sal_string.as index 1e315b17e..b54a122d0 100644 --- a/aldor/lib/aldor/src/datastruc/sal_string.as +++ b/aldor/lib/aldor/src/datastruc/sal_string.as @@ -597,6 +597,18 @@ extend TextReader: with { } } +extend OutputTypeFunctions(T: OutputType): with { + toString: T -> String +} +== add { + import from TextWriter; + toString(t: T): String == { + sb: StringBuffer := new(); + (sb::TextWriter) << t; + string sb + } +} + #if ALDORTEST ---------------------- test sal_string.as -------------------------- #include "aldor" @@ -631,8 +643,15 @@ testBasics(): () == { testConcat("a", "b", "ab"); } +testToString(): () == { + import from String; + import from Integer; + assertEquals("1234", toString 1234); +} + testBasics(); testIterate(); +testToString(); #endif From ea8636c232fb6f87eb2a816d299e4995021b74ac Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 28 Jul 2015 20:41:20 +0100 Subject: [PATCH 084/352] Add conversion to literal.. kind of needed for testing... --- aldor/lib/aldor/src/datastruc/sal_string.as | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/lib/aldor/src/datastruc/sal_string.as b/aldor/lib/aldor/src/datastruc/sal_string.as index b54a122d0..38110d917 100644 --- a/aldor/lib/aldor/src/datastruc/sal_string.as +++ b/aldor/lib/aldor/src/datastruc/sal_string.as @@ -191,6 +191,7 @@ when using C--functions in \salli clients.} ++ of length `len' beginning at position `start'. substring: (%, Z) -> %; substring: (%, Z, Z) -> %; + literal: % -> Literal; #if ALDOC \alpage{substring} \Usage{\name(s, n)\\ \name(s, n, m)} @@ -224,6 +225,7 @@ of \emph{s}, while \name(s,n,m) returns a copy of the substring of length firstIndex:Z == 0; local quote:Ch == char "_""; string(l:Literal):% == string(l pretend Pointer); + literal(s: %): Literal == s pretend Literal; substring(s: %, pos: Z): % == substring(s, pos, #s - pos); data(s:%):PackedPrimitiveArray Ch == rep s; From 07fe315ceb5fa95e8b58e76d6283f2cfd3048455 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 6 Jun 2015 08:29:39 +0100 Subject: [PATCH 085/352] libaldor: Add HashSet type. Basically a Set implemented via HashTable. --- aldor/lib/aldor/src/Makefile.am | 1 + aldor/lib/aldor/src/arith/sal_mint.as | 7 ++ aldor/lib/aldor/src/datastruc/Makefile.deps | 2 + aldor/lib/aldor/src/datastruc/Makefile.in | 3 +- aldor/lib/aldor/src/datastruc/sal_hashset.as | 82 ++++++++++++++++++++ 5 files changed, 94 insertions(+), 1 deletion(-) create mode 100644 aldor/lib/aldor/src/datastruc/sal_hashset.as diff --git a/aldor/lib/aldor/src/Makefile.am b/aldor/lib/aldor/src/Makefile.am index 2a881811b..d057a58ff 100644 --- a/aldor/lib/aldor/src/Makefile.am +++ b/aldor/lib/aldor/src/Makefile.am @@ -53,6 +53,7 @@ libaldor_a_SOURCES = \ datastruc/sal_fstruc.c \ datastruc/sal_fold.c \ datastruc/sal_hash.c \ + datastruc/sal_hashset.c \ datastruc/sal_kntry.c \ datastruc/sal_langx.c \ datastruc/sal_list.c \ diff --git a/aldor/lib/aldor/src/arith/sal_mint.as b/aldor/lib/aldor/src/arith/sal_mint.as index 8f5f8836f..94087ffa3 100644 --- a/aldor/lib/aldor/src/arith/sal_mint.as +++ b/aldor/lib/aldor/src/arith/sal_mint.as @@ -64,6 +64,8 @@ of $+,-,\ast,/,\land$, while modInverse(a, b) returns the inverse of $a$ modulo $n$.} \Remarks{Those operations require that $0 \le a, b < n$.} #endif + hashCombine: (%, %) -> %; + export from IntegerSegment %; } == add { @@ -270,6 +272,11 @@ of $a$ modulo $n$.} } u; } + + hashCombine(acc: %, b: %): % == { + -- this needs to be "better", see util.c + acc * 31 + b + } } extend Byte:Join(OutputType, InputType) == add { diff --git a/aldor/lib/aldor/src/datastruc/Makefile.deps b/aldor/lib/aldor/src/datastruc/Makefile.deps index 465bd94ff..ed099c89b 100644 --- a/aldor/lib/aldor/src/datastruc/Makefile.deps +++ b/aldor/lib/aldor/src/datastruc/Makefile.deps @@ -39,3 +39,5 @@ sal_langx_deps := sal_list sal_string sal_union_deps := sal_string sal_langx sal_map_deps := sal_list + +sal_hashset_deps := sal_string sal_fold sal_hash diff --git a/aldor/lib/aldor/src/datastruc/Makefile.in b/aldor/lib/aldor/src/datastruc/Makefile.in index 784e055ec..ec512f575 100644 --- a/aldor/lib/aldor/src/datastruc/Makefile.in +++ b/aldor/lib/aldor/src/datastruc/Makefile.in @@ -19,7 +19,8 @@ library = ald_symbol ald_symtab sal_array sal_barray sal_bdata \ sal_bstruc sal_data sal_ddata sal_fstruc sal_hash sal_kntry \ sal_list sal_lstruc sal_memblk sal_parray sal_pkarray \ sal_set sal_slist sal_sortas sal_sset sal_stream sal_string \ - sal_table sal_fold ald_flags sal_langx sal_union sal_map + sal_table sal_fold ald_flags sal_langx sal_union sal_map \ + sal_hashset @BUILD_JAVA_TRUE@javalibrary := $(library) diff --git a/aldor/lib/aldor/src/datastruc/sal_hashset.as b/aldor/lib/aldor/src/datastruc/sal_hashset.as new file mode 100644 index 000000000..e8b671974 --- /dev/null +++ b/aldor/lib/aldor/src/datastruc/sal_hashset.as @@ -0,0 +1,82 @@ +#include "aldor" + +HashSet(T: HashType): BoundedFiniteDataStructureType T with { + bracket: Tuple T -> %; + bracket: Generator T -> %; + contains?: (%, T) -> Boolean; + insert!: (%, T) -> (); + empty: () -> %; +} +== add { + Rep ==> HashTable(T, Boolean); + import from Rep; + default set: %; + + (a: %) = (b: %): Boolean == { + import from MachineInteger; + import from BooleanFold; + # a = #b and (_and)/(contains?(a, elt) for elt in b) + } + + generator set: Generator T == { + k for (k, v) in rep set; + } + # set: MachineInteger == #(rep set); + free! set: () == free! rep set; + empty? set: Boolean == empty? set; + empty(): % == per table(); + copy set: % == per copy rep set; + + insert!(set, e: T): () == { + set!(rep set, e, true); + } + + contains?(set, e: T): Boolean == { + import from Partial Boolean; + not failed? find(e, rep set); + } + + [(tuple: Tuple T)]: % == { + import from MachineInteger; + acc := empty(); + for n in 1..length tuple repeat + insert!(acc, element(tuple, n)); + acc + } + + [(g: Generator T)]: % == { + acc := empty(); + for elt in g repeat insert!(acc, elt); + acc; + } + + if T has OutputType then + (tw: TextWriter) << (set: %): TextWriter == { + import from String; + import from T; + tw << "["; + sep := ""; + for k in set repeat { + tw << sep << k; + sep := ", "; + } + tw << "]"; + } + +} + +#if ALDORTEST +#include "aldor" +#include "aldorio" +#pile + +test(): () == + import from Assert Integer + import from Fold2(Integer, Integer) + import from Integer + import from HashSet Integer + e: HashSet Integer := [n for n in 1..1000] + assertEquals(500*1001, (+, 0)/(x for x in e)); + +test(); +#endif From 21aa80298f83702911009da26b46b3a0c111b9ff Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 28 Jun 2016 21:51:51 +0100 Subject: [PATCH 086/352] libaldor: Fix set intersection; buggy on empty list --- aldor/lib/aldor/src/datastruc/sal_set.as | 25 ++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/aldor/lib/aldor/src/datastruc/sal_set.as b/aldor/lib/aldor/src/datastruc/sal_set.as index 710670e99..f544d7d04 100644 --- a/aldor/lib/aldor/src/datastruc/sal_set.as +++ b/aldor/lib/aldor/src/datastruc/sal_set.as @@ -109,7 +109,7 @@ of the call, as in {\tt x := \name!(x, y)}.} (l:%) + (n:Z):% == per(rep(l) + n); union(l:%, x:T):% == union!(copy l, x); union(l1:%, l2:%):% == union!(copy l1, l2); - intersection(l1:%, l2:%):% == intersection!(copy l1, l2); +-- intersection(l1:%, l2:%):% == intersection!(copy l1, l2); (l1:%) - (l2:%):% == minus!(copy l1, l2); map(f:T -> T)(l:%):% == map!(f)(copy l); copy!(m:%, l:%):% == per copy!(rep m, rep l); @@ -148,11 +148,16 @@ of the call, as in {\tt x := \name!(x, y)}.} per l; } + intersection(l1: %, l2: %): % == [elt for elt in l1 | member?(elt, l2)]; + --intersection(l1: %, l2: %): % == intersection!(copy l1, l2); intersection!(l1:%, l2:%):% == { empty? l1 or empty? l2 => empty; x := first(l := rep l1); ll := per rest l; - member?(x, l2) => per setRest!(l, rep intersection!(ll, l2)); + member?(x, l2) => { + setRest!(l, rep intersection!(ll, l2)); + l1; + } intersection!(ll, l2); } @@ -242,3 +247,19 @@ of the call, as in {\tt x := \name!(x, y)}.} } } } + +#if ALDORTEST +#include "aldor" +#pile + +test(): () == + import from Assert Set String, String + s1: Set String := ["a"] + s2: Set String := ["b", "a"] + assertEquals(s1, intersection(s1, s2)) + s3: Set String := ["a", "b"] + assertEquals(s1, intersection(s1, s3)) + +test() + +#endif From d8f313b328f640d7ec774d1657534fe94ee4eda2 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 28 Jul 2015 20:43:50 +0100 Subject: [PATCH 087/352] libaldor::Added simple (ish) SExpression type --- aldor/configure.ac | 1 + aldor/lib/aldor/src/Makefile.am | 3 +- aldor/lib/aldor/src/lisp/Makefile.deps | 3 + aldor/lib/aldor/src/lisp/Makefile.in | 25 ++ aldor/lib/aldor/src/lisp/sal_sexpr.as | 525 +++++++++++++++++++++++++ 5 files changed, 556 insertions(+), 1 deletion(-) create mode 100644 aldor/lib/aldor/src/lisp/Makefile.deps create mode 100644 aldor/lib/aldor/src/lisp/Makefile.in create mode 100644 aldor/lib/aldor/src/lisp/sal_sexpr.as diff --git a/aldor/configure.ac b/aldor/configure.ac index 21af2e5ec..065ee7a5d 100644 --- a/aldor/configure.ac +++ b/aldor/configure.ac @@ -110,6 +110,7 @@ AC_CONFIG_FILES( lib/aldor/src/base/Makefile lib/aldor/src/arith/Makefile lib/aldor/src/datastruc/Makefile + lib/aldor/src/lisp/Makefile lib/aldor/src/test/Makefile lib/aldor/src/util/Makefile lib/aldor/src/gmp/Makefile diff --git a/aldor/lib/aldor/src/Makefile.am b/aldor/lib/aldor/src/Makefile.am index d057a58ff..dc3df68cf 100644 --- a/aldor/lib/aldor/src/Makefile.am +++ b/aldor/lib/aldor/src/Makefile.am @@ -1,4 +1,4 @@ -SUBDIRS = lang base arith datastruc util gmp test +SUBDIRS = lang base arith datastruc util gmp lisp test @BUILD_JAVA_TRUE@JAVA_SUBDIRS = $(filter-out gmp, $(SUBDIRS)) @BUILD_JAVA_TRUE@JAVA_TARGET = aldor.jar @@ -71,6 +71,7 @@ libaldor_a_SOURCES = \ datastruc/sal_union.c \ datastruc/sal_map.c \ lang/sal_lang.c \ + lisp/sal_sexpr.c \ test/tst_assert.c \ util/ald_trace.c \ util/eio_rsto.c \ diff --git a/aldor/lib/aldor/src/lisp/Makefile.deps b/aldor/lib/aldor/src/lisp/Makefile.deps new file mode 100644 index 000000000..37c9f8871 --- /dev/null +++ b/aldor/lib/aldor/src/lisp/Makefile.deps @@ -0,0 +1,3 @@ +library_deps := lang base arith datastruc util + +sal_sexpr_deps := diff --git a/aldor/lib/aldor/src/lisp/Makefile.in b/aldor/lib/aldor/src/lisp/Makefile.in new file mode 100644 index 000000000..94ef2e284 --- /dev/null +++ b/aldor/lib/aldor/src/lisp/Makefile.in @@ -0,0 +1,25 @@ +@SET_MAKE@ +VPATH = @srcdir@ + +# For AM_V_* +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ + +builddir := @builddir@ +abs_builddir := @abs_builddir@ +top_builddir := @top_builddir@ +abs_top_builddir:= @abs_top_builddir@ +srcdir := @srcdir@ +abs_srcdir := @abs_srcdir@ +top_srcdir := @top_srcdir@ +abs_top_srcdir := @abs_top_srcdir@ +subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) + +# Build starts here +library = sal_sexpr + +@BUILD_JAVA_TRUE@javalibrary := $(library) +java_test_blacklist := sal_sexpr + +include $(abs_top_srcdir)/lib/aldor/src/common.mk + +sal_sexpr.aldortest.exe sal_sexpr.aldortest-exec-interp sal_sexpr.aldortest-exec-java: sal_sexpr.asy diff --git a/aldor/lib/aldor/src/lisp/sal_sexpr.as b/aldor/lib/aldor/src/lisp/sal_sexpr.as new file mode 100644 index 000000000..3a7018b56 --- /dev/null +++ b/aldor/lib/aldor/src/lisp/sal_sexpr.as @@ -0,0 +1,525 @@ +#include "aldor" +#include "aldorio" +#pile + +local Cons: PrimitiveType with + cons: (SExpression, SExpression) -> % + first: % -> SExpression + rest: % -> SExpression + setFirst!: (%, SExpression) -> () + setRest!: (%, SExpression) -> () +== add + Rep == Record(car: SExpression, cdr: SExpression) + import from Rep + default cons1, cons2: % + + first(cons: %): SExpression == rep(cons).car + rest(cons: %): SExpression == rep(cons).cdr + cons(car: SExpression, cdr: SExpression): % == per [car, cdr] + + setFirst!(cons: %, sx: SExpression): () == rep(cons).car := sx + setRest!(cons: %, sx: SExpression): () == rep(cons).cdr := sx + + cons1 = cons2: Boolean == + first cons1 = first cons2 and rest cons1 = rest cons2 + +CharSets: with + symStart?: Character -> Boolean + symPart?: Character -> Boolean + numberStart?: Character -> Boolean + numberPart?: Character -> Boolean + whitespace?: Character -> Boolean +== add + default c: Character + local symStarts: Set Character := + [char "+", char "-", + char "*", char "/", + char "<", char ">", + char "%", char "$"] + + symStart?(c): Boolean == letter? c or member?(c, symStarts) + whitespace?(c): Boolean == c = space or c = newline or c = tab + symPart?(c): Boolean == + symStart? c or digit? c + + numberStart? c: Boolean == digit? c + numberPart? c: Boolean == digit? c + +SExpression: Join(OutputType, PrimitiveType) with + sexpr: Symbol -> % + sexpr: Integer -> % + sexpr: String -> % + sexpr: Cons -> % + nil: % + cons?: % -> Boolean + int?: % -> Boolean + str?: % -> Boolean + sym?: % -> Boolean + nil?: % -> Boolean + + cons: (%, %) -> % + first: % -> % + rest: % -> % + bracket: Generator % -> % + bracket: Tuple % -> % + append: (%, %) -> % + + sym: % -> Symbol + int: % -> Integer + str: % -> String + + first: % -> % + rest: % -> % + + nth: (%, Integer) -> % + generator: % -> Generator % +== add + Rep == Union(SYM: Symbol, INT: Integer, STR: String, CONS: Cons) + import from Rep + default sx, sx1, sx2: % + nil: % == (nil$Pointer) pretend % + nil(): % == (nil$Pointer) pretend % + + sym(sx: %): Symbol == rep(sx).SYM + int(sx: %): Integer == rep(sx).INT + str(sx: %): String == rep(sx).STR + + sexpr(sym: Symbol): % == per [sym] + sexpr(n: Integer): % == per [n] + sexpr(str: String): % == per [str] + sexpr(cons: Cons): % == per [cons] + + cons? sx: Boolean == not nil? sx and rep(sx) case CONS + sym? sx: Boolean == not nil? sx and rep(sx) case SYM + int? sx: Boolean == not nil? sx and rep(sx) case INT + str? sx: Boolean == not nil? sx and rep(sx) case STR + nil? sx: Boolean == { + import from Pointer; + (rep(sx) pretend Pointer) = nil + } + first sx: % == first rep(sx).CONS + rest sx: % == rest rep(sx).CONS + + setRest!(sx, r: SExpression): () == setRest!(rep(sx).CONS, r) + + cons(sx1, sx2): % == + per [cons(sx1, sx2)] + + sx1 = sx2: Boolean == + cons? sx1 and cons? sx2 => + rep(sx1).CONS = rep(sx2).CONS + sym? sx1 and sym? sx2 => + rep(sx1).SYM = rep(sx2).SYM + int? sx1 and int? sx2 => + rep(sx1).INT = rep(sx2).INT + str? sx1 and str? sx2 => + rep(sx1).STR = rep(sx2).STR + nil? sx1 and nil? sx2 => true + false + + (o: TextWriter) << (sx: %): TextWriter == + nil? sx => o << "()" + cons? sx => writeList(o, sx) + int? sx => o << rep(sx).INT + str? sx => writeString(o, rep(sx).STR) + sym? sx => writeSymbol(o, rep(sx).SYM) + never + + bracket(t: Tuple %): % == + import from MachineInteger + length(t) = 0 => nil + length(t) = 1 => cons(element(t, 1), nil) + l: % := nil + for n in length(t)..1 by -1 repeat l := cons(element(t, n), l) + l + + bracket(g: Generator %): % == + l := nil() + last := nil() + for sx in g repeat + if last = nil() then + l := cons(sx, nil()) + last := l + else + next: % := cons(sx, nil()) + setRest!(last, next) + last := next + return l + + -- this is needed (by append) to avoid a of_emerge bug which + -- merges a potentially null reference. + local copyList(sx): (SExpression, SExpression) == + nil? sx => never + last: % := cons(first sx, nil()) + result := last + sx := rest sx + while cons? sx repeat + next: % := cons(first sx, nil()) + setRest!(last, next) + last := next + sx := rest sx + if not nil? sx then never + (result, last) + + append(sx1, sx2): % == + nil? sx1 => sx2 + (result, lastPair) := copyList(sx1) + setRest!(lastPair, sx2) + result + + nth(sx, n: Integer): % == if n = 0 then first sx else nth(rest sx, n-1) + + generator(sx): Generator % == generate { + while cons? sx repeat { + yield first sx; + sx := rest sx + } + } + + local writeList(o: TextWriter, sx): TextWriter == + o << "(" + o << first sx + sx := rest sx + while cons? sx repeat + o << " " << first(sx) + sx := rest(sx) + if not nil? sx then + o << " . " << sx + o << ")" + + local writeString(o: TextWriter, s: String): TextWriter == + o << "_"" << s << "_"" + + local writeSymbol(o: TextWriter, s: Symbol): TextWriter == + o << name s + +LStream(T: Type): Category == with + peek: % -> T + next!: % -> () + hasNext?: % -> Boolean + +TextLStream: LStream Character with + tstream: TextReader -> %; +== add + Rep == Record(rdr: TextReader, curr: Character, hasCurr: Boolean, atEof: Boolean); + import from Rep + import from Character + default str: %; + + local hasCurr? str: Boolean == rep(str).hasCurr + + tstream(rdr: TextReader): % == per [rdr, eof, false, false] + + local readOne(str): () == + c := read!(rep(str).rdr) + if eof = c then + rep(str).atEof := true + else + rep(str).curr := c + rep(str).hasCurr := true + + peek(str): Character == + rep(str).atEof => never + if not hasCurr? str then readOne str + rep(str).atEof => never + rep(str).curr + + hasNext?(str): Boolean == + if not hasCurr? str then readOne str + not rep(str).atEof + + next!(str): () == + rep(str).hasCurr := false + +FnLStream(T: Type): LStream T with + tstream: (readOne: () -> Partial T) -> % +== add + Rep == Record(readOne!: () -> Partial T, + curr: Partial T, atEos: Boolean); + import from Rep + default str: %; + + tstream(readOne!: () -> Partial T): % == per [readOne!, failed, false] + + local readOne!(str): () == + item := rep(str).readOne!() + if failed? item then rep(str).atEos := true + rep(str).curr := item + + peek(str): T == + rep(str).atEos => never + if failed? rep(str).curr then readOne!(str) + retract rep(str).curr + + hasNext?(str): Boolean == + rep(str).atEos => false + if failed? rep(str).curr then readOne!(str) + not rep(str).atEos + + next!(str): () == + rep(str).curr := failed + + +SExpressionReader: with + read: (TextReader) -> Partial SExpression; +== add + Token == Record(type: 'sym,number,str,ws,oparen,cparen,dot,error', txt: String); + import from Token + import from CharSets + readOneToken(rdr: TextReader): Partial Token == + import from TextLStream + s := tstream rdr + if hasNext? s then readOneToken! s else failed + + read(rdr: TextReader): Partial SExpression == + import from TextLStream + import from FnLStream Token + s := tstream rdr + tokstrm := tstream((): Partial Token +-> {stdout << "C:ReadOne" << newline; + readOneToken! s}); + sxMaybe: Partial SExpression := read(tokstrm) + sxMaybe + + readOneToken!(s: TextLStream): Partial Token == + import from Character + not hasNext? s => failed + c := peek s; + whitespace? c => [readWhitespace(s)] + c = char "(" => + next! s + [[oparen, c::String]] + c = char ")" => + next! s + [[cparen, c::String]] + c = char "|" => [readEscaped s] + c = char "." => + next! s + [[dot, c::String]] + c = char "_"" => [readString s] + symStart? c => [readSymbol s] + numberStart? c => [readNumber s] + failed + + readString(s: TextLStream): Token == + done := false + text := "" + next! s + while hasNext? s and peek s ~= char "_"" repeat + text := text + peek(s)::String + next! s + not hasNext? s => [error, "eof inside string"] + [str, text] + + readWhitespace(s: TextLStream): Token == + import from Character + text := peek(s)::String + next! s + while whitespace? peek s repeat + text := text + peek(s)::String + next! s + [ws, text] + + readEscaped(s: TextLStream): Token == + import from Character + next! s + text := "" + while peek s ~= char "|" repeat + text := text + peek(s)::String + next! s + next! s + [sym, text] + + readNumber(s: TextLStream): Token == + text := "" + while hasNext? s and numberPart? peek s repeat + text := text + peek(s)::String + next! s + [number, text] + + readSymbol(s: TextLStream): Token == + text := "" + while hasNext? s and symPart? peek s repeat + text := text + peek(s)::String + next! s + [sym, text] + + read(s: FnLStream Token): Partial SExpression == + import from SExpression, Symbol + skipWhitespace!(): () == + while hasNext? s and peek(s).type = ws repeat + next! s + + readList(): Partial SExpression == + not hasNext? s => failed + peek(s).type = cparen => + next! s + [nil] + tmp := read() + failed? tmp => failed + head: Cons := cons(retract tmp, nil) + last := head + done := false + while not done repeat + skipWhitespace!() + if not hasNext? s then return failed + if peek(s).type = dot then + next! s + final := read() + failed? final => return failed + setRest!(last, retract final) + done := true + else if peek(s).type = cparen then + done := true + next! s + else + next := read() + failed? next => return failed + nextCell: Cons := cons(retract next, nil) + setRest!(last, sexpr nextCell) + last := nextCell + return [sexpr head] + + read(): Partial SExpression == + import from Integer + skipWhitespace!() + not hasNext? s => + failed + tok := peek s; + next! s + if tok.type = oparen then readList() + else if tok.type = cparen then failed + else if tok.type = str then [sexpr tok.txt] + else if tok.type = sym then + [sexpr (-tok.txt)] + else if tok.type = number then [sexpr integer literal tok.txt] + else + failed + read() + +#if ALDORTEST +#include "aldor" +#include "aldorio" +#pile + +readOne(s: String): Partial SExpression == + import from SExpressionReader + sb: StringBuffer := new() + sb::TextWriter << s + read(sb::TextReader) + +test(): () == + import from Partial SExpression + import from SExpression + import from Assert SExpression + import from Integer + import from Symbol + + sxMaybe := readOne("foo") + assertFalse failed? sxMaybe + foo := sexpr (-"foo") + assertEquals(foo, retract sxMaybe) + + sxMaybe := readOne("23") + stdout << "SX: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals(sexpr 23, retract sxMaybe) + + sxMaybe := readOne( "_"hello_"") + stdout << "SX: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals(sexpr "hello", retract sxMaybe) + + sxMaybe := readOne("(foo)") + stdout << "SX: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals(cons(foo, nil), retract sxMaybe) + + sxMaybe := readOne("(foo 2)") + stdout << "SX: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals(cons(foo, cons(sexpr 2, nil)), retract sxMaybe) + + sxMaybe := readOne("(foo . 2)") + stdout << "SX: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals(cons(foo, sexpr 2), retract sxMaybe) + + sxMaybe := readOne("|+->|") + stdout << "SX: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals(sexpr (-"+->"), retract sxMaybe) + + sxMaybe := readOne("(foo () 2)") + stdout << "SX: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals([sexpr(-"foo"), [], sexpr 2], retract sxMaybe) + +test() + +test2(): () == + import from File + import from SExpression + import from SExpressionReader + import from Partial SExpression + + rdr := open("sal__sexpr.asy")::TextReader + + sx := read(rdr) + stdout << sx << newline + +testBracket(): () == + import from Assert SExpression + import from Integer + sx: SExpression := [sexpr x for x in 1..3] + assertEquals(sexpr 1, first sx) + assertEquals(sexpr 2, first rest sx) + assertEquals(sexpr 3, first rest rest sx) + assertEquals(nil, rest rest rest sx) + +testAppend(): () == + import from Assert SExpression + import from Integer + sx1: SExpression := cons(sexpr 1, nil) + sx2: SExpression := cons(sexpr 2, nil) + assertEquals(sexpr 1, first append(nil, sx1)) + assertEquals(nil, rest append(nil, sx1)) + assertEquals(sexpr 1, first append(sx1, nil)) + assertEquals(sexpr 1, first append(sx1, sx2)) + assertEquals(sexpr 2, first rest append(sx1, sx2)) + +testNth(): () == + import from Assert SExpression + import from SExpression + import from Integer + l: SExpression := [sexpr 1, sexpr 2, sexpr 3] + assertEquals(sexpr 1, nth(l, 0)) + assertEquals(sexpr 2, nth(l, 1)) + assertEquals(sexpr 3, nth(l, 2)) + +testGenerator(): () == + import from Assert Integer + import from SExpression + import from Integer + import from Fold Integer + sx: SExpression := [sexpr n for n in 1..3] + sum := (+)/(int elt for elt in sx) + assertEquals(6, sum) + +test2() +testBracket() +testAppend() +testNth() +testGenerator() + +import from Integer +nada: SExpression := cons(sexpr 1, sexpr 2) +testAppend2(): SExpression == + l := nada + l2 := if cons? l then a := cons(sexpr 22, nil) else nil + append(l2, l) + +nada: SExpression := nil + +testAppend2() + +#endif From fcd1ce15379d28e1820b524c9cad3646afb5ac6b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 24 May 2016 21:27:17 +0100 Subject: [PATCH 088/352] libaldor: Allow sexprs to contain '?' --- aldor/lib/aldor/src/lisp/sal_sexpr.as | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/aldor/lib/aldor/src/lisp/sal_sexpr.as b/aldor/lib/aldor/src/lisp/sal_sexpr.as index 3a7018b56..f98626a13 100644 --- a/aldor/lib/aldor/src/lisp/sal_sexpr.as +++ b/aldor/lib/aldor/src/lisp/sal_sexpr.as @@ -35,7 +35,8 @@ CharSets: with [char "+", char "-", char "*", char "/", char "<", char ">", - char "%", char "$"] + char "%", char "$", + char "?"] symStart?(c): Boolean == letter? c or member?(c, symStarts) whitespace?(c): Boolean == c = space or c = newline or c = tab @@ -454,6 +455,11 @@ test(): () == assertFalse failed? sxMaybe assertEquals([sexpr(-"foo"), [], sexpr 2], retract sxMaybe) + sxMaybe := readOne("symbol?") + stdout << "SX: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals(sexpr(-"symbol?"), retract sxMaybe) + test() test2(): () == From 2087a43ceaf804863dcf3f7901bc950e99ab0569 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 24 May 2016 21:28:34 +0100 Subject: [PATCH 089/352] libaldor: SExpression is now an InputType. --- aldor/lib/aldor/src/lisp/sal_sexpr.as | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/aldor/lib/aldor/src/lisp/sal_sexpr.as b/aldor/lib/aldor/src/lisp/sal_sexpr.as index f98626a13..65cdb7ed8 100644 --- a/aldor/lib/aldor/src/lisp/sal_sexpr.as +++ b/aldor/lib/aldor/src/lisp/sal_sexpr.as @@ -46,7 +46,7 @@ CharSets: with numberStart? c: Boolean == digit? c numberPart? c: Boolean == digit? c -SExpression: Join(OutputType, PrimitiveType) with +SExpression: Join(InputType, OutputType, PrimitiveType) with sexpr: Symbol -> % sexpr: Integer -> % sexpr: String -> % @@ -194,6 +194,10 @@ SExpression: Join(OutputType, PrimitiveType) with local writeSymbol(o: TextWriter, s: Symbol): TextWriter == o << name s + <<(rdr: TextReader): % == + import from SExpressionReader, Partial % + retract read rdr + LStream(T: Type): Category == with peek: % -> T next!: % -> () From c760fd1747476bde18513b4acbc7d88f3164b606 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 24 May 2016 21:34:29 +0100 Subject: [PATCH 090/352] sal_sexpr: Remove logging --- aldor/lib/aldor/src/lisp/sal_sexpr.as | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/aldor/lib/aldor/src/lisp/sal_sexpr.as b/aldor/lib/aldor/src/lisp/sal_sexpr.as index 65cdb7ed8..58791ed78 100644 --- a/aldor/lib/aldor/src/lisp/sal_sexpr.as +++ b/aldor/lib/aldor/src/lisp/sal_sexpr.as @@ -280,8 +280,7 @@ SExpressionReader: with import from TextLStream import from FnLStream Token s := tstream rdr - tokstrm := tstream((): Partial Token +-> {stdout << "C:ReadOne" << newline; - readOneToken! s}); + tokstrm := tstream((): Partial Token +-> readOneToken! s) sxMaybe: Partial SExpression := read(tokstrm) sxMaybe From 195e90ccce7bdf3a1faee60683cd291ba889d13c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 22 May 2015 22:23:07 +0100 Subject: [PATCH 091/352] algebra::logic: Add some basic types. - Nothing huge, type for boolean expressions and an atom domain --- aldor/configure.ac | 1 + aldor/lib/algebra/src/Makefile.am | 4 ++ aldor/lib/algebra/src/logic/Makefile.deps | 6 +++ aldor/lib/algebra/src/logic/Makefile.in | 20 ++++++++ aldor/lib/algebra/src/logic/sit_bit.as | 23 +++++++++ aldor/lib/algebra/src/logic/sit_idxatom.as | 54 +++++++++++++++++++++ aldor/lib/algebra/src/logic/sit_logiccat.as | 36 ++++++++++++++ 7 files changed, 144 insertions(+) create mode 100644 aldor/lib/algebra/src/logic/Makefile.deps create mode 100644 aldor/lib/algebra/src/logic/Makefile.in create mode 100644 aldor/lib/algebra/src/logic/sit_bit.as create mode 100644 aldor/lib/algebra/src/logic/sit_idxatom.as create mode 100644 aldor/lib/algebra/src/logic/sit_logiccat.as diff --git a/aldor/configure.ac b/aldor/configure.ac index 065ee7a5d..ee9fdf48c 100644 --- a/aldor/configure.ac +++ b/aldor/configure.ac @@ -128,6 +128,7 @@ AC_CONFIG_FILES( lib/algebra/src/categories/Makefile lib/algebra/src/basic/Makefile lib/algebra/src/basic/compbug/Makefile + lib/algebra/src/logic/Makefile lib/algebra/src/mat/Makefile lib/algebra/src/mat/gauss/Makefile lib/algebra/src/mat/modular/Makefile diff --git a/aldor/lib/algebra/src/Makefile.am b/aldor/lib/algebra/src/Makefile.am index ff9ba2305..428b3dd84 100644 --- a/aldor/lib/algebra/src/Makefile.am +++ b/aldor/lib/algebra/src/Makefile.am @@ -8,6 +8,7 @@ SUBDIRS = \ categories \ basic \ basic/compbug \ + logic \ mat \ mat/gauss \ mat/modular \ @@ -150,6 +151,9 @@ libalgebra_a_SOURCES = \ fraction/sit_quotcat.c \ fraction/sit_uflgqot.c \ fraction/sit_vecquot.c \ + logic/sit_bit.c \ + logic/sit_idxatom.c \ + logic/sit_logiccat.c \ mat/gauss/sit_dfge.c \ mat/gauss/sit_ff2ge.c \ mat/gauss/sit_ffge.c \ diff --git a/aldor/lib/algebra/src/logic/Makefile.deps b/aldor/lib/algebra/src/logic/Makefile.deps new file mode 100644 index 000000000..894a2e2ec --- /dev/null +++ b/aldor/lib/algebra/src/logic/Makefile.deps @@ -0,0 +1,6 @@ +sit_logiccat_deps := +sit_idxatom_deps := sit_logiccat +sit_bit_deps := sit_logiccat + +library_deps := util numbers extree extree/operators extree/parser \ + categories basic diff --git a/aldor/lib/algebra/src/logic/Makefile.in b/aldor/lib/algebra/src/logic/Makefile.in new file mode 100644 index 000000000..5937a073c --- /dev/null +++ b/aldor/lib/algebra/src/logic/Makefile.in @@ -0,0 +1,20 @@ +@SET_MAKE@ +VPATH = @srcdir@ + +# For AM_V_* +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ + +builddir := @builddir@ +abs_builddir := @abs_builddir@ +top_builddir := @top_builddir@ +abs_top_builddir:= @abs_top_builddir@ +srcdir := @srcdir@ +abs_srcdir := @abs_srcdir@ +top_srcdir := @top_srcdir@ +abs_top_srcdir := @abs_top_srcdir@ +subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) + +# Build starts here +library = sit_logiccat sit_idxatom sit_bit + +include $(abs_top_srcdir)/lib/algebra/src/common.mk diff --git a/aldor/lib/algebra/src/logic/sit_bit.as b/aldor/lib/algebra/src/logic/sit_bit.as new file mode 100644 index 000000000..c665a337f --- /dev/null +++ b/aldor/lib/algebra/src/logic/sit_bit.as @@ -0,0 +1,23 @@ +#include "algebra" + +Bit: BooleanAlgebra with { + coerce: Boolean -> %; + coerce: % -> Boolean; +} + == add { + Rep == Boolean; + import from Rep; + true: % == per true; + false: % == per false; + + _and(a: %, b: %): % == per(rep a and rep b); + _or(a: %, b: %): % == per(rep a or rep b); + _not(a: %): % == per not rep a; + + coerce(b: Boolean): % == per b; + coerce(bit: %): Boolean == rep bit; + + extree(a: %): ExpressionTree == extree rep a; + + (a: %) = (b: %): Boolean == rep a = rep b; +} \ No newline at end of file diff --git a/aldor/lib/algebra/src/logic/sit_idxatom.as b/aldor/lib/algebra/src/logic/sit_idxatom.as new file mode 100644 index 000000000..4e5178a67 --- /dev/null +++ b/aldor/lib/algebra/src/logic/sit_idxatom.as @@ -0,0 +1,54 @@ +#include "algebra" + +IndexedAtom: LogicAtom with { + atom: Integer -> %; + index: % -> Integer; + negate: % -> %; + negated?: % -> Boolean; + isNegation?: (%, %) -> Boolean; + positive: % -> %; +} +== add { + Rep == Integer; + import from Rep; + + atom(x: Integer): % == { + x <= 0 => never; + per x; + } + + extree(a: %): ExpressionTree == extree rep(a); + + (a: %) < (b: %): Boolean == rep(a) < rep(b); + (a: %) = (b: %): Boolean == rep(a) = rep(b); + + index(x: %): Integer == abs(rep(x)); + + negate(x: %): % == per(-rep(x)); + positive(x: %): % == if rep(x) < 0 then per(-rep(x)) else x; + negated?(x: %): Boolean == rep(x) < 0; + + isNegation?(a: %, b: %): Boolean == rep(a) = -rep(b); + +} + +#if ALDORTEST +#include "algebra" +#include "aldorio" +#pile + +test(): () == + import from Assert IndexedAtom + import from IndexedAtom + import from LogicAtomTests IndexedAtom + import from Integer + a1 := atom 1 + a2 := atom 2 + assertTrue(testAtom(a1)) + assertTrue(testAtom(a2)) + assertNotEquals(a1, a2) + assertEquals(a1, atom 1) + assertFalse negated? a1 + assertTrue negated? negate a1 + +#endif diff --git a/aldor/lib/algebra/src/logic/sit_logiccat.as b/aldor/lib/algebra/src/logic/sit_logiccat.as new file mode 100644 index 000000000..c09995b41 --- /dev/null +++ b/aldor/lib/algebra/src/logic/sit_logiccat.as @@ -0,0 +1,36 @@ +#include "algebra" + +LogicAtom: Category == Join(ExpressionType, TotallyOrderedType) with { + negate: % -> %; + negated?: % -> Boolean; + positive: % -> %; +} + +BooleanAlgebra: Category == ExpressionType with { + _and: (%, %) -> %; + _or: (%, %) -> %; + _not: % -> %; + + false: %; + true: %; +} + + +-- Test the basic axioms for Atoms +-- not very interesting, but anyways.. +LogicAtomTests(LA: LogicAtom): with { + testAtom: LA -> Boolean; +} +== add { + testAtom(a: LA): Boolean == { + not (a = a) => false; + a ~= a => false; + negate a ~= a => false; + negated? a => negate a = positive a; + negated? a => not negated? negate a; + not negated? a => negated? negate a; + not negated? a => a = positive a; + negate negate a ~= a => false; + true; + } +} From e3ef5f9bf83247cffbe9602765e871cefd615e3c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 24 May 2015 07:22:27 +0100 Subject: [PATCH 092/352] algebra: Add logical expression type - just something fairly basic.. structural equality only. --- aldor/lib/algebra/src/Makefile.am | 1 + aldor/lib/algebra/src/logic/Makefile.deps | 1 + aldor/lib/algebra/src/logic/Makefile.in | 2 +- aldor/lib/algebra/src/logic/sit_lexpr.as | 203 ++++++++++++++++++++++ 4 files changed, 206 insertions(+), 1 deletion(-) create mode 100644 aldor/lib/algebra/src/logic/sit_lexpr.as diff --git a/aldor/lib/algebra/src/Makefile.am b/aldor/lib/algebra/src/Makefile.am index 428b3dd84..4dc1eea65 100644 --- a/aldor/lib/algebra/src/Makefile.am +++ b/aldor/lib/algebra/src/Makefile.am @@ -153,6 +153,7 @@ libalgebra_a_SOURCES = \ fraction/sit_vecquot.c \ logic/sit_bit.c \ logic/sit_idxatom.c \ + logic/sit_lexpr.c \ logic/sit_logiccat.c \ mat/gauss/sit_dfge.c \ mat/gauss/sit_ff2ge.c \ diff --git a/aldor/lib/algebra/src/logic/Makefile.deps b/aldor/lib/algebra/src/logic/Makefile.deps index 894a2e2ec..a5764098a 100644 --- a/aldor/lib/algebra/src/logic/Makefile.deps +++ b/aldor/lib/algebra/src/logic/Makefile.deps @@ -1,6 +1,7 @@ sit_logiccat_deps := sit_idxatom_deps := sit_logiccat sit_bit_deps := sit_logiccat +sit_lexpr_deps := sit_idxatom library_deps := util numbers extree extree/operators extree/parser \ categories basic diff --git a/aldor/lib/algebra/src/logic/Makefile.in b/aldor/lib/algebra/src/logic/Makefile.in index 5937a073c..9ce1c231a 100644 --- a/aldor/lib/algebra/src/logic/Makefile.in +++ b/aldor/lib/algebra/src/logic/Makefile.in @@ -15,6 +15,6 @@ abs_top_srcdir := @abs_top_srcdir@ subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) # Build starts here -library = sit_logiccat sit_idxatom sit_bit +library = sit_logiccat sit_idxatom sit_bit sit_lexpr include $(abs_top_srcdir)/lib/algebra/src/common.mk diff --git a/aldor/lib/algebra/src/logic/sit_lexpr.as b/aldor/lib/algebra/src/logic/sit_lexpr.as new file mode 100644 index 000000000..cc3892949 --- /dev/null +++ b/aldor/lib/algebra/src/logic/sit_lexpr.as @@ -0,0 +1,203 @@ +#include "algebra" +#include "aldorio" + +OrClause: ExpressionType with { + clause: IndexedAtom -> %; + _or: Tuple % -> Partial %; + atom: % -> Partial IndexedAtom; + terms: % -> List IndexedAtom; + + false: () -> %; + false?: % -> Boolean; +} +== add { + Rep ==> List IndexedAtom; + import from Rep; + + clause(a: IndexedAtom): % == per [a]; + false(): % == per []; + false?(cl: %): Boolean == empty? rep cl; + + atom(cl: %): Partial IndexedAtom == { + false? cl => failed; + not empty? rest rep cl => failed; + [first rep cl] + } + + terms(cl: %): List IndexedAtom == rep cl; + + local safelyCons(a: IndexedAtom, b: Partial List IndexedAtom): Partial List IndexedAtom == + if failed? b then failed else [cons(a, retract b)]; + + local merge(a: Rep, b: Rep): Partial Rep == { + import from IndexedAtom, Integer; + empty? a => [b]; + empty? b => [a]; + aatom := first a; + batom := first b; + if aatom = batom then safelyCons(first a, merge(rest a, rest b)) + else if isNegation?(aatom, batom) then failed; + else if index aatom > index batom then safelyCons(first b, merge(a, rest b)) + else safelyCons(first a, merge(rest a, b)); + } + + local or2(a: %, b: %): Partial % == { + import from Partial Rep; + pr := merge(rep a, rep b); + failed? pr => failed; + [per retract pr]; + } + + _or(t: Tuple %): Partial % == { + import from MachineInteger; + acc := element(t, 1); + for idx in 2..(length(t)) repeat { + term := element(t, idx); + pacc := or2(acc, term); + failed? pacc => return failed; + acc := retract pacc; + } + [acc] + } + + (a: %) = (b: %): Boolean == rep a = rep b; + + extree(a: %): ExpressionTree == { + import from List ExpressionTree, IndexedAtom; + import from ListMapper(IndexedAtom, ExpressionTree); + import from ExpressionTreeLeaf; + empty? rep a => extree leaf(true); + ExpressionTreeList(map(extree)(rep a)); + } + +} + +LogicExpression: BooleanAlgebra with { + expression: IndexedAtom -> %; + not?: % -> Boolean; + and?: % -> Boolean; + or?: % -> Boolean; + + true?: % -> Boolean; + false?: % -> Boolean; +} +== add { + Rep ==> Union(AND: List %, OR: List %, NOT: %, CL: OrClause); + import from Rep; + import from OrClause; + import from List %; + default expr: %; + + not? expr: Boolean == rep(expr) case NOT; + and? expr: Boolean == rep(expr) case AND; + or? expr: Boolean == rep(expr) case OR or rep(expr) case CL; + local clause? expr: Boolean == rep(expr) case CL; + expression(a: IndexedAtom): % == per [clause a]; + + local terms expr: List % == { + import from List IndexedAtom; + clause? expr => [expression atom for atom in terms rep(expr).CL]; + and? expr => rep(expr).AND; + or? expr => rep(expr).OR; + not? expr => [rep(expr).NOT]; + never; + } + + true: % == per [ [], AND]; + false: % == per [ false(), CL]; + + true? expr: Boolean == and? expr and empty? rep(expr).AND; + false? expr: Boolean == clause? expr and false? rep(expr).CL; + + _not(e: %): % == { + true? e => false; + false? e => true; + not? e => rep(e).NOT; + per [e, NOT]; + } + + _and(expr1: %, expr2: %): % == { + and? expr1 and and? expr2 => per [append!(copy rep(expr1).AND, rep(expr2).AND), AND]; + per [[expr1, expr2], AND]; + } + + _or(expr1: %, expr2: %): % == { + import from Partial OrClause; + clause? expr1 and clause? expr2 => { + tmp := _or(rep(expr1).CL, rep(expr2).CL); + failed? tmp => true; + per [retract tmp, CL] + } + or? expr1 and or? expr2 => per [append!(copy terms expr1, terms expr2), OR]; + per [[expr1, expr2], OR]; + } + + extree(a: %): ExpressionTree == { + import from List ExpressionTree; + import from ExpressionTreeLeaf; + import from ListMapper(LogicExpression, ExpressionTree); + clause? a => extree(rep(a).CL); + or? a => ExpressionTreePlus(map(extree) rep(a).OR); + and? a => { + empty? rep(a).AND => extree leaf false; + ExpressionTreeTimes(map(extree) rep(a).AND); + } + not? a => ExpressionTreeMinus([extree(rep(a).NOT)]); + never; + } + + (expr1: %) = (expr2: %): Boolean == { + and? expr1 => and? expr2 and rep(expr1).AND = rep(expr2).AND; + clause? expr1 => clause? expr2 and rep(expr1).CL = rep(expr2).CL; + or? expr1 => or? expr2 and rep(expr1).OR = rep(expr2).OR; + not? expr1 => not? expr2 and rep(expr1).OR = rep(expr2).OR; + false + } + +} + +#if ALDORTEST +#include "algebra" +#include "aldorio" +#pile + +test(): () == + import from OrClause + import from Assert OrClause + import from Assert Partial OrClause + import from Partial OrClause + import from IndexedAtom + import from Integer + atom1 := atom 1 + atom2 := atom 2 + + assertEquals(false(), false()) + assertEquals(clause atom1, clause atom1) + assertNotEquals(clause atom1, clause atom2) + assertNotEquals(clause atom1, false()) + + assertEquals([clause atom1], _or(false(), clause atom1)) + assertEquals([clause atom1], _or(clause atom1, clause atom1)) + assertEquals(_or(clause atom1, clause atom2), _or(clause atom2, clause atom1)) + assertEquals(_or(clause atom1, clause atom2, clause negate atom1), failed) + +test2(): () == + import from Assert LogicExpression + import from LogicExpression + import from OrClause + import from IndexedAtom + import from Integer + + e1 := expression atom 1; + e2 := expression atom 2; + e3 := expression atom 3; + + assertTrue(or? _or(e1, e2)) + assertTrue(and? _and(e1, e2)) + assertTrue(and? _and(e1, _or(e1, e3))) + assertTrue(not? _not(_or(e1, e2))) + +test() +test2() + +#endif From a6e0c120ff21da51cca152e4055019e3e9cf4ec6 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 6 Jun 2015 08:42:13 +0100 Subject: [PATCH 093/352] algebra::logic: Add true? and false? to BooleanAlgebra --- aldor/lib/algebra/src/logic/sit_bit.as | 5 ++++- aldor/lib/algebra/src/logic/sit_logiccat.as | 4 +++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/aldor/lib/algebra/src/logic/sit_bit.as b/aldor/lib/algebra/src/logic/sit_bit.as index c665a337f..222b56f47 100644 --- a/aldor/lib/algebra/src/logic/sit_bit.as +++ b/aldor/lib/algebra/src/logic/sit_bit.as @@ -9,7 +9,10 @@ Bit: BooleanAlgebra with { import from Rep; true: % == per true; false: % == per false; - + + true?(a: %): Boolean == rep a; + false?(a: %): Boolean == not rep a; + _and(a: %, b: %): % == per(rep a and rep b); _or(a: %, b: %): % == per(rep a or rep b); _not(a: %): % == per not rep a; diff --git a/aldor/lib/algebra/src/logic/sit_logiccat.as b/aldor/lib/algebra/src/logic/sit_logiccat.as index c09995b41..73bf8d11b 100644 --- a/aldor/lib/algebra/src/logic/sit_logiccat.as +++ b/aldor/lib/algebra/src/logic/sit_logiccat.as @@ -13,8 +13,10 @@ BooleanAlgebra: Category == ExpressionType with { false: %; true: %; -} + true?: % -> Boolean; + false?: % -> Boolean; +} -- Test the basic axioms for Atoms -- not very interesting, but anyways.. From 7d5356f725de4bbcb8072846db7783b37b9d2a1b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 10 Aug 2015 20:05:54 +0100 Subject: [PATCH 094/352] algebra::logic: Add an order and hash function to logic domains .. this way they can go in tables & c --- aldor/lib/algebra/src/logic/sit_idxatom.as | 3 +- aldor/lib/algebra/src/logic/sit_lexpr.as | 504 ++++++++++++++++++++- 2 files changed, 494 insertions(+), 13 deletions(-) diff --git a/aldor/lib/algebra/src/logic/sit_idxatom.as b/aldor/lib/algebra/src/logic/sit_idxatom.as index 4e5178a67..5b6f6a3e7 100644 --- a/aldor/lib/algebra/src/logic/sit_idxatom.as +++ b/aldor/lib/algebra/src/logic/sit_idxatom.as @@ -1,6 +1,6 @@ #include "algebra" -IndexedAtom: LogicAtom with { +IndexedAtom: Join(HashType, LogicAtom) with { atom: Integer -> %; index: % -> Integer; negate: % -> %; @@ -30,6 +30,7 @@ IndexedAtom: LogicAtom with { isNegation?(a: %, b: %): Boolean == rep(a) = -rep(b); + hash(a: %): MachineInteger == hash rep a; } #if ALDORTEST diff --git a/aldor/lib/algebra/src/logic/sit_lexpr.as b/aldor/lib/algebra/src/logic/sit_lexpr.as index cc3892949..ee5980a0b 100644 --- a/aldor/lib/algebra/src/logic/sit_lexpr.as +++ b/aldor/lib/algebra/src/logic/sit_lexpr.as @@ -1,11 +1,11 @@ #include "algebra" #include "aldorio" -OrClause: ExpressionType with { +OrClause: Join(ExpressionType, TotallyOrderedType, HashType) with { clause: IndexedAtom -> %; _or: Tuple % -> Partial %; atom: % -> Partial IndexedAtom; - terms: % -> List IndexedAtom; + atoms: % -> List IndexedAtom; false: () -> %; false?: % -> Boolean; @@ -24,7 +24,13 @@ OrClause: ExpressionType with { [first rep cl] } - terms(cl: %): List IndexedAtom == rep cl; + hash(cl: %): MachineInteger == { + import from Fold2(MachineInteger, MachineInteger); + import from IndexedAtom; + (hashCombine, 31)/(hash atom for atom in rep cl) + } + + atoms(cl: %): List IndexedAtom == rep cl; local safelyCons(a: IndexedAtom, b: Partial List IndexedAtom): Partial List IndexedAtom == if failed? b then failed else [cons(a, retract b)]; @@ -70,16 +76,125 @@ OrClause: ExpressionType with { ExpressionTreeList(map(extree)(rep a)); } + (a: %) < (b: %): Boolean == { + import from IndexedAtom; + false? a => false; + false? b => true; + a1 := first rep a; + b1 := first rep b; + a1 < b1 => true; + b1 < a1 => false; + per rest rep a < per rest rep b; + } + +} + + +AndClause: Join(ExpressionType, TotallyOrderedType, HashType) with { + clause: IndexedAtom -> %; + _and: Tuple % -> Partial %; + atom: % -> Partial IndexedAtom; + atoms: % -> List IndexedAtom; + + true: () -> %; + true?: % -> Boolean; +} +== add { + Rep ==> List IndexedAtom; + import from Rep; + + clause(a: IndexedAtom): % == per [a]; + true(): % == per []; + true?(cl: %): Boolean == empty? rep cl; + + atom(cl: %): Partial IndexedAtom == { + true? cl => failed; + not empty? rest rep cl => failed; + [first rep cl] + } + + hash(cl: %): MachineInteger == { + import from Fold2(MachineInteger, MachineInteger); + import from IndexedAtom; + (hashCombine, 31)/(hash atom for atom in rep cl) + } + + atoms(cl: %): List IndexedAtom == rep cl; + + local safelyCons(a: IndexedAtom, b: Partial List IndexedAtom): Partial List IndexedAtom == + if failed? b then failed else [cons(a, retract b)]; + + local merge(a: Rep, b: Rep): Partial Rep == { + import from IndexedAtom, Integer; + empty? a => [b]; + empty? b => [a]; + aatom := first a; + batom := first b; + if aatom = batom then safelyCons(aatom, merge(rest a, rest b)) + else if isNegation?(aatom, batom) then failed; + else if index aatom > index batom then safelyCons(batom, merge(a, rest b)) + else safelyCons(aatom, merge(rest a, b)); + } + + local and2(a: %, b: %): Partial % == { + import from Partial Rep; + pr := merge(rep a, rep b); + failed? pr => failed; + [per retract pr]; + } + + _and(t: Tuple %): Partial % == { + import from MachineInteger; + acc := element(t, 1); + for idx in 2..(length(t)) repeat { + term := element(t, idx); + pacc := and2(acc, term); + failed? pacc => return failed; + acc := retract pacc; + } + [acc] + } + + (a: %) = (b: %): Boolean == rep a = rep b; + + extree(a: %): ExpressionTree == { + import from List ExpressionTree, IndexedAtom; + import from ListMapper(IndexedAtom, ExpressionTree); + import from ExpressionTreeLeaf; + empty? rep a => extree leaf(true); + ExpressionTreeList(map(extree)(rep a)); + } + + (a: %) < (b: %): Boolean == { + import from IndexedAtom; + true? b => false; + true? a => true; + a1 := first rep a; + b1 := first rep b; + a1 < b1 => true; + b1 < a1 => false; + per rest rep a < per rest rep b; + } + } -LogicExpression: BooleanAlgebra with { + +OrLogicExpression: Join(BooleanAlgebra, TotallyOrderedType, HashType) with { expression: IndexedAtom -> %; not?: % -> Boolean; and?: % -> Boolean; or?: % -> Boolean; - true?: % -> Boolean; - false?: % -> Boolean; + clause?: % -> Boolean; + clause: % -> OrClause; + atoms: % -> List IndexedAtom; + + terms: % -> List %; + + _and: List % -> %; + _or: List % -> %; + + evaluate: (T: BooleanAlgebra, IndexedAtom -> T) -> (% -> T); } == add { Rep ==> Union(AND: List %, OR: List %, NOT: %, CL: OrClause); @@ -91,24 +206,57 @@ LogicExpression: BooleanAlgebra with { not? expr: Boolean == rep(expr) case NOT; and? expr: Boolean == rep(expr) case AND; or? expr: Boolean == rep(expr) case OR or rep(expr) case CL; - local clause? expr: Boolean == rep(expr) case CL; + clause? expr: Boolean == rep(expr) case CL; expression(a: IndexedAtom): % == per [clause a]; - local terms expr: List % == { + terms expr: List % == { import from List IndexedAtom; - clause? expr => [expression atom for atom in terms rep(expr).CL]; + clause? expr => [expression atom for atom in atoms rep(expr).CL]; and? expr => rep(expr).AND; or? expr => rep(expr).OR; not? expr => [rep(expr).NOT]; never; } + hash expr: MachineInteger == { + import from Fold2(MachineInteger, MachineInteger); + clause? expr => hash clause expr; + and? expr or or? expr => (hashCombine, 31)/(hash term for term in terms expr); + not? expr => hashCombine(6247, hash rep(expr).NOT); + never; + } + + atoms expr: List IndexedAtom == { + assert clause? expr; + atoms rep(expr).CL; + } + + clause expr: OrClause == { + not clause? expr => { stdout << "Not a Clause: " << expr << newline; never} + rep(expr).CL; + } + true: % == per [ [], AND]; false: % == per [ false(), CL]; true? expr: Boolean == and? expr and empty? rep(expr).AND; false? expr: Boolean == clause? expr and false? rep(expr).CL; + _and(l: List %): % == { + acc: % := true; + for term in l repeat { + acc := _and(acc, term); + } + acc; + } + _or(l: List %): % == { + acc: % := false; + for term in l repeat { + acc := _or(acc, term); + } + acc; + } + _not(e: %): % == { true? e => false; false? e => true; @@ -117,12 +265,22 @@ LogicExpression: BooleanAlgebra with { } _and(expr1: %, expr2: %): % == { + true? expr1 => expr2; + false? expr1 => expr1; + true? expr2 => expr1; + false? expr2 => expr2; and? expr1 and and? expr2 => per [append!(copy rep(expr1).AND, rep(expr2).AND), AND]; + and? expr1 => per [append!(copy rep(expr1).AND, expr2), AND]; + and? expr2 => per [cons(expr1, rep(expr2).AND), AND]; per [[expr1, expr2], AND]; } _or(expr1: %, expr2: %): % == { import from Partial OrClause; + true? expr1 => expr1; + false? expr1 => expr2; + true? expr2 => expr2; + false? expr2 => expr1; clause? expr1 and clause? expr2 => { tmp := _or(rep(expr1).CL, rep(expr2).CL); failed? tmp => true; @@ -132,12 +290,23 @@ LogicExpression: BooleanAlgebra with { per [[expr1, expr2], OR]; } + local validate(e: %): () == { + true? e => return; + false? e => return; + clause? e => return; + not? e => validate(rep(e).NOT); + or? e => if empty? rest terms e then never; + and? e => if empty? rest terms e then never; + never; + } + extree(a: %): ExpressionTree == { import from List ExpressionTree; import from ExpressionTreeLeaf; - import from ListMapper(LogicExpression, ExpressionTree); + import from ListMapper(%, ExpressionTree); + validate(a); clause? a => extree(rep(a).CL); - or? a => ExpressionTreePlus(map(extree) rep(a).OR); + or? a => ExpressionTreeTimes(map(extree) rep(a).OR); and? a => { empty? rep(a).AND => extree leaf false; ExpressionTreeTimes(map(extree) rep(a).AND); @@ -149,11 +318,263 @@ LogicExpression: BooleanAlgebra with { (expr1: %) = (expr2: %): Boolean == { and? expr1 => and? expr2 and rep(expr1).AND = rep(expr2).AND; clause? expr1 => clause? expr2 and rep(expr1).CL = rep(expr2).CL; + clause? expr2 => false; or? expr1 => or? expr2 and rep(expr1).OR = rep(expr2).OR; - not? expr1 => not? expr2 and rep(expr1).OR = rep(expr2).OR; + not? expr1 => not? expr2 and rep(expr1).NOT = rep(expr2).NOT; false } + + local listCompare(l1: List %, l2: List %): Boolean == { + empty? l1 and empty? l2 => false; + empty? l1 => true; + empty? l2 => false; + first l1 < first l2 => true; + first l2 < first l1 => false; + listCompare(rest l1, rest l2); + } + + (a: %) < (b: %): Boolean == { + r := lessThan(a, b); + r + } + + local orderForType(a: %): Integer == { + false? a => 0; + true? a => 5; + not? a => 1; + clause? a => 2; + or? a => 3; + and? a => 4; + never; + } + + lessThan(a: %, b: %): Boolean == { + import from Integer; + orderForType a < orderForType b => true; + orderForType b < orderForType a => false; + orderForType a ~= orderForType b => never; + clause? a and clause? b => clause a < clause b; + not? a and not? b => _not a < _not b; + and? a and and? b => listCompare(terms a, terms b); + or? a and or? b => listCompare(terms a, terms b); + never; + } + + evaluate(T: BooleanAlgebra, mapfn: IndexedAtom -> T): % -> T == { + import from T; + import from Fold2(T, T); + import from ListMapper(IndexedAtom, T); + import from ListMapper(%, T); + fn(expr: %): T == { + clause? expr => (_or, false)/map(mapfn) atoms clause expr; + not? expr => _not fn rep(expr).NOT; + and? expr => (_and, true)/map(fn) terms expr; + or? expr => (_or, false)/map(fn) terms expr; + never; + } + fn; + } +} + + +LogicExpression: Join(BooleanAlgebra, TotallyOrderedType, HashType) with { + expression: IndexedAtom -> %; + not?: % -> Boolean; + and?: % -> Boolean; + or?: % -> Boolean; + + clause?: % -> Boolean; + clause: % -> AndClause; + atoms: % -> List IndexedAtom; + + terms: % -> List %; + + _and: List % -> %; + _or: List % -> %; + + evaluate: (T: BooleanAlgebra, IndexedAtom -> T) -> (% -> T); +} +== add { + Rep ==> Union(AND: List %, OR: List %, NOT: %, CL: AndClause); + import from Rep; + import from AndClause; + import from List %; + default expr: %; + + not? expr: Boolean == rep(expr) case NOT; + and? expr: Boolean == rep(expr) case AND or rep(expr) case CL; + or? expr: Boolean == rep(expr) case OR; + clause? expr: Boolean == rep(expr) case CL; + expression(a: IndexedAtom): % == per [clause a]; + + terms expr: List % == { + import from List IndexedAtom; + clause? expr => [expression atom for atom in atoms rep(expr).CL]; + and? expr => rep(expr).AND; + or? expr => rep(expr).OR; + not? expr => [rep(expr).NOT]; + never; + } + + hash expr: MachineInteger == { + import from Fold2(MachineInteger, MachineInteger); + clause? expr => hash clause expr; + and? expr or or? expr => (hashCombine, 31)/(hash term for term in terms expr); + not? expr => hashCombine(6247, hash rep(expr).NOT); + never; + } + + atoms expr: List IndexedAtom == { + assert clause? expr; + atoms rep(expr).CL; + } + + clause expr: AndClause == { + not clause? expr => { stdout << "Not a Clause: " << expr << newline; never} + rep(expr).CL; + } + + false: % == per [ [], OR]; + true: % == per [ true(), CL]; + + true? expr: Boolean == clause? expr and true? rep(expr).CL; + false? expr: Boolean == or? expr and empty? rep(expr).OR; + + _and(l: List %): % == { + acc: % := true; + for term in l repeat { + acc := _and(acc, term); + } + acc; + } + + _or(l: List %): % == { + acc: % := false; + for term in l repeat { + acc := _or(acc, term); + } + acc; + } + + _not(e: %): % == { + true? e => false; + false? e => true; + not? e => rep(e).NOT; + per [e, NOT]; + } + + _and(expr1: %, expr2: %): % == { + import from Partial AndClause; + true? expr1 => expr2; + false? expr1 => expr1; + true? expr2 => expr1; + false? expr2 => expr2; + clause? expr1 and clause? expr2 => { + tmp := _and(rep(expr1).CL, rep(expr2).CL); + failed? tmp => false; + per [retract tmp, CL] + } + and? expr1 and and? expr2 => per [append!(copy terms expr1, terms expr2), AND]; + and? expr1 => per [append!(copy terms expr1, [expr2]), AND]; + and? expr2 => per [cons(expr1, terms expr2), AND]; + per [[expr1, expr2], AND]; + } + _or(expr1: %, expr2: %): % == { + true? expr1 => expr1; + false? expr1 => expr2; + true? expr2 => expr2; + false? expr2 => expr1; + or? expr1 and or? expr2 => per [append!(copy terms expr1, terms expr2), OR]; + or? expr1 => per [append!(copy terms expr1, [expr2]), OR]; + or? expr2 => per [cons(expr1, terms expr2), OR]; + per [[expr1, expr2], OR]; + } + + local validate(e: %): () == { + true? e => return; + false? e => return; + clause? e => return; + not? e => validate(rep(e).NOT); + or? e => if empty? rest terms e then never; + and? e => if empty? rest terms e then never; + never; + } + + extree(a: %): ExpressionTree == { + import from List ExpressionTree; + import from ExpressionTreeLeaf; + import from ListMapper(%, ExpressionTree); + validate(a); + clause? a => extree(rep(a).CL); + and? a => { + empty? rep(a).AND => extree leaf false; + ExpressionTreeTimes(map(extree) rep(a).AND); + } + or? a => ExpressionTreePlus(map(extree) rep(a).OR); + not? a => ExpressionTreeMinus([extree(rep(a).NOT)]); + never; + } + + (expr1: %) = (expr2: %): Boolean == { + clause? expr1 => clause? expr2 and rep(expr1).CL = rep(expr2).CL; + clause? expr2 => false; + and? expr1 => and? expr2 and rep(expr1).AND = rep(expr2).AND; + or? expr1 => or? expr2 and rep(expr1).OR = rep(expr2).OR; + not? expr1 => not? expr2 and rep(expr1).NOT = rep(expr2).NOT; + false + } + + local listCompare(l1: List %, l2: List %): Boolean == { + empty? l1 and empty? l2 => false; + empty? l1 => true; + empty? l2 => false; + first l1 < first l2 => true; + first l2 < first l1 => false; + listCompare(rest l1, rest l2); + } + + (a: %) < (b: %): Boolean == { + r := lessThan(a, b); + r + } + + local orderForType(a: %): Integer == { + false? a => 0; + true? a => 5; + not? a => 1; + clause? a => 2; + or? a => 3; + and? a => 4; + never; + } + + local lessThan(a: %, b: %): Boolean == { + import from Integer; + orderForType a < orderForType b => true; + orderForType b < orderForType a => false; + orderForType a ~= orderForType b => never; + clause? a and clause? b => clause a < clause b; + not? a and not? b => _not a < _not b; + and? a and and? b => listCompare(terms a, terms b); + or? a and or? b => listCompare(terms a, terms b); + never; + } + + evaluate(T: BooleanAlgebra, mapfn: IndexedAtom -> T): % -> T == { + import from T; + import from Fold2(T, T); + import from ListMapper(IndexedAtom, T); + import from ListMapper(%, T); + fn(expr: %): T == { + clause? expr => (_and, true)/map(mapfn) atoms clause expr; + not? expr => _not fn rep(expr).NOT; + and? expr => (_and, true)/map(fn) terms expr; + or? expr => (_or, false)/map(fn) terms expr; + never; + } + fn; + } } #if ALDORTEST @@ -181,6 +602,33 @@ test(): () == assertEquals(_or(clause atom1, clause atom2), _or(clause atom2, clause atom1)) assertEquals(_or(clause atom1, clause atom2, clause negate atom1), failed) +orClauses2(): List OrClause == + import from OrClause + import from IndexedAtom + import from Partial OrClause + import from Integer + [ false(), clause atom 1, clause atom 2, + clause negate atom 1, clause negate atom 2, + retract _or(clause atom 1, clause atom 2), + retract _or(clause atom 1, clause negate atom 2), + retract _or(clause negate atom 1, clause atom 2), + retract _or(clause negate atom 1, clause negate atom 2)] + +testOrClauseOrder(): () == + import from ListMapper(Integer, IndexedAtom) + import from Assert OrClause + import from List OrClause + import from OrClause + for e1 in orClauses2() repeat + for e2 in orClauses2() repeat + assertFalse(e1 < e2 and e2 < e1) + if e1 = e2 then + assertFalse(e1 < e2) + assertFalse(e2 < e1) + else + assertFalse(e1 < e2 and e2 < e1) + assertTrue(e1 < e2 or e2 < e1) + test2(): () == import from Assert LogicExpression import from LogicExpression @@ -197,7 +645,39 @@ test2(): () == assertTrue(and? _and(e1, _or(e1, e3))) assertTrue(not? _not(_or(e1, e2))) +testSSet(): () == + import from Integer; + import from IndexedAtom; + import from LogicExpression + import from MachineInteger + import from Assert MachineInteger + l: List LogicExpression := [ expression atom 1, expression atom 2, false, + expression atom 2, expression atom 1] + ll: SortedSet LogicExpression := [x for x in l] + stdout << ll << newline + assertEquals(3, #ll) + +testEvaluate(): () == + import from Integer + import from IndexedAtom + import from LogicExpression + import from Bit, Assert Bit; + import from Integer + eval := evaluate(Bit, (a: IndexedAtom): Bit +-> (even? index a)::Bit) + assertEquals(true, eval expression atom 2); + assertEquals(false, eval expression atom 1); + assertEquals(false, eval _not expression atom 2); + assertEquals(true, eval _not expression atom 1); + assertEquals(false, eval _and(expression atom 1, expression atom 2)); + assertEquals(true, eval _or(expression atom 1, expression atom 2)); + assertEquals(false, eval _and(expression atom 1, expression negate atom 2)); + + test() test2() +testOrClauseOrder() +testSSet() + +testEvaluate() #endif From ffa396ca7a6afc6bb1bf93447beaf02c06f409c8 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 10 Aug 2015 20:08:22 +0100 Subject: [PATCH 095/352] algebra::logic: Add basic (inefficient & incomplete) DNF type. Enough in here to convert logic expressions into a "normal" form, but form isn't fully normalised yet. --- aldor/lib/algebra/src/Makefile.am | 1 + aldor/lib/algebra/src/logic/Makefile.deps | 1 + aldor/lib/algebra/src/logic/Makefile.in | 2 +- aldor/lib/algebra/src/logic/sit_dnf.as | 328 ++++++++++++++++++++++ 4 files changed, 331 insertions(+), 1 deletion(-) create mode 100644 aldor/lib/algebra/src/logic/sit_dnf.as diff --git a/aldor/lib/algebra/src/Makefile.am b/aldor/lib/algebra/src/Makefile.am index 4dc1eea65..87ad5018e 100644 --- a/aldor/lib/algebra/src/Makefile.am +++ b/aldor/lib/algebra/src/Makefile.am @@ -152,6 +152,7 @@ libalgebra_a_SOURCES = \ fraction/sit_uflgqot.c \ fraction/sit_vecquot.c \ logic/sit_bit.c \ + logic/sit_dnf.c \ logic/sit_idxatom.c \ logic/sit_lexpr.c \ logic/sit_logiccat.c \ diff --git a/aldor/lib/algebra/src/logic/Makefile.deps b/aldor/lib/algebra/src/logic/Makefile.deps index a5764098a..c34965671 100644 --- a/aldor/lib/algebra/src/logic/Makefile.deps +++ b/aldor/lib/algebra/src/logic/Makefile.deps @@ -2,6 +2,7 @@ sit_logiccat_deps := sit_idxatom_deps := sit_logiccat sit_bit_deps := sit_logiccat sit_lexpr_deps := sit_idxatom +sit_dnf_deps := sit_lexpr library_deps := util numbers extree extree/operators extree/parser \ categories basic diff --git a/aldor/lib/algebra/src/logic/Makefile.in b/aldor/lib/algebra/src/logic/Makefile.in index 9ce1c231a..da9601e98 100644 --- a/aldor/lib/algebra/src/logic/Makefile.in +++ b/aldor/lib/algebra/src/logic/Makefile.in @@ -15,6 +15,6 @@ abs_top_srcdir := @abs_top_srcdir@ subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) # Build starts here -library = sit_logiccat sit_idxatom sit_bit sit_lexpr +library = sit_logiccat sit_idxatom sit_bit sit_lexpr sit_dnf include $(abs_top_srcdir)/lib/algebra/src/common.mk diff --git a/aldor/lib/algebra/src/logic/sit_dnf.as b/aldor/lib/algebra/src/logic/sit_dnf.as new file mode 100644 index 000000000..cdc24ee43 --- /dev/null +++ b/aldor/lib/algebra/src/logic/sit_dnf.as @@ -0,0 +1,328 @@ +#include "algebra" +#include "aldorio" + +ListIterator(T: with): with { + reset: % -> %; + hasNext?: % -> Boolean; + next: % -> %; + current: % -> T; + iterator: List T -> %; + if T has OutputType then OutputType; +} +== add { + Rep ==> Cross(l: List T, i: List T); + import from Rep; + import from List T; + + iterator(lst: List T): % == per cross(lst, lst); + + local cross(l: List T, i: List T): Cross(List T, List T) == (l, i); + reset(iter: %): % == { (w, i) := rep(iter); per cross(w, w)} + + hasNext?(iter: %): Boolean == { + (l, i) := rep iter; + not empty? rest i; + } + + next(iter: %): % == { + (l, i) := rep iter; + per cross(l, rest i); + } + + current(iter: %): T == { + (l, i) := rep iter; + first i + } + + if T has OutputType then (o: TextWriter) << (i: %): TextWriter == { + import from T; + (l, ll) := rep i; + o << "{I: " << l << ", " << ll << "}"; + } +} + +State(T: OutputType): with { + init: List List T -> %; + next: % -> (Partial %, List T); + generator: % -> Generator List T; +} +== add { + Rep ==> List ListIterator T; + import from Rep; + import from ListIterator T; + + init(initlst: List List T): % == per [iterator l for l in initlst]; + + generator(iter: %): Generator List T == generate { + import from Partial %; + done := false; + while not done repeat { + (nextIter, nextElt) := next iter; + yield nextElt; + if failed? nextIter then done := true; + else { + iter := retract nextIter; + yield nextElt; + } + } + } + + + next(state: %): (Partial %, List T) == { + ll := rep state; + nextElt: List T := []; + nextState: List ListIterator T := []; + carry: Boolean := true; + while carry and not empty? ll repeat { + iter := first ll; + nextElt := cons(current iter, nextElt); + if hasNext? iter then { + nextIter := next iter; + nextState := cons(nextIter, nextState); + carry := false; + } + else { + iter := reset iter; + nextState := cons(iter, nextState); + carry := true; + } + ll := rest ll; + } + while (not empty? ll) repeat { + iter := first ll; + nextElt := cons(current iter, nextElt); + nextState := cons(iter, nextState); + ll := rest ll; + } + carry => (failed, nextElt); + ([per reverse! nextState], nextElt); + } +} + +Dnf: BooleanAlgebra with { + normalForm: LogicExpression -> %; + evaluate: (T: BooleanAlgebra, IndexedAtom -> T) -> (% -> T); +} +== add { + Rep == List AndClause; + import from Rep; + import from AndClause; + import from LogicExpression; + default dnf, dnf1, dnf2: %; + + false: % == per []; + true: % == per [true()]; + + _not dnf: % == error "Not implemented"; + _and(dnf1, dnf2): % == error "Not implemented"; + _or(dnf1, dnf2): % == error "Not implemented"; + + true? dnf: Boolean == dnf = true; + false? dnf: Boolean == empty? rep dnf; + + dnf1 = dnf2: Boolean == rep(dnf1) = rep(dnf2); + + extree dnf: ExpressionTree == { + import from ListMapper(AndClause, ExpressionTree); + import from ExpressionTreeLeaf; + empty? rep dnf => extree leaf true; + ExpressionTreeList map(extree) rep dnf; + } + + normalForm(inexpr: LogicExpression): % == { + e := removeNegations(inexpr); + e := distribution(e); + dnf := dnfFromNormalForm e; + dnf + } + + dnfFromNormalForm(e: LogicExpression): % == { + import from List LogicExpression; + clause? e => per [clause e]; + or? e => per [clause term for term in terms e]; + stdout << "Not in normal form " << e << newline; + never; + } + + local removeNegations(e: LogicExpression): LogicExpression == { + import from List LogicExpression; + import from List IndexedAtom; + import from IndexedAtom; + clause? e => e; + empty? terms e => e; + and? e => _and [removeNegations term for term in terms e]; + or? e => _or [removeNegations term for term in terms e]; + i := _not e; + not? i => removeNegations(_not i); + clause? i and empty? rest atoms i => expression negate first atoms i; + or? i => _and([removeNegations(_not ie) for ie in terms i]); + and? i => _or([removeNegations(_not ie) for ie in terms i]); + error "Negations case"; + } + + distribution(e: LogicExpression): LogicExpression == { + import from List LogicExpression; + import from LogicExpression; + import from Fold2(LogicExpression, List LogicExpression); + clause? e => e; + false? e => e; + true? e => e; + not? e => error "No nots allowed"; + and? e => { + import from List List LogicExpression; + import from State LogicExpression; + qq := [distribution clause for clause in terms e]; + l: List List LogicExpression := [ [atom for atom in terms subexpr] for subexpr in qq]; + _or[_and(clause) for clause in init l]; + } + or? e => { + ll := [distribution term for term in terms e]; + _or ll; + } + return e; + } + + + distribution0(e: LogicExpression): LogicExpression == { + import from List LogicExpression; + not? e => { + stdout << "Remove negation failed " << newline; + never; + } + clause? e => e; + not or? e => e;-- WRONG! + eT := terms e; + empty? eT => e; + empty? rest eT => never; + t0 := first eT; + r := rest eT; + and? t0 => { + -- or(and(t00, t0R), r) ==> and(or(t00, r), or(t0R, r)) + t00 := first terms t0; + t0R := rest terms t0; + _and(distribution(_or(t00, _and(r))), distribution(_or(_and(t0R), _and(r)))); + } + _or(distribution t0, distribution(_or(r))); + } + + evaluate(T: BooleanAlgebra, atomToT: IndexedAtom -> T)(v: %): T == { + import from T; + import from List OrClause; + import from List IndexedAtom; + import from Fold2(T, T); + import from ListMapper(IndexedAtom, T); + (_or, false)/((_and, true)/map(atomToT) atoms clause for clause in rep(v)); + } + +} + +#if ALDORTEST +#include "algebra" +#include "aldorio" +#pile + +test(): () == + import from LogicExpression; + import from Integer; + import from IndexedAtom; + l: LogicExpression := expression atom 1; + dnf: Dnf := normalForm l; + stdout << l << " --> " << dnf << newline; + l := _or(expression atom 1, expression atom 2); + dnf := normalForm l; + stdout << l << " --> " << dnf << newline; + l := _and(expression atom 1, expression atom 2); + dnf := normalForm l; + stdout << l << " --> " << dnf << newline; + l := _or(l, expression atom 3); + dnf := normalForm l; + stdout << l << " --> " << dnf << newline; + + l := _or(_not l, expression atom 3); + dnf := normalForm l; + stdout << l << " --> " << dnf << newline; + + l := _and(_or(expression atom 1, expression atom 2), expression atom 3); + dnf := normalForm l; + stdout << l << " --> " << dnf << newline; + + + + +allExpressions(depth: Integer, nAtoms: Integer): HashSet LogicExpression == { + import from List SortedSet LogicExpression; + import from List LogicExpression; + import from LogicExpression; + import from IndexedAtom; + if depth = 0 then [expression atom n for n in 1..nAtoms] + else { + exprs: HashSet LogicExpression := allExpressions(depth - 1, nAtoms); + for e in exprs repeat + stdout << e << newline; + hs := copy exprs; + for e in exprs | not not? e repeat insert!(hs, _not e); + for e1 in exprs repeat { + for e2 in exprs repeat { + insert!(hs, _and(e1, e2)); + insert!(hs, _or(e1, e2)); + } + } + hs + } +} + +--test(); + +foo(): () == + import from Integer; + import from HashSet LogicExpression; + import from LogicExpression; + for d in 1..3 repeat for n in 1..3 repeat stdout << d << " " << coerce(#allExpressions(d, n)) << newline; + stdout << "hello " << newline; + for e in allExpressions(1, 1) repeat stdout << e << newline; + stdout << "hello2 " << newline; + for e in allExpressions(1, 2) repeat stdout << e << newline; + +--foo(); + + +testEvaluate(): () == + import from LogicExpression + import from HashSet LogicExpression + import from List Bit, Bit, Assert Bit + import from Dnf + import from Integer + import from MachineInteger + import from IndexedAtom + allExprs := allExpressions(2, 2); + + for expr in allExprs repeat + dnf := normalForm expr; + ll: List List Bit := [[false, false], [false, true], [true, false], [true, true]] + valuation(i: MachineInteger)(atom: IndexedAtom): Bit == + v := ll.(i).(machine index atom); + if negated? atom then _not v else v; + for i in 1..4@MachineInteger repeat + assertEquals(evaluate(Bit, valuation(i)) expr, + evaluate(Bit, valuation(i)) dnf); + +testEvaluate() + + + +iterateState(): () == + import from State Integer; + import from List Integer, List List Integer; + import from Partial State Integer; + import from Integer; + ll := [[1,2], [10]] + state := init ll; + done := false; + while not done repeat + (nextState, elt) := next state; + if failed? nextState then done := true; + else state := retract nextState; + +iterateState() + +#endif From 5bfc711102f4656e634be461d170c47ebeab9efd Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 15 Jun 2015 20:05:08 +0100 Subject: [PATCH 096/352] algebra::Logic: Add implies? to AndClause, and extra constructor function --- aldor/lib/algebra/src/logic/sit_lexpr.as | 51 +++++++++++++++++++++++- 1 file changed, 50 insertions(+), 1 deletion(-) diff --git a/aldor/lib/algebra/src/logic/sit_lexpr.as b/aldor/lib/algebra/src/logic/sit_lexpr.as index ee5980a0b..631778c37 100644 --- a/aldor/lib/algebra/src/logic/sit_lexpr.as +++ b/aldor/lib/algebra/src/logic/sit_lexpr.as @@ -93,11 +93,14 @@ OrClause: Join(ExpressionType, TotallyOrderedType, HashType) with { AndClause: Join(ExpressionType, TotallyOrderedType, HashType) with { clause: IndexedAtom -> %; _and: Tuple % -> Partial %; + _and: Generator % -> Partial %; atom: % -> Partial IndexedAtom; atoms: % -> List IndexedAtom; true: () -> %; true?: % -> Boolean; + + implies?: (%, %) -> Boolean; } == add { Rep ==> List IndexedAtom; @@ -155,6 +158,37 @@ AndClause: Join(ExpressionType, TotallyOrderedType, HashType) with { [acc] } + _and(g: Generator %): Partial % == { + import from MachineInteger; + acc: % := true(); + for term in g repeat { + pacc := and2(acc, term); + failed? pacc => return failed; + acc := retract pacc; + } + [acc] + } + + + implies?(lhs: %, rhs: %): Boolean == { + import from IndexedAtom; + lhsList := rep lhs; + rhsList := rep rhs; + while not empty? rhsList and not empty? lhsList repeat { + if first lhsList = first rhsList then { + lhsList := rest lhsList; + rhsList := rest rhsList; + } + else if first lhsList < first rhsList then { + lhsList := rest lhsList; + } + else { + return false; + } + } + return empty? rhsList; + } + (a: %) = (b: %): Boolean == rep a = rep b; extree(a: %): ExpressionTree == { @@ -673,11 +707,26 @@ testEvaluate(): () == assertEquals(false, eval _and(expression atom 1, expression negate atom 2)); +testImplies(): () == + import from AndClause + import from IndexedAtom + import from Partial AndClause + import from Assert AndClause + import from Integer + cl := retract _and(clause atom 1, clause atom 3) + + assertTrue(implies?(cl, cl)) + assertTrue(implies?(cl, clause atom 1)) + assertTrue(implies?(cl, clause atom 3)) + assertFalse(implies?(cl, clause atom 4)) + assertFalse(implies?(cl, clause atom 2)) + assertFalse(implies?(cl, clause negate atom 1)) + test() test2() testOrClauseOrder() testSSet() testEvaluate() - +testImplies() #endif From 922ae63d60fe50cac4263123eaf7c7015aa1f852 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 26 Oct 2015 19:42:57 +0000 Subject: [PATCH 097/352] buildlib.mk: sublib_depend depends on Makefile.deps Case when a new library is added to Makefile.deps --- aldor/lib/buildlib.mk | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index d50c10c53..685b65488 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -120,10 +120,10 @@ $(addsuffix .ao, $(alldomains)): %.ao: $(SUBLIB_DEPEND).al $(AM_DBG) $(aldorexedir)/aldor $(aldor_args); \ rm lib$(libraryname)_$*.al -$(SUBLIB_DEPEND).al: $(foreach l,$(library_deps),$(librarylibdir)/$l/$(SUBLIB).al) +$(SUBLIB_DEPEND).al: $(foreach l,$(library_deps),$(librarylibdir)/$l/$(SUBLIB).al) Makefile.deps $(AM_V_AR)set -e; \ ar cr $@; \ - for l in $+; do \ + for l in $(filter %.al,$+); do \ if [ ! -f $$l ]; then \ echo "missing $$l"; \ exit 1; \ From 0468a3301f8e05ae11ad2ac018c09f7539ee97d3 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 24 Aug 2015 11:41:32 +0100 Subject: [PATCH 098/352] absyn.c: Copy needs to preserve AB_State_Error --- aldor/aldor/src/absyn.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/absyn.c b/aldor/aldor/src/absyn.c index 5665d3885..aef1cfbba 100644 --- a/aldor/aldor/src/absyn.c +++ b/aldor/aldor/src/absyn.c @@ -1693,12 +1693,14 @@ abTransferSemantics(AbSyn from, AbSyn to) abState(to) = abState(from); abTPoss(to) = tpossRefer(abTPoss(from)); break; - case AB_State_HasUnique: abState(to) = abState(from); abTUnique(to) = abTUnique(from); break; - + case AB_State_Error: + abState(to) = abState(from); + abTPoss(to) = tpossRefer(abTPoss(from)); + break; default: break; } From 076c02d2a8b7c289ed570125d8a3365a91d9e420 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 24 Aug 2015 11:43:21 +0100 Subject: [PATCH 099/352] gf_seq.c: When looking for definitions, recurse into apply, but do not add definitions to the list of things to define at top level. --- aldor/aldor/src/gf_seq.c | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/aldor/aldor/src/gf_seq.c b/aldor/aldor/src/gf_seq.c index 50651119f..9e61ee594 100644 --- a/aldor/aldor/src/gf_seq.c +++ b/aldor/aldor/src/gf_seq.c @@ -78,7 +78,7 @@ local int dgSortClassify (DefGroup); local DefSet dgSeqToDefSet (AbSyn, SymeList); local DefGroup dgMakeFixGroup (DefGroupList); local DefGroup dgStmtToDef (AbSyn, int); -local void dgAbGetUsedSymes (AbSyn, DefGroup); +local void dgAbGetUsedSymes (AbSyn, DefGroup, Bool); local DefGroupTag dgGetTag (AbSyn); local Bool dgSymeIsLocal (Syme); local DefGroup dgNewGroup (DefGroupTag, AbSyn); @@ -653,7 +653,7 @@ dgStmtToDef(AbSyn absyn, int i) { DefGroup dg = dgNewGroup(dgGetTag(absyn), absyn); - dgAbGetUsedSymes(absyn, dg); + dgAbGetUsedSymes(absyn, dg, true); if (dg->tag == DG_Cond) { listFree(Syme)(dg->defines); dg->defines = listNil(Syme); @@ -663,8 +663,10 @@ dgStmtToDef(AbSyn absyn, int i) } +local Bool dgAbIsTopLevel(AbSyn ab); + local void -dgAbGetUsedSymes(AbSyn ab, DefGroup dg) +dgAbGetUsedSymes(AbSyn ab, DefGroup dg, Bool topLevel) { Syme syme; int i, argc; @@ -688,12 +690,13 @@ dgAbGetUsedSymes(AbSyn ab, DefGroup dg) for (i = 0; i < argc; i++) { syme = abSyme(abDefineeId(argv[i])); if (!syme) continue; - dg->defines = listCons(Syme)(syme, dg->defines); + if (topLevel) + dg->defines = listCons(Syme)(syme, dg->defines); } /* Now find all the symes used from the rhs */ - dgAbGetUsedSymes(ab->abDefine.rhs, dg); + dgAbGetUsedSymes(ab->abDefine.rhs, dg, topLevel); break; case AB_LitInteger: @@ -710,17 +713,28 @@ dgAbGetUsedSymes(AbSyn ab, DefGroup dg) if ( (syme = abImplicitSyme(ab)) != NULL && dgSymeIsLocal(syme)) dg->usedSymes = listCons(Syme)(syme, dgUses(dg)); for (i=0; iusedSymes = listCons(Syme)(syme, dgUses(dg)); } for (i=0; i Date: Fri, 20 Jan 2017 21:08:48 +0000 Subject: [PATCH 100/352] aldor/test: Add multinever case (return type of Exit from many-valued function) --- aldor/aldor/test/Makefile.in | 3 ++- aldor/aldor/test/multinever.as | 9 +++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) create mode 100644 aldor/aldor/test/multinever.as diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 88823c134..4d03144b1 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -77,7 +77,7 @@ foamdir = $(abs_top_builddir)/aldor/lib/libfoam aptests := exquo fmtests := rectest enumtest clos strtable1 simple apply -ctests := rectest enumtest +ctests := rectest enumtest multinever otests := enumtest xtests := enumtest @BUILD_JAVA_TRUE@jruntests := jimport @@ -98,6 +98,7 @@ opt1_AXLFLAGS=-Y$(foamdir)/al -I $(foamsrcdir)/al -lRuntimeLib=foam -Q9 strtable1_AXLFLAGS=-Y$(foamdir)/al -I $(foamsrcdir)/al -lRuntimeLib=foam -Q9 clos_AXLFLAGS := -Q2 simple_AXLFLAGS=-O +multinever_AXLFLAGS = -Q9 _aptests := $(sort $(aptests)) _ctests := $(sort $(ctests) $(otests)) diff --git a/aldor/aldor/test/multinever.as b/aldor/aldor/test/multinever.as new file mode 100644 index 000000000..eeeeb252d --- /dev/null +++ b/aldor/aldor/test/multinever.as @@ -0,0 +1,9 @@ +#include "foamlib" +#pile +Foo: with + foo: Integer -> (String, String) +== add + foo(n: Integer): (String, String) == never + +import from Integer, Foo +(a, b) := foo 22 From cc2757b2a31b7f70bf56b2f279b0dad4bdd74f2c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 21 Oct 2015 20:52:09 +0100 Subject: [PATCH 101/352] aldor/test: Add a test of dependent tuples used in types. --- aldor/aldor/test/Makefile.in | 2 +- aldor/aldor/test/maptuple.as | 17 +++++++++++++++++ 2 files changed, 18 insertions(+), 1 deletion(-) create mode 100644 aldor/aldor/test/maptuple.as diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 4d03144b1..9e64389a3 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -77,7 +77,7 @@ foamdir = $(abs_top_builddir)/aldor/lib/libfoam aptests := exquo fmtests := rectest enumtest clos strtable1 simple apply -ctests := rectest enumtest multinever +ctests := rectest enumtest multinever maptuple otests := enumtest xtests := enumtest @BUILD_JAVA_TRUE@jruntests := jimport diff --git a/aldor/aldor/test/maptuple.as b/aldor/aldor/test/maptuple.as new file mode 100644 index 000000000..5a514e150 --- /dev/null +++ b/aldor/aldor/test/maptuple.as @@ -0,0 +1,17 @@ +#include "foamlib" +#pile + +MapMangler(a: Tuple Type, f: a -> SingleInteger): with + skr: a -> SingleInteger +== add + skr(s: a): SingleInteger == f s + +import from SingleInteger; + +foo(): () == + import from MapMangler( (String, SingleInteger), (a: String, b: SingleInteger): SingleInteger +-> b) + import from String + skr("hello", 22) + + +foo() From 6b776ac03210991b2c6afdb7ae781b212ed9a533 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 24 Aug 2015 20:03:33 +0100 Subject: [PATCH 102/352] of_emerg.c: By default, setting debug to on should dump everything. --- aldor/aldor/src/of_emerg.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/aldor/aldor/src/of_emerg.c b/aldor/aldor/src/of_emerg.c index b7299528e..66ae65133 100644 --- a/aldor/aldor/src/of_emerg.c +++ b/aldor/aldor/src/of_emerg.c @@ -184,7 +184,7 @@ emMergeUnit(Foam unit) * For each program definition in a unit, merge it. */ -int emDebugDefNo = 1; /* this is useful when debugging a perticular prog */ +int emDebugDefNo = -1; /* this is useful when debugging a perticular prog */ local void emMergeDefs(Foam defs) @@ -196,9 +196,9 @@ emMergeDefs(Foam defs) /* #if 0*/ /* enable this if you want to see in-out foam when debugging */ if (DEBUG(emerge)) { - if (emDefNo == emDebugDefNo) { + if (emDebugDefNo == -1 || emDefNo == emDebugDefNo) { fprintf(dbOut, "Prog--index%d--count%d<<\n",emDefNo,emCount); - foamWrSExpr(dbOut, def,SXRW_Default); + foamPrintDb(def); } } /* #endif */ @@ -209,9 +209,9 @@ emMergeDefs(Foam defs) /* #if 0*/ /* enable this if you want to see in-out foam when debugging */ if (DEBUG(emerge)) { - if (emDefNo == emDebugDefNo) { + if (emDebugDefNo == -1 || emDefNo == emDebugDefNo) { fprintf(dbOut, "Prog--index%d--count%d>>\n",emDefNo,emCount); - foamWrSExpr(dbOut, def,SXRW_Default); + foamPrintDb(def); } } /* #endif */ @@ -229,7 +229,7 @@ emMergeProg(Foam prog) EmUsageState * usedArray; emLocalUsage = emMakeUsageVec(prog->foamProg.locals); emOrigNumLocals = foamDDeclArgc(prog->foamProg.locals); - + /* previously on ER ... , no seriously, this keeps all the used tags from the previous marking run */ usedArray = (EmUsageState *) stoAlloc(OB_Other, (emOrigNumLocals+1) * sizeof(EmUsageState)); From 785a2faad0d8ce69a37476fed6fd5b2edfc39787 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 5 Aug 2016 22:23:08 +0100 Subject: [PATCH 103/352] libaldor: introduce iterable. cf. java --- aldor/lib/aldor/src/base/Makefile.deps | 1 + aldor/lib/aldor/src/base/Makefile.in | 6 +++--- aldor/lib/aldor/src/base/sal_iterable.as | 5 +++++ 3 files changed, 9 insertions(+), 3 deletions(-) create mode 100644 aldor/lib/aldor/src/base/sal_iterable.as diff --git a/aldor/lib/aldor/src/base/Makefile.deps b/aldor/lib/aldor/src/base/Makefile.deps index 977f48dba..f47a765e9 100644 --- a/aldor/lib/aldor/src/base/Makefile.deps +++ b/aldor/lib/aldor/src/base/Makefile.deps @@ -6,6 +6,7 @@ sal_serial_deps := sal_base sal_bstream sal_otype_deps := sal_base sal_tstream sal_itype_deps := sal_base sal_tstream sal_gener_deps := sal_base +sal_iterable_deps := sal_gener sal_htype_deps := sal_base sal_syntax_deps := sal_base sal_order_deps := sal_base diff --git a/aldor/lib/aldor/src/base/Makefile.in b/aldor/lib/aldor/src/base/Makefile.in index 6339509de..48cc5b14e 100644 --- a/aldor/lib/aldor/src/base/Makefile.in +++ b/aldor/lib/aldor/src/base/Makefile.in @@ -16,9 +16,9 @@ subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) # Build starts here library = ald_pfunc sal_base sal_base0 sal_bstream sal_byte sal_char \ - sal_copy sal_gener sal_htype sal_itype sal_manip sal_order \ - sal_otype sal_partial sal_serial sal_syntax sal_torder \ - sal_tstream \ + sal_copy sal_gener sal_htype sal_iterable sal_itype \ + sal_manip sal_order sal_otype sal_partial sal_serial \ + sal_syntax sal_torder sal_tstream @BUILD_JAVA_TRUE@javalibrary := $(library) diff --git a/aldor/lib/aldor/src/base/sal_iterable.as b/aldor/lib/aldor/src/base/sal_iterable.as new file mode 100644 index 000000000..4f88ee19a --- /dev/null +++ b/aldor/lib/aldor/src/base/sal_iterable.as @@ -0,0 +1,5 @@ +#include "aldor" + +Iterable(T: Type): Category == with { + generator: % -> Generator T +} From 6e6ee082e95154bb8c4c0034a8048d4e841acf05 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 13 Jan 2017 21:36:27 +0000 Subject: [PATCH 104/352] list.c: Allow listRemove to be called with NULL to indicate that pointer equality should be used. --- aldor/aldor/src/list.c | 12 +++++++++--- aldor/aldor/src/test/test_list.c | 18 +++++++++++++++++- 2 files changed, 26 insertions(+), 4 deletions(-) diff --git a/aldor/aldor/src/list.c b/aldor/aldor/src/list.c index 2190c4b66..f394641b3 100644 --- a/aldor/aldor/src/list.c +++ b/aldor/aldor/src/list.c @@ -18,6 +18,12 @@ typedef Bool (*PointerListEltEqFun) (Pointer, Pointer); typedef int (*PointerListEltPrFun) (FILE *, Pointer); typedef Bool (*PointerListEltSatFun) (Pointer); +local Bool +ptrEqEqual(PointerListEltEqFun eq, Pointer a, Pointer b) +{ + if (a == b) return true; + return eq != NULL && (*eq)(a, b); +} /* * Create a new list with unique element x. */ @@ -441,7 +447,7 @@ ptrlistPosition(PointerList l, Pointer x, PointerListEltEqFun eq) { Length i; for (i = 0; l; l = l->rest, i++) - if ((*eq)(l->first, x)) return i; + if (ptrEqEqual(eq, l->first, x)) return i; return -1; } @@ -473,10 +479,10 @@ ptrlistNRemove(PointerList l, Pointer x, PointerListEltEqFun eq) PointerList p, t; if (!l) return l; - if ((*eq)(l->first, x)) return ptrlistFreeCons(l); + if (ptrEqEqual(eq, l->first, x)) return ptrlistFreeCons(l); for (p = l, t = l->rest; t; p = t, t = t->rest) { - if ((*eq)(t->first, x)) { + if (ptrEqEqual(eq, t->first, x)) { p->rest = ptrlistFreeCons(t); break; } diff --git a/aldor/aldor/src/test/test_list.c b/aldor/aldor/src/test/test_list.c index 59eaa41d6..c4054dd03 100644 --- a/aldor/aldor/src/test/test_list.c +++ b/aldor/aldor/src/test/test_list.c @@ -1,9 +1,12 @@ #include "axlobs.h" #include "foam.h" #include "testlib.h" +#include "int.h" local void testList(); +local Bool eqMod5(AInt, AInt); + void listTestSuite() { @@ -15,7 +18,7 @@ listTestSuite() local void testList() { - AIntList l; + AIntList l, m; l = listListNull(AInt)(0); testIntEqual("", 0, listLength(AInt)(l)); @@ -52,5 +55,18 @@ testList() testIntEqual("0", 1, listElt(AInt)(l, 0)); testIntEqual("1", 2, listElt(AInt)(l, 1)); testIntEqual("2", 3, listElt(AInt)(l, 2)); + + l = listList(AInt)(3, 1, 2, 3); + testTrue("eq0", listEqual(AInt)(listNRemove(AInt)(l, 99, NULL), l, aintEqual)); + testTrue("eq0", listEqual(AInt)(listNRemove(AInt)(l, 2, NULL), listList(AInt)(2, 1, 3), aintEqual)); + + l = listList(AInt)(3, 1, 2, 3); + testTrue("eq0", listEqual(AInt)(listNRemove(AInt)(l, 7, eqMod5), + listList(AInt)(2, 1, 3), aintEqual)); } +local Bool +eqMod5(AInt a, AInt b) +{ + return a % 5 == b % 5; +} From 1985f710005cd3bca7ab2b6c9a38c8590df3aeb0 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 26 Nov 2015 22:21:55 +0000 Subject: [PATCH 105/352] src: Add a tset type - typed sets of values.. currently a bit incomplete Needs: - User supplied equality functions - Conversion to hashtable (or binary tree) --- aldor/aldor/src/Makefile.am | 4 +- aldor/aldor/src/test/test_tset.c | 50 +++++++++++++++ aldor/aldor/src/test/testall.c | 1 + aldor/aldor/src/test/testall.h | 1 + aldor/aldor/src/ttable.c | 104 +++++++++++++++++++++++++++++++ aldor/aldor/src/ttable.h | 64 +++++++++++++++++++ 6 files changed, 223 insertions(+), 1 deletion(-) create mode 100644 aldor/aldor/src/test/test_tset.c create mode 100644 aldor/aldor/src/ttable.c create mode 100644 aldor/aldor/src/ttable.h diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index fb984a4f7..8db340f8b 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -130,6 +130,7 @@ libgen_a_SOURCES = \ strops.c \ symbol.c \ table.c \ + ttable.c \ termtype.c \ test.c \ textansi.c \ @@ -291,7 +292,8 @@ testsuite = \ test/test_tibup.c \ test/test_tfsat.c \ test/test_tinfer.c \ - test/test_tposs.c + test/test_tposs.c \ + test/test_tset.c testall_SOURCES = \ $(testsuite) \ diff --git a/aldor/aldor/src/test/test_tset.c b/aldor/aldor/src/test/test_tset.c new file mode 100644 index 000000000..107dec678 --- /dev/null +++ b/aldor/aldor/src/test/test_tset.c @@ -0,0 +1,50 @@ +#include "testall.h" +#include "testlib.h" +#include "ttable.h" +#include "list.h" + +DECLARE_LIST(String); +DECLARE_TSET(String); + +CREATE_TSET(String); + +local void testTSet(void); + +void +tsetTestSuite() +{ + init(); + TEST(testTSet); + fini(); +} + + +local void +testTSet() +{ + StringTSet set; + String x = "x"; + String y = "y"; + + set = tsetCreate(String)(); + testFalse("", tsetMember(String)(set, x)); + testFalse("", tsetMember(String)(set, y)); + + tsetAdd(String)(set, x); + testTrue("", tsetMember(String)(set, x)); + testFalse("", tsetMember(String)(set, y)); + + tsetAdd(String)(set, y); + testTrue("", tsetMember(String)(set, x)); + testTrue("", tsetMember(String)(set, y)); + + tsetRemove(String)(set, x); + testFalse("", tsetMember(String)(set, x)); + testTrue("", tsetMember(String)(set, y)); + + tsetRemove(String)(set, y); + testFalse("", tsetMember(String)(set, x)); + testFalse("", tsetMember(String)(set, y)); + + tsetFree(String)(set); +} diff --git a/aldor/aldor/src/test/testall.c b/aldor/aldor/src/test/testall.c index e18f030a8..ceaeb21a6 100644 --- a/aldor/aldor/src/test/testall.c +++ b/aldor/aldor/src/test/testall.c @@ -40,6 +40,7 @@ main(int argc, char *argv[]) if (testShouldRun("errorset")) errorSetTestSuite(); if (testShouldRun("bitv")) bitvTestSuite(); if (testShouldRun("list")) listTestSuite(); + if (testShouldRun("tset")) tsetTestSuite(); if (testShouldRun("fname")) fnameTest(); if (testShouldRun("archive")) archiveTestSuite(); if (testShouldRun("foam")) foamTest(); diff --git a/aldor/aldor/src/test/testall.h b/aldor/aldor/src/test/testall.h index e66f48c7a..2792d06b3 100644 --- a/aldor/aldor/src/test/testall.h +++ b/aldor/aldor/src/test/testall.h @@ -32,5 +32,6 @@ void tfsatTest(void); void tibupTest(void); void tinferTest(void); void tpossTest(void); +void tsetTestSuite(void); #endif diff --git a/aldor/aldor/src/ttable.c b/aldor/aldor/src/ttable.c new file mode 100644 index 000000000..ae2d5482e --- /dev/null +++ b/aldor/aldor/src/ttable.c @@ -0,0 +1,104 @@ +#include "cport.h" +#include "store.h" +#include "ttable.h" + +local PointerTSet ptrTSetCreate (void); +local PointerTSet ptrTSetEmpty (void); +local void ptrTSetFree (PointerTSet); +local void ptrTSetAdd (PointerTSet, Pointer); +local void ptrTSetRemove (PointerTSet, Pointer); +local Bool ptrTSetMember (PointerTSet, Pointer); +local Bool ptrTSetIsEmpty(PointerTSet); +local PointerTSetIter ptrTSetIter(PointerTSet); +local PointerTSetIter ptrTSetIterNext(PointerTSetIter); +local Pointer ptrTSetIterElt(PointerTSetIter); +local Bool ptrTSetIterHasNext(PointerTSetIter); + +local PointerTSet ptrTSetEmptyVal; + +const struct TSetOpsStructName(Pointer) ptrTSetOps = { + ptrTSetCreate, + ptrTSetFree, + ptrTSetAdd, + ptrTSetRemove, + ptrTSetMember, + ptrTSetIsEmpty, + ptrTSetEmpty, + ptrTSetIter, + ptrTSetIterNext, + ptrTSetIterElt, + ptrTSetIterHasNext, +}; + +local PointerTSet +ptrTSetCreate() +{ + PointerTSet tset = (PointerTSet) stoAlloc(OB_Other, sizeof(*tset)); + tset->lst = listNil(Pointer); + return tset; +} + +local PointerTSet +ptrTSetEmpty() +{ + if (ptrTSetEmptyVal == NULL) + ptrTSetEmptyVal = ptrTSetCreate(); + return ptrTSetEmptyVal; +} + +local void +ptrTSetFree(PointerTSet tset) +{ + listFree(Pointer)(tset->lst); + stoFree(tset); +} + +local Bool +ptrTSetIsEmpty(PointerTSet tset) +{ + return listNil(Pointer) == tset->lst; +} + +local Bool +ptrTSetMember(PointerTSet tset, Pointer ptr) +{ + return listMemq(Pointer)(tset->lst, ptr); +} + +local void +ptrTSetAdd(PointerTSet tset, Pointer ptr) +{ + if (listMemq(Pointer)(tset->lst, ptr)) + return; + tset->lst = listCons(Pointer)(ptr, tset->lst); +} + +local void +ptrTSetRemove(PointerTSet tset, Pointer ptr) +{ + tset->lst = listNRemove(Pointer)(tset->lst, ptr, 0); +} + +local PointerTSetIter +ptrTSetIter(PointerTSet tset) +{ + return tset->lst; +} + +local PointerTSetIter +ptrTSetIterNext(PointerTSetIter iter) +{ + return iter->rest; +} + +local Pointer +ptrTSetIterElt(PointerTSetIter iter) +{ + return iter->first; +} + +local Bool +ptrTSetIterHasNext(PointerTSetIter iter) +{ + return iter != listNil(Pointer); +} diff --git a/aldor/aldor/src/ttable.h b/aldor/aldor/src/ttable.h new file mode 100644 index 000000000..098444ddb --- /dev/null +++ b/aldor/aldor/src/ttable.h @@ -0,0 +1,64 @@ +#ifndef _TTABLE_H_ +#define _TTABLE_H_ +#include "cport.h" +#include "ostream.h" +#include "list.h" + +#define TSet(Type) Type##TSet +#define TSetIter(Type) Type##TSetIter +#define DECLARE_TSET(Type) \ + typedef struct Type##_TSet { \ + Type##List lst; \ + } *TSet(Type); \ + typedef Type##List Type##TSetIter; \ + TSetOpsStruct(Type); \ + extern struct TSetOpsStructName(Type) \ + const *TSetOps(Type) \ + + +#define CREATE_TSET(Type) \ +struct TSetOpsStructName(Type) const *TSetOps(Type) = \ + (struct TSetOpsStructName(Type) const *) &ptrTSetOps + +#if 0 + ; /* for editor indentation */ +#endif + +#define tsetCreate(Type) (TSetOps(Type)->Create) +#define tsetEmpty(Type) (TSetOps(Type)->Create) +#define tsetFree(Type) (TSetOps(Type)->Free) +#define tsetAdd(Type) (TSetOps(Type)->Add) +#define tsetRemove(Type) (TSetOps(Type)->Remove) +#define tsetMember(Type) (TSetOps(Type)->Member) +#define tsetIsEmpty(Type) (TSetOps(Type)->IsEmpty) +#define tsetIter(Type) (TSetOps(Type)->Iter) +#define tsetIterNext(Type) (TSetOps(Type)->IterNext) +#define tsetIterElt(Type) (TSetOps(Type)->IterElt) +#define tsetIterHasNext(Type) (TSetOps(Type)->IterHasNext) + +#define TSetOps(Type) Type##_tsetPointer +#define TSetOpsStructName(Type) Type##_tsetOpsStruct + +#define TSetOpsStruct(Type) \ +struct TSetOpsStructName(Type) { \ + TSet(Type) (*Create) (void); \ + void (*Free) (TSet(Type)); \ + void (*Add) (TSet(Type), Type); \ + void (*Remove) (TSet(Type), Type); \ + Bool (*Member) (TSet(Type), Type); \ + Bool (*IsEmpty)(TSet(Type)); \ + TSet(Type) (*Empty)(void); \ + TSetIter(Type) (*Iter)(TSet(Type)); \ + TSetIter(Type) (*IterNext)(TSetIter(Type)); \ + Type (*IterElt)(TSetIter(Type)); \ + Bool (*IterHasNext)(TSetIter(Type)); \ +} +#if 0 + ; /* for editor indentation */ +#endif + +DECLARE_TSET(Pointer); + +extern const struct TSetOpsStructName(Pointer) ptrTSetOps; + +#endif From 457015f1f76e3f08e0b12fc01622646cd16db737 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 4 Dec 2015 16:00:07 +0000 Subject: [PATCH 106/352] tform.c: Replace tfDomExports and similar macros with functions. --- aldor/aldor/src/sefo.c | 7 ++- aldor/aldor/src/tform.c | 96 +++++++++++++++++++++++++++++++++++++---- aldor/aldor/src/tform.h | 16 +++---- 3 files changed, 96 insertions(+), 23 deletions(-) diff --git a/aldor/aldor/src/sefo.c b/aldor/aldor/src/sefo.c index 70bd9eb1a..6da5785bc 100644 --- a/aldor/aldor/src/sefo.c +++ b/aldor/aldor/src/sefo.c @@ -3265,8 +3265,7 @@ tformSubst0(AbSub sigma, TForm tf) tfGetCatSelf(tf); tfParents(final) = parentListSubst0(sigma, symes); if (tfCatExports(tf)) - tfCatExports(final) = - listCopy(Syme)(tfParents(final)); + tfSetCatExports(final, listCopy(Syme)(tfParents(final))); tfCascades(final) = tqualListSubst0(sigma, tfGetCatCascades(tf)); tfHasCascades(final) = true; @@ -4461,7 +4460,7 @@ tformFrBuffer(Lib lib, Buffer buf) if (tfIsWith(tf)) { SymeList symes; int n; - tfCatExports(tf) = symeListFrBuffer(lib, buf); + tfSetCatExports(tf, symeListFrBuffer(lib, buf)); n = bufGetHInt(buf); symes = tfCatExports(tf); if (n != listLength(Syme)(symes)) { @@ -4474,7 +4473,7 @@ tformFrBuffer(Lib lib, Buffer buf) } } if (tfIsThird(tf)) - tfThdExports(tf) = symeListFrBuffer(lib, buf); + tfSetThdExports(tf, symeListFrBuffer(lib, buf)); tfSetFVars(tf, fvFrSymes(symeListFrBuffer(lib, buf))); diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index e36fe74c9..383758105 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -181,6 +181,15 @@ local TForm tfIsIdempotent (TForm); local void tfForwardIdempotent (TForm, TForm); local void tfExtendFinishTwins (Stab, Syme); +/****************************************************************************** + * + * :: Type imports and exports + * + *****************************************************************************/ + +local void tfSetDomImports (TForm, SymeList); +local void tfSetDomExports (TForm, SymeList); + /****************************************************************************** * * :: Debugging facilities @@ -3622,7 +3631,9 @@ tfAddDomExports(TForm tf, SymeList symes) nsymes = tfJoinExportLists(mods, tfDomExports(tf), symes, NULL); - return tfSetDomExports(tf, nsymes); + tfSetDomExports(tf, nsymes); + + return nsymes; } local SymeList @@ -3633,7 +3644,9 @@ tfAddCatExports(TForm tf, SymeList symes) nsymes = tfJoinExportLists(mods, tfCatExports(tf), symes, NULL); - return tfSetCatExports(tf, nsymes); + tfSetCatExports(tf, nsymes); + + return nsymes; } local SymeList @@ -3644,7 +3657,9 @@ tfAddThdExports(TForm tf, SymeList symes) nsymes = tfJoinExportLists(mods, tfThdExports(tf), symes, NULL); - return tfSetThdExports(tf, nsymes); + tfSetThdExports(tf, nsymes); + + return nsymes; } local SymeList @@ -3661,7 +3676,9 @@ tfAddHasExports(TForm tf, TForm cat) nsymes = tfGetCatExports(cat); nsymes = tfJoinExportLists(mods, tfDomExports(tf), nsymes, cond); - return tfSetDomExports(tf, nsymes); + tfSetDomExports(tf, nsymes); + + return nsymes; } /* @@ -4088,7 +4105,9 @@ tfGetCatExportsFrIf(TForm cat) esymes = tfGetCatExports(tfIfElse(cat)); symes = tfJoinExportLists(mods, symes, esymes, cond); - return tfSetCatExports(cat, symes); + tfSetCatExports(cat, symes); + + return symes; } local SymeList @@ -4103,7 +4122,9 @@ tfGetCatExportsFrJoin(TForm cat) symes = tfJoinExportLists(mods, symes, nsymes, NULL); } - return tfSetCatExports(cat, symes); + tfSetCatExports(cat, symes); + + return symes; } local SymeList @@ -4120,7 +4141,9 @@ tfGetCatExportsFrMeet(TForm cat) symes = tfMeetExportLists(mods, symes, nsymes, NULL); } - return tfSetCatExports(cat, symes); + tfSetCatExports(cat, symes); + + return symes; } /****************************************************************************** @@ -4171,6 +4194,61 @@ tfGetBuiltinSyme(TForm tf, Symbol sym) return syme0; } +/****************************************************************************** + * + * :: Type imports and exports + * + *****************************************************************************/ + +extern SymeList +tfDomImports(TForm tf) +{ + return tf->domImports; +} + +extern void +tfSetDomImports(TForm tf, SymeList symeList) +{ + tf->domImports = symeList; +} + +extern SymeList +tfDomExports(TForm tf) +{ + return tf->domExports; +} + +extern void +tfSetDomExports(TForm tf, SymeList symeList) +{ + tf->domExports = symeList; +} + +extern SymeList +tfCatExports(TForm tf) +{ + return tf->catExports; +} + +extern void +tfSetCatExports(TForm tf, SymeList symeList) +{ + tf->catExports = symeList; +} + +extern SymeList +tfThdExports(TForm tf) +{ + return tf->thdExports; +} + +extern void +tfSetThdExports(TForm tf, SymeList symeList) +{ + tf->thdExports = symeList; +} + + /* * Called on a domain to get the symbol meanings to include * in the current scope. Use this in preference to the older @@ -6798,7 +6876,7 @@ tfWithFrSymes(SymeList symes) { TForm tf; tf = tfNewNode(TF_With, 2, tfNone(), tfNone()); - tfCatExports(tf) = symes; + tfSetCatExports(tf, symes); tfSetMeaning(tf); return tf; } @@ -6829,7 +6907,7 @@ tfThird(SymeList symes) { TForm tf; tf = tfNewNode(TF_Third, 1, tfNone()); - tfThdExports(tf) = symes; + tfSetThdExports(tf, symes); tfSetMeaning(tf); return tf; } diff --git a/aldor/aldor/src/tform.h b/aldor/aldor/src/tform.h index 263a1bbfe..1539ce5f0 100644 --- a/aldor/aldor/src/tform.h +++ b/aldor/aldor/src/tform.h @@ -185,11 +185,13 @@ typedef Bool (*TFormPredicate) (TForm); #define tfParents(tf) ((tf)->parents) #define tfSymes(tf) ((tf)->symes) -#define tfDomExports(tf) ((tf)->domExports) -#define tfCatExports(tf) ((tf)->catExports) -#define tfThdExports(tf) ((tf)->thdExports) +extern SymeList tfDomImports (TForm); +extern SymeList tfDomExports (TForm); +extern SymeList tfCatExports (TForm); +extern SymeList tfThdExports (TForm); -#define tfDomImports(tf) ((tf)->domImports) +extern void tfSetCatExports (TForm, SymeList); +extern void tfSetThdExports (TForm, SymeList); #define tfSetStab(tf,st) ((tf)->stab = (st)) #define tfSetSelf(tf,sl) ((tf)->self = (sl)) @@ -197,12 +199,6 @@ typedef Bool (*TFormPredicate) (TForm); #define tfSetParents(tf,sl) ((tf)->parents = (sl)) #define tfSetSymes(tf,sl) ((tf)->symes = (sl)) -#define tfSetDomExports(tf,sl) (tfDomExports(tf) = (sl)) -#define tfSetCatExports(tf,sl) (tfCatExports(tf) = (sl)) -#define tfSetThdExports(tf,sl) (tfThdExports(tf) = (sl)) - -#define tfSetDomImports(tf,sl) (tfDomImports(tf) = (sl)) - #define tfConsts(tf) ((tf)->consts) #define tfQueries(tf) ((tf)->queries) From e92d02a01e63603a6f1b2a0e9c51712de6c0e00f Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 14 Jan 2017 22:16:35 +0000 Subject: [PATCH 107/352] src/symeset: Add simple symeset object --- aldor/aldor/src/Makefile.am | 1 + aldor/aldor/src/axlobs.c | 1 + aldor/aldor/src/axlobs.h | 3 +- aldor/aldor/src/formatters.c | 10 +++++ aldor/aldor/src/symbol.c | 3 ++ aldor/aldor/src/symbol.h | 2 + aldor/aldor/src/symeset.c | 84 ++++++++++++++++++++++++++++++++++++ aldor/aldor/src/symeset.h | 31 +++++++++++++ 8 files changed, 134 insertions(+), 1 deletion(-) create mode 100644 aldor/aldor/src/symeset.c create mode 100644 aldor/aldor/src/symeset.h diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index 8db340f8b..6eebc3d9d 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -177,6 +177,7 @@ libstruct_a_SOURCES = \ srcline.c \ stab.c \ syme.c \ + symeset.c \ symcoinfo.c \ tconst.c \ tfcond.c \ diff --git a/aldor/aldor/src/axlobs.c b/aldor/aldor/src/axlobs.c index 8e8fb5dea..e86bd30b4 100644 --- a/aldor/aldor/src/axlobs.c +++ b/aldor/aldor/src/axlobs.c @@ -88,6 +88,7 @@ struct ob_info obInfo[] = { {OB_Foam, "OB_Foam", 1}, {OB_Lib, "OB_Lib", 1}, {OB_Archive, "OB_Archive", 1}, + {OB_SymeSet, "OB_SymeSet", 1}, { -1, NULL, 1} }; diff --git a/aldor/aldor/src/axlobs.h b/aldor/aldor/src/axlobs.h index 1bd960b9e..a8424ae28 100644 --- a/aldor/aldor/src/axlobs.h +++ b/aldor/aldor/src/axlobs.h @@ -117,7 +117,8 @@ DECLARE_LIST(SymeList); # define OB_Foam (OB_AXLGEN_LIMIT + 12) # define OB_Lib (OB_AXLGEN_LIMIT + 13) # define OB_Archive (OB_AXLGEN_LIMIT + 14) -# define OB_LIMIT (OB_AXLGEN_LIMIT + 15) +# define OB_SymeSet (OB_AXLGEN_LIMIT + 15) +# define OB_LIMIT (OB_AXLGEN_LIMIT + 16) /* * Structure containing information about each type. diff --git a/aldor/aldor/src/formatters.c b/aldor/aldor/src/formatters.c index 05fb48627..9e10954af 100644 --- a/aldor/aldor/src/formatters.c +++ b/aldor/aldor/src/formatters.c @@ -2,6 +2,7 @@ #include "formatters.h" #include "axlobs.h" #include "syme.h" +#include "symeset.h" #include "freevar.h" #include "bigint.h" #include "ostream.h" @@ -21,6 +22,7 @@ local int fvFormatter(OStream stream, Pointer p); local int tconstFormatter(OStream stream, Pointer p); local int symeFormatter(OStream stream, Pointer p); +local int symeSetFormatter(OStream stream, Pointer p); local int symeListFormatter(OStream stream, Pointer p); local int symeListListFormatter(OStream stream, Pointer p); @@ -54,6 +56,7 @@ fmttsInit() fmtRegister("TConst", tconstFormatter); fmtRegister("Syme", symeFormatter); + fmtRegister("SymeSet", symeSetFormatter); fmtRegister("SymeList", symeListFormatter); fmtRegister("SymeListList", symeListListFormatter); @@ -209,6 +212,13 @@ tconstFormatter(OStream ostream, Pointer p) return i; } +local int +symeSetFormatter(OStream ostream, Pointer p) +{ + SymeSet symeSet = (SymeSet) p; + return symeSetFormat(ostream, symeSet); +} + local int tfListFormatter(OStream ostream, Pointer p) { diff --git a/aldor/aldor/src/symbol.c b/aldor/aldor/src/symbol.c index 3ab95273a..aa02234c4 100644 --- a/aldor/aldor/src/symbol.c +++ b/aldor/aldor/src/symbol.c @@ -11,10 +11,13 @@ #include "strops.h" #include "symbol.h" #include "table.h" +#include "ttable.h" static Table symbolPool = 0; static long genSymCount = 0; +CREATE_TSET(Symbol); + void symClear(void) { diff --git a/aldor/aldor/src/symbol.h b/aldor/aldor/src/symbol.h index 12084563a..afbfb8119 100644 --- a/aldor/aldor/src/symbol.h +++ b/aldor/aldor/src/symbol.h @@ -20,6 +20,7 @@ #define _SYMBOL_H_ #include "axlobs.h" +#include "ttable.h" struct symbol { MostAlignedType *info; /* Used as desired, initialized to 0 */ @@ -42,5 +43,6 @@ extern void symClear (void); extern int symPrint (FILE *, Symbol); extern void symMap (void (*symfun)(Symbol)); +DECLARE_TSET(Symbol); #endif /* !_SYMBOL_H_ */ diff --git a/aldor/aldor/src/symeset.c b/aldor/aldor/src/symeset.c new file mode 100644 index 000000000..f5c6fa257 --- /dev/null +++ b/aldor/aldor/src/symeset.c @@ -0,0 +1,84 @@ +#include "symeset.h" +#include "sefo.h" +#include "store.h" +#include "ttable.h" +#include "format.h" + +SymeSet +symeSetFrSymes(SymeList symes) +{ + SymeSet set = (SymeSet) stoAlloc(OB_SymeSet, sizeof(*set)); + Syme syme; + + set->names = tsetCreate(Symbol)(); + set->symes = listNil(Syme); + set->symes = symes; + + while (symes != listNil(Syme)) { + tsetAdd(Symbol)(set->names, symeId(symes->first)); + symes = cdr(symes); + } + + return set; +} + +void +symeSetFree(SymeSet symeSet) +{ + tsetFree(Symbol)(symeSet->names); + listFree(Syme)(symeSet->symes); + stoFree(symeSet); +} + +Bool +symeSetIsEmpty(SymeSet symeSet) +{ + if (tsetIsEmpty(Symbol)(symeSet->names)) + return true; + return listNil(Syme) == symeSet->symes; +} + +Bool +symeSetMember(SymeSet symeSet, Syme syme) +{ + if (!tsetMember(Symbol)(symeSet->names, symeId(syme))) + return false; + return listMember(Syme)(symeSet->symes, syme, symeEqual); +} + +Bool +symeSetMayHave(SymeSet symeSet, Symbol sym) +{ + return tsetMember(Symbol)(symeSet->names, sym); +} + +SymeList +symeSetList(SymeSet symeSet) +{ + return symeSet->symes; +} + +SymeList +symeSetSymesForSymbol(SymeSet symeSet, Symbol symbol) +{ + SymeList sl = listNil(Syme); + SymeList tmp; + if (!tsetMember(Symbol)(symeSet->names, symbol)) + return listNil(Syme); + + tmp = symeSet->symes; + while (tmp != listNil(Syme)) { + if (symbol == symeId(car(tmp))) + sl = listCons(Syme)(car(tmp), sl); + tmp = cdr(tmp); + } + + return listNReverse(Syme)(sl); +} + +int +symeSetFormat(OStream ostream, SymeSet symeSet) +{ + SymeList sl = symeSet->symes; + return ostreamPrintf(ostream, "{S: %pSymeList}", sl); +} diff --git a/aldor/aldor/src/symeset.h b/aldor/aldor/src/symeset.h new file mode 100644 index 000000000..df214d6cc --- /dev/null +++ b/aldor/aldor/src/symeset.h @@ -0,0 +1,31 @@ +#ifndef _SYMESET_H_ +#define _SYMESET_H_ +#include "ttable.h" +#include "symbol.h" +#include "syme.h" + +/* A SymeSet contains a collection of symes - we hold the names + * separately as these can be used to determine quickly if a set does + * not contain a syme of the given name + */ + +typedef struct SymeSet { + SymbolTSet names; + SymeList symes; +} *SymeSet; + +extern SymeSet symeSetFrSymes (SymeList symes); +extern void symeSetFree (SymeSet symeSet); + +extern Bool symeSetIsEmpty (SymeSet symeSet); +extern Bool symeSetMember (SymeSet symeSet, Syme syme); +extern Bool symeSetMayHave (SymeSet symeSet, Symbol symbol); +extern SymbolTSet symeSetNames (SymeSet symeSet); +extern SymeSet symeSetUnion (SymeSet symeSet1, SymeSet symeSet2); +extern SymeList symeSetList (SymeSet symeSet); + +extern SymeList symeSetSymesForSymbol(SymeSet symeSet, Symbol symbol); + +extern int symeSetFormat (OStream ostream, SymeSet symeSet); + +#endif From 15544a83ebcd97a2114b2ed8a87a5b803ed1a5ce Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 18 Dec 2015 20:17:52 +0000 Subject: [PATCH 108/352] symeset: Add symesetEmpty --- aldor/aldor/src/symeset.c | 10 ++++++++++ aldor/aldor/src/symeset.h | 1 + 2 files changed, 11 insertions(+) diff --git a/aldor/aldor/src/symeset.c b/aldor/aldor/src/symeset.c index f5c6fa257..22a53ecee 100644 --- a/aldor/aldor/src/symeset.c +++ b/aldor/aldor/src/symeset.c @@ -4,6 +4,8 @@ #include "ttable.h" #include "format.h" +static SymeSet theEmptySymeSet; + SymeSet symeSetFrSymes(SymeList symes) { @@ -22,6 +24,14 @@ symeSetFrSymes(SymeList symes) return set; } +SymeSet +symeSetEmpty() +{ + if (theEmptySymeSet == NULL) + theEmptySymeSet = symeSetFrSymes(listNil(Syme)); + return theEmptySymeSet; +} + void symeSetFree(SymeSet symeSet) { diff --git a/aldor/aldor/src/symeset.h b/aldor/aldor/src/symeset.h index df214d6cc..8ce3e47f1 100644 --- a/aldor/aldor/src/symeset.h +++ b/aldor/aldor/src/symeset.h @@ -15,6 +15,7 @@ typedef struct SymeSet { } *SymeSet; extern SymeSet symeSetFrSymes (SymeList symes); +extern SymeSet symeSetEmpty (void); extern void symeSetFree (SymeSet symeSet); extern Bool symeSetIsEmpty (SymeSet symeSet); From b536f71c33e62009b37c8ca97915712f479c511a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 5 Dec 2015 16:39:38 +0000 Subject: [PATCH 109/352] symeset: Add test suite --- aldor/aldor/src/Makefile.am | 1 + aldor/aldor/src/test/test_symeset.c | 42 +++++++++++++++++++++++++++++ aldor/aldor/src/test/testall.c | 1 + aldor/aldor/src/test/testall.h | 1 + 4 files changed, 45 insertions(+) create mode 100644 aldor/aldor/src/test/test_symeset.c diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index 6eebc3d9d..7f03dac05 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -289,6 +289,7 @@ testsuite = \ test/test_srcpos.c \ test/test_stab.c \ test/test_syme.c \ + test/test_symeset.c \ test/test_tform.c \ test/test_tibup.c \ test/test_tfsat.c \ diff --git a/aldor/aldor/src/test/test_symeset.c b/aldor/aldor/src/test/test_symeset.c new file mode 100644 index 000000000..973a1e84c --- /dev/null +++ b/aldor/aldor/src/test/test_symeset.c @@ -0,0 +1,42 @@ +#include "testall.h" +#include "testlib.h" + +#include "stab.h" +#include "symeset.h" +#include "syme.h" + +local void testSymeSet(void); + +void symeSetTestSuite() +{ + init(); + TEST(testSymeSet); + fini(); +} + +void +testSymeSet() +{ + Stab stab; + SymeSet symeSet; + Syme syme1, syme1a, syme2, syme2a; + + initFile(); + stab = stabFile(); + syme1 = symeNewParam(symInternConst("syme1"), tfCross(0), car(stab)); + syme1a = symeNewParam(symInternConst("syme1"), tfTuple(tfCross(0)), car(stab)); + syme2 = symeNewParam(symInternConst("syme2"), tfCross(0), car(stab)); + syme2a = symeNewParam(symInternConst("syme2"), tfTuple(tfCross(0)), car(stab)); + + symeSet = symeSetFrSymes(listList(Syme)(3, syme1, syme1a, syme2)); + testTrue("", symeSetMember(symeSet, syme1)); + testTrue("", symeSetMember(symeSet, syme1a)); + testTrue("", symeSetMember(symeSet, syme2)); + testFalse("", symeSetMember(symeSet, syme2a)); + + testIntEqual("", 2, listLength(Syme)(symeSetSymesForSymbol(symeSet, symInternConst("syme1")))); + testIntEqual("", 1, listLength(Syme)(symeSetSymesForSymbol(symeSet, symInternConst("syme2")))); + testIntEqual("", 0, listLength(Syme)(symeSetSymesForSymbol(symeSet, symInternConst("syme3")))); + + finiFile(); +} diff --git a/aldor/aldor/src/test/testall.c b/aldor/aldor/src/test/testall.c index ceaeb21a6..e330592e5 100644 --- a/aldor/aldor/src/test/testall.c +++ b/aldor/aldor/src/test/testall.c @@ -58,6 +58,7 @@ main(int argc, char *argv[]) if (testShouldRun("tform")) tformTest(); if (testShouldRun("scobind")) scobindTest(); if (testShouldRun("syme")) symeTest(); + if (testShouldRun("symeset")) symeSetTestSuite(); if (testShouldRun("tibup")) tibupTest(); if (testShouldRun("tfsat")) tfsatTest(); if (testShouldRun("retype")) retypeTest(); diff --git a/aldor/aldor/src/test/testall.h b/aldor/aldor/src/test/testall.h index 2792d06b3..97b949f5b 100644 --- a/aldor/aldor/src/test/testall.h +++ b/aldor/aldor/src/test/testall.h @@ -27,6 +27,7 @@ void scobindTest(void); void srcposTest(void); void stabTest(void); void symeTest(void); +void symeSetTestSuite(void); void tformTest(void); void tfsatTest(void); void tibupTest(void); From 8100bbb4c4b75d3697941d8050e88a6fa8aac6dc Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 11 Dec 2015 13:34:02 +0000 Subject: [PATCH 110/352] Replace tf->domImports list with symeset. Note that we sometimes return an empty list -- which can indicate that we don't know what the imports are at this stage. Work-around it, but need to figure out a better fix. --- aldor/aldor/src/tform.c | 60 +++++++++++++++++++++++++++++++---------- aldor/aldor/src/tform.h | 6 +++-- 2 files changed, 50 insertions(+), 16 deletions(-) diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 383758105..f0a578b5a 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -32,6 +32,7 @@ #include "comsg.h" #include "strops.h" #include "bigint.h" +#include "symeset.h" Bool tfDebug = false; Bool tfExprDebug = false; @@ -187,9 +188,10 @@ local void tfExtendFinishTwins (Stab, Syme); * *****************************************************************************/ -local void tfSetDomImports (TForm, SymeList); +local void tfSetDomImports (TForm, SymeSet); local void tfSetDomExports (TForm, SymeList); +local SymeSet tfStabCreateDomImportSet(Stab stab, TForm tf); /****************************************************************************** * * :: Debugging facilities @@ -276,7 +278,7 @@ tfNewEmpty(TFormTag tag, Length argc) tf->catExports = listNil(Syme); tf->thdExports = listNil(Syme); - tf->domImports = listNil(Syme); + tf->domImports = NULL; tf->consts = listNil(TConst); tf->queries = listNil(TForm); @@ -425,7 +427,7 @@ tfFree(TForm tf) listFree(Syme)(tf->self); /* A type form does not own its domExports. */ - listFree(Syme)(tf->domImports); + symeSetFree(tf->domImports); stoFree((Pointer) tf); } @@ -2385,8 +2387,8 @@ tfCopyQueries(TForm to, TForm from) if (tfDomExports(to)) tfSetDomExports(to, listNil(Syme)); if (tfDomImports(to)) { - listFree(Syme)(tfDomImports(to)); - tfSetDomImports(to, listNil(Syme)); + symeSetFree(tfDomImports(to)); + tfSetDomImports(to, NULL); } return tfQueries(to); @@ -3242,7 +3244,8 @@ tfValidateDomExportsParam(TForm tf) local void tfValidateDomImportsParam(TForm tf) { - tfValidateCheckConstInfo(tf, tfDomImports(tf), "imports"); + if (tfDomImports(tf)) + tfValidateCheckConstInfo(tf, symeSetList(tfDomImports(tf)), "imports"); } local void @@ -4186,7 +4189,7 @@ tfGetBuiltinSyme(TForm tf, Symbol sym) Syme syme0 = NULL; assert(tfDomImports(tf)); - for (symes = tfDomImports(tf); symes; symes = cdr(symes)) { + for (symes = symeSetList(tfDomImports(tf)); symes; symes = cdr(symes)) { Syme syme = car(symes); if (symeId(syme) == sym) syme0 = syme; @@ -4200,16 +4203,16 @@ tfGetBuiltinSyme(TForm tf, Symbol sym) * *****************************************************************************/ -extern SymeList +extern SymeSet tfDomImports(TForm tf) { return tf->domImports; } extern void -tfSetDomImports(TForm tf, SymeList symeList) +tfSetDomImports(TForm tf, SymeSet symeSet) { - tf->domImports = symeList; + tf->domImports = symeSet; } extern SymeList @@ -4255,17 +4258,43 @@ tfSetThdExports(TForm tf, SymeList symeList) * tfGetDomImports() to reduce the chance of polluting the * top-level stab for the current file. */ + +local Bool +tfImportsPending(TForm tf) +{ + return symeSetList(tfDomImports(tf)) == listNil(Syme); +} + SymeList tfStabGetDomImports(Stab stab, TForm tf) { - SymeList xsymes, symes; + return symeSetList(tfStabGetDomImportSet(stab, tf)); +} +SymeSet +tfStabGetDomImportSet(Stab stab, TForm tf) +{ tf = tfDefineeType(tf); tf = tfIgnoreExceptions(tf); - if (tfDomImports(tf)) + if (tfDomImports(tf) && !tfImportsPending(tf)) return tfDomImports(tf); + if (tfDomImports(tf)) { + symeSetFree(tfDomImports(tf)); + tfSetDomImports(tf, NULL); + } + tfStabCreateDomImportSet(stab, tf); + + return tfDomImports(tf); +} + +local SymeSet +tfStabCreateDomImportSet(Stab stab, TForm tf) +{ + + SymeSet symeSet; + SymeList xsymes, symes; if (DEBUG(tfImport)) { fprintf(dbOut, "(tfStabGetDomImports: from "); @@ -4293,7 +4322,9 @@ tfStabGetDomImports(Stab stab, TForm tf) symes = symeListCheckCondition(symes); - tfSetDomImports(tf, symes); + symeSet = symeSetFrSymes(symes); + + tfSetDomImports(tf, symeSet); if (tfIsBasicLib(tf)) tfInitBasicTypes(tf); @@ -4306,7 +4337,8 @@ tfStabGetDomImports(Stab stab, TForm tf) } tfValidateDomImports(tf); - return symes; + + return symeSet; } /* diff --git a/aldor/aldor/src/tform.h b/aldor/aldor/src/tform.h index 1539ce5f0..59f9a0494 100644 --- a/aldor/aldor/src/tform.h +++ b/aldor/aldor/src/tform.h @@ -13,6 +13,7 @@ #include "foam.h" #include "tfcond.h" #include "errorset.h" +#include "symeset.h" extern SymeList tfSetSymesFn(TForm, SymeList); @@ -141,7 +142,7 @@ struct tform { SymeList catExports; /* Exports from categories. */ SymeList thdExports; /* Exports from 3d-order. */ - SymeList domImports; /* Imports with % replaced. */ + SymeSet domImports; /* Imports with % replaced. */ TConstList consts; /* Promises of satisfaction. */ TFormList queries; /* Questions asked: D has C. */ @@ -185,7 +186,7 @@ typedef Bool (*TFormPredicate) (TForm); #define tfParents(tf) ((tf)->parents) #define tfSymes(tf) ((tf)->symes) -extern SymeList tfDomImports (TForm); +extern SymeSet tfDomImports (TForm); extern SymeList tfDomExports (TForm); extern SymeList tfCatExports (TForm); extern SymeList tfThdExports (TForm); @@ -363,6 +364,7 @@ extern TQualList tfGetDomCascades (TForm); extern TQualList tfGetCatCascades (TForm); extern TQualList tfGetThdCascades (TForm); +extern SymeSet tfStabGetDomImportSet (Stab, TForm); extern SymeList tfStabGetDomImports (Stab, TForm); extern SymeList tfGetDomImports (TForm); extern SymeList tfGetCatImportsFrWith (Sefo, SymeList); From 93bdcd3c20718148da3279ff776deb01debd6a89 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 5 Dec 2015 16:42:16 +0000 Subject: [PATCH 111/352] tform.c: Fixup: Use symeSet functions instead of tfGetDomImports. --- 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 f0a578b5a..7703e0594 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -4356,7 +4356,7 @@ tfGetDomImports(TForm tf) * compiled. This allows inner symbols to escape their stab * levels and jump directly to the top. */ - return tfStabGetDomImports(stabFile(), tf); + return symeSetList(tfStabGetDomImportSet(stabFile(), tf)); } From b6ef633c3891fec7216ece1d3be23f7623167dfe Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 5 Dec 2015 17:19:22 +0000 Subject: [PATCH 112/352] src/aldor: Use imports by name where possible. --- aldor/aldor/src/syme.c | 10 ++++++---- aldor/aldor/src/terror.c | 2 +- aldor/aldor/src/tform.c | 22 ++++++++++++++++++++-- aldor/aldor/src/tform.h | 2 ++ aldor/aldor/src/ti_bup.c | 2 +- aldor/aldor/src/ti_tdn.c | 9 +++++---- 6 files changed, 35 insertions(+), 12 deletions(-) diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c index 89b820510..48fabdbd1 100644 --- a/aldor/aldor/src/syme.c +++ b/aldor/aldor/src/syme.c @@ -1093,17 +1093,19 @@ local void symeFillFrExporter(Syme isyme, TForm exporter) { Stab stab; + SymeSet symeSet; SymeList symes; assert(symeLib(isyme)); stab = symeLib(isyme)->stab; tiTopFns()->tiTfSefo(stab, exporter); - - for (symes = tfGetDomImports(exporter); symes; symes = cdr(symes)) { + symeSet = tfGetDomImportSet(exporter); + symes = symeSetSymesForSymbol(symeSet, symeId(isyme)); + for (symes = tfGetDomImportsByName(exporter, symeId(isyme)); symes; symes = cdr(symes)) { Syme syme = car(symes); - if (symeId(syme) == symeId(isyme) && - symeTypeCode(syme) == symeTypeCode(isyme)) { + assert(symeId(syme) == symeId(isyme)); + if (symeTypeCode(syme) == symeTypeCode(isyme)) { /* Lazy domain imports know where they came from. */ if (symeIsLazy(syme)) symeFillFrLibrary(syme); symeSetType(isyme, symeType(syme)); diff --git a/aldor/aldor/src/terror.c b/aldor/aldor/src/terror.c index 58db88bae..e35b20544 100644 --- a/aldor/aldor/src/terror.c +++ b/aldor/aldor/src/terror.c @@ -1254,7 +1254,7 @@ bputAllValidMeanings(Buffer obuf, Stab stab, AbSyn ab, Length argc, SatMask mask = tfSatTErrorMask(), result; SymeList symes; - for (symes = tfGetDomImports(tf); symes; symes = cdr(symes)) { + for (symes = tfGetDomImportsByName(tf, idSym); symes; symes = cdr(symes)) { Syme syme = car(symes); TForm opType; diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 7703e0594..6d8d127b8 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -4174,9 +4174,10 @@ tfHasDomImport(TForm tf, Symbol sym, TForm type) { SymeList sl; - for (sl = tfGetDomImports(tf); sl; sl = cdr(sl)) { + for (sl = tfGetDomImportsByName(tf, sym); sl; sl = cdr(sl)) { Syme syme = car(sl); - if (symeId(syme) == sym && tformEqual(symeType(syme), type)) + assert(symeId(syme) == sym); + if (tformEqual(symeType(syme), type)) return syme; } return NULL; @@ -4359,6 +4360,23 @@ tfGetDomImports(TForm tf) return symeSetList(tfStabGetDomImportSet(stabFile(), tf)); } +SymeSet +tfGetDomImportSet(TForm tf) +{ + /* + * This use of stabFile() is extremely unfortunate because it + * associates the tform with the top-level of the file being + * compiled. This allows inner symbols to escape their stab + * levels and jump directly to the top. + */ + return tfStabGetDomImportSet(stabFile(), tf); +} + +SymeList +tfGetDomImportsByName(TForm tf, Symbol sym) +{ + return symeSetSymesForSymbol(tfStabGetDomImportSet(stabFile(), tf), sym); +} SymeList tfGetCatImportsFrWith(Sefo sefo, SymeList bsymes) diff --git a/aldor/aldor/src/tform.h b/aldor/aldor/src/tform.h index 59f9a0494..e6adba82b 100644 --- a/aldor/aldor/src/tform.h +++ b/aldor/aldor/src/tform.h @@ -367,6 +367,8 @@ extern TQualList tfGetThdCascades (TForm); extern SymeSet tfStabGetDomImportSet (Stab, TForm); extern SymeList tfStabGetDomImports (Stab, TForm); extern SymeList tfGetDomImports (TForm); +extern SymeSet tfGetDomImportSet (TForm); +extern SymeList tfGetDomImportsByName (TForm, Symbol); extern SymeList tfGetCatImportsFrWith (Sefo, SymeList); extern Syme tfHasDomExportMod (TForm,SymeList,Symbol,TForm); extern Syme tfHasDomImport (TForm, Symbol, TForm); diff --git a/aldor/aldor/src/ti_bup.c b/aldor/aldor/src/ti_bup.c index c9b77c23b..ee0a4b75b 100644 --- a/aldor/aldor/src/ti_bup.c +++ b/aldor/aldor/src/ti_bup.c @@ -2758,7 +2758,7 @@ tibupQualify(Stab stab, AbSyn absyn, TForm type) } else { symes = listNil(Syme); - msymes = tfGetDomImports(tforg); + msymes = tfGetDomImportsByName(tforg, sym); for ( ; msymes; msymes = cdr(msymes)) { Syme syme = car(msymes); if (sym != symeId(syme)) diff --git a/aldor/aldor/src/ti_tdn.c b/aldor/aldor/src/ti_tdn.c index 839269506..42ae684e4 100644 --- a/aldor/aldor/src/ti_tdn.c +++ b/aldor/aldor/src/ti_tdn.c @@ -2014,11 +2014,12 @@ titdnQualify(Stab stab, AbSyn absyn, TForm type) } else { symes = listNil(Syme); - msymes = tfGetDomImports(tforg); - for ( ; msymes; msymes = cdr(msymes)) - if (symeId(car(msymes)) == sym - && ablogIsListKnown(symeCondition(car(msymes)))) + msymes = tfGetDomImportsByName(tforg, sym); + for ( ; msymes; msymes = cdr(msymes)) { + assert(symeId(car(msymes)) == sym); + if (ablogIsListKnown(symeCondition(car(msymes)))) symes = listCons(Syme)(car(msymes), symes); + } fsymes = symes; } From a962f92470fb1953dbe22de2b99a3aec4c496616 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 5 Dec 2015 21:38:54 +0000 Subject: [PATCH 113/352] Add stabPutMeaningsSet.. idea is to be able to add a symeSet to a symboltable. From that, it should be possible to avoid importing until a specific name is needed --- aldor/aldor/src/stab.c | 24 +++++++++++++++--------- aldor/aldor/src/stab.h | 1 + 2 files changed, 16 insertions(+), 9 deletions(-) diff --git a/aldor/aldor/src/stab.c b/aldor/aldor/src/stab.c index 2ce4b4f5d..1f9375c97 100644 --- a/aldor/aldor/src/stab.c +++ b/aldor/aldor/src/stab.c @@ -1223,6 +1223,12 @@ stabAddMeaning(Stab stab, Syme syme) return syme; } +void +stabPutMeaningSet(Stab stab, SymeSet symeSet) +{ + stabPutMeanings(stab, symeSetList(symeSet)); +} + void stabPutMeanings(Stab stab, SymeList symes) { @@ -1704,8 +1710,8 @@ stabGetExportedSymes(Stab stab) TQualList stabImportFrom(Stab stab, TQual tq) { - SymeList dsymes; - TForm origin = tqBase(tq); + SymeSet dsymes; + TForm origin = tqBase(tq); /* Carefully follow this tform */ @@ -1743,11 +1749,11 @@ stabImportFrom(Stab stab, TQual tq) stabImportRemark(stab, tqQual(tq), origin); if (tqIsForeign(tq)) - dsymes = tqGetForeignImports(stab, tq); + dsymes = symeSetFrSymes(tqGetForeignImports(stab, tq)); else if (tqIsBuiltin(tq)) - dsymes = tqGetBuiltinImports(stab, tq); + dsymes = symeSetFrSymes(tqGetBuiltinImports(stab, tq)); else if (tqIsQualified(tq)) - dsymes = tqGetQualImports(tq); + dsymes = symeSetFrSymes(tqGetQualImports(tq)); else { Stab nstab = stab; @@ -1769,19 +1775,19 @@ stabImportFrom(Stab stab, TQual tq) /* Get the domain imports of origin */ - dsymes = tfStabGetDomImports(nstab, origin); + dsymes = tfStabGetDomImportSet(nstab, origin); /* * It doesn't matter which stab we chose to get domain * imports from, we are importing into the local one. */ - if (dsymes) stabMakeImportedTForm(stab, origin); + if (!symeSetIsEmpty(dsymes)) stabMakeImportedTForm(stab, origin); } - stabPutMeanings(stab, dsymes); + stabPutMeaningSet(stab, dsymes); - stabImportDEBUG(dbOut, "... imported: %pSymeCList\n", dsymes); + stabImportDEBUG(dbOut, "... imported: %pSymeSet\n", dsymes); if (!tqIsQualified(tq)) return tfGetDomCascades(origin); diff --git a/aldor/aldor/src/stab.h b/aldor/aldor/src/stab.h index 9f3f01b53..07bae5afa 100644 --- a/aldor/aldor/src/stab.h +++ b/aldor/aldor/src/stab.h @@ -166,6 +166,7 @@ extern void stabUseMeaning (Stab, Syme); extern Bool stabHasMeaning (Stab, Syme); extern Syme stabAddMeaning (Stab, Syme); extern void stabPutMeanings (Stab, SymeList); +extern void stabPutMeaningSet (Stab, SymeSet); extern Syme stabDefParam (Stab, Symbol, TForm); extern Syme stabDefLexConst (Stab, Symbol, TForm); From 57cf9ddce13e594529d1bfa2c348e09e448768cb Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 11 Dec 2015 15:47:51 +0000 Subject: [PATCH 114/352] absyn.h: Add macro helpers for iterating across sequence-like things. --- aldor/aldor/src/absyn.h | 33 +++++++++++++++++ aldor/aldor/src/genfoam.c | 64 +++------------------------------ aldor/aldor/src/tform.c | 76 +++------------------------------------ aldor/aldor/src/ti_bup.c | 16 +-------- aldor/aldor/src/ti_sef.c | 15 +------- 5 files changed, 45 insertions(+), 159 deletions(-) diff --git a/aldor/aldor/src/absyn.h b/aldor/aldor/src/absyn.h index 3c16b5c44..66ab7f65b 100644 --- a/aldor/aldor/src/absyn.h +++ b/aldor/aldor/src/absyn.h @@ -1200,5 +1200,38 @@ extern AbSyn abNewDocTextOfList (TokenList); default: bugBadCase (abTag(ab)); \ } +#define AB_SEQ_ITER(absyn, argc, argv) \ + Statement(switch (abTag(absyn)) { \ + case AB_Nothing: \ + argc = 0; \ + argv = 0; \ + break; \ + case AB_Sequence: \ + argc = abArgc(absyn); \ + argv = abArgv(absyn); \ + break; \ + default: \ + argc = 1; \ + argv = &absyn; \ + break; \ + }) + + +#define AB_COMMA_ITER(absyn, argc, argv) \ + Statement(switch (abTag(absyn)) { \ + case AB_Nothing: \ + argc = 0; \ + argv = 0; \ + break; \ + case AB_Comma: \ + argc = abArgc(absyn); \ + argv = abArgv(absyn); \ + break; \ + default: \ + argc = 1; \ + argv = &absyn; \ + break; \ + }) + #endif /* !_ABSYN_H_ */ diff --git a/aldor/aldor/src/genfoam.c b/aldor/aldor/src/genfoam.c index bdc957033..346540e1c 100644 --- a/aldor/aldor/src/genfoam.c +++ b/aldor/aldor/src/genfoam.c @@ -933,20 +933,7 @@ genExport(AbSyn absyn) if (!sym) return 0; - switch (abTag(what)) { - case AB_Nothing: - argc = 0; - argv = 0; - break; - case AB_Sequence: - argc = abArgc(what); - argv = abArgv(what); - break; - default: - argc = 1; - argv = &what; - break; - } + AB_SEQ_ITER(what, argc, argv); for (i = 0; i < argc; i += 1) { AbSyn ab = argv[i]; @@ -5513,20 +5500,7 @@ gen0PLambdaParam(Syme syme) /* printf("BDS: Entered gen0PLambdaParam\n"); */ - switch (abTag(param)) { - case AB_Nothing: - argc = 0; - argv = 0; - break; - case AB_Comma: - argc = abArgc(param); - argv = abArgv(param); - break; - default: - argc = 1; - argv = ¶m; - break; - } + AB_COMMA_ITER(param, argc, argv); for (i = 0; i < argc; i += 1) { AbSyn argi = abDefineeId(argv[i]); @@ -8196,21 +8170,8 @@ gen0DbgFnEntry(AbSyn fn) gen0DebugIssueStmt(GenDebugFnEntry, name, lineNo, type, foamNewSInt(inDom), foamNewBool(true)); - - switch (abTag(params)) { - case AB_Nothing: - argc = 0; - argv = NULL; - break; - case AB_Comma: - argc = abArgc(params); - argv = abArgv(params); - break; - default: - argc = 1; - argv = ¶ms; - break; - } + + AB_COMMA_ITER(params, argc, argv); for (i=0; i Date: Fri, 18 Dec 2015 20:21:20 +0000 Subject: [PATCH 115/352] tform.c: Add tformGetExportsByName and more symeset import things. --- aldor/aldor/src/tform.c | 41 ++++++++++++++++++++++++++++++++++++++++- aldor/aldor/src/tform.h | 6 ++++++ 2 files changed, 46 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 30e4c5e97..0dcec4671 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -277,6 +277,7 @@ tfNewEmpty(TFormTag tag, Length argc) tf->domExports = listNil(Syme); tf->catExports = listNil(Syme); tf->thdExports = listNil(Syme); + tf->domExportNames = NULL; tf->domImports = NULL; @@ -3734,6 +3735,26 @@ tfMangleSymes(TForm tf, TForm cat, SymeList esymes, SymeList symes) return esymes; } +SymbolTSet +tfGetDomExportNames(TForm tf) +{ + SymeList exports; + SymbolTSet symbols; + + if (tfDomExportNames(tf)) + return tfDomExportNames(tf); + + exports = tfGetDomExports(tf); + + symbols = tsetCreate(Symbol)(); + + while (exports != listNil(Syme)) { + tsetAdd(Symbol)(symbols, symeId(car(exports))); + exports = cdr(exports); + } + + return symbols; +} /* * Called on a domain to get the symbol meanings which are @@ -4188,6 +4209,18 @@ tfSetDomExports(TForm tf, SymeList symeList) tf->domExports = symeList; } +extern SymbolTSet +tfDomExportNames(TForm tf) +{ + return tf->domExportNames; +} + +extern void +tfSetDomExportNames(TForm tf, SymbolTSet symbols) +{ + tf->domExportNames = symbols; +} + extern SymeList tfCatExports(TForm tf) { @@ -4335,7 +4368,13 @@ tfGetDomImportSet(TForm tf) SymeList tfGetDomImportsByName(TForm tf, Symbol sym) { - return symeSetSymesForSymbol(tfStabGetDomImportSet(stabFile(), tf), sym); + return tfStabGetDomImportsByName(stabFile(), tf, sym); +} + +SymeList +tfStabGetDomImportsByName(Stab stab, TForm tf, Symbol sym) +{ + return symeSetSymesForSymbol(tfStabGetDomImportSet(stab, tf), sym); } SymeList diff --git a/aldor/aldor/src/tform.h b/aldor/aldor/src/tform.h index e6adba82b..0fb4ad3a9 100644 --- a/aldor/aldor/src/tform.h +++ b/aldor/aldor/src/tform.h @@ -144,6 +144,8 @@ struct tform { SymeSet domImports; /* Imports with % replaced. */ + SymbolTSet domExportNames; /* Symbols exported */ + TConstList consts; /* Promises of satisfaction. */ TFormList queries; /* Questions asked: D has C. */ TQualList cascades; /* Cascaded imports. */ @@ -188,11 +190,13 @@ typedef Bool (*TFormPredicate) (TForm); extern SymeSet tfDomImports (TForm); extern SymeList tfDomExports (TForm); +extern SymbolTSet tfDomExportNames (TForm); extern SymeList tfCatExports (TForm); extern SymeList tfThdExports (TForm); extern void tfSetCatExports (TForm, SymeList); extern void tfSetThdExports (TForm, SymeList); +extern void tfSetDomExportNames (TForm, SymbolTSet); #define tfSetStab(tf,st) ((tf)->stab = (st)) #define tfSetSelf(tf,sl) ((tf)->self = (sl)) @@ -354,6 +358,7 @@ extern TForm tfCatExportsPending (TForm); extern TForm tfThdExportsPending (TForm); extern SymeList tfGetDomExports (TForm); +extern SymbolTSet tfGetDomExportNames (TForm); extern SymeList tfGetCatExports (TForm); extern SymeList tfGetThdExports (TForm); @@ -365,6 +370,7 @@ extern TQualList tfGetCatCascades (TForm); extern TQualList tfGetThdCascades (TForm); extern SymeSet tfStabGetDomImportSet (Stab, TForm); +extern SymeList tfStabGetDomImportsByName(Stab, TForm, Symbol); extern SymeList tfStabGetDomImports (Stab, TForm); extern SymeList tfGetDomImports (TForm); extern SymeSet tfGetDomImportSet (TForm); From a973657adedfeaa1908160728f221589e900ef1e Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 30 Apr 2016 16:41:44 +0100 Subject: [PATCH 116/352] genfoam: Get argument type correctly when using named parameters and single arg functions Union: [foo==...] Return correctly typed value on multi-valued exit. --- aldor/aldor/src/genfoam.c | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/aldor/aldor/src/genfoam.c b/aldor/aldor/src/genfoam.c index 346540e1c..042a48118 100644 --- a/aldor/aldor/src/genfoam.c +++ b/aldor/aldor/src/genfoam.c @@ -651,14 +651,12 @@ genFoamValAs(TForm tf, AbSyn ab) { Foam foam = genFoamVal(ab); if (tfIsExit(gen0AbType(ab))) { - if (foamTag(foam) == FOAM_Nil) - return foam; - if (tfIsMulti(tf) && tfMultiArgc(tf) > 0) { Foam fakeValue; int i; - gen0AddStmt(foam, ab); + if (foamHasSideEffect(foam)) + gen0AddStmt(foam, ab); fakeValue = foamNewEmpty(FOAM_Values, tfMultiArgc(tf)); for (i = 0; i < tfMultiArgc(tf); i++) { @@ -1598,17 +1596,16 @@ gen0MakeApplyArgs(Syme syme, AbSyn absyn, Length *valc) assert(!ftnfixedret); vals[0] = gen0EmbedApply(argc, argv, op, abEmbedApply(op)); } - else if (argc == 1 && tfIsMulti(gen0AbContextType(argv[0]))) { + else if (argc == 1 && *valc == 0) { + genFoamStmt(argv[0]); + } + else if (argc == 1 && tfIsMulti(gen0AbContextType(tfMapSelectArg(opTf, absyn, 0)))) { assert(!extraArg); - if (*valc == 0) - genFoamStmt(argv[0]); - else { - Foam val = genFoamVal(argv[0]); - assert(foamTag(val) == FOAM_Values); - assert(foamArgc(val) == *valc); - for (i = 0; i < *valc; i += 1) - vals[i] = val->foamValues.argv[i]; - } + Foam val = genFoamVal(argv[0]); + assert(foamTag(val) == FOAM_Values); + assert(foamArgc(val) == *valc); + for (i = 0; i < *valc; i += 1) + vals[i] = val->foamValues.argv[i]; } else if (ftnfixedret) { From ffe5d0838f76f921fc48f3fa551f709d16dfda69 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 30 Apr 2016 16:42:22 +0100 Subject: [PATCH 117/352] tests: Add union to known std types --- aldor/aldor/src/test/abquick.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/test/abquick.c b/aldor/aldor/src/test/abquick.c index 45516ec86..2f553e661 100644 --- a/aldor/aldor/src/test/abquick.c +++ b/aldor/aldor/src/test/abquick.c @@ -157,11 +157,13 @@ stdtypes() String Boolean_txt = "Boolean: with == add"; String Join_txt = "Join(T: Tuple Category): Category == with"; String Record_txt = "Record(T: Tuple Type): with == add"; + String Union_txt = "Union(T: Tuple Type): with == add"; String Enumeration_txt = "Enumeration(T: Tuple Type): with == add"; - StringList lines = listList(String)(10, Type_txt, Category_txt, Cross_txt, + StringList lines = listList(String)(11, Type_txt, Category_txt, Cross_txt, Tuple_txt, Map_txt, Boolean_txt, Join_txt, - Generator_txt, Record_txt, Enumeration_txt); + Generator_txt, Record_txt, Union_txt, + Enumeration_txt); AbSynList code = abqParseLines(lines); AbSyn absyn = abNewSequenceL(sposNone, code); From 3291e6605dfe33dad7b99cf8386b429979c6dc09 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 14 May 2016 20:49:50 +0100 Subject: [PATCH 118/352] tfsat.c: Use tconst (with a condition) when dealing with imports This fixes this case: X: Category == with x: % tfsat.c: Check tfPending cases before trying to deal with implicit imports. This ensures that cases like the below work. QQQ(T: X): Category == with q: % Foo(S: with): Category == with if % has X then QQQ(%) --- aldor/aldor/src/tconst.c | 30 ++++++++++++++++++++++-------- aldor/aldor/src/tconst.h | 10 +++++++--- aldor/aldor/src/tfsat.c | 31 ++++++++++++++++++++++++++----- aldor/aldor/src/tfsat.h | 1 + aldor/aldor/src/tposs.c | 5 +++-- 5 files changed, 59 insertions(+), 18 deletions(-) diff --git a/aldor/aldor/src/tconst.c b/aldor/aldor/src/tconst.c index e5f4a8bf8..944556ac6 100644 --- a/aldor/aldor/src/tconst.c +++ b/aldor/aldor/src/tconst.c @@ -15,6 +15,7 @@ #include "tconst.h" #include "tfsat.h" #include "tform.h" +#include "ablogic.h" Bool tcDebug = false; @@ -79,7 +80,7 @@ tcFini(void) void tcSatPush(TForm S, TForm T) { - tcNewSat(NULL, S, T, NULL); + tcNewSat(NULL, NULL, S, T, NULL); } void @@ -89,7 +90,7 @@ tcSatPop(void) } TConst -tcAlloc(TConstTag tag, TForm owner, Length argc, va_list argp) +tcAlloc(TConstTag tag, TForm owner, AbLogic known, AbSyn ab0, Length argc, va_list argp) { TConst tc; Length i; @@ -103,8 +104,10 @@ tcAlloc(TConstTag tag, TForm owner, Length argc, va_list argp) tc->pos = NULL; tc->parent = NULL; tc->id = NULL; + tc->known = known; tc->serial = ++tcSerialNum; tc->owner = owner; + tc->ab0 = ab0; tc->argc = argc; tc->argv = (argc ? (TForm *) (tc + 1) : NULL); @@ -215,13 +218,13 @@ tcPrint(FILE *f, TConst tc) } void -tcNew(TConstTag tag, TForm owner, AbSyn id, Length argc, ...) +tcNew(TConstTag tag, TForm owner, AbLogic known, AbSyn id, AbSyn ab0, Length argc, ...) { TConst tc; va_list argp; va_start(argp, argc); - tc = tcAlloc(tag, owner, argc, argp); + tc = tcAlloc(tag, owner, known, ab0, argc, argp); va_end(argp); tc->id = id; @@ -238,9 +241,15 @@ tcNew(TConstTag tag, TForm owner, AbSyn id, Length argc, ...) } void -tcNewSat(TForm owner, TForm S, TForm T, AbSyn a) +tcNewSat(TForm owner, AbLogic known, TForm S, TForm T, AbSyn a) { - tcNew(TC_Satisfies, owner, a, 2, S, T); + tcNew(TC_Satisfies, owner, ablogCopy(known), a, NULL, 2, S, T); +} + +void +tcNewSat1(TForm owner, AbLogic known, AbSyn ab0, TForm S, TForm T, AbSyn a) +{ + tcNew(TC_Satisfies, owner, ablogCopy(known), a, ab0, 2, S, T); } void @@ -281,12 +290,17 @@ void tcCheck(TConst tc) { Bool result; - + AbLogic known; + extern AbLogic abCondKnown; + listPush(TConst, tc, tcStack); switch (tcTag(tc)) { case TC_Satisfies: - result = tfSatisfies(tcArgv(tc)[0], tcArgv(tc)[1]); + known = abCondKnown; + abCondKnown = tcKnown(tc); + result = tfSatisfies1(tc->ab0, tcArgv(tc)[0], tcArgv(tc)[1]); + abCondKnown = known; break; default: bugBadCase(tcTag(tc)); diff --git a/aldor/aldor/src/tconst.h b/aldor/aldor/src/tconst.h index bd4b98222..41d50cb5f 100644 --- a/aldor/aldor/src/tconst.h +++ b/aldor/aldor/src/tconst.h @@ -35,9 +35,11 @@ struct tconst { BPack(TConstTag) tag; /* What kind of constraint. */ AbSyn pos; /* Where to report errors. */ AbSyn id; /* const checked on behalf of id */ + AbLogic known; /* Conditional context at point */ TConst parent; /* Traceback parent. */ Length serial; /* Serial number. */ TForm owner; /* TForm which checks it. */ + AbSyn ab0; /* Random piece of absyn. */ Length argc; /* Number of arguments. */ TForm *argv; /* Additional arguments. */ }; @@ -58,6 +60,7 @@ struct tconst { #define tcOwner(tc) ((tc)->owner) #define tcArgc(tc) ((tc)->argc) #define tcArgv(tc) ((tc)->argv) +#define tcKnown(tc) ((tc)->known) #define tcSetParent(tc, p) (tcParent(tc) = (p)) @@ -69,7 +72,7 @@ extern void tcFini (void); extern void tcSatPush (TForm, TForm); extern void tcSatPop (void); -extern TConst tcAlloc (TConstTag, TForm, Length, +extern TConst tcAlloc (TConstTag, TForm, AbLogic, AbSyn, Length, va_list); extern void tcFree (TConst); extern void tcPush (TConst); @@ -78,9 +81,10 @@ extern Bool tcEq (TConst, TConst); extern Bool tcEqual (TConst, TConst); extern int tcPrint (FILE *, TConst); -extern void tcNew (TConstTag, TForm, AbSyn, +extern void tcNew (TConstTag, TForm, AbLogic, AbSyn, AbSyn, Length, ...); -extern void tcNewSat (TForm, TForm, TForm, AbSyn); +extern void tcNewSat (TForm, AbLogic, TForm, TForm, AbSyn); +extern void tcNewSat1 (TForm, AbLogic, AbSyn, TForm, TForm, AbSyn); extern void tcMove (TForm, TForm); extern void tfCheckConsts (TForm); diff --git a/aldor/aldor/src/tfsat.c b/aldor/aldor/src/tfsat.c index 3b0f63249..4ad749379 100644 --- a/aldor/aldor/src/tfsat.c +++ b/aldor/aldor/src/tfsat.c @@ -199,6 +199,7 @@ local SatMask tfSatCAT (SatMask, TForm S); local SatMask tfSatTYPE (SatMask, TForm S); local SatMask tfSatUsePending (SatMask, TForm S, TForm T); +local SatMask tfSatUsePending1 (SatMask, AbSyn, TForm, TForm); local SatMask tfSatEvery (SatMask, TForm S, TForm T); local SatMask tfSatEach (SatMask, TForm S, TForm T); local SatMask tfSatMap0 (SatMask, TForm S, TForm T); @@ -455,6 +456,13 @@ tfSatisfies(TForm S, TForm T) return tfSatBit(mask, S, T); } +Bool +tfSatisfies1(AbSyn Sab, TForm S, TForm T) +{ + SatMask mask = TFS_Commit | TFS_UsualMask | TFS_Conditions; + return tfSatSucceed(tfSat1(mask, Sab, S, T)); +} + Bool tfSatValues(TForm S, TForm T) { @@ -772,7 +780,7 @@ tfSatArgPoss(SatMask mask, AbSyn Sab, TForm T) if (tfSatAllow(mask, TFS_Pending) && tpossIsUnique(S)) { tcSatPush(tpossUnique(S), T); - result = tfSatUsePending(mask, tpossUnique(S), T); + result = tfSatUsePending1(mask, Sab, tpossUnique(S), T); tcSatPop(); if (tfSatSucceed(result)) return result; @@ -983,6 +991,13 @@ tfSat1(SatMask mask, AbSyn Sab, TForm S, TForm T) if (tfSatSucceed(tfSatDOM(mask, S))) { if (tfSatUseConditions(mask) && abCondKnown != NULL && Sab != NULL) { + if (tfIsPending(S)) { + if (tfSatAllow(mask, TFS_Pending)) { + result = tfSatUsePending1(mask, + Sab, S, T); + return result; + } + } TForm tf = ablogImpliedType(abCondKnown, Sab, S); if (tf != NULL) { tfsDEBUG(dbOut, "Swapping type: %pTForm to %pTForm\n", S, tf); @@ -1126,6 +1141,12 @@ tfSatTYPE(SatMask mask, TForm S) local SatMask tfSatUsePending(SatMask mask, TForm S, TForm T) +{ + return tfSatUsePending1(mask, NULL, S, T); +} + +local SatMask +tfSatUsePending1(SatMask mask, AbSyn Sab, TForm S, TForm T) { SatMask result; @@ -1133,14 +1154,14 @@ tfSatUsePending(SatMask mask, TForm S, TForm T) tfSatSetPendingFail(S); result = tfSatResult(mask, TFS_Pending); if (tfSatCommit(mask)) - tcNewSat(S, S, T, NULL); + tcNewSat1(S, abCondKnown, Sab, S, T, NULL); return result; } if (tfIsPending(T)) { tfSatSetPendingFail(T); result = tfSatResult(mask, TFS_Pending); if (tfSatCommit(mask)) - tcNewSat(T, S, T, NULL); + tcNewSat1(T, abCondKnown, Sab, S, T, NULL); return result; } @@ -1568,7 +1589,7 @@ tfSatCatExports(SatMask mask, AbSyn Sab, TForm S, TForm T) result = tfSatResult(mask, TFS_Pending); tfSatSetPendingFail(p); if (tfSatCommit(mask)) - tcNewSat(p, S, T, tfSatInfo(mask) ? symeLazyCheckData : NULL); + tcNewSat(p, abCondKnown, S, T, tfSatInfo(mask) ? symeLazyCheckData : NULL); } return result; @@ -1602,7 +1623,7 @@ tfSatThdExports(SatMask mask, TForm S, TForm T) result = tfSatResult(mask, TFS_Pending); tfSatSetPendingFail(p); if (tfSatCommit(mask)) - tcNewSat(p, S, T, tfSatInfo(mask) ? symeLazyCheckData : NULL); + tcNewSat(p, abCondKnown, S, T, tfSatInfo(mask) ? symeLazyCheckData : NULL); } return result; diff --git a/aldor/aldor/src/tfsat.h b/aldor/aldor/src/tfsat.h index a6e43fec3..df8d0de6a 100644 --- a/aldor/aldor/src/tfsat.h +++ b/aldor/aldor/src/tfsat.h @@ -54,6 +54,7 @@ extern TForm tfsEmbedResult (TForm, AbEmbed); * which requires an object of type T. */ extern Bool tfSatisfies (TForm S, TForm T); +extern Bool tfSatisfies1 (AbSyn Sab, TForm S, TForm T); /* * Return true if any object of type S is valid in a value context which diff --git a/aldor/aldor/src/tposs.c b/aldor/aldor/src/tposs.c index 2ecf9d166..4de21d0d1 100644 --- a/aldor/aldor/src/tposs.c +++ b/aldor/aldor/src/tposs.c @@ -22,6 +22,7 @@ #include "tconst.h" #include "tposs.h" #include "tfsat.h" +#include "ablogic.h" /* * Each node is given a set of possible meanings. @@ -376,11 +377,11 @@ tpossIsPending(TPoss tp, TForm t) tcSatPush(S, t); if (tfIsPending(S)) { - tcNewSat(S, S, t, NULL); + tcNewSat(S, ablogFalse(), S, t, NULL); result = true; } if (tfIsPending(t)) { - tcNewSat(t, S, t, NULL); + tcNewSat(t, ablogFalse(), S, t, NULL); result = true; } From 5694920cdefb013960a2cbb48e1e956b8ddd3c91 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 15 May 2016 11:07:40 +0100 Subject: [PATCH 119/352] terror.c: Bugfix for case where fn has multiple meanings and default values --- aldor/aldor/src/terror.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/terror.c b/aldor/aldor/src/terror.c index e35b20544..360065bd7 100644 --- a/aldor/aldor/src/terror.c +++ b/aldor/aldor/src/terror.c @@ -1371,6 +1371,7 @@ bputBadArgType(TRejectInfo trInfo, Buffer obuf, AbSyn ab, Length argc, for ( ; trInfo->i < trInfo->argc && trWhy(trCurrent(trInfo)) == TR_BadArgType; trInfo->i++) { + Length iargc; tr = trCurrent(trInfo); abArgi = argf(ab, trArgN(tr)); @@ -1379,8 +1380,8 @@ bputBadArgType(TRejectInfo trInfo, Buffer obuf, AbSyn ab, Length argc, bputTReject(obuf, tr, fmtOp); - argc = tfMapHasDefaults(opType) ? tfMapArgc(opType) : argc; - parType = tfAsMultiArgN(tf, argc, trParN(tr)); + iargc = tfMapHasDefaults(opType) ? tfMapArgc(opType) : argc; + parType = tfAsMultiArgN(tf, iargc, trParN(tr)); fmtParType = fmtTForm(parType); /* "rejected because arg .. did not match ... */ From 50b19117db35bcea3a13b77f1b24a55c6abf8a3a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 15 May 2016 11:11:33 +0100 Subject: [PATCH 120/352] tfsat.c: Deal with Union(x: Cross(A, B), ...) --- aldor/aldor/src/tfsat.c | 4 ++++ aldor/aldor/src/ti_bup.c | 1 + aldor/lib/aldor/src/datastruc/sal_union.as | 24 ++++++++++++++++++++++ 3 files changed, 29 insertions(+) diff --git a/aldor/aldor/src/tfsat.c b/aldor/aldor/src/tfsat.c index 4ad749379..701c705d9 100644 --- a/aldor/aldor/src/tfsat.c +++ b/aldor/aldor/src/tfsat.c @@ -356,6 +356,10 @@ tfSatEmbedType(TForm tf1, TForm tf2) /* Ignore exceptions for the purposes of embedding as well */ tf2 = tfIgnoreExceptions(tf2); + // FIXME: This is for examples like Union(x: Cross(A, B)) + // Need to figure out what the best thing here is.. + tf1 = tfDefineeType(tf1); + t1 = tfTag(tf1); t2 = tfTag(tf2); diff --git a/aldor/aldor/src/ti_bup.c b/aldor/aldor/src/ti_bup.c index 50cbbd8a3..0f7121b2f 100644 --- a/aldor/aldor/src/ti_bup.c +++ b/aldor/aldor/src/ti_bup.c @@ -1355,6 +1355,7 @@ tibup0InferLhs(Stab stab, AbSyn absyn, AbSyn lhs, AbSyn rhs, TPoss tprhs) trhsv= &trhs; } else if (abTag(lhs) == AB_Comma) { + trhs = tfDefineeType(trhs); rhs = NULL; if (tfIsCross(trhs) && tfCrossArgc(trhs) == lhsc) trhsv = tfCrossArgv(trhs); diff --git a/aldor/lib/aldor/src/datastruc/sal_union.as b/aldor/lib/aldor/src/datastruc/sal_union.as index 4c8366e4f..c9b4741fb 100644 --- a/aldor/lib/aldor/src/datastruc/sal_union.as +++ b/aldor/lib/aldor/src/datastruc/sal_union.as @@ -30,3 +30,27 @@ extend Union(T: Tuple Type): with { } } + +#if ALDORTEST +#include "aldor" +#pile +foo(): () == + U == Union(x: String) + import from Assert String, String + import from U + s := [x == "hello"] + assertEquals(s.x, "hello") + +foo2(): () == + U == Union(x: Cross(String, String)) + import from Assert String, String + import from U + u := [x == ("hello", "mum")] + (a, b) := u.x + assertEquals(a, "hello") + assertEquals(b, "mum") + +foo() +foo2() + +#endif From e13f7ea8f889b8cdef2f81687496326c1c7da7ca Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 30 Jul 2016 10:30:41 +0100 Subject: [PATCH 121/352] tfsat.c: Allow conditional tests to fail with "pending" --- aldor/aldor/src/tfsat.c | 29 +++++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) diff --git a/aldor/aldor/src/tfsat.c b/aldor/aldor/src/tfsat.c index 701c705d9..73a1f1d14 100644 --- a/aldor/aldor/src/tfsat.c +++ b/aldor/aldor/src/tfsat.c @@ -215,7 +215,7 @@ local SatMask tfSatExports (SatMask,SymeList,SymeList,SymeList); local SatMask tfSatExport (SatMask,SymeList,AbSyn Stf, SymeList S,Syme t); local SatMask tfSatParents (SatMask,SymeList, AbSyn, SymeList,SymeList); -local Bool tfSatConditions (SymeList, Syme, Syme); +local SatMask tfSatConditions (SatMask, SymeList, Syme, Syme); local Bool sefoListMemberMod (SymeList, Sefo, SefoList); local void tfSatPushMapConds (TForm); local void tfSatPopMapConds (TForm); @@ -1705,13 +1705,20 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) /* First round.. try "normally" */ for (symes = S; !tfSatSucceed(result) && symes; symes = cdr(symes)) { + SatMask satConditions; Syme s = car(symes); - if (symeEqualModConditions(mods, s, t) && - tfSatConditions(mods, s, t)) { + if (!symeEqualModConditions(mods, s, t)) + continue; + satConditions = tfSatConditions(mask, mods, s, t); + if (tfSatSucceed(satConditions)) { result = tfSatTrue(mask); tryHarder = false; } + else if (tfSatPending(satConditions)) { + result = tfSatPending(mask); + tryHarder = false; + } } tfsExportDEBUG(dbOut, "tfSatExport[%d]:: Incoming S: %pAbSyn retry: %d\n", serialThis, Sab, tryHarder); @@ -1756,11 +1763,12 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) extern TForm tiGetTForm (Stab, AbSyn); -local Bool -tfSatConditions(SymeList mods, Syme s, Syme t) +local SatMask +tfSatConditions(SatMask mask, SymeList mods, Syme s, Syme t) { SefoList Sconds = symeCondition(s); SefoList Tconds = symeCondition(t); + SatMask result = tfSatTrue(mask); for (; Sconds; Sconds = cdr(Sconds)) { Sefo cond = car(Sconds); @@ -1781,13 +1789,18 @@ tfSatConditions(SymeList mods, Syme s, Syme t) tfdom = abGetCategory(cond->abHas.expr); cat = cond->abHas.property; tfcat = abTForm(cat) ? abTForm(cat) : tiTopFns()->tiGetTopLevelTForm(NULL, cat); + result = tfSat(mask, tfdom, tfcat); - if (tfSatisfies(tfdom, tfcat)) + if (tfSatSucceed(result)) continue; + else if (tfSatPending(result)) { + result = tfSatResult(mask, TFS_Pending); + continue; + } } - return false; + return tfSatFalse(mask); } - return true; + return result; } local Bool From 27326af47d127fdaab7b4bbf3e2ee086518cb82a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 15 May 2016 11:58:50 +0100 Subject: [PATCH 122/352] sal_hash: Bug fixes around empty tables. --- aldor/lib/aldor/src/datastruc/sal_hash.as | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/aldor/lib/aldor/src/datastruc/sal_hash.as b/aldor/lib/aldor/src/datastruc/sal_hash.as index bec440bb0..cbcb2484d 100644 --- a/aldor/lib/aldor/src/datastruc/sal_hash.as +++ b/aldor/lib/aldor/src/datastruc/sal_hash.as @@ -87,7 +87,7 @@ returns \emph{t} after the removal.} Rep == Record(nentr:Z, tbl:A L KV, defType:Z, defFun: K -> V); table():% == { import from Z; table 8 }; - table(n:Z):% == newTable(0, n); + table(n:Z):% == newTable(0, max(1, n)); remember(f:K -> V):% == { import from Z; newTable(0, 8, 1, f); } forget(f:K -> V):% == { import from Z; newTable(0, 8, -1, f); } empty?(t:%):Boolean == { import from Z; zero? numberOfEntries t } @@ -135,6 +135,7 @@ returns \emph{t} after the removal.} -- sz = number of slots in the table local newTable(n:Z, sz:Z, type:Z, func:K -> V):% == { import from A L KV, L KV, Rep; + zero? sz => never; per [n, new(sz, empty), type, func]; } @@ -276,8 +277,11 @@ test(): () == { assertEquals("bob", tbl("fred")); assertFalse(failed? find("fred", tbl)); assertTrue(failed? find("zzz", tbl)); - assertFalse(failed? find("fr" + "ed", tbl)); + + tbl := table(); + assertTrue(failed? find("xx", tbl)); + } testIteration(): () == { From 9aa7d2acf19f8d3ddf7475091afb75cb135c780b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 19 May 2016 20:44:22 +0100 Subject: [PATCH 123/352] util.[ch]: Add function for pointer equality. Handy when comparing lists quickly. --- aldor/aldor/src/util.c | 6 ++++++ aldor/aldor/src/util.h | 2 ++ 2 files changed, 8 insertions(+) diff --git a/aldor/aldor/src/util.c b/aldor/aldor/src/util.c index 3ee2f460e..0474d0e51 100644 --- a/aldor/aldor/src/util.c +++ b/aldor/aldor/src/util.c @@ -229,6 +229,12 @@ memltest(Pointer p, int c, ULong l) return true; } +Bool +ptrEqFn(Pointer p, Pointer q) +{ + return ptrEqual(p, q); +} + /***************************************************************************** * diff --git a/aldor/aldor/src/util.h b/aldor/aldor/src/util.h index 68950f28f..495bc1272 100644 --- a/aldor/aldor/src/util.h +++ b/aldor/aldor/src/util.h @@ -133,6 +133,8 @@ extern Bool memltest (Pointer p, int c, ULong l); * are all equal to c. */ +extern Bool ptrEqFn (Pointer p, Pointer q); + /****************************************************************************** * * :: Bit-fiddling From 0fcc17a426562e3964bbf1789d0e758d351dfccd Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 24 May 2016 21:26:04 +0100 Subject: [PATCH 124/352] libaldor: Add a 'fromString' method --- aldor/lib/aldor/src/base/sal_itype.as | 3 +++ aldor/lib/aldor/src/datastruc/sal_string.as | 24 ++++++++++++++++++++- 2 files changed, 26 insertions(+), 1 deletion(-) diff --git a/aldor/lib/aldor/src/base/sal_itype.as b/aldor/lib/aldor/src/base/sal_itype.as index 7ceadf84d..2e5159a93 100644 --- a/aldor/lib/aldor/src/base/sal_itype.as +++ b/aldor/lib/aldor/src/base/sal_itype.as @@ -30,5 +30,8 @@ define InputType: Category == with { \Retval{$<<$ s reads an element of the current type in text format from the stream s and returns the element read.} #endif + + export from InputTypeFunctions %; } +InputTypeFunctions(T: with): with == add; diff --git a/aldor/lib/aldor/src/datastruc/sal_string.as b/aldor/lib/aldor/src/datastruc/sal_string.as index 38110d917..1940c11f8 100644 --- a/aldor/lib/aldor/src/datastruc/sal_string.as +++ b/aldor/lib/aldor/src/datastruc/sal_string.as @@ -611,6 +611,21 @@ extend OutputTypeFunctions(T: OutputType): with { } } +extend InputTypeFunctions(T: InputType): with { + fromString: String -> T +} +== add { + import from TextReader; + fromString(txt: String): T == { + sb: StringBuffer := new(); + sb::TextWriter << txt; + res: T := << sb::TextReader; + free! sb; + res + } +} + + #if ALDORTEST ---------------------- test sal_string.as -------------------------- #include "aldor" @@ -651,9 +666,16 @@ testToString(): () == { assertEquals("1234", toString 1234); } +testToFromString(): () == { + import from MachineInteger; + assertEquals(12, fromString("12")); + assertEquals("0", toString(fromString("0")@MachineInteger)); + assertEquals(99, fromString(toString(99))); +} + testBasics(); testIterate(); testToString(); - +testToFromString(); #endif From 4b48cf10d284c6f56dbdb9615d1240a72aa28cac Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 28 Jun 2016 21:42:15 +0100 Subject: [PATCH 125/352] java: Add ptrToSint .. use hashcode, as it's the best we've got. --- aldor/aldor/lib/java/src/foamj/Foam.java | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/lib/java/src/foamj/Foam.java b/aldor/aldor/lib/java/src/foamj/Foam.java index e171a770a..2ba717ce3 100644 --- a/aldor/aldor/lib/java/src/foamj/Foam.java +++ b/aldor/aldor/lib/java/src/foamj/Foam.java @@ -96,7 +96,7 @@ public static Object throwException(RuntimeException e) { } public static int ptrToSInt(Object o) { - throw new RuntimeException(); + return System.identityHashCode(o); } public static Word sintToPtr(int o) { From 19da8decfaf4f24ee042ab961adc9c5edb8bca39 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 1 Jan 2017 20:58:00 +0000 Subject: [PATCH 126/352] syme.c: Add a fussier equality function Used by annotation file creator; we need to differentiate between exports and imports. --- aldor/aldor/src/syme.c | 18 ++++++++++++++++++ aldor/aldor/src/syme.h | 5 +++++ 2 files changed, 23 insertions(+) diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c index 48fabdbd1..9630e4298 100644 --- a/aldor/aldor/src/syme.c +++ b/aldor/aldor/src/syme.c @@ -255,6 +255,24 @@ symeEq(Syme syme1, Syme syme2) return syme1 == syme2; } +Bool +symeEqualWithAnnotation(Syme syme1, Syme syme2) +{ + if (syme1 == syme2) { + return true; + } + if (symeKind(syme1) != symeKind(syme2)) { + return false; + } + + if (symeDefLevel(syme1) != symeDefLevel(syme2)) { + return false; + } + + return symeEqual(syme1, syme2); +} + + /* * symeHash is a macro and we sometimes need a function. */ diff --git a/aldor/aldor/src/syme.h b/aldor/aldor/src/syme.h index f13403a88..a541f320c 100644 --- a/aldor/aldor/src/syme.h +++ b/aldor/aldor/src/syme.h @@ -510,6 +510,11 @@ extern SymeList symeListMakeLazyConditions (SymeList); extern Bool symeUseIdentifier (AbSyn, Syme); +/* + * Pickier equal - used when producing annotations + */ +extern Bool symeEqualWithAnnotation(Syme, Syme); + /* * Syme SExpr I/O. */ From 35e04602b5d4163c0d069831b546b666d1412f38 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 25 Jan 2017 20:50:57 +0000 Subject: [PATCH 127/352] Compiler: Add annotated abstract syntax output --- aldor/aldor/src/Makefile.am | 5 + aldor/aldor/src/annabs.c | 468 +++++++++++++++++++++++++++++ aldor/aldor/src/annabs.h | 9 + aldor/aldor/src/axlcomp.c | 6 + aldor/aldor/src/emit.c | 22 ++ aldor/aldor/src/emit.h | 1 + aldor/aldor/src/ftype.c | 2 + aldor/aldor/src/ftype.h | 2 + aldor/aldor/src/srcpos.c | 11 + aldor/aldor/src/srcpos.h | 1 + aldor/aldor/src/test/test_annabs.c | 46 +++ aldor/aldor/src/test/testall.c | 1 + aldor/aldor/src/test/testall.h | 1 + 13 files changed, 575 insertions(+) create mode 100644 aldor/aldor/src/annabs.c create mode 100644 aldor/aldor/src/annabs.h create mode 100644 aldor/aldor/src/test/test_annabs.c diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index 7f03dac05..14c23e5b9 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -150,6 +150,7 @@ libstruct_a_SOURCES = \ abpretty.c \ absub.c \ absyn.c \ + annabs.c \ archive.c \ axlobs.c \ compcfg.c \ @@ -268,6 +269,7 @@ testsuite = \ test/test_ablogic.c \ test/test_abnorm.c \ test/test_absyn.c \ + test/test_annabs.c \ test/test_archive.c \ test/test_bigint.c \ test/test_bitv.c \ @@ -307,6 +309,9 @@ testall_SOURCES = \ testall_LDADD = libphase.a libstruct.a libgen.a libport.a -lm testall_LDFLAGS = testall_CFLAGS = -save-temps $(STRICTCFLAGS) + +CFLAGS=-O0 -g + # # Special rules # diff --git a/aldor/aldor/src/annabs.c b/aldor/aldor/src/annabs.c new file mode 100644 index 000000000..d33561bca --- /dev/null +++ b/aldor/aldor/src/annabs.c @@ -0,0 +1,468 @@ +#include "axlobs.h" + +#include "ablogic.h" +#include "absyn.h" +#include "archive.h" +#include "doc.h" +#include "debug.h" +#include "int.h" +#include "sefo.h" +#include "sexpr.h" +#include "stab.h" +#include "store.h" +#include "syme.h" +#include "spesym.h" +#include "table.h" +#include "ti_bup.h" +#include "ti_tdn.h" +#include "tform.h" + +/***************************************************************************** + * + * :: Annotated SExpression + * + ****************************************************************************/ + +SExpr abToAnnotatedSExpr(AbSyn whole); + +typedef struct _AbAnnotationBucket { + Table indexForSefo; + Table sxForIndex; + AInt nextIndex; + Table indexForSyme; + Table symeSxForIndex; + AInt nextSymeIndex; +} *AbAnnotationBucket; + +local AbAnnotationBucket abcNew(void); +local void abcFree(AbAnnotationBucket bucket); +local AInt abcGetSefo(AbAnnotationBucket bucket, Sefo sefo); +local AInt abcAddSefo(AbAnnotationBucket bucket, Sefo sefo); +local void abcSetSefoSExpr(AbAnnotationBucket bucket, AInt idx, SExpr sx); + +local AInt abcGetSyme(AbAnnotationBucket bucket, Syme syme); +local AInt abcAddSyme(AbAnnotationBucket bucket, Syme syme); +local void abcSetSymeSExpr(AbAnnotationBucket bucket, AInt idx, SExpr sx); + +local void abAnnotateInferMissing(Stab stab, AbSyn absyn); +local SExpr abAnnotateSymeRef(Syme syme, AbAnnotationBucket bucket); +local SExpr abAnnotateSyme(Syme syme, AbAnnotationBucket bucket); + +local SExpr abAnnotatedSExpr(AbSyn ab, AbAnnotationBucket bucket); +local SExpr abAnnotateId(AbSyn id, AbAnnotationBucket bucket); +local SExpr abAnnotateUnique(AbSyn id, AbAnnotationBucket bucket); +local SExpr abAnnotateTPoss(AbSyn id, AbAnnotationBucket bucket); +local SExpr abAnnotateError(AbSyn id, AbAnnotationBucket bucket); +local SExpr abToAnnotatedTForm(TForm tf, AbAnnotationBucket bucket); +local SExpr abAnnotateSefo(Sefo sefo, AbAnnotationBucket bucket); +local SExpr abAnnotateExportArchive(Archive ar, Syme syme); + +local AbAnnotationBucket +abcNew(void) +{ + AbAnnotationBucket bucket = (AbAnnotationBucket) stoAlloc((int) OB_Other, sizeof(*bucket)); + bucket->indexForSefo = tblNew((TblHashFun) abHashSefo, (TblEqFun) sefoEqual); + bucket->sxForIndex = tblNew((TblHashFun) aintHash, (TblEqFun) aintEqual); + bucket->indexForSyme = tblNew((TblHashFun) symeHashFn, (TblEqFun) symeEqualWithAnnotation); + bucket->symeSxForIndex = tblNew((TblHashFun) aintHash, (TblEqFun) aintEqual); + bucket->nextIndex = 0; + bucket->nextSymeIndex = 0; + return bucket; +} + +local void +abcFree(AbAnnotationBucket bucket) +{ + tblFree(bucket->indexForSefo); + tblFree(bucket->sxForIndex); + tblFree(bucket->indexForSyme); + tblFree(bucket->symeSxForIndex); + stoFree(bucket); +} + + +local AInt +abcGetSefo(AbAnnotationBucket bucket, Sefo sefo) +{ + return (AInt) tblElt(bucket->indexForSefo, sefo, (TblElt) (AInt) -1); +} + +local AInt +abcAddSefo(AbAnnotationBucket bucket, Sefo sefo) +{ + AInt idx = bucket->nextIndex++; + tblSetElt(bucket->indexForSefo, sefo, (TblElt) (AInt) idx); + return idx; +} + +local void +abcSetSefoSExpr(AbAnnotationBucket bucket, AInt idx, SExpr sx) +{ + tblSetElt(bucket->sxForIndex, (TblElt) idx, sx); +} + + +local AInt +abcGetSyme(AbAnnotationBucket bucket, Syme syme) +{ + return (AInt) tblElt(bucket->indexForSyme, syme, (TblElt) (AInt) -1); +} + +local AInt +abcAddSyme(AbAnnotationBucket bucket, Syme syme) +{ + AInt idx = bucket->nextSymeIndex++; + tblSetElt(bucket->indexForSyme, syme, (TblElt) (AInt) idx); + return idx; +} + +local void +abcSetSymeSExpr(AbAnnotationBucket bucket, AInt idx, SExpr sx) +{ + tblSetElt(bucket->symeSxForIndex, (TblElt) idx, sx); +} + + +local SExpr +abcSExpr(AbAnnotationBucket bucket) +{ + SExpr wholeSefo = sxNil; + SExpr wholeSyme = sxNil; + int i; + for (i=0; inextIndex; i++) { + SExpr sx = tblElt(bucket->sxForIndex, (TblElt) (AInt) i, NULL); + wholeSefo = sxCons(sx, wholeSefo); + } + for (i=0; inextSymeIndex; i++) { + SExpr sx = tblElt(bucket->symeSxForIndex, (TblElt) (AInt) i, NULL); + wholeSyme = sxCons(sx, wholeSyme); + } + + return sxiList(2, sxNReverse(wholeSyme), sxNReverse(wholeSefo)); +} + +SExpr +abToAnnotatedSExpr(AbSyn whole) +{ + AbAnnotationBucket bucket = abcNew(); + SExpr sexpr; + + abAnnotateInferMissing(stabFile(), whole); + sexpr = abAnnotatedSExpr(whole, bucket); + sexpr = sxCons(sexpr, abcSExpr(bucket)); + abcFree(bucket); + + return sexpr; +} + + +local void +abAnnotateInferMissing(Stab stab, AbSyn absyn) { + AbSyn lhs; + int i; + + if (absyn == NULL) + return; + + if (abStab(absyn)) + stab = abStab(absyn); + /* + if (abState(absyn) == AB_State_AbSyn) { + tiBottomUp(stab, absyn, tfUnknown); + tiTopDown(stab, absyn, tfUnknown); + } + */ + switch (abTag(absyn)) { + case AB_Id: + case AB_IdSy: + case AB_LitInteger: + case AB_LitString: + case AB_LitFloat: + break; + case AB_Foreign: + //abAnnotateInferMissing(stab, absyn->abForeign.what); + break; + case AB_Label: + abAnnotateInferMissing(stab, absyn->abLabel.expr); + break; + case AB_Assign: + lhs = absyn->abAssign.lhs; + if (abImplicit(lhs) != NULL) { + abAnnotateInferMissing(stab, absyn->abAssign.rhs); + for (i=0; iabId.sym)); + break; + case AB_Id: + sx = abAnnotateId(ab, bucket); + break; + case AB_DocText: + sx = sxiList(2, + abInfo(abTag(ab)).sxsym, + sxiFrString(docString(ab->abDocText.doc)) + ); + break; + case AB_LitInteger: + case AB_LitString: + case AB_LitFloat: + sx = sxiList(2, + abInfo(abTag(ab)).sxsym, + sxiFrString(ab->abLitString.str) + ); + break; + case AB_Declare: { + Syme syme = abSyme(ab->abDeclare.id); + + sx = sxCons(abInfo(abTag(ab)).sxsym, sxNil); + for (ai = 0; ai < abArgc(ab); ai++) + sx = sxCons(abAnnotatedSExpr(abArgv(ab)[ai], bucket), sx); + + sx = sxNReverse(sx); + break; + } + default: + sx = sxCons(abInfo(abTag(ab)).sxsym, sxNil); + for (ai = 0; ai < abArgc(ab); ai++) + sx = sxCons(abAnnotatedSExpr(abArgv(ab)[ai], bucket), sx); + sx = sxNReverse(sx); + } + + sx = sxiRepos(abPos(ab), sx); + return sx; +} + +local SExpr +abAnnotateId(AbSyn id, AbAnnotationBucket bucket) +{ + SExpr sx; + switch (abState(id)) { + case AB_State_AbSyn: + case AB_State_HasPoss: + sx = abAnnotateTPoss(id, bucket); + break; + case AB_State_HasUnique: + sx = abAnnotateUnique(id, bucket); + break; + case AB_State_Error: + sx = abAnnotateError(id, bucket); + break; + default: + sx = NULL; + assert(false); + } + + return sxCons(abInfo(abTag(id)).sxsym, sx); +} + +local SExpr +abAnnotateAbSyn(AbSyn id, AbAnnotationBucket bucket) +{ + SExpr whole = sxNil; + + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("name")), sxiFrSymbol(abIdSym(id))), whole); + + return whole; +} + +local SExpr +abAnnotateUnique(AbSyn id, AbAnnotationBucket bucket) +{ + Syme syme = abSyme(id); + SrcPos spos = abPos(id); + SExpr sposSx = (sposIsNone(spos)) ? sxNil : sposToSExpr(spos); + + if (abIsTheId(id, ssymCategory)) { + syme = car(stabGetMeanings(stabFile(), ablogFalse(), ssymCategory)); + } + else if (syme == NULL) { + return abAnnotateAbSyn(id, bucket); + } + SExpr symeSx = abAnnotateSyme(syme, bucket); + SExpr whole = sxNil; + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("syme")), symeSx), whole); + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("srcpos")), sposSx), whole); + + return whole; +} + +local SExpr +abAnnotateSyme(Syme syme, AbAnnotationBucket bucket) +{ + AInt idx = abcGetSyme(bucket, syme); + if (idx == -1) { + AInt newIdx = abcAddSyme(bucket, syme); + SExpr sx = abAnnotateSymeRef(syme, bucket); + abcSetSymeSExpr(bucket, newIdx, sx); + return sxCons(sxiFrSymbol(symInternConst("ref")), sxiFrInteger(newIdx)); + } + else { + return sxCons(sxiFrSymbol(symInternConst("ref")), sxiFrInteger(idx)); + } + +} + +local SExpr +abAnnotateSymeRef(Syme syme, AbAnnotationBucket bucket) +{ + TForm tf = symeType(syme); + SExpr exporterSx = sxNil; + + SrcPos spos = symeSrcPos(syme); + SExpr sposSx = (sposIsNone(spos)) ? NULL : sposToSExpr(spos); + Bool wantType = true; + SExpr whole = sxNil; + + if (symeIsLibrary(syme)) { + wantType = false; + } + if (symeIsExport(syme)) { + Syme original = symeOriginal(syme); + AInt constNum = symeConstNum(original); + AInt defnNum = symeDefnNum(original); + Lib lib = symeLib(syme); + + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("typeCode")), + sxiFrInteger(symeTypeCode(original))), whole); + if (lib != NULL) { + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("lib")), + sxiFrString(fnameUnparse(lib->name))), whole); + } + } + if (symeIsImport(syme)) { + TForm exporter = symeExporter(syme); + + if (tfIsArchive(exporter)) { + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("typeCode")), + sxiFrInteger(symeTypeCode(syme))), whole); + exporterSx = abAnnotateExportArchive(tfArchiveAr(exporter), syme); + wantType = false; + } + else { + Syme original = symeOriginal(syme); + SExpr originalSx = abAnnotateSyme(original, bucket); + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("original")), + originalSx), whole); + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("typeCode")), + sxiFrInteger(symeTypeCode(original))), whole); + exporterSx = abToAnnotatedTForm(exporter, bucket); + } + } + + if (!sxiNull(exporterSx)) { + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("exporter")), exporterSx), whole); + } + if (wantType) { + SExpr typeSx = sxNil; + if (tfIsDomainType(tf)) { + typeSx = sxiFrString("-- Domain --"); + } + else if (tfIsCategoryType(tf) || tfIsThird(tf)) { + typeSx = sxiFrString("-- Category --"); + } + else { + typeSx = abToAnnotatedTForm(tf, bucket); + } + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("type")), typeSx), whole); + } + + if (sposSx != NULL) { + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("srcpos")), sposSx), whole); + } + + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("name")), sxiFrSymbol(symeId(syme))), whole); + + return whole; +} + +local SExpr +abAnnotateExportArchive(Archive ar, Syme syme) +{ + Syme original = symeOriginal(syme); + Syme symeLib = arLibrarySyme(ar, original); + Lib lib = symeLibrary(symeLib); + SExpr whole = sxNil; + + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("lib")), + sxiFrString(fnameUnparse(lib->name))), whole); + + return whole; +} + + + +local SExpr +abAnnotateTPoss(AbSyn id, AbAnnotationBucket bucket) +{ + SExpr whole = sxNil; + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("name")), sxiFrSymbol(abIdSym(id))), + whole); + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("state")), sxiFrString("tposs")), + whole); + return whole; +} + +local SExpr +abAnnotateError(AbSyn id, AbAnnotationBucket bucket) +{ + SExpr whole = sxNil; + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("name")), sxiFrSymbol(abIdSym(id))), + whole); + whole = sxCons(sxCons(sxiFrSymbol(symInternConst("state")), sxiFrString("error")), + whole); + return whole; +} + +local SExpr +abToAnnotatedTForm(TForm tf, AbAnnotationBucket bucket) +{ + return abAnnotateSefo(tfExpr(tf), bucket); +} + +local SExpr +abAnnotateSefo(Sefo sefo, AbAnnotationBucket bucket) +{ + AInt idx = abcGetSefo(bucket, sefo); + if (idx == -1) { + AInt newIdx = abcAddSefo(bucket, sefo); + SExpr sx = abAnnotatedSExpr(sefo, bucket); + abcSetSefoSExpr(bucket, newIdx, sx); + return sxCons(sxiFrSymbol(symInternConst("ref")), sxiFrInteger(newIdx)); + } + else { + return sxCons(sxiFrSymbol(symInternConst("ref")), sxiFrInteger(idx)); + } +} + diff --git a/aldor/aldor/src/annabs.h b/aldor/aldor/src/annabs.h new file mode 100644 index 000000000..9c2c88dfe --- /dev/null +++ b/aldor/aldor/src/annabs.h @@ -0,0 +1,9 @@ +#ifndef _ANNABS_H_ +#define _ANNABS_H_ + +#include "sexpr.h" +#include "absyn.h" + +SExpr abToAnnotatedSExpr(AbSyn whole); + +#endif diff --git a/aldor/aldor/src/axlcomp.c b/aldor/aldor/src/axlcomp.c index e2f9fc841..eed70ba06 100644 --- a/aldor/aldor/src/axlcomp.c +++ b/aldor/aldor/src/axlcomp.c @@ -9,6 +9,7 @@ #include "abcheck.h" #include "abnorm.h" #include "abuse.h" +#include "annabs.h" #include "axltop.h" #include "bloop.h" #include "ccomp.h" @@ -1099,6 +1100,11 @@ compPhaseTInfer(EmitInfo finfo, Stab stab, AbSyn ab) typeInfer(stab, ab); /* annotates the tree in-place */ + if (emitIsOutputNeededOrWarn(finfo, FTYPENO_ANNABS)) { + SExpr sexpr = abToAnnotatedSExpr(ab); + emitTheAnnotatedAbSyn(finfo, sexpr); + } + phEnd((PhPrFun) abPrint, (PhPrFun) abPrettyPrint, (Pointer) ab); return ab; } diff --git a/aldor/aldor/src/emit.c b/aldor/aldor/src/emit.c index 74eb1597e..1265dad59 100644 --- a/aldor/aldor/src/emit.c +++ b/aldor/aldor/src/emit.c @@ -108,6 +108,7 @@ emitSelect(String arg) else if (ftypeIs(ft,FTYPENO_INTERMED)) ftn = FTYPENO_INTERMED; else if (ftypeIs(ft,FTYPENO_FOAMEXPR)) ftn = FTYPENO_FOAMEXPR; else if (ftypeIs(ft,FTYPENO_SYMEEXPR)) ftn = FTYPENO_SYMEEXPR; + else if (ftypeIs(ft,FTYPENO_ANNABS)) ftn = FTYPENO_ANNABS; else if (ftypeEqual(ft, "lsp")) ftn = FTYPENO_LISP; else if (ftypeEqual(ft, "java")) ftn = FTYPENO_JAVA; @@ -693,6 +694,7 @@ emitIsGeneratedFile(FileName fn) case FTYPENO_OBJECT: case FTYPENO_JAVA: case FTYPENO_EXEC: + case FTYPENO_ANNABS: return true; default: return false; @@ -941,6 +943,26 @@ emitTheSymbolExpr(EmitInfo finfo, SymeList symes, AbSyn macs) emitSetDone(FTYPENO_SYMEEXPR); } +/* + * Emit lisp-readable symbol meaning information to the .asy file. + */ +void +emitTheAnnotatedAbSyn(EmitInfo finfo, SExpr whole) +{ + FILE *fout; + FileName fn; + + fn = emitFileName(finfo, FTYPENO_ANNABS); + emitInfoInUse(finfo, FTYPENO_ANNABS) = true; + fout = fileWrOpen(fn); + sxiWrite(fout, whole, SXRW_Default); + + fclose(fout); + emitInfoInUse(finfo, FTYPENO_ANNABS) = false; + emitSetDone(FTYPENO_ANNABS); +} + + /* * Emit lisp-readable Foam codes to the .fm file. */ diff --git a/aldor/aldor/src/emit.h b/aldor/aldor/src/emit.h index 4b391d0b0..5f246d9dd 100644 --- a/aldor/aldor/src/emit.h +++ b/aldor/aldor/src/emit.h @@ -88,6 +88,7 @@ extern void emitTheAbSyn (EmitInfo, AbSyn); extern void emitTheIntermed (EmitInfo, SymeList, Foam, AbSyn); extern void emitTheDependencies (EmitInfo); extern void emitTheSymbolExpr (EmitInfo, SymeList, AbSyn); +extern void emitTheAnnotatedAbSyn (EmitInfo, SExpr); extern void emitTheFoamExpr (EmitInfo, Foam); extern void emitTheLisp (EmitInfo, SExpr); extern void emitTheC (EmitInfo, CCodeList); diff --git a/aldor/aldor/src/ftype.c b/aldor/aldor/src/ftype.c index 2b06fb6cd..b262cb1fd 100644 --- a/aldor/aldor/src/ftype.c +++ b/aldor/aldor/src/ftype.c @@ -16,6 +16,7 @@ ftypeNo(String ftype) if (ftypeEqual(ftype, FTYPE_SRC)) return FTYPENO_SRC; if (ftypeEqual(ftype, FTYPE_INCLUDED)) return FTYPENO_INCLUDED; if (ftypeEqual(ftype, FTYPE_ABSYN)) return FTYPENO_ABSYN; + if (ftypeEqual(ftype, FTYPE_ANNABS)) return FTYPENO_ANNABS; if (ftypeEqual(ftype, FTYPE_OLDABSYN)) return FTYPENO_OLDABSYN; if (ftypeEqual(ftype, FTYPE_INTERMED)) return FTYPENO_INTERMED; if (ftypeEqual(ftype, FTYPE_FOAMEXPR)) return FTYPENO_FOAMEXPR; @@ -43,6 +44,7 @@ ftypeString(FTypeNo ftype) case FTYPENO_SRC: return FTYPE_SRC; case FTYPENO_INCLUDED: return FTYPE_INCLUDED; case FTYPENO_ABSYN: return FTYPE_ABSYN; + case FTYPENO_ANNABS: return FTYPE_ANNABS; case FTYPENO_OLDABSYN: return FTYPE_OLDABSYN; case FTYPENO_INTERMED: return FTYPE_INTERMED; case FTYPENO_FOAMEXPR: return FTYPE_FOAMEXPR; diff --git a/aldor/aldor/src/ftype.h b/aldor/aldor/src/ftype.h index 984813d2a..84937ec65 100644 --- a/aldor/aldor/src/ftype.h +++ b/aldor/aldor/src/ftype.h @@ -13,6 +13,7 @@ #define FTYPE_SRC "as" #define FTYPE_INCLUDED "ai" #define FTYPE_ABSYN "ap" +#define FTYPE_ANNABS "abn" #define FTYPE_OLDABSYN "ax" #define FTYPE_INTERMED "ao" #define FTYPE_FOAMEXPR "fm" @@ -42,6 +43,7 @@ enum ftypeNo { FTYPENO_INTERMED, FTYPENO_FOAMEXPR, FTYPENO_SYMEEXPR, + FTYPENO_ANNABS, FTYPENO_LOCK, FTYPENO_LISP, FTYPENO_C, diff --git a/aldor/aldor/src/srcpos.c b/aldor/aldor/src/srcpos.c index b94ffc4d0..d4fbc6dab 100644 --- a/aldor/aldor/src/srcpos.c +++ b/aldor/aldor/src/srcpos.c @@ -15,6 +15,7 @@ #include "util.h" #include "srcpos.h" #include "strops.h" +#include "sexpr.h" /* * The "fields" are @@ -655,3 +656,13 @@ spstackPrintDb(SrcPosStack sposStk) } } +SExpr +sposToSExpr(SrcPos spos) +{ + FileName fileName = sposFile(spos); + SExpr fileSx = fileName == NULL ? sxNil: sxiFrString(fnameName(fileName)); + + return sxiList(3, fileSx, + sxiFrInteger(sposLine(spos)), + sxiFrInteger(sposChar(spos))); +} diff --git a/aldor/aldor/src/srcpos.h b/aldor/aldor/src/srcpos.h index d27716057..865674540 100644 --- a/aldor/aldor/src/srcpos.h +++ b/aldor/aldor/src/srcpos.h @@ -53,6 +53,7 @@ extern Bool sposIsMacroExpanded (SrcPos); extern SrcPos sposMacroExpanded (SrcPos); extern void sposGrowGloLineTbl (FileName fname, Length flno, Length glno); +extern SExpr sposToSExpr(SrcPos); /* * :: SrcPosStack diff --git a/aldor/aldor/src/test/test_annabs.c b/aldor/aldor/src/test/test_annabs.c new file mode 100644 index 000000000..01f84e31c --- /dev/null +++ b/aldor/aldor/src/test/test_annabs.c @@ -0,0 +1,46 @@ +#include "testall.h" +#include "testlib.h" + +#include "abquick.h" +#include "annabs.h" +#include "abuse.h" +#include "absyn.h" +#include "scobind.h" +#include "sexpr.h" +#include "stab.h" +#include "tinfer.h" + +local void testAnnotateSimple(void); + +void annotateAbSynTest() +{ + init(); + TEST(testAnnotateSimple); + fini(); +} + +local void +testAnnotateSimple() +{ + String fDef = "f(): () == never"; + String fCall = "f()"; + + StringList lines = listList(String)(2, fDef, fCall); + AbSynList absynList = listCons(AbSyn)(stdtypes(), abqParseLines(lines)); + AbSyn absyn = abNewSequenceL(sposNone, absynList); + Stab stab; + + initFile(); + stab = stabFile(); + + abPutUse(absyn, AB_Use_NoValue); + abPrintDb(absyn); + scopeBind(stab, absyn); + typeInfer(stab, absyn); + + SExpr sx = abToAnnotatedSExpr(absyn); + + sxiWrite(stdout, sx, SXRW_Default); + + finiFile(); +} diff --git a/aldor/aldor/src/test/testall.c b/aldor/aldor/src/test/testall.c index e330592e5..b8b89de03 100644 --- a/aldor/aldor/src/test/testall.c +++ b/aldor/aldor/src/test/testall.c @@ -61,6 +61,7 @@ main(int argc, char *argv[]) if (testShouldRun("symeset")) symeSetTestSuite(); if (testShouldRun("tibup")) tibupTest(); if (testShouldRun("tfsat")) tfsatTest(); + if (testShouldRun("annabs")) annotateAbSynTest(); if (testShouldRun("retype")) retypeTest(); if (testShouldRun("genfoam")) genfoamTestSuite(); if (testShouldRun("tposs")) tpossTest(); diff --git a/aldor/aldor/src/test/testall.h b/aldor/aldor/src/test/testall.h index 97b949f5b..8f7bb60df 100644 --- a/aldor/aldor/src/test/testall.h +++ b/aldor/aldor/src/test/testall.h @@ -5,6 +5,7 @@ void abcheckTest(void); void ablogTest(void); void abnormTest(void); void absynTest(void); +void annotateAbSynTest(void); void archiveTestSuite(void); void bigintTestSuite(void); void bintTestSuite(void); From 04a402b6d267f74b337b6f5407a4cde0bf2b70a1 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 20 Jan 2017 21:47:47 +0000 Subject: [PATCH 128/352] annotations: Add rule to produce .abn files. --- aldor/lib/buildlib.mk | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index 685b65488..7241ce125 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -91,6 +91,7 @@ $(addsuffix .c, $(library)): %.c: %.ao %.dep ifndef Libraryname Libraryname := $(shell echo '$(libraryname)' | sed -e 's/^[a-z]/\u&/') endif + aldor_args = $(aldor_common_args) \ -Y. \ -I$(libraryincdir) \ @@ -99,6 +100,7 @@ aldor_args = $(aldor_common_args) \ $($*_AXLFLAGS) \ -Fasy=$*.asy \ -Fao=$*.ao \ + -Fabn=$*.abn \ $(filter %$*.as,$^) \ $(filter %$*.ax,$^) @@ -108,6 +110,7 @@ $(addsuffix .ao, $(asdomains)): %.ao: %.as $(addsuffix .ao, $(axdomains)): %.ao: %.ax $(addsuffix .ao, $(alldomains)): %.ao: $(foreach x,$(librarydeps),$(top_builddir)/lib/$(x)/src/lib$(x).al) +$(addsuffix .abn, $(alldomains)): %.abn: %.ao SUBLIB := _sublib_$(libraryname) SUBLIB_DEPEND := _sublib_depend_$(libraryname) @@ -322,6 +325,7 @@ mostlyclean: rm -f *.java rm -f *.class rm -f *.exe + rm -f *.abn rm -f *.asy clean: mostlyclean From 3ab480b68fb7233ba19f56c3dd5ac472ce3846e4 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Jan 2017 12:49:46 +0000 Subject: [PATCH 129/352] tfsat.c: Deal with cases like X: Cat == with Module %; Module(T: X): Cat == ... Basically, if "s" is % and T is a type with a self eq to s, we can return a positive result. --- aldor/aldor/src/tfsat.c | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/aldor/aldor/src/tfsat.c b/aldor/aldor/src/tfsat.c index 73a1f1d14..8e926b352 100644 --- a/aldor/aldor/src/tfsat.c +++ b/aldor/aldor/src/tfsat.c @@ -1698,6 +1698,23 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) int serialThis = serialNo++; AbSub sigma; + /* Check for % explicitly + * More exactly, as long as Sab is %, find % from t; if it corresponds to Sab or mods, + * then we have the thing we want. + * This fixes up cases like Rng: C == with Module(%); Module(X: Rng) == ... + */ + if (Sab && tfHasSelf(symeType(t)) + && abIsTheId(Sab, ssymSelf)) { + for (symes = tfSelf(symeType(t)); !tfSatSucceed(result) && symes; symes = cdr(symes)) { + if (listMemq(Syme)(mods, car(symes))) { + result = tfSatTrue(mask); + } + } + if (tfSatSucceed(result)) { + return result; + } + } + tfsExportDEBUG(dbOut, "tfSatExport[%d]:: Start S: %pAbSyn\n", serialThis, Sab); if (symeHasDefault(t) && !symeIsSelfSelf(t)) From 5e3f2072f7fdc18e0e2875204ced2006b8a54758 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Jan 2017 13:02:29 +0000 Subject: [PATCH 130/352] tfsat.c: Special case conditions on % that are implicitly true [this needs more testing] --- aldor/aldor/src/tfsat.c | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/aldor/aldor/src/tfsat.c b/aldor/aldor/src/tfsat.c index 8e926b352..3de724b31 100644 --- a/aldor/aldor/src/tfsat.c +++ b/aldor/aldor/src/tfsat.c @@ -1780,6 +1780,8 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) extern TForm tiGetTForm (Stab, AbSyn); +static SatMask tfSatConditionOnSelf(SatMask mask, SymeList mods, Syme s, Sefo property); + local SatMask tfSatConditions(SatMask mask, SymeList mods, Syme s, Syme t) { @@ -1803,6 +1805,12 @@ tfSatConditions(SatMask mask, SymeList mods, Syme s, Syme t) if (abTag(cond) == AB_Has) { TForm tfdom, tfcat; AbSyn cat; + if (abIsTheId(cond->abHas.expr, ssymSelf)) { + if (tfSatSucceed(tfSatConditionOnSelf(mask, mods, s, cond->abHas.property))) + continue; + else + return tfSatFalse(mask); + } tfdom = abGetCategory(cond->abHas.expr); cat = cond->abHas.property; tfcat = abTForm(cat) ? abTForm(cat) : tiTopFns()->tiGetTopLevelTForm(NULL, cat); @@ -1820,6 +1828,18 @@ tfSatConditions(SatMask mask, SymeList mods, Syme s, Syme t) return result; } +SatMask +tfSatConditionOnSelf(SatMask mask, SymeList mods, Syme s, Sefo property) +{ + /* This looks for "if % has X then X".. + * Ideally, should look for "if % has T then X" and see if T => X */ + if (sefoEqualMod(mods, tfExpr(symeType(s)), property)) { + return tfSatTrue(mask); + } + return tfSatFalse(mask); +} + + local Bool sefoListMemberMod(SymeList mods, Sefo sefo, SefoList sefos) { From 9e34fef873915c5921898fd0bf3fa782066a611c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 9 Jan 2017 22:20:34 +0000 Subject: [PATCH 131/352] scobind.c: Fix segfault where extend is in same file as original. --- aldor/aldor/src/scobind.c | 5 +++-- aldor/aldor/src/test/test_scobind.c | 22 ++++++++++++++++++++++ 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/scobind.c b/aldor/aldor/src/scobind.c index 854eed184..8906ab112 100644 --- a/aldor/aldor/src/scobind.c +++ b/aldor/aldor/src/scobind.c @@ -1753,8 +1753,9 @@ scobindDeclareId(AbSyn id, AbSyn type, AbSyn val, DeclContext context) if (dtype && !abEqualModDeclares(type, dtype)) comsgWarning(id, ALDOR_W_ScoVarDefault, symString(sym)); - /* Check the value against any previous value which was given. */ - if (val && oval && !abEqual(val, oval)) { + /* Check the value against any previous value which was given (extends get a free pass). */ + if (val && oval && !abEqual(val, oval) + && context != SCO_Sig_Extend) { /*!! comsgError(id, ALDOR_E_ScoVal, symString(sym)); */ return di; } diff --git a/aldor/aldor/src/test/test_scobind.c b/aldor/aldor/src/test/test_scobind.c index 974247b1a..1c630c461 100644 --- a/aldor/aldor/src/test/test_scobind.c +++ b/aldor/aldor/src/test/test_scobind.c @@ -5,10 +5,13 @@ #include "testlib.h" #include "ablogic.h" #include "symbol.h" +#include "abuse.h" +#include "comsg.h" local void testScobind(void); local void testScobindCondition(void); local void testScobindConditionMulti(void); +local void testScobindExtends(void); /* XXX: from test_tinfer.c */ void init(void); @@ -23,6 +26,7 @@ scobindTest(void) TEST(testScobind); TEST(testScobindCondition); TEST(testScobindConditionMulti); + TEST(testScobindExtends); fini(); } @@ -102,3 +106,21 @@ scobindTestCheckUnique(Stab stab, Symbol sym) testIntEqual("unique", 1, listLength(Syme)(sl)); testPointerEqual("name", sym, symeId(car(sl))); } + +local void +testScobindExtends() +{ + AbSyn ab1; + CoMsg message; + + initFile(); + Stab stabGlobal = stabNewGlobal(); + Stab stabFile = stabNewFile(stabGlobal); + Stab stab = stabFile; + + ab1 = abqParse("E1: Category == with Foo;\nextend E1: Category == with"); + abPutUse(ab1, AB_Use_NoValue); + scopeBind(stabFile, ab1); + testIntEqual("Error count", 0, comsgErrorCount()); + finiFile(); +} From bbed1ca970c0e8610b064a77d7343c91f8efcfe8 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 15 Jan 2017 18:00:08 +0000 Subject: [PATCH 132/352] genjava: Foreign import closures should return object of type word. --- aldor/aldor/src/gf_java.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/gf_java.c b/aldor/aldor/src/gf_java.c index e0a841575..be7db670c 100644 --- a/aldor/aldor/src/gf_java.c +++ b/aldor/aldor/src/gf_java.c @@ -70,7 +70,8 @@ gfjImportApply(Syme syme) gen0AddParam(foamNewDecl(FOAM_Word, strCopy("this"), emptyFormatSlot)); gen0AddStmt(foamNewDef(foamNewLex(int0, int0), foamNewPar(int0)), NULL); - gen0AddStmt(foamNewReturn(foamNewClos(foamNewEnv(int0), foamNewConst(innerConstNum))), NULL); + gen0AddStmt(foamNewReturn(foamNewCast(FOAM_Word, + foamNewClos(foamNewEnv(int0), foamNewConst(innerConstNum)))), NULL); gen0ProgAddFormat(fmtNum, foamNewDDecl(FOAM_DDecl_LocalEnv, From 723fb54a3f172a9594ca7ac11a00bc08f84d3f78 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 16 Jan 2017 21:55:56 +0000 Subject: [PATCH 133/352] aldor/lib/common.mk: Remove -Zdb from build options It makes a mess of foam output. This will stop unicl from using -g, but these days gcc does a reasonable job of retaining enough call information. --- aldor/lib/aldor/src/common.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/lib/aldor/src/common.mk b/aldor/lib/aldor/src/common.mk index 6379e676a..d600792db 100644 --- a/aldor/lib/aldor/src/common.mk +++ b/aldor/lib/aldor/src/common.mk @@ -5,6 +5,6 @@ libraryname := aldor librarydeps := #AXLCDB := -W check -Csmax=0 -Zdb -Qno-cc -AXLFLAGS := -Z db -Q3 $(AXLCDB) +AXLFLAGS := -Q3 $(AXLCDB) include $(top_srcdir)/lib/buildlib.mk From c7477998fc7342bb5c62d988477fbf6fa49855ce Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 16 Jan 2017 21:57:23 +0000 Subject: [PATCH 134/352] gf_implicit.c: Need to generate return values of the correct type. Can't just return a word. --- aldor/aldor/src/gf_implicit.c | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/aldor/aldor/src/gf_implicit.c b/aldor/aldor/src/gf_implicit.c index b2f1ab6bd..7439e1e0d 100644 --- a/aldor/aldor/src/gf_implicit.c +++ b/aldor/aldor/src/gf_implicit.c @@ -32,9 +32,9 @@ extern Bool genfoamConstDebug; local Foam gen1ImplicitExport (Syme, FoamTag); local void gen0ImplicitPANew (FoamList, FoamTag); -local void gen0ImplicitPAGet (FoamList, FoamTag); +local void gen0ImplicitPAGet (FoamList, FoamTag, FoamTag); local void gen0ImplicitPASet (FoamList, FoamTag); -local void gen0ImplicitPRGet (FoamList, FoamTag); +local void gen0ImplicitPRGet (FoamList, FoamTag, FoamTag); local void gen0ImplicitPRSet (FoamList, FoamTag); local void gen0ImplicitPRSize (FoamList, FoamTag); local FoamTag gen1ImplicitType (TForm); @@ -231,7 +231,7 @@ gen1ImplicitExport(Syme syme, FoamTag repTag) gen0ImplicitPANew(pars, repTag); break; case GFI_PackedArrayGet: - gen0ImplicitPAGet(pars, repTag); + gen0ImplicitPAGet(pars, retType, repTag); break; case GFI_PackedArraySet: gen0ImplicitPASet(pars, repTag); @@ -240,7 +240,7 @@ gen1ImplicitExport(Syme syme, FoamTag repTag) gen0ImplicitPRSet(pars, repTag); break; case GFI_PackedRecordGet: - gen0ImplicitPRGet(pars, repTag); + gen0ImplicitPRGet(pars, retType, repTag); break; case GFI_PackedRepSize: gen0ImplicitPRSize(pars, repTag); @@ -314,7 +314,7 @@ gen0ImplicitPANew(FoamList pars, FoamTag repTag) * Construct the body of PackedArrayGet: (Arr, SInt) -> % */ local void -gen0ImplicitPAGet(FoamList pars, FoamTag repTag) +gen0ImplicitPAGet(FoamList pars, FoamTag retType, FoamTag repTag) { Foam parArr, parElt, foam; @@ -334,8 +334,8 @@ gen0ImplicitPAGet(FoamList pars, FoamTag repTag) foam = foamNewAElt(repTag, parElt, parArr); - /* Cast to uniform type */ - foam = foamNewCast(FOAM_Word, foam); + /* Cast to return type */ + foam = foamNewCast(retType, foam); /* Return the array element selected */ @@ -392,7 +392,7 @@ gen0ImplicitPASet(FoamList pars, FoamTag repTag) * Construct the body of PackedRecordGet: Ptr -> % */ local void -gen0ImplicitPRGet(FoamList pars, FoamTag repTag) +gen0ImplicitPRGet(FoamList pars, FoamTag retType, FoamTag repTag) { Foam par, foam; @@ -407,8 +407,8 @@ gen0ImplicitPRGet(FoamList pars, FoamTag repTag) foam = foamNewAElt(repTag, foamNewSInt(int0), par); - /* Cast to uniform type */ - foam = foamNewCast(FOAM_Word, foam); + /* Cast to return type */ + foam = foamNewCast(retType, foam); /* Return the value extracted */ From a847542a3051d4250c421f34169a1b0628609ac6 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 17 Jan 2017 23:06:00 +0000 Subject: [PATCH 135/352] genfoam.c: Allow for exit in expressions returning multiple values --- aldor/aldor/src/genfoam.c | 52 ++++++++++++++++++++++++++++----------- 1 file changed, 37 insertions(+), 15 deletions(-) diff --git a/aldor/aldor/src/genfoam.c b/aldor/aldor/src/genfoam.c index 042a48118..5cd10c905 100644 --- a/aldor/aldor/src/genfoam.c +++ b/aldor/aldor/src/genfoam.c @@ -140,6 +140,8 @@ local Foam gen0CrossToTuple (Foam, TForm); local Foam gen0Define (AbSyn); local Foam gen0DefineRhs (AbSyn, AbSyn, AbSyn); local Foam gen0Embed (Foam, AbSyn, TForm, AbEmbed); +local Foam gen0EmbedExit (Foam, AbSyn, TForm); +local Foam gen0NilValue (TForm); local Symbol gen0ExportingTo (AbSyn absyn); local void gen0ExportToBuiltin (AbSyn fun); local void gen0ExportToC (AbSyn fun); @@ -650,23 +652,24 @@ Foam genFoamValAs(TForm tf, AbSyn ab) { Foam foam = genFoamVal(ab); + return gen0EmbedExit(foam, ab, tf); +} + +local Foam +gen0EmbedExit(Foam foam, AbSyn ab, TForm tf) +{ if (tfIsExit(gen0AbType(ab))) { if (tfIsMulti(tf) && tfMultiArgc(tf) > 0) { - Foam fakeValue; - int i; - - if (foamHasSideEffect(foam)) + if (foam != NULL && foamHasSideEffect(foam)) gen0AddStmt(foam, ab); - fakeValue = foamNewEmpty(FOAM_Values, tfMultiArgc(tf)); - for (i = 0; i < tfMultiArgc(tf); i++) { - FoamTag type = gen0Type(tfMultiArgN(tf, i), NULL); - fakeValue->foamValues.argv[i] = foamNewCast(type, foamNewNil()); - } - - return fakeValue; + return gen0NilValue(tf); } else { + FoamTag expectedType = gen0Type(tf, NULL); + if (expectedType != FOAM_Word && foam != NULL) { + foam = foamNewCast(expectedType, foam); + } return foam; } } @@ -675,6 +678,25 @@ genFoamValAs(TForm tf, AbSyn ab) } } +local Foam +gen0NilValue(TForm tf) +{ + if (!tfIsMulti(tf)) { + return foamNewNil(); + } + else { + Foam fakeValue = foamNewEmpty(FOAM_Values, tfMultiArgc(tf)); + int i; + + for (i = 0; i < tfMultiArgc(tf); i++) { + FoamTag type = gen0Type(tfMultiArgN(tf, i), NULL); + fakeValue->foamValues.argv[i] = foamNewCast(type, foamNewNil()); + } + return fakeValue; + } +} + + Foam genFoamType(AbSyn ab) { @@ -4927,6 +4949,8 @@ gen0Sequence(TForm tf, AbSyn *argv, Length argc, Length i) if (j == argc - 1) { Foam result = gen0TempValue(s); + if (gen0ValueMode) + result = gen0EmbedExit(result, s, tf); if (flag) gen0ResetImportPlace(topLines); return result; } @@ -5108,11 +5132,9 @@ gen0Lambda(AbSyn absyn, Syme syme, AbSyn defaults) if (!val && !gen0ProgHasReturn()) { - if (tfMapRetc(tf) == 0) - val = foamNewEmpty(FOAM_Values, int0); - else - val = foamNewNil(); + val = gen0NilValue(tfMapRet(tf)); } + if (val) gen0AddStmt(foamNewReturn(val), absyn); gen0ProgAddStateFormat(index); From fc96e10951ae4f5fd654a4c5bc9367ed9d04e42d Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 17 Jan 2017 23:07:47 +0000 Subject: [PATCH 136/352] genfoam: deal with try/catch returning no value --- aldor/aldor/src/gf_prog.c | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/aldor/aldor/src/gf_prog.c b/aldor/aldor/src/gf_prog.c index 0cdb914d3..13d6e773d 100644 --- a/aldor/aldor/src/gf_prog.c +++ b/aldor/aldor/src/gf_prog.c @@ -14,6 +14,7 @@ #include "syme.h" #include "strops.h" #include "fbox.h" +#include "tform.h" /***************************************************************************** * @@ -55,9 +56,14 @@ gen0BuildFunction(ProgType pt, String name, AbSyn expr) saved = gen0ProgSaveState(pt); - ret = genFoamVal(expr); - if (ret) gen0AddStmt(foamNewReturn(ret), expr); - + if (tfIsNone(gen0AbContextType(expr))) { + genFoamStmt(expr); + gen0AddStmt(foamNewReturn(foamNew(FOAM_Values, (Length) 0)), expr); + } + else { + ret = genFoamValAs(gen0AbContextType(expr), expr); + if (ret) gen0AddStmt(foamNewReturn(ret), expr); + } gen0ProgPushFormat(emptyFormatSlot); gen0IssueDCache(); From 32da8fa713f34f7da85b0e4104e9cc0e991bca7b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 26 Jan 2017 00:01:29 +0000 Subject: [PATCH 137/352] configure: Cater for gcc-4.7 when looking for errors It seems to need a reason to produce a warning before checking arguments. --- aldor/m4/strict_compile.m4 | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/aldor/m4/strict_compile.m4 b/aldor/m4/strict_compile.m4 index 2b6c55119..1052b41ec 100644 --- a/aldor/m4/strict_compile.m4 +++ b/aldor/m4/strict_compile.m4 @@ -1,27 +1,26 @@ # Define warnings based on compiler (and version) AC_DEFUN([ALDOR_CC_OPTION], -[AC_MSG_CHECKING($CC supports $1); echo > conftest$1.c; +[AC_MSG_CHECKING($CC supports $1); echo "$3" > conftest$1.c; res=no - if $CC $1 -c conftest$1.c > /dev/null 2>&1; then $2="$1"; res=yes; fi; + if $CC -Werror $1 -c conftest$1.c > /dev/null 2>&1; then $2="$1"; res=yes; fi; AC_MSG_RESULT($res)]) AC_DEFUN([ALDOR_STRICT_COMPILE], - [ALDOR_CC_OPTION(-Wno-shift-negative-value,cfg_no_shift_negative_value) + [ALDOR_CC_OPTION(-Wno-shift-negative-value,cfg_no_shift_negative_value,int main() { return 1 << -1; }) ALDOR_CC_OPTION(-Wno-sign-compare,cfg_no_sign_compare) AC_MSG_CHECKING(Strict options for C compiler) cfgSTRICTCFLAGS="-pedantic -std=c99 -Wall -Wextra -Werror -Wno-empty-body -Wno-enum-compare -Wno-missing-field-initializers -Wno-unused -Wno-unused-parameter -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing -Wno-unused $cfg_no_sign_compare $cfg_no_shift_negative_value " - if test "${CC}x" = gccx - then - cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -Wno-error=clobbered -Wno-unused" - elif test "${CC}x" = clangx - then - cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -fcolor-diagnostics -Wno-error=enum-conversion -Wno-error=tautological-compare -Wno-parentheses-equality" - else - AC_MSG_WARN(Unknown C compiler ${CC}) - cfgSTRICTCFLAGS="" - fi + case "${CC}" in + gcc*) + cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -Wno-error=clobbered -Wno-unused";; + clang*) + cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -fcolor-diagnostics -Wno-error=enum-conversion -Wno-error=tautological-compare -Wno-parentheses-equality";; + *) + AC_MSG_WARN(Unknown C compiler ${CC}) + cfgSTRICTCFLAGS="";; + esac AC_MSG_RESULT(${CC})]) From 5f9e2e98b9ad13644443ab26e9002e15205d2ff2 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 27 Jan 2017 20:37:58 +0000 Subject: [PATCH 138/352] store.c: Remove calls to strncasecmp as it isn't hugely portable. --- aldor/aldor/src/store.c | 27 ++++++++++++--------------- 1 file changed, 12 insertions(+), 15 deletions(-) diff --git a/aldor/aldor/src/store.c b/aldor/aldor/src/store.c index d7f31e796..23883b243 100644 --- a/aldor/aldor/src/store.c +++ b/aldor/aldor/src/store.c @@ -47,8 +47,6 @@ * penalty of a 48K table in static data. */ -#define _DEFAULT_SOURCE 1 /* strncasecmp */ - #include "debug.h" #include "opsys.h" #include "store.h" @@ -3600,21 +3598,20 @@ stoShowArgs(char *detail) /* How long is the word? */ l = detail - w; - /* Do we recognise it? */ if (!strncmp(w,"pages",l)) r |= STO_SHOW_PAGES; - else if (!strncasecmp(w,"memory",l)) r |= STO_SHOW_MEMORY; - else if (!strncasecmp(w,"overhead",l)) r |= STO_SHOW_OVERHEAD; - else if (!strncasecmp(w,"reserved",l)) r |= STO_SHOW_RESERVED; - else if (!strncasecmp(w,"fixed",l)) r |= STO_SHOW_FIXED; - else if (!strncasecmp(w,"mixed",l)) r |= STO_SHOW_MIXED; - else if (!strncasecmp(w,"pagemap",l)) r |= STO_SHOW_PAGEMAP; - else if (!strncasecmp(w,"pagekey",l)) r |= STO_SHOW_PAGEKEY; - else if (!strncasecmp(w,"memmap",l)) r |= STO_SHOW_MEMMAP; - else if (!strncasecmp(w,"census",l)) r |= STO_SHOW_CENSUS; - else if (!strncasecmp(w,"usage",l)) r |= STO_SHOW_USAGE; - else if (!strncasecmp(w,"all",l)) r |= STO_SHOW_ALL; - else if (!strncasecmp(w,"show",l)) + else if (!strncmp(w,"memory",l)) r |= STO_SHOW_MEMORY; + else if (!strncmp(w,"overhead",l)) r |= STO_SHOW_OVERHEAD; + else if (!strncmp(w,"reserved",l)) r |= STO_SHOW_RESERVED; + else if (!strncmp(w,"fixed",l)) r |= STO_SHOW_FIXED; + else if (!strncmp(w,"mixed",l)) r |= STO_SHOW_MIXED; + else if (!strncmp(w,"pagemap",l)) r |= STO_SHOW_PAGEMAP; + else if (!strncmp(w,"pagekey",l)) r |= STO_SHOW_PAGEKEY; + else if (!strncmp(w,"memmap",l)) r |= STO_SHOW_MEMMAP; + else if (!strncmp(w,"census",l)) r |= STO_SHOW_CENSUS; + else if (!strncmp(w,"usage",l)) r |= STO_SHOW_USAGE; + else if (!strncmp(w,"all",l)) r |= STO_SHOW_ALL; + else if (!strncmp(w,"show",l)) { (void)fprintf(osStderr, "\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n\n", From c7323e06c451a2f0f2b5046919e7b6cf8b9c7e9a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 27 Jan 2017 23:18:17 +0000 Subject: [PATCH 139/352] configure.ac: Try to get a clean compilation for sbrk() --- aldor/aldor/lib/libfoam/Makefile.am | 4 ++-- aldor/aldor/src/opsys.c | 6 +----- aldor/aldor/src/opsys_port.h.in | 12 ++++++++++++ aldor/aldor/subcmd/unitools/Makefile.am | 7 ++++--- aldor/configure.ac | 1 + aldor/m4/error-on-warn.m4 | 1 + aldor/m4/sbrk.m4 | 24 ++++++++++++++++++++++++ 7 files changed, 45 insertions(+), 10 deletions(-) create mode 100644 aldor/aldor/src/opsys_port.h.in create mode 100644 aldor/m4/sbrk.m4 diff --git a/aldor/aldor/lib/libfoam/Makefile.am b/aldor/aldor/lib/libfoam/Makefile.am index 72e5ac624..b8e7e1dba 100644 --- a/aldor/aldor/lib/libfoam/Makefile.am +++ b/aldor/aldor/lib/libfoam/Makefile.am @@ -2,7 +2,7 @@ SUBDIRS = al aldorsrcdir = $(top_srcdir)/aldor/src -runtime_CFLAGS = -I $(aldorsrcdir) +runtime_CFLAGS = -I $(aldorsrcdir) -I ../../src runtime_ALDOR = al/runtime.c runtime_CSOURCES = \ @@ -21,7 +21,7 @@ runtime_CSOURCES = \ util.c \ xfloat.c -AM_CFLAGS = -I$(aldorsrcdir) -DFOAM_RTS +AM_CFLAGS = -I$(aldorsrcdir) -I ../../src -DFOAM_RTS lib_LIBRARIES = diff --git a/aldor/aldor/src/opsys.c b/aldor/aldor/src/opsys.c index a0a68a100..b7d59f883 100644 --- a/aldor/aldor/src/opsys.c +++ b/aldor/aldor/src/opsys.c @@ -6,11 +6,7 @@ * ****************************************************************************/ - -#define _ALL_SOURCE 1 /* For RS/6000 - should come before cport.h include. */ -#define _POSIX_SOURCE 1 /* For Linux/BSD. */ -#define _DEFAULT_SOURCE 1 /* sbrk */ - +#include "opsys_port.h" #include "cport.h" #include "editlevels.h" #include "opsys.h" diff --git a/aldor/aldor/src/opsys_port.h.in b/aldor/aldor/src/opsys_port.h.in new file mode 100644 index 000000000..621f7a09f --- /dev/null +++ b/aldor/aldor/src/opsys_port.h.in @@ -0,0 +1,12 @@ +#ifndef _OPSYS_PORT_H +#define _OPSYS_PORT_H + +/* This isn't the nicest way of ensuring that sbrk() shows up without warnings + - really ought to come up with another solution. */ + +#define _ALL_SOURCE 1 /* For RS/6000 - should come before cport.h include. */ +#define _POSIX_SOURCE 1 /* For Linux/BSD. */ + +#define @SBRK_OPT@ + +#endif diff --git a/aldor/aldor/subcmd/unitools/Makefile.am b/aldor/aldor/subcmd/unitools/Makefile.am index ac14ae9f7..2471582b4 100644 --- a/aldor/aldor/subcmd/unitools/Makefile.am +++ b/aldor/aldor/subcmd/unitools/Makefile.am @@ -1,8 +1,9 @@ # Aldor portability layer noinst_LIBRARIES = libport.a s = $(srcdir)/../../src +l = ../../src -libport_a_CFLAGS = -I $s +libport_a_CFLAGS = -I $s -I $l $(AM_CFLAGS) libport_a_SOURCES = \ bigint.c \ @@ -36,12 +37,12 @@ bin_PROGRAMS = unicl unicl_SOURCES = unicl.c unicl_LDADD = libport.a -lm -unicl_CFLAGS = -I $s $(AM_CFLAGS) +unicl_CFLAGS = -I $s -I $l $(AM_CFLAGS) # Print platform information noinst_PROGRAMS = platform -platform_CFLAGS = -I $s $(AM_CFLAGS) +platform_CFLAGS = -I $s -I $l $(AM_CFLAGS) CLEANFILES=$(libport_a_SOURCES) diff --git a/aldor/configure.ac b/aldor/configure.ac index ee9fdf48c..29967c4eb 100644 --- a/aldor/configure.ac +++ b/aldor/configure.ac @@ -87,6 +87,7 @@ AC_CONFIG_FILES( aldor/subcmd/unitools/Makefile aldor/subcmd/testaldor/Makefile aldor/src/Makefile + aldor/src/opsys_port.h aldor/lib/Makefile aldor/lib/libfoamlib/Makefile aldor/lib/libfoamlib/al/Makefile diff --git a/aldor/m4/error-on-warn.m4 b/aldor/m4/error-on-warn.m4 index c44bff2de..86b43f50c 100644 --- a/aldor/m4/error-on-warn.m4 +++ b/aldor/m4/error-on-warn.m4 @@ -1,6 +1,7 @@ AC_DEFUN([ALDOR_ERROR_ON_WARN], ALDOR_STRICT_COMPILE +ALDOR_SBRK_OPTION [AC_MSG_CHECKING(what extra warning flags to pass to the C compiler) warnFLAGS= STRICTCFLAGS="${CFLAGS}" diff --git a/aldor/m4/sbrk.m4 b/aldor/m4/sbrk.m4 new file mode 100644 index 000000000..58b61ffff --- /dev/null +++ b/aldor/m4/sbrk.m4 @@ -0,0 +1,24 @@ + +AC_DEFUN([ALDOR_SBRK_OPTION], +[AC_MSG_CHECKING(Determining source for sbrk) +cat > conftest_sbrk.c << EOF +#include +int main() { sbrk(3); } +EOF + +if ${CC} ${CFLAGS} ${cfgSTRICTCFLAGS} conftest_sbrk.c >&AS_MESSAGE_LOG_FD 2>&1; +then + sbrk_opt=_ALDOR_ANY_SBRK +elif ${CC} ${CFLAGS} ${cfgSTRICTCFLAGS} -D_BSD_SOURCE conftest_sbrk.c >&AS_MESSAGE_LOG_FD 2>&1; +then + sbrk_opt=_BSD_SOURCE +elif ${CC} ${CFLAGS} ${cfgSTRICTCFLAGS} -D_DEFAULT_SOURCE conftest_sbrk.c >&AS_MESSAGE_LOG_FD 2>&1; +then + sbrk_opt=_DEFAULT_SOURCE +else + AC_MSG_FAILURE([No way to get sbrk()]) +fi +SBRK_OPT=$sbrk_opt +AC_SUBST(SBRK_OPT) +AC_MSG_RESULT($sbrk_opt) +]) From c621aaadb654f732eb941897c0ac13abbf9a86ff Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 27 Jan 2017 23:19:20 +0000 Subject: [PATCH 140/352] configure.ac: Use code that triggers the warning when looking for errors. --- aldor/m4/strict_compile.m4 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/m4/strict_compile.m4 b/aldor/m4/strict_compile.m4 index 1052b41ec..233642e0f 100644 --- a/aldor/m4/strict_compile.m4 +++ b/aldor/m4/strict_compile.m4 @@ -8,8 +8,8 @@ AC_DEFUN([ALDOR_CC_OPTION], AC_DEFUN([ALDOR_STRICT_COMPILE], - [ALDOR_CC_OPTION(-Wno-shift-negative-value,cfg_no_shift_negative_value,int main() { return 1 << -1; }) - ALDOR_CC_OPTION(-Wno-sign-compare,cfg_no_sign_compare) + [ALDOR_CC_OPTION(-Wno-error=shift-negative-value,cfg_no_shift_negative_value,int main() { return -1 << 1; }) + ALDOR_CC_OPTION(-Wno-error=sign-compare,cfg_no_sign_compare) AC_MSG_CHECKING(Strict options for C compiler) cfgSTRICTCFLAGS="-pedantic -std=c99 -Wall -Wextra -Werror -Wno-empty-body -Wno-enum-compare -Wno-missing-field-initializers -Wno-unused -Wno-unused-parameter -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing -Wno-unused $cfg_no_sign_compare $cfg_no_shift_negative_value " From 5eda5e863817886b483e00bebb570fd1b9da348a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 28 Jan 2017 20:02:38 +0000 Subject: [PATCH 141/352] lib/test/Makefile: Use relative paths to libraries --- aldor/lib/aldor/test/Tests.am | 2 +- aldor/lib/algebra/test/Tests.am | 2 +- aldor/lib/axldem/test/Tests.am | 2 +- aldor/lib/axllib/test/Tests.am | 2 +- aldor/lib/testprog.am | 3 +-- 5 files changed, 5 insertions(+), 6 deletions(-) diff --git a/aldor/lib/aldor/test/Tests.am b/aldor/lib/aldor/test/Tests.am index a215b68a3..f8fef2892 100644 --- a/aldor/lib/aldor/test/Tests.am +++ b/aldor/lib/aldor/test/Tests.am @@ -1,4 +1,4 @@ -LDADD= /home/pab/Work/aldorgit/build/lib/aldor/src/libaldor.a /home/pab/Work/aldorgit/build/aldor/lib/libfoam/libfoam.a /home/pab/Work/aldorgit/build/aldor/lib/libfoamlib/libfoamlib.a -lm +LDADD= ../../../lib/aldor/src/libaldor.a ../../../aldor/lib/libfoam/libfoam.a ../../../aldor/lib/libfoamlib/libfoamlib.a -lm check_PROGRAMS += bug1332/bug1332 bug1332_bug1332_SOURCES = bug1332/bug1332-aldormain.c bug1332/bug1332.c CLEANFILES += bug1332/bug1332-aldormain.c bug1332/bug1332.c bug1332/bug1332.ao diff --git a/aldor/lib/algebra/test/Tests.am b/aldor/lib/algebra/test/Tests.am index 2379f6333..f433e5770 100644 --- a/aldor/lib/algebra/test/Tests.am +++ b/aldor/lib/algebra/test/Tests.am @@ -1,4 +1,4 @@ -LDADD= /home/pab/Work/aldorgit/build/lib/algebra/src/libalgebra.a /home/pab/Work/aldorgit/build/lib/aldor/src/libaldor.a /home/pab/Work/aldorgit/build/aldor/lib/libfoam/libfoam.a /home/pab/Work/aldorgit/build/aldor/lib/libfoamlib/libfoamlib.a -lm +LDADD= ../../../lib/algebra/src/libalgebra.a ../../../lib/aldor/src/libaldor.a ../../../aldor/lib/libfoam/libfoam.a ../../../aldor/lib/libfoamlib/libfoamlib.a -lm check_PROGRAMS += Trandom/Trandom Trandom_Trandom_SOURCES = Trandom/Trandom-aldormain.c Trandom/Trandom.c CLEANFILES += Trandom/Trandom-aldormain.c Trandom/Trandom.c Trandom/Trandom.ao diff --git a/aldor/lib/axldem/test/Tests.am b/aldor/lib/axldem/test/Tests.am index bd8c491a3..2583d1ea3 100644 --- a/aldor/lib/axldem/test/Tests.am +++ b/aldor/lib/axldem/test/Tests.am @@ -1,4 +1,4 @@ -LDADD= /home/pab/Work/aldorgit/build/lib/axldem/src/libaxldem.a /home/pab/Work/aldorgit/build/lib/axllib/src/libaxllib.a /home/pab/Work/aldorgit/build/aldor/lib/libfoam/libfoam.a /home/pab/Work/aldorgit/build/aldor/lib/libfoamlib/libfoamlib.a -lm +LDADD= ../../../lib/axldem/src/libaxldem.a ../../../lib/axllib/src/libaxllib.a ../../../aldor/lib/libfoam/libfoam.a ../../../aldor/lib/libfoamlib/libfoamlib.a -lm check_PROGRAMS += bug1089/bug1089 bug1089_bug1089_SOURCES = bug1089/bug1089-aldormain.c bug1089/bug1089.c CLEANFILES += bug1089/bug1089-aldormain.c bug1089/bug1089.c bug1089/bug1089.ao diff --git a/aldor/lib/axllib/test/Tests.am b/aldor/lib/axllib/test/Tests.am index 8d68c4896..1b6f54542 100644 --- a/aldor/lib/axllib/test/Tests.am +++ b/aldor/lib/axllib/test/Tests.am @@ -1,4 +1,4 @@ -LDADD= /home/pab/Work/aldorgit/build/lib/axllib/src/libaxllib.a /home/pab/Work/aldorgit/build/aldor/lib/libfoam/libfoam.a /home/pab/Work/aldorgit/build/aldor/lib/libfoamlib/libfoamlib.a -lm +LDADD= ../../../lib/axllib/src/libaxllib.a ../../../aldor/lib/libfoam/libfoam.a ../../../aldor/lib/libfoamlib/libfoamlib.a -lm check_PROGRAMS += 1test/1test 1test_1test_SOURCES = 1test/1test-aldormain.c 1test/1test.c CLEANFILES += 1test/1test-aldormain.c 1test/1test.c 1test/1test.ao diff --git a/aldor/lib/testprog.am b/aldor/lib/testprog.am index ffbc18c09..3b0846d7e 100644 --- a/aldor/lib/testprog.am +++ b/aldor/lib/testprog.am @@ -48,9 +48,8 @@ TESTS = $(check_PROGRAMS) include Tests.am $(srcdir)/Tests.am: $(srcdir)/Makefile.am $(abs_top_srcdir)/lib/testprog.am - echo $(libraries) $(foreach i,$(libraries), $(abs_top_builddir)/lib/src/$(i)/lib$(i).a) truncate -s0 $@ - echo "LDADD=$(foreach i,$(libraries), $(abs_top_builddir)/lib/$(i)/src/lib$(i).a) $(abs_top_builddir)/aldor/lib/libfoam/libfoam.a $(abs_top_builddir)/aldor/lib/libfoamlib/libfoamlib.a -lm" >> $@ + echo "LDADD=$(foreach i,$(libraries), ${top_builddir}/lib/$(i)/src/lib$(i).a) ${top_builddir}/aldor/lib/libfoam/libfoam.a ${top_builddir}/aldor/lib/libfoamlib/libfoamlib.a -lm" >> $@ for test in $(AXLTESTS); do \ ctest=`echo $$test | sed -e 's/-/_/g'`; \ echo "check_PROGRAMS += $$test/$$test" >> $@; \ From 368b1f022b08d8ebbc70fa56a74eec9beff90859 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 4 Feb 2017 21:44:47 +0000 Subject: [PATCH 142/352] configure.ac: Adjust options so that sign-compare isn't a warning. --- aldor/m4/strict_compile.m4 | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/aldor/m4/strict_compile.m4 b/aldor/m4/strict_compile.m4 index 233642e0f..0227f0d86 100644 --- a/aldor/m4/strict_compile.m4 +++ b/aldor/m4/strict_compile.m4 @@ -9,16 +9,21 @@ AC_DEFUN([ALDOR_CC_OPTION], AC_DEFUN([ALDOR_STRICT_COMPILE], [ALDOR_CC_OPTION(-Wno-error=shift-negative-value,cfg_no_shift_negative_value,int main() { return -1 << 1; }) - ALDOR_CC_OPTION(-Wno-error=sign-compare,cfg_no_sign_compare) + ALDOR_CC_OPTION(-Wno-sign-compare,cfg_no_sign_compare) AC_MSG_CHECKING(Strict options for C compiler) - cfgSTRICTCFLAGS="-pedantic -std=c99 -Wall -Wextra -Werror -Wno-empty-body -Wno-enum-compare -Wno-missing-field-initializers -Wno-unused -Wno-unused-parameter -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing -Wno-unused $cfg_no_sign_compare $cfg_no_shift_negative_value " - + cfgSTRICTCFLAGS="-pedantic -std=c99 -Wall -Wextra -Werror -Wno-empty-body -Wno-enum-compare \ + -Wno-missing-field-initializers -Wno-unused -Wno-unused-parameter \ + -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing \ + $cfg_no_sign_compare $cfg_no_shift_negative_value" case "${CC}" in gcc*) - cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -Wno-error=clobbered -Wno-unused";; + cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -Wno-error=clobbered" + ;; clang*) - cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -fcolor-diagnostics -Wno-error=enum-conversion -Wno-error=tautological-compare -Wno-parentheses-equality";; + cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -fcolor-diagnostics -Wno-error=enum-conversion \ + -Wno-error=tautological-compare -Wno-parentheses-equality" + ;; *) AC_MSG_WARN(Unknown C compiler ${CC}) cfgSTRICTCFLAGS="";; From ba3a814b07050e20b72d018ea04101f1bb85c686 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 4 Feb 2017 21:45:11 +0000 Subject: [PATCH 143/352] test/Makefile: Add DBG=1 to .ao -> .o rule --- aldor/aldor/test/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 9e64389a3..9906de123 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -142,7 +142,7 @@ $(patsubst %, out/java/%.class, $(_jtests)): out/java/%.class: out/java/%.java $(patsubst %, %.o, $(_otests)): %.o: out/ao/%.ao $(AM_V_ALDOR_OBJ) \ mkdir -p $$(dirname $@); \ - $(aldorexedir)/aldor $(nfile) \ + $(AM_DBG) $(aldorexedir)/aldor $(nfile) \ -Ccc=$(aldortooldir)/unicl \ -Cargs="-Wconfig=$(aldorsrcdir)/aldor.conf $(UNICLFLAGS) -I$(aldorsrcdir)" \ -Fo=$(builddir)/$@ $< From 602ce0a5f5a248e4629fcb1ad359144f30b9903c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 11 Feb 2017 16:00:33 +0000 Subject: [PATCH 144/352] annotations: Drop attempt to ensure that compilation is complete. Didn't work well, and easier to check status as we go. --- aldor/aldor/src/annabs.c | 55 ---------------------------------------- 1 file changed, 55 deletions(-) diff --git a/aldor/aldor/src/annabs.c b/aldor/aldor/src/annabs.c index d33561bca..3c695708c 100644 --- a/aldor/aldor/src/annabs.c +++ b/aldor/aldor/src/annabs.c @@ -44,7 +44,6 @@ local AInt abcGetSyme(AbAnnotationBucket bucket, Syme syme); local AInt abcAddSyme(AbAnnotationBucket bucket, Syme syme); local void abcSetSymeSExpr(AbAnnotationBucket bucket, AInt idx, SExpr sx); -local void abAnnotateInferMissing(Stab stab, AbSyn absyn); local SExpr abAnnotateSymeRef(Syme syme, AbAnnotationBucket bucket); local SExpr abAnnotateSyme(Syme syme, AbAnnotationBucket bucket); @@ -147,7 +146,6 @@ abToAnnotatedSExpr(AbSyn whole) AbAnnotationBucket bucket = abcNew(); SExpr sexpr; - abAnnotateInferMissing(stabFile(), whole); sexpr = abAnnotatedSExpr(whole, bucket); sexpr = sxCons(sexpr, abcSExpr(bucket)); abcFree(bucket); @@ -155,59 +153,6 @@ abToAnnotatedSExpr(AbSyn whole) return sexpr; } - -local void -abAnnotateInferMissing(Stab stab, AbSyn absyn) { - AbSyn lhs; - int i; - - if (absyn == NULL) - return; - - if (abStab(absyn)) - stab = abStab(absyn); - /* - if (abState(absyn) == AB_State_AbSyn) { - tiBottomUp(stab, absyn, tfUnknown); - tiTopDown(stab, absyn, tfUnknown); - } - */ - switch (abTag(absyn)) { - case AB_Id: - case AB_IdSy: - case AB_LitInteger: - case AB_LitString: - case AB_LitFloat: - break; - case AB_Foreign: - //abAnnotateInferMissing(stab, absyn->abForeign.what); - break; - case AB_Label: - abAnnotateInferMissing(stab, absyn->abLabel.expr); - break; - case AB_Assign: - lhs = absyn->abAssign.lhs; - if (abImplicit(lhs) != NULL) { - abAnnotateInferMissing(stab, absyn->abAssign.rhs); - for (i=0; i Date: Sat, 11 Feb 2017 16:14:27 +0000 Subject: [PATCH 145/352] Java library: Reformat - Might as well, as this library is pretty stable at the moment. --- .../lib/java/src/foamj/AbstractValue.java | 74 ++- .../lib/java/src/foamj/CastException.java | 12 +- aldor/aldor/lib/java/src/foamj/Clos.java | 75 +-- aldor/aldor/lib/java/src/foamj/Env.java | 72 ++- aldor/aldor/lib/java/src/foamj/EnvRecord.java | 8 +- aldor/aldor/lib/java/src/foamj/Fn.java | 44 +- aldor/aldor/lib/java/src/foamj/Foam.java | 600 +++++++++--------- aldor/aldor/lib/java/src/foamj/FoamClass.java | 2 +- .../aldor/lib/java/src/foamj/FoamContext.java | 106 ++-- .../lib/java/src/foamj/FoamException.java | 16 +- aldor/aldor/lib/java/src/foamj/FoamJ.java | 457 +++++++------ aldor/aldor/lib/java/src/foamj/Format.java | 18 +- aldor/aldor/lib/java/src/foamj/Globals.java | 22 +- .../lib/java/src/foamj/HaltException.java | 6 +- aldor/aldor/lib/java/src/foamj/Math.java | 409 ++++++------ .../aldor/lib/java/src/foamj/MultiRecord.java | 10 +- aldor/aldor/lib/java/src/foamj/Record.java | 84 +-- aldor/aldor/lib/java/src/foamj/Value.java | 116 ++-- aldor/aldor/lib/java/src/foamj/Word.java | 106 +++- 19 files changed, 1225 insertions(+), 1012 deletions(-) diff --git a/aldor/aldor/lib/java/src/foamj/AbstractValue.java b/aldor/aldor/lib/java/src/foamj/AbstractValue.java index e9db69069..236dd6512 100644 --- a/aldor/aldor/lib/java/src/foamj/AbstractValue.java +++ b/aldor/aldor/lib/java/src/foamj/AbstractValue.java @@ -3,19 +3,63 @@ import java.math.BigInteger; public abstract class AbstractValue implements Value { - public Word asWord() { throw new CastException(this); } - public int toSInt() { throw new CastException(this); } - public short toHInt() { throw new CastException(this); } - public BigInteger toBInt() { throw new CastException(this); } - public double toDFlo() { throw new CastException(this); } - public float toSFlo() { throw new CastException(this); } - public Object toArray() { throw new CastException(this); } - public Record toRecord() { throw new CastException(this); } - public Clos toClos() { throw new CastException(this); } - public boolean toBool() { throw new CastException(this); } - public MultiRecord toMulti() { throw new CastException(this); } - public char toChar() { throw new CastException(this); } - public Object toPtr() { throw new CastException(this); } - public Env toEnv() { throw new CastException(this); } - public byte toByte() { throw new CastException(this); } + public Word asWord() { + throw new CastException(this); + } + + public int toSInt() { + throw new CastException(this); + } + + public short toHInt() { + throw new CastException(this); + } + + public BigInteger toBInt() { + throw new CastException(this); + } + + public double toDFlo() { + throw new CastException(this); + } + + public float toSFlo() { + throw new CastException(this); + } + + public Object toArray() { + throw new CastException(this); + } + + public Record toRecord() { + throw new CastException(this); + } + + public Clos toClos() { + throw new CastException(this); + } + + public boolean toBool() { + throw new CastException(this); + } + + public MultiRecord toMulti() { + throw new CastException(this); + } + + public char toChar() { + throw new CastException(this); + } + + public Object toPtr() { + throw new CastException(this); + } + + public Env toEnv() { + throw new CastException(this); + } + + public byte toByte() { + throw new CastException(this); + } } \ No newline at end of file diff --git a/aldor/aldor/lib/java/src/foamj/CastException.java b/aldor/aldor/lib/java/src/foamj/CastException.java index 5bb3aed8b..531b8dcb5 100644 --- a/aldor/aldor/lib/java/src/foamj/CastException.java +++ b/aldor/aldor/lib/java/src/foamj/CastException.java @@ -3,11 +3,11 @@ @SuppressWarnings("serial") public class CastException extends RuntimeException { - public CastException(AbstractValue abstractValue) { - this("Casting: " + abstractValue.getClass().getName()); - } + public CastException(AbstractValue abstractValue) { + this("Casting: " + abstractValue.getClass().getName()); + } - public CastException(String string) { - super(string); - } + public CastException(String string) { + super(string); + } } diff --git a/aldor/aldor/lib/java/src/foamj/Clos.java b/aldor/aldor/lib/java/src/foamj/Clos.java index 667fa6c15..512a7c6a3 100644 --- a/aldor/aldor/lib/java/src/foamj/Clos.java +++ b/aldor/aldor/lib/java/src/foamj/Clos.java @@ -1,62 +1,65 @@ package foamj; -import java.util.Arrays; - - public class Clos extends AbstractValue implements Word, Value { private Env env; private Fn fn; private Word info; - + public Clos(Env env, Fn fn) { - this.env = env; - this.fn = fn; + this.env = env; + this.fn = fn; + } + + public Value call(Value... vals) { + //System.out.println("(Calling: " + fn.getName() + " " + Arrays.asList(vals)); + Value v = fn.ocall(env, vals); + //System.out.println(" Return: " + v + ")"); + + return v; } - public Value call(Value ... vals) { - //System.out.println("(Calling: " + fn.getName() + " " + Arrays.asList(vals)); - Value v = fn.ocall(env, vals); - //System.out.println(" Return: " + v + ")"); - - return v; + public static Clos fromValue(Value v) { + return (Clos) v; } - - public static Clos fromValue(Value v) { return (Clos) v; } - + public String toString() { - return "{Clos: " + fn + ", " + env.getId() + "}"; + return "{Clos: " + fn + ", " + env.getId() + "}"; } - + public Fn getProg() { - return fn; + return fn; } public Env getEnv() { - return env; + return env; } - + public void setProg(Fn fn) { - this.fn = fn; + this.fn = fn; } - + public void setEnv(Env env) { - this.env = env; + this.env = env; + } + + public void setInfo(Word info) { + this.info = info; } - public void setInfo(Word info) { - this.info = info; - } + public Word getInfo() { + return info; + } - public Word getInfo() { - return info; - } - - public Clos toClos() { return this; } + public Clos toClos() { + return this; + } - public Word asWord() { return this; } + public Word asWord() { + return this; + } - @Override - public Value toValue() { - return this; - } + @Override + public Value toValue() { + return this; + } } diff --git a/aldor/aldor/lib/java/src/foamj/Env.java b/aldor/aldor/lib/java/src/foamj/Env.java index 95d5febf8..fb7bf10bd 100644 --- a/aldor/aldor/lib/java/src/foamj/Env.java +++ b/aldor/aldor/lib/java/src/foamj/Env.java @@ -1,51 +1,55 @@ package foamj; public class Env extends AbstractValue implements Value { - private EnvRecord thisLvl; - private Env parent; - private Word info; - private int id; - private static int count = 0; - - public Env(EnvRecord lvl, Env parent) { - this.thisLvl = lvl; - this.parent = parent; - this.id = count++; - } - + private EnvRecord thisLvl; + private Env parent; + private Word info; + private int id; + private static int count = 0; + + public Env(EnvRecord lvl, Env parent) { + this.thisLvl = lvl; + this.parent = parent; + this.id = count++; + } + public Env nthParent(int idx) { - Env e = this; - while (idx != 0) { - e = e.parent; - idx--; - } - return e; + Env e = this; + while (idx != 0) { + e = e.parent; + idx--; + } + return e; + } + + public Env toEnv() { + return this; } - public Env toEnv() { return this; } public EnvRecord level() { - return thisLvl; + return thisLvl; } - + public Env parent() { - return parent; + return parent; } public void ensure() { - if (info != null) { - ((Clos) info).call(); - } + if (info != null) { + ((Clos) info).call(); + } } - public void setInfo(Word info) { - this.info = info; - } - public Word getInfo() { - return info; - } + public void setInfo(Word info) { + this.info = info; + } - public String getId() { - return ""+id; - } + public Word getInfo() { + return info; + } + + public String getId() { + return "" + id; + } } diff --git a/aldor/aldor/lib/java/src/foamj/EnvRecord.java b/aldor/aldor/lib/java/src/foamj/EnvRecord.java index 8d473e2dd..4273cee70 100644 --- a/aldor/aldor/lib/java/src/foamj/EnvRecord.java +++ b/aldor/aldor/lib/java/src/foamj/EnvRecord.java @@ -1,8 +1,8 @@ package foamj; public class EnvRecord extends Record { - - public EnvRecord(Format fmt) { - super(fmt); - } + + public EnvRecord(Format fmt) { + super(fmt); + } } \ No newline at end of file diff --git a/aldor/aldor/lib/java/src/foamj/Fn.java b/aldor/aldor/lib/java/src/foamj/Fn.java index 249b54b29..f408aab71 100644 --- a/aldor/aldor/lib/java/src/foamj/Fn.java +++ b/aldor/aldor/lib/java/src/foamj/Fn.java @@ -3,30 +3,32 @@ /** * Represents a foam function. * The value is generally a hash code; we only ever use PRef 0. - * @author pab * + * @author pab */ public abstract class Fn { - private int val; - private String name; - - public Fn(String name) { - this.name = name; - } - - abstract public Value ocall(Env env, Value... vals); - - public void setInfo(int idx, int val) { - this.val = val; - } - - public int getInfo(int idx) { - return val; - } + private int val; + private String name; + + public Fn(String name) { + this.name = name; + } + + abstract public Value ocall(Env env, Value... vals); + + public void setInfo(int idx, int val) { + this.val = val; + } + + public int getInfo(int idx) { + return val; + } - public String getName() { - return name; - } + public String getName() { + return name; + } - public String toString() { return "Fn-"+name; } + public String toString() { + return "Fn-" + name; + } } \ No newline at end of file diff --git a/aldor/aldor/lib/java/src/foamj/Foam.java b/aldor/aldor/lib/java/src/foamj/Foam.java index 2ba717ce3..df61df524 100644 --- a/aldor/aldor/lib/java/src/foamj/Foam.java +++ b/aldor/aldor/lib/java/src/foamj/Foam.java @@ -1,429 +1,441 @@ package foamj; -import java.math.BigInteger; -import java.lang.Math; import java.io.PrintStream; +import java.lang.Math; +import java.math.BigInteger; public class Foam { public final static int RTE = 1; public final static int PlatformOS = 1; - public static void fputc(Word cw, Word w) { - PrintStream ps = (PrintStream) Word.U.toArray(w); - char c = (char) cw.toSInt(); - ps.write(c); - } - - public static Word fgetss(Word w1, Word w2, Word w3, Word w4) { - throw new RuntimeException(); - } - - public static Word fgetc(Word cw) { - throw new RuntimeException(); - } - - public static void fputs(Word s, Word w) { - PrintStream ps = (PrintStream) Word.U.toArray(s); - char[] arr = (char[])w.toArray(); - for (int i=0; i int - public static Word fputss(Word w1, Word w2, Word w3, Word w4) { - char[] arr = (char[]) w1.toArray(); - int start = w2.toSInt(); - int limit = w3.toSInt(); - if (limit == -1) { - System.out.print(new String(arr).substring(start)); - return Word.U.fromSInt(arr.length -1 - start); - } - else { - System.out.print(new String(arr, start, limit-start)); - return Word.U.fromSInt(limit-start); - } - } - - public static Word stdoutFile() { - return Word.U.fromArray(System.out); - } - - public static Word stderrFile() { - return Word.U.fromArray(System.err); - } - - public static Word stdinFile() { - return Word.U.fromArray(System.in); - } - - public static Word fopen(Word w1, Word w2) { - throw new RuntimeException(); - } - - public static Word fflush(Word w1) { - PrintStream ps = (PrintStream) Word.U.toArray(w1); - ps.flush(); - return w1; - } + public static Word fputss(Word w1, Word w2, Word w3, Word w4) { + char[] arr = (char[]) w1.toArray(); + int start = w2.toSInt(); + int limit = w3.toSInt(); + if (limit == -1) { + System.out.print(new String(arr).substring(start)); + return Word.U.fromSInt(arr.length - 1 - start); + } else { + System.out.print(new String(arr, start, limit - start)); + return Word.U.fromSInt(limit - start); + } + } + + public static Word stdoutFile() { + return Word.U.fromArray(System.out); + } + + public static Word stderrFile() { + return Word.U.fromArray(System.err); + } + + public static Word stdinFile() { + return Word.U.fromArray(System.in); + } + + public static Word fopen(Word w1, Word w2) { + throw new RuntimeException(); + } + + public static Word fflush(Word w1) { + PrintStream ps = (PrintStream) Word.U.toArray(w1); + ps.flush(); + return w1; + } public static void lungetc(Word w1, Word w2) { - throw new RuntimeException(); + throw new RuntimeException(); } - public static Word fclose(Word w1) { - throw new RuntimeException(); - } + public static Word fclose(Word w1) { + throw new RuntimeException(); + } - public static Word formatBInt(BigInteger a) { - return Word.U.fromArray(("" + a+'\0').toCharArray()); - } + public static Word formatBInt(BigInteger a) { + return Word.U.fromArray(("" + a + '\0').toCharArray()); + } - public static Word formatSInt(int a) { - return Word.U.fromArray(("" + a+'\0').toCharArray()); - } + public static Word formatSInt(int a) { + return Word.U.fromArray(("" + a + '\0').toCharArray()); + } - public static Word formatSFlo(float a) { - return Word.U.fromArray(("" + a+'\0').toCharArray()); - } + public static Word formatSFlo(float a) { + return Word.U.fromArray(("" + a + '\0').toCharArray()); + } - public static void halt(int r) { - throw new HaltException(r); - } + public static void halt(int r) { + throw new HaltException(r); + } - public static Object throwException(RuntimeException e) { - throw e; - } + public static Object throwException(RuntimeException e) { + throw e; + } public static int ptrToSInt(Object o) { - return System.identityHashCode(o); - } + return System.identityHashCode(o); + } public static Word sintToPtr(int o) { - throw new RuntimeException("wheee"); - } + throw new RuntimeException("wheee"); + } - public static BigInteger fiSFloMantissa(float f) { - throw new RuntimeException(); - } + public static BigInteger fiSFloMantissa(float f) { + throw new RuntimeException(); + } + + public static BigInteger fiSFloExponent(float f) { + throw new RuntimeException(); + } + + public static Word fiStrHash(Word w) { + return Word.U.fromSInt(w.hashCode()); + } - public static BigInteger fiSFloExponent(float f) { - throw new RuntimeException(); - } + public static Word osFnameUnparse(Word w1, Word w2, Word w3) { + throw new RuntimeException(); + } - public static Word fiStrHash(Word w) { - return Word.U.fromSInt(w.hashCode()); - } + public static Word osFnameUnparseSize(Word w1, Word w2) { + throw new RuntimeException(); + } - public static Word osFnameUnparse(Word w1, Word w2, Word w3) { - throw new RuntimeException(); - } + public static Word osFnameParseSize(Word w1, Word w2) { + throw new RuntimeException(); + } - public static Word osFnameUnparseSize(Word w1, Word w2) { - throw new RuntimeException(); - } - - public static Word osFnameParseSize(Word w1, Word w2) { - throw new RuntimeException(); - } + public static Word osFnameParse(Word w1, Word w2, Word w3, Word w4) { + throw new RuntimeException(); + } + + public static Word osFnameDirEqual(Word w1, Word w2) { + throw new RuntimeException(); + } + + public static Word osRun(Word w1) { + throw new RuntimeException(); + } + + public static Word osRunQuoteArg(Word w1, Word w2) { + throw new RuntimeException(); + } - public static Word osFnameParse(Word w1, Word w2, Word w3, Word w4) { - throw new RuntimeException(); - } + public static Word osRunConcurrent(Word w1, Record r1, Record r2, Record r3) { + throw new RuntimeException(); + } - public static Word osFnameDirEqual(Word w1, Word w2) { - throw new RuntimeException(); - } + public static Word osCpuTime() { + throw new RuntimeException(); + } - public static Word osRun(Word w1) { - throw new RuntimeException(); - } + public static Word osDate() { + throw new RuntimeException(); + } - public static Word osRunQuoteArg(Word w1, Word w2) { - throw new RuntimeException(); - } + public static Word osGetEnv(Word w1) { + throw new RuntimeException(); + } - public static Word osRunConcurrent(Word w1, Record r1, Record r2, Record r3) { - throw new RuntimeException(); - } + public static Word osPutEnv(Word w1) { + throw new RuntimeException(); + } - public static Word osCpuTime() { - throw new RuntimeException(); - } + public static Word osPutEnvIsKept() { + throw new RuntimeException(); + } - public static Word osDate() { - throw new RuntimeException(); - } + public static Word osCurDirName() { + throw new RuntimeException(); + } - public static Word osGetEnv(Word w1) { - throw new RuntimeException(); - } + public static Word osTmpDirName() { + throw new RuntimeException(); + } - public static Word osPutEnv(Word w1) { - throw new RuntimeException(); - } + public static Word osSubdir(Word w1, Word w2, Word w3) { + throw new RuntimeException(); + } - public static Word osPutEnvIsKept() { - throw new RuntimeException(); - } + public static Word osSubdirLength(Word w1, Word w2) { + throw new RuntimeException(); + } - public static Word osCurDirName() { - throw new RuntimeException(); - } + public static Word osFnameTempSeed() { + throw new RuntimeException(); + } - public static Word osTmpDirName() { - throw new RuntimeException(); - } + public static Word osFnameTempDir(Word w1) { + throw new RuntimeException(); + } - public static Word osSubdir(Word w1, Word w2, Word w3) { - throw new RuntimeException(); - } + public static Word osIsInteractive(Word w1) { + throw new RuntimeException(); + } - public static Word osSubdirLength(Word w1, Word w2) { - throw new RuntimeException(); - } - - public static Word osFnameTempSeed() { - throw new RuntimeException(); - } - - public static Word osFnameTempDir(Word w1) { - throw new RuntimeException(); - } - - public static Word osIsInteractive(Word w1) { - throw new RuntimeException(); - } - - public static Word osFileRemove(Word w1) { - throw new RuntimeException(); - } - - public static Word osFileRename(Word w1, Word w2) { - throw new RuntimeException(); - } - - public static Word osFileIsThere(Word w1) { - throw new RuntimeException(); - } - - public static Word osFileHash(Word w1) { - throw new RuntimeException(); - } - - public static Word osFileSize(Word w1) { - throw new RuntimeException(); - } - - public static Word osDirIsThere(Word w1) { - throw new RuntimeException(); - } - - public static Word osDirSwap(Word w1, Word w2, Word w3) { - throw new RuntimeException(); - } - - public static Word osIncludePath() { - throw new RuntimeException(); - } - - public static Word osLibraryPath() { - throw new RuntimeException(); - } - - public static Word osExecutePath() { - throw new RuntimeException(); - } - - public static Word osPathLength(Word w1) { - throw new RuntimeException(); - } - - public static Word osPathParse(Word w1, Word w2, Word w3) { - throw new RuntimeException(); - } - - public static Word osSetFaultHandler(Word w1) { - throw new RuntimeException(); - } - - public static Word osSetLimitHandler(Word w1) { - throw new RuntimeException(); - } - - public static Word osSetBreakHandler(Word w1) { - throw new RuntimeException(); - } - - public static Word osSetDangerHandler(Word w1) { - throw new RuntimeException(); - } - - public static Word osAlloc(Word w1) { - throw new RuntimeException(); - } - - public static Word osFree(Word w1) { - throw new RuntimeException(); - } - - public static Word osAllocAlignHint(Word w1) { - throw new RuntimeException(); - } - - public static Word osAllocShow() { - throw new RuntimeException(); - } - - public static Word osMemMap(Word w1) { - throw new RuntimeException(); - } - - public static void fiRaiseException(Word w) { - throw new RuntimeException(w.toString()); - } - - public static float arrToSFlo(Object o) { - char[] arr = (char[]) o; - return new Float(new String(arr, 0, arr.length-1)); - - } - public static double arrToDFlo(Object o) { - char[] arr = (char[]) o; - return new Double(new String(arr, 0, arr.length-1)); - } - public static int arrToSInt(Object o) { - char[] arr = (char[]) o; - return Integer.parseInt(new String(arr, 0, arr.length-1)); - } - public static BigInteger arrToBInt(Object o) { - char[] arr = (char[]) o; - return new BigInteger(new String(arr, 0, arr.length-1)); - } + public static Word osFileRemove(Word w1) { + throw new RuntimeException(); + } + + public static Word osFileRename(Word w1, Word w2) { + throw new RuntimeException(); + } + + public static Word osFileIsThere(Word w1) { + throw new RuntimeException(); + } + + public static Word osFileHash(Word w1) { + throw new RuntimeException(); + } + + public static Word osFileSize(Word w1) { + throw new RuntimeException(); + } + + public static Word osDirIsThere(Word w1) { + throw new RuntimeException(); + } + + public static Word osDirSwap(Word w1, Word w2, Word w3) { + throw new RuntimeException(); + } + + public static Word osIncludePath() { + throw new RuntimeException(); + } + + public static Word osLibraryPath() { + throw new RuntimeException(); + } + + public static Word osExecutePath() { + throw new RuntimeException(); + } + + public static Word osPathLength(Word w1) { + throw new RuntimeException(); + } + + public static Word osPathParse(Word w1, Word w2, Word w3) { + throw new RuntimeException(); + } + + public static Word osSetFaultHandler(Word w1) { + throw new RuntimeException(); + } + + public static Word osSetLimitHandler(Word w1) { + throw new RuntimeException(); + } + + public static Word osSetBreakHandler(Word w1) { + throw new RuntimeException(); + } + + public static Word osSetDangerHandler(Word w1) { + throw new RuntimeException(); + } + + public static Word osAlloc(Word w1) { + throw new RuntimeException(); + } + + public static Word osFree(Word w1) { + throw new RuntimeException(); + } + + public static Word osAllocAlignHint(Word w1) { + throw new RuntimeException(); + } + + public static Word osAllocShow() { + throw new RuntimeException(); + } + + public static Word osMemMap(Word w1) { + throw new RuntimeException(); + } + + public static void fiRaiseException(Word w) { + throw new RuntimeException(w.toString()); + } + + public static float arrToSFlo(Object o) { + char[] arr = (char[]) o; + return new Float(new String(arr, 0, arr.length - 1)); + + } + + public static double arrToDFlo(Object o) { + char[] arr = (char[]) o; + return new Double(new String(arr, 0, arr.length - 1)); + } + + public static int arrToSInt(Object o) { + char[] arr = (char[]) o; + return Integer.parseInt(new String(arr, 0, arr.length - 1)); + } + + public static BigInteger arrToBInt(Object o) { + char[] arr = (char[]) o; + return new BigInteger(new String(arr, 0, arr.length - 1)); + } public static Word powf(Word w1, Word w2) { - throw new RuntimeException(); + throw new RuntimeException(); } public static Word randomSeed() { - return Word.U.fromSInt(1000); + return Word.U.fromSInt(1000); } public static void stoGc() { - throw new RuntimeException(); + throw new RuntimeException(); } public static void stoShow() { - throw new RuntimeException(); + throw new RuntimeException(); } public static Word gcTimer() { - throw new RuntimeException(); + throw new RuntimeException(); } public static void fiSetDebugVar(Word word) { - throw new RuntimeException(); + throw new RuntimeException(); } public static void agatSendLong(Word w1, Word w2) { - throw new RuntimeException(); + throw new RuntimeException(); } public static void agatSendChar(Word w1, Word w2) { - throw new RuntimeException(); + throw new RuntimeException(); } public static void agatSendFloat(Word w1, Word w2) { - throw new RuntimeException(); + throw new RuntimeException(); } public static void agatSendDouble(Word w1, double w2) { - throw new RuntimeException(); + throw new RuntimeException(); } public static Word cerrno() { - throw new RuntimeException(); + throw new RuntimeException(); } public static Word ftell(Word w) { - throw new RuntimeException(); + throw new RuntimeException(); } public static Word fseekset(Word w1, Word w2) { - throw new RuntimeException(); + throw new RuntimeException(); } public static Word fseekend(Word w1, Word w2) { - throw new RuntimeException(); + throw new RuntimeException(); } public static Word fseekcur(Word w1, Word w2) { - throw new RuntimeException(); + throw new RuntimeException(); } public static Word mkstemp(Word w1) { - throw new RuntimeException(); + throw new RuntimeException(); } public static Word lfputc(Word w1, Word w2) { - throw new RuntimeException(); + throw new RuntimeException(); } public static Word unlink(Word w) { - throw new RuntimeException(); + throw new RuntimeException(); } public static void system(Object obj) { - throw new RuntimeException(); + throw new RuntimeException(); } public static double sqrt(double d) { - return Math.sqrt(d); + return Math.sqrt(d); } + public static double pow(double a, double b) { - return Math.pow(a, b); + return Math.pow(a, b); } + public static double log(double d) { - return Math.log(d); + return Math.log(d); } + public static double exp(double d) { - return Math.exp(d); + return Math.exp(d); } public static double sin(double d) { - return Math.sin(d); + return Math.sin(d); } + public static double cos(double d) { - return Math.cos(d); + return Math.cos(d); } + public static double tan(double d) { - return Math.tan(d); + return Math.tan(d); } public static double sinh(double d) { - return Math.sinh(d); + return Math.sinh(d); } + public static double cosh(double d) { - return Math.cosh(d); + return Math.cosh(d); } + public static double tanh(double d) { - return Math.tanh(d); + return Math.tanh(d); } public static double asin(double d) { - return Math.asin(d); + return Math.asin(d); } + public static double acos(double d) { - return Math.acos(d); + return Math.acos(d); } + public static double atan(double d) { - return Math.atan(d); + return Math.atan(d); } + public static double atan2(double a, double b) { - return Math.atan2(a, b); + return Math.atan2(a, b); } } diff --git a/aldor/aldor/lib/java/src/foamj/FoamClass.java b/aldor/aldor/lib/java/src/foamj/FoamClass.java index 6711e61d1..2202e396d 100644 --- a/aldor/aldor/lib/java/src/foamj/FoamClass.java +++ b/aldor/aldor/lib/java/src/foamj/FoamClass.java @@ -1,5 +1,5 @@ package foamj; public interface FoamClass { - void run(); + void run(); } diff --git a/aldor/aldor/lib/java/src/foamj/FoamContext.java b/aldor/aldor/lib/java/src/foamj/FoamContext.java index 9444401ce..1bb4d7dc4 100644 --- a/aldor/aldor/lib/java/src/foamj/FoamContext.java +++ b/aldor/aldor/lib/java/src/foamj/FoamContext.java @@ -6,60 +6,62 @@ public class FoamContext { ConcurrentHashMap loadFns = new ConcurrentHashMap<>(); - public void startFoam(FoamClass c, String[] args) { - Word[] mainArgv = new Word[1]; - mainArgv[0] = Word.U.fromArray(literalCharArray(c.getClass().getName())); - Globals.setGlobal("mainArgc", Word.U.fromSInt(1).toValue()); - Globals.setGlobal("mainArgv", Word.U.fromArray(mainArgv).toValue()); - c.run(); - } - private static char[] literalCharArray(String s) { - char[] arr = new char[s.length()+1]; - for (int i=0; i c; - try { - c = (Class) ClassLoader.getSystemClassLoader().loadClass(name); - Constructor cons = c.getConstructor(FoamContext.class); - FoamClass fc = cons.newInstance(FoamContext.this); - fc.run(); - } catch (ClassNotFoundException e) { - throw new RuntimeException(e); - } catch (SecurityException e) { - throw new RuntimeException(e); - } catch (NoSuchMethodException e) { - throw new RuntimeException(e); - } catch (IllegalArgumentException e) { - throw new RuntimeException(e); - } catch (InstantiationException e) { - throw new RuntimeException(e); - } catch (IllegalAccessException e) { - throw new RuntimeException(e); - } catch (InvocationTargetException e) { - throw new RuntimeException(e); - } - return null; - } - }; - Clos clos = new Clos(null, loader); - loadFns.put(name, clos); - return clos; - } + + @SuppressWarnings("unchecked") + public Clos createLoadFn(final String name) { + if (loadFns.get(name) != null) + return loadFns.get(name); + Fn loader = new Fn("constructor-" + name) { + boolean called = false; + + public Value ocall(Env env, Value... vals) { + if (called) + return null; + called = true; + Class c; + try { + c = (Class) ClassLoader.getSystemClassLoader().loadClass(name); + Constructor cons = c.getConstructor(FoamContext.class); + FoamClass fc = cons.newInstance(FoamContext.this); + fc.run(); + } catch (ClassNotFoundException e) { + throw new RuntimeException(e); + } catch (SecurityException e) { + throw new RuntimeException(e); + } catch (NoSuchMethodException e) { + throw new RuntimeException(e); + } catch (IllegalArgumentException e) { + throw new RuntimeException(e); + } catch (InstantiationException e) { + throw new RuntimeException(e); + } catch (IllegalAccessException e) { + throw new RuntimeException(e); + } catch (InvocationTargetException e) { + throw new RuntimeException(e); + } + return null; + } + }; + Clos clos = new Clos(null, loader); + loadFns.put(name, clos); + return clos; + } } diff --git a/aldor/aldor/lib/java/src/foamj/FoamException.java b/aldor/aldor/lib/java/src/foamj/FoamException.java index ed354caa8..d5f8e2cd2 100644 --- a/aldor/aldor/lib/java/src/foamj/FoamException.java +++ b/aldor/aldor/lib/java/src/foamj/FoamException.java @@ -2,13 +2,13 @@ @SuppressWarnings("serial") public class FoamException extends RuntimeException { - private int status; - - public FoamException(int status) { - this.status = status; - } + private int status; - public int getStatus() { - return status; - } + public FoamException(int status) { + this.status = status; + } + + public int getStatus() { + return status; + } } diff --git a/aldor/aldor/lib/java/src/foamj/FoamJ.java b/aldor/aldor/lib/java/src/foamj/FoamJ.java index a3412fe8b..a6a9bfcdc 100644 --- a/aldor/aldor/lib/java/src/foamj/FoamJ.java +++ b/aldor/aldor/lib/java/src/foamj/FoamJ.java @@ -4,212 +4,255 @@ public class FoamJ { - /** - * Array type - rely on casting to retract to base type - * @author pab - * - */ - static class Array extends AbstractValue implements Value, Word { - private Object arr; - Array(Object arr) { - this.arr = arr; - } - - public Object toArray() { - return arr; - } - - @Override - public Value toValue() { return this; } - public Word asWord() { - return this; - } - - public String toString() { - return "A"+arr.toString() + "]"; - } - - } - - /** - * a. - * T1 = (Add (Cast SInt x) 1) - * --> - * t1 = x.toInteger() + 1; - * .. - * T2 = (Cast Word (Add (Cast SInt x) 1)) - * --> - * t1 = Word.U.fromSInt(x.toSInt() + 1); - */ - static public class SInt extends AbstractValue implements Value, Word { - private int value; - - public SInt(int x) { - this.value = x; - } - - public int toSInt() { return value; } - - @Override - public Value toValue() { - return this; - } - - public Word asWord() { - return this; - } - public String toString() { return ""+value; } - } - - static public class HInt extends AbstractValue implements Value, Word { - private short value; - - public HInt(short x) { - this.value = x; - } - - public short toHInt() { return value; } - - @Override - public Value toValue() { - return this; - } - - public Word asWord() { - return this; - } - public String toString() { return ""+value; } - } - - static public class SFlo extends AbstractValue implements Value, Word { - private float value; - - public SFlo(float x) { - this.value = x; - } - - public float toSFlo() { return value; } - - @Override - public Value toValue() { - return this; - } - - public Word asWord() { - return this; - } - public String toString() { return ""+value; } - } - - static public class DFlo extends AbstractValue implements Value, Word { - private double value; - - public DFlo(double x) { - this.value = x; - } - - public double toDFlo() { return value; } - - @Override - public Value toValue() { - return this; - } - - public Word asWord() { - return this; - } - public String toString() { return ""+value; } - } - - static public class BInt extends AbstractValue implements Value, Word { - private BigInteger value; - - public BInt(BigInteger x) { - this.value = x; - } - - public BigInteger toBInt() { return value; } - - public Word asWord() {return this;} - @Override - public Value toValue() { - return this; - } - } - - static public class Bool extends AbstractValue implements Value, Word { - private boolean value; - - public Bool(boolean b) { - this.value = b; - } - - public boolean toBool() { return value; } - - @Override - public Value toValue() { - return this; - } - public Word asWord() { - return this; - } - - public String toString() { return ""+value; } - } - - static public class Char extends AbstractValue implements Value, Word { - private char value; - - public Char(char b) { - this.value = b; - } - - public char toChar() { return value; } - - @Override - public Value toValue() { - return this; - } - public Word asWord() { - return this; - } - } - - - static public class Ptr extends AbstractValue implements Value, Word { - private Object value; - - public Ptr(Object b) { - this.value = b; - } - - public Object toPtr() { return value; } - - @Override - public Value toValue() { - return this; - } - public Word asWord() { - return this; - } - } - - static public class Byte extends AbstractValue implements Value, Word { - private byte value; - - public Byte(byte b) { - this.value = b; - } - - public byte toByte() { return value; } - - @Override - public Value toValue() { - return this; - } - public Word asWord() { - return this; - } - } + /** + * Array type - rely on casting to retract to base type + * + * @author pab + */ + static class Array extends AbstractValue implements Value, Word { + private Object arr; + + Array(Object arr) { + this.arr = arr; + } + + public Object toArray() { + return arr; + } + + @Override + public Value toValue() { + return this; + } + + public Word asWord() { + return this; + } + + public String toString() { + return "A" + arr.toString() + "]"; + } + + } + + /** + * a. + * T1 = (Add (Cast SInt x) 1) + * --> + * t1 = x.toInteger() + 1; + * .. + * T2 = (Cast Word (Add (Cast SInt x) 1)) + * --> + * t1 = Word.U.fromSInt(x.toSInt() + 1); + */ + static public class SInt extends AbstractValue implements Value, Word { + private int value; + + public SInt(int x) { + this.value = x; + } + + public int toSInt() { + return value; + } + + @Override + public Value toValue() { + return this; + } + + public Word asWord() { + return this; + } + + public String toString() { + return "" + value; + } + } + + static public class HInt extends AbstractValue implements Value, Word { + private short value; + + public HInt(short x) { + this.value = x; + } + + public short toHInt() { + return value; + } + + @Override + public Value toValue() { + return this; + } + + public Word asWord() { + return this; + } + + public String toString() { + return "" + value; + } + } + + static public class SFlo extends AbstractValue implements Value, Word { + private float value; + + public SFlo(float x) { + this.value = x; + } + + public float toSFlo() { + return value; + } + + @Override + public Value toValue() { + return this; + } + + public Word asWord() { + return this; + } + + public String toString() { + return "" + value; + } + } + + static public class DFlo extends AbstractValue implements Value, Word { + private double value; + + public DFlo(double x) { + this.value = x; + } + + public double toDFlo() { + return value; + } + + @Override + public Value toValue() { + return this; + } + + public Word asWord() { + return this; + } + + public String toString() { + return "" + value; + } + } + + static public class BInt extends AbstractValue implements Value, Word { + private BigInteger value; + + public BInt(BigInteger x) { + this.value = x; + } + + public BigInteger toBInt() { + return value; + } + + public Word asWord() { + return this; + } + + @Override + public Value toValue() { + return this; + } + } + + static public class Bool extends AbstractValue implements Value, Word { + private boolean value; + + public Bool(boolean b) { + this.value = b; + } + + public boolean toBool() { + return value; + } + + @Override + public Value toValue() { + return this; + } + + public Word asWord() { + return this; + } + + public String toString() { + return "" + value; + } + } + + static public class Char extends AbstractValue implements Value, Word { + private char value; + + public Char(char b) { + this.value = b; + } + + public char toChar() { + return value; + } + + @Override + public Value toValue() { + return this; + } + + public Word asWord() { + return this; + } + } + + + static public class Ptr extends AbstractValue implements Value, Word { + private Object value; + + public Ptr(Object b) { + this.value = b; + } + + public Object toPtr() { + return value; + } + + @Override + public Value toValue() { + return this; + } + + public Word asWord() { + return this; + } + } + + static public class Byte extends AbstractValue implements Value, Word { + private byte value; + + public Byte(byte b) { + this.value = b; + } + + public byte toByte() { + return value; + } + + @Override + public Value toValue() { + return this; + } + + public Word asWord() { + return this; + } + } } diff --git a/aldor/aldor/lib/java/src/foamj/Format.java b/aldor/aldor/lib/java/src/foamj/Format.java index e77a9f85b..8387d292c 100644 --- a/aldor/aldor/lib/java/src/foamj/Format.java +++ b/aldor/aldor/lib/java/src/foamj/Format.java @@ -2,16 +2,20 @@ /** * Represents a Foam DDecl. - * + *

* Should really have some type information, but * at the moment is just a size. - * @author pab * + * @author pab */ public class Format { - private int size; - public Format(int sz) { - this.size = sz; - } - int size() { return size; } + private int size; + + public Format(int sz) { + this.size = sz; + } + + int size() { + return size; + } } \ No newline at end of file diff --git a/aldor/aldor/lib/java/src/foamj/Globals.java b/aldor/aldor/lib/java/src/foamj/Globals.java index db03ea15f..87c63f400 100644 --- a/aldor/aldor/lib/java/src/foamj/Globals.java +++ b/aldor/aldor/lib/java/src/foamj/Globals.java @@ -5,17 +5,17 @@ public class Globals { - /* - * :: Globals - */ - static private final Map globals = new ConcurrentHashMap(); - - static public Value getGlobal(String s) { - return globals.get(s); - } + /* + * :: Globals + */ + static private final Map globals = new ConcurrentHashMap(); - static public void setGlobal(String s, Value v) { - globals.put(s, v); - } + static public Value getGlobal(String s) { + return globals.get(s); + } + + static public void setGlobal(String s, Value v) { + globals.put(s, v); + } } diff --git a/aldor/aldor/lib/java/src/foamj/HaltException.java b/aldor/aldor/lib/java/src/foamj/HaltException.java index 45fbd3f98..874c21c3c 100644 --- a/aldor/aldor/lib/java/src/foamj/HaltException.java +++ b/aldor/aldor/lib/java/src/foamj/HaltException.java @@ -3,8 +3,8 @@ @SuppressWarnings("serial") public class HaltException extends FoamException { - public HaltException(int status) { - super(status); - } + public HaltException(int status) { + super(status); + } } diff --git a/aldor/aldor/lib/java/src/foamj/Math.java b/aldor/aldor/lib/java/src/foamj/Math.java index c609e54d9..a924d0c64 100644 --- a/aldor/aldor/lib/java/src/foamj/Math.java +++ b/aldor/aldor/lib/java/src/foamj/Math.java @@ -12,306 +12,331 @@ public class Math { public static final int ROUND_DOWN = 3; public static final int ROUND_DONTCARE = 4; - public static boolean bit(int n, int idx) { - return (n & (1<> 32); - return tmp & 0x3FFFFFFF; - - } - - public static boolean isZero(BigInteger b) { - return b.compareTo(BigInteger.ZERO) == 0; - } - public static boolean isNeg(BigInteger b) { - return b.compareTo(BigInteger.ZERO) < 0; - } - public static boolean isPos(BigInteger b) { - return b.compareTo(BigInteger.ZERO) > 0; - } - public static boolean isEven(BigInteger b) { - return !b.testBit(0); - } - public static boolean isOdd(BigInteger b) { - return b.testBit(0); - } - - public static boolean isSingle(BigInteger b) { - return b.compareTo(BigInteger.valueOf(Integer.MAX_VALUE)) <= 0 - && b.compareTo(BigInteger.valueOf(Integer.MIN_VALUE)) >= 0; - } - - public static boolean eq(BigInteger b1, BigInteger b2) { - return b1.compareTo(b2) == 0; - } - - public static boolean ne(BigInteger b1, BigInteger b2) { - return b1.compareTo(b2) != 0; - } - - public static boolean lt(BigInteger b1, BigInteger b2) { - return b1.compareTo(b2) < 0; - } - public static boolean le(BigInteger b1, BigInteger b2) { - return b1.compareTo(b2) <= 0; - } - - public static BigInteger prev(BigInteger b) { - return b.subtract(BigInteger.ONE); - } - public static BigInteger next(BigInteger b) { - return b.add(BigInteger.ONE); - } - public static BigInteger plus(BigInteger b1, BigInteger b2) { - return b1.add(b2); - } - public static BigInteger minus(BigInteger b1, BigInteger b2) { - return b1.subtract(b2); - } - public static BigInteger times(BigInteger b1, BigInteger b2) { - return b1.multiply(b2); - } - public static BigInteger timesPlus(BigInteger b1, BigInteger b2, BigInteger b3) { - return b1.multiply(b2).add(b3); - } - public static BigInteger mod(BigInteger b1, BigInteger b2) { - return b1.mod(b2); - } - public static BigInteger quo(BigInteger b1, BigInteger b2) { - return b1.divide(b2); - } - public static BigInteger rem(BigInteger b1, BigInteger b2) { - return b1.remainder(b2); - } - public static MultiRecord divide(BigInteger b1, BigInteger b2) { - BigInteger[] qr = b1.divideAndRemainder(b2); - MultiRecord result = new MultiRecord(divideFormat); - result.setField(0, "quo", Value.U.fromBInt(qr[0])); - result.setField(1, "rem", Value.U.fromBInt(qr[1])); - return result; - } - - - public static int formatSInt(int v, Object dest, int c) { - String s = "" + v; - char[] arr = (char[]) dest; - for (int i=0; i> 32); + return tmp & 0x3FFFFFFF; + + } + + public static boolean isZero(BigInteger b) { + return b.compareTo(BigInteger.ZERO) == 0; + } + + public static boolean isNeg(BigInteger b) { + return b.compareTo(BigInteger.ZERO) < 0; + } + + public static boolean isPos(BigInteger b) { + return b.compareTo(BigInteger.ZERO) > 0; + } + + public static boolean isEven(BigInteger b) { + return !b.testBit(0); + } + + public static boolean isOdd(BigInteger b) { + return b.testBit(0); + } + + public static boolean isSingle(BigInteger b) { + return b.compareTo(BigInteger.valueOf(Integer.MAX_VALUE)) <= 0 + && b.compareTo(BigInteger.valueOf(Integer.MIN_VALUE)) >= 0; + } + + public static boolean eq(BigInteger b1, BigInteger b2) { + return b1.compareTo(b2) == 0; + } + + public static boolean ne(BigInteger b1, BigInteger b2) { + return b1.compareTo(b2) != 0; + } + + public static boolean lt(BigInteger b1, BigInteger b2) { + return b1.compareTo(b2) < 0; + } + + public static boolean le(BigInteger b1, BigInteger b2) { + return b1.compareTo(b2) <= 0; + } + + public static BigInteger prev(BigInteger b) { + return b.subtract(BigInteger.ONE); + } + + public static BigInteger next(BigInteger b) { + return b.add(BigInteger.ONE); + } + + public static BigInteger plus(BigInteger b1, BigInteger b2) { + return b1.add(b2); + } + + public static BigInteger minus(BigInteger b1, BigInteger b2) { + return b1.subtract(b2); + } + + public static BigInteger times(BigInteger b1, BigInteger b2) { + return b1.multiply(b2); + } + + public static BigInteger timesPlus(BigInteger b1, BigInteger b2, BigInteger b3) { + return b1.multiply(b2).add(b3); + } + + public static BigInteger mod(BigInteger b1, BigInteger b2) { + return b1.mod(b2); + } + + public static BigInteger quo(BigInteger b1, BigInteger b2) { + return b1.divide(b2); + } + + public static BigInteger rem(BigInteger b1, BigInteger b2) { + return b1.remainder(b2); + } + + public static MultiRecord divide(BigInteger b1, BigInteger b2) { + BigInteger[] qr = b1.divideAndRemainder(b2); + MultiRecord result = new MultiRecord(divideFormat); + result.setField(0, "quo", Value.U.fromBInt(qr[0])); + result.setField(1, "rem", Value.U.fromBInt(qr[1])); + return result; + } + + + public static int formatSInt(int v, Object dest, int c) { + String s = "" + v; + char[] arr = (char[]) dest; + for (int i = 0; i < c; i++) { + arr[c + i] = s.charAt(i); + } + return c + s.length(); + } + + public static BigInteger sIPower(BigInteger b1, int b2) { + throw new RuntimeException(); + } + + public static BigInteger bIPower(BigInteger b1, BigInteger b2) { + throw new RuntimeException(); + } + public static BigInteger powerMod(BigInteger b1, BigInteger b2, BigInteger b3) { - throw new RuntimeException(); - } + throw new RuntimeException(); + } - public static BigInteger shiftUp(BigInteger b1, int n) { - return b1.shiftLeft(n); - } + public static BigInteger shiftUp(BigInteger b1, int n) { + return b1.shiftLeft(n); + } - public static BigInteger shiftDn(BigInteger b1, int n) { - return b1.shiftRight(n); - } + public static BigInteger shiftDn(BigInteger b1, int n) { + return b1.shiftRight(n); + } - public static BigInteger shiftRem(BigInteger b1, int n) { - BigInteger allOnes = BigInteger.ONE.shiftLeft(n).subtract(BigInteger.ONE); + public static BigInteger shiftRem(BigInteger b1, int n) { + BigInteger allOnes = BigInteger.ONE.shiftLeft(n).subtract(BigInteger.ONE); - return b1.and(allOnes); - } + return b1.and(allOnes); + } public static int timesModInv(int a, int b, int c, double d) { - throw new RuntimeException(); + throw new RuntimeException(); } public static MultiRecord wordTimesDouble(Word w1, Word w2) { - int i1 = w1.toSInt(); - int i2 = w2.toSInt(); - long lprod = (long) i1 * (long) i2; - MultiRecord pair = new MultiRecord(wordTimesFormat); - pair.setField(0, "hi", Value.U.fromSInt((int) (lprod >> 32))); - pair.setField(1, "lo", Value.U.fromSInt((int) (lprod & ((1L<<32)-1)))); + int i1 = w1.toSInt(); + int i2 = w2.toSInt(); + long lprod = (long) i1 * (long) i2; + MultiRecord pair = new MultiRecord(wordTimesFormat); + pair.setField(0, "hi", Value.U.fromSInt((int) (lprod >> 32))); + pair.setField(1, "lo", Value.U.fromSInt((int) (lprod & ((1L << 32) - 1)))); - return pair; + return pair; } public static MultiRecord wordDivideDouble(Word w1, Word w2, Word w3) { - long h = (long) w1.toSInt(); - long l = (long) w2.toSInt(); - long d = (long) w3.toSInt(); - long full = (h << 32) + l; - long lquo = full/d; - long rem = full % d; - MultiRecord result = new MultiRecord(wordDivideFormat); - result.setField(0, "hi", Value.U.fromSInt((int) (lquo >> 32))); - result.setField(1, "lo", Value.U.fromSInt((int) (lquo & ((1L<<32)-1)))); - result.setField(2, "rem", Value.U.fromSInt((int) rem)); + long h = (long) w1.toSInt(); + long l = (long) w2.toSInt(); + long d = (long) w3.toSInt(); + long full = (h << 32) + l; + long lquo = full / d; + long rem = full % d; + MultiRecord result = new MultiRecord(wordDivideFormat); + result.setField(0, "hi", Value.U.fromSInt((int) (lquo >> 32))); + result.setField(1, "lo", Value.U.fromSInt((int) (lquo & ((1L << 32) - 1)))); + result.setField(2, "rem", Value.U.fromSInt((int) rem)); - return result; + return result; } public static MultiRecord wordPlusStep(Word w1, Word w2, Word w3) { - throw new RuntimeException(); + throw new RuntimeException(); } public static MultiRecord wordTimesStep(Word w1, Word w2, Word w3, Word w4) { - throw new RuntimeException(); + throw new RuntimeException(); } public static float sfloAssemble(boolean sign, int i, Word w) { - throw new RuntimeException(); + throw new RuntimeException(); } public static MultiRecord sfloDissemble(float f) { - throw new RuntimeException(); + throw new RuntimeException(); } public static float sfloNext(float f) { - throw new RuntimeException(); + throw new RuntimeException(); } public static float sfloPrev(float f) { - throw new RuntimeException(); + throw new RuntimeException(); } public static float sfloRTimes(float a, float b, int r) { - throw new RuntimeException(); + throw new RuntimeException(); } public static float sfloRMinus(float a, float b, int r) { - throw new RuntimeException(); + throw new RuntimeException(); } public static float sfloRPlus(float a, float b, int r) { - throw new RuntimeException(); + throw new RuntimeException(); } public static float sfloRDivide(float a, float b, int r) { - throw new RuntimeException(); + throw new RuntimeException(); } public static float sfloRTimesPlus(float a, float b, float c, int r) { - throw new RuntimeException(); + throw new RuntimeException(); } public static BigInteger sfloTruncate(float a) { - throw new RuntimeException(); + throw new RuntimeException(); } + public static float sfloFraction(float a) { - throw new RuntimeException(); + throw new RuntimeException(); } + public static BigInteger sfloRound(float a, int b) { - throw new RuntimeException(); + throw new RuntimeException(); } - public static double dfloAssemble(boolean sign, int i, Word w1, Word w2) { - throw new RuntimeException(); + throw new RuntimeException(); } public static MultiRecord dfloDissemble(double f) { - throw new RuntimeException(); + throw new RuntimeException(); } + public static float dfloNext(double f) { - throw new RuntimeException(); + throw new RuntimeException(); } public static float dfloPrev(double f) { - throw new RuntimeException(); + throw new RuntimeException(); } public static double dfloRTimes(double a, double b, int r) { - throw new RuntimeException(); + throw new RuntimeException(); } public static double dfloRMinus(double a, double b, int r) { - throw new RuntimeException(); + throw new RuntimeException(); } public static double dfloRPlus(double a, double b, int r) { - throw new RuntimeException(); + throw new RuntimeException(); } public static double dfloRDivide(double a, double b, int r) { - throw new RuntimeException(); + throw new RuntimeException(); } public static double dfloRTimesPlus(double a, double b, double c, int r) { - throw new RuntimeException(); + throw new RuntimeException(); } public static BigInteger dfloTruncate(double a) { - throw new RuntimeException(); + throw new RuntimeException(); } + public static double dfloFraction(double a) { - throw new RuntimeException(); + throw new RuntimeException(); } + public static BigInteger dfloRound(double a, int b) { - throw new RuntimeException(); + throw new RuntimeException(); } public static int formatBInt(BigInteger i, Object o, int n) { - throw new RuntimeException(); + throw new RuntimeException(); } + public static int formatSFlo(float i, Object o, int n) { - throw new RuntimeException(); + throw new RuntimeException(); } + public static int formatDFlo(double i, Object o, int n) { - throw new RuntimeException(); + throw new RuntimeException(); } public static MultiRecord scanSFlo(Object o, int n) { - throw new RuntimeException(); + throw new RuntimeException(); } + public static MultiRecord scanDFlo(Object o, int n) { - throw new RuntimeException(); + throw new RuntimeException(); } + public static MultiRecord scanSInt(Object o, int n) { - throw new RuntimeException(); + throw new RuntimeException(); } + public static MultiRecord scanBInt(Object o, int n) { - throw new RuntimeException(); + throw new RuntimeException(); } } diff --git a/aldor/aldor/lib/java/src/foamj/MultiRecord.java b/aldor/aldor/lib/java/src/foamj/MultiRecord.java index 607bd0bd8..960821bfe 100644 --- a/aldor/aldor/lib/java/src/foamj/MultiRecord.java +++ b/aldor/aldor/lib/java/src/foamj/MultiRecord.java @@ -2,10 +2,12 @@ public class MultiRecord extends Record { - public MultiRecord(Format fmt) { - super(fmt); - } + public MultiRecord(Format fmt) { + super(fmt); + } - public MultiRecord toMulti() { return this; } + public MultiRecord toMulti() { + return this; + } } \ No newline at end of file diff --git a/aldor/aldor/lib/java/src/foamj/Record.java b/aldor/aldor/lib/java/src/foamj/Record.java index 489a06c7c..f49b4c5d8 100644 --- a/aldor/aldor/lib/java/src/foamj/Record.java +++ b/aldor/aldor/lib/java/src/foamj/Record.java @@ -2,46 +2,46 @@ public class Record extends AbstractValue implements Value, Word { - private Value[] arr; - private int id; - private static int count; - - public Record(Format fmt) { - arr = new Value[fmt.size()]; - id = count++; - } - - public Value getField(int idx, String name) { - return arr[idx]; - } - - public Word getWord(int idx, String name) { - return arr[idx].asWord(); - } - - public int getSInt(int idx, String name) { - return arr[idx].toSInt(); - } - - public void setField(int idx, String name, Value val) { - arr[idx] = val; - } - - @Override - public Value toValue() { - return this; - } - - @Override - public Record toRecord() { - return this; - } - - public Word asWord() { - return this; - } - - public String toString() { - return "[R: "+id + "]"; - } + private Value[] arr; + private int id; + private static int count; + + public Record(Format fmt) { + arr = new Value[fmt.size()]; + id = count++; + } + + public Value getField(int idx, String name) { + return arr[idx]; + } + + public Word getWord(int idx, String name) { + return arr[idx].asWord(); + } + + public int getSInt(int idx, String name) { + return arr[idx].toSInt(); + } + + public void setField(int idx, String name, Value val) { + arr[idx] = val; + } + + @Override + public Value toValue() { + return this; + } + + @Override + public Record toRecord() { + return this; + } + + public Word asWord() { + return this; + } + + public String toString() { + return "[R: " + id + "]"; + } } diff --git a/aldor/aldor/lib/java/src/foamj/Value.java b/aldor/aldor/lib/java/src/foamj/Value.java index 13cda0e42..b7dfa52a5 100644 --- a/aldor/aldor/lib/java/src/foamj/Value.java +++ b/aldor/aldor/lib/java/src/foamj/Value.java @@ -1,56 +1,92 @@ package foamj; -import java.math.BigInteger; -import foamj.FoamJ.Array; -import foamj.FoamJ.BInt; -import foamj.FoamJ.SInt; -import foamj.FoamJ.HInt; -import foamj.FoamJ.Bool; -import foamj.FoamJ.Ptr; -import foamj.FoamJ.SFlo; -import foamj.FoamJ.DFlo; -import foamj.FoamJ.Char; +import foamj.FoamJ.*; import foamj.FoamJ.Byte; +import java.math.BigInteger; + /** * Generic type used where we have to pass random objects around */ public interface Value { - Word asWord(); - int toSInt(); - BigInteger toBInt(); - short toHInt(); - byte toByte(); - double toDFlo(); + Word asWord(); + + int toSInt(); + + BigInteger toBInt(); + + short toHInt(); + + byte toByte(); + + double toDFlo(); + float toSFlo(); - Object toArray(); - Record toRecord(); - Clos toClos(); - MultiRecord toMulti(); - boolean toBool(); + + Object toArray(); + + Record toRecord(); + + Clos toClos(); + + MultiRecord toMulti(); + + boolean toBool(); + char toChar(); + Object toPtr(); + Env toEnv(); - public class U { - static public Record toRecord(Value value) { - if (value == null) - return null; - else - return value.toRecord(); - } - - public static Value fromBool(boolean b) { return new Bool(b); } - public static Value fromSInt(int x) { return new SInt(x); } - public static Value fromArray(Object x) { return new Array(x); } - public static Value fromBInt(BigInteger x) { return new BInt(x); } - public static Value fromPtr(Object o) { return new Ptr(o); } - public static Value fromSFlo(float o) { return new SFlo(o); } - public static Value fromDFlo(double o) { return new DFlo(o); } - public static Value fromChar(char o) { return new Char(o); } - public static Value fromByte(byte o) { return new Byte(o); } - public static Value fromHInt(short o) { return new HInt(o); } - } + public class U { + static public Record toRecord(Value value) { + if (value == null) + return null; + else + return value.toRecord(); + } + + public static Value fromBool(boolean b) { + return new Bool(b); + } + + public static Value fromSInt(int x) { + return new SInt(x); + } + + public static Value fromArray(Object x) { + return new Array(x); + } + + public static Value fromBInt(BigInteger x) { + return new BInt(x); + } + + public static Value fromPtr(Object o) { + return new Ptr(o); + } + + public static Value fromSFlo(float o) { + return new SFlo(o); + } + + public static Value fromDFlo(double o) { + return new DFlo(o); + } + + public static Value fromChar(char o) { + return new Char(o); + } + + public static Value fromByte(byte o) { + return new Byte(o); + } + + public static Value fromHInt(short o) { + return new HInt(o); + } + } } diff --git a/aldor/aldor/lib/java/src/foamj/Word.java b/aldor/aldor/lib/java/src/foamj/Word.java index 496ae83ba..f905a1b5b 100644 --- a/aldor/aldor/lib/java/src/foamj/Word.java +++ b/aldor/aldor/lib/java/src/foamj/Word.java @@ -1,56 +1,92 @@ package foamj; -import java.math.BigInteger; - -import foamj.FoamJ.Array; -import foamj.FoamJ.SInt; -import foamj.FoamJ.Bool; -import foamj.FoamJ.Char; +import foamj.FoamJ.*; import foamj.FoamJ.Byte; -import foamj.FoamJ.SFlo; -import foamj.FoamJ.DFlo; -import foamj.FoamJ.HInt; -import foamj.FoamJ.BInt; + +import java.math.BigInteger; /** * Implementation of Foam Word type. */ public interface Word { - Word asWord(); + Word asWord(); + Value toValue(); - int toSInt(); + + int toSInt(); + boolean toBool(); + Object toArray(); + char toChar(); + float toSFlo(); + double toDFlo(); + short toHInt(); + BigInteger toBInt(); + byte toByte(); - + public class U { - static public Object toArray(Word word) { - if (word == null) - return null; - else - return word.toArray(); - } - - public static Word fromSInt(int x) { return new SInt(x); } - public static Word fromBInt(BigInteger x) { return new BInt(x); } - public static Word fromHInt(short x) { return new HInt(x); } - public static Word fromArray(Object x) { return new Array(x); } - public static Word fromBool(boolean b) { return new Bool(b); } - public static Word fromChar(char c) { return new Char(c); } - public static Word fromByte(byte b) { return new Byte(b); } - public static Word fromSFlo(float f) { return new SFlo(f); } - public static Word fromDFlo(double d) { return new DFlo(d); } - public static Word fromRec(Record r) { return r; } - public static Word fromClos(Clos r) { return r; } - public static Word fromValue(Value v) { - if (v == null) return null; - else return v.asWord(); - } + static public Object toArray(Word word) { + if (word == null) + return null; + else + return word.toArray(); + } + + public static Word fromSInt(int x) { + return new SInt(x); + } + + public static Word fromBInt(BigInteger x) { + return new BInt(x); + } + + public static Word fromHInt(short x) { + return new HInt(x); + } + + public static Word fromArray(Object x) { + return new Array(x); + } + + public static Word fromBool(boolean b) { + return new Bool(b); + } + + public static Word fromChar(char c) { + return new Char(c); + } + + public static Word fromByte(byte b) { + return new Byte(b); + } + + public static Word fromSFlo(float f) { + return new SFlo(f); + } + + public static Word fromDFlo(double d) { + return new DFlo(d); + } + + public static Word fromRec(Record r) { + return r; + } + + public static Word fromClos(Clos r) { + return r; + } + + public static Word fromValue(Value v) { + if (v == null) return null; + else return v.asWord(); + } } } From 35d0764b81960cb037e7c3eb2b8135eccfb0ad21 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 28 Mar 2017 23:20:06 +0100 Subject: [PATCH 146/352] configure.ac: Always generate .git version instead of date --- aldor/configure.ac | 21 +-------------------- aldor/m4/git.m4 | 29 +++++++++++++++++++++++++++++ 2 files changed, 30 insertions(+), 20 deletions(-) create mode 100644 aldor/m4/git.m4 diff --git a/aldor/configure.ac b/aldor/configure.ac index 29967c4eb..9917ce186 100644 --- a/aldor/configure.ac +++ b/aldor/configure.ac @@ -58,26 +58,7 @@ AC_SUBST([LIBTOOL_DEPS]) # Enable extra warnings and -Werror if supported. ALDOR_ERROR_ON_WARN -# Force git build id. -git_build_id=0 -AC_ARG_ENABLE([git-build-id], - [AS_HELP_STRING([--enable-git-build-id], - [Force git sha1 hash as build id])], - [git_build_id=], - [git_build_id=`cd $srcdir; git status --porcelain 2>&1`]) - -# Git SHA1 hash as ld build-id. -AC_MSG_CHECKING([build id]) -if test -z "$git_build_id"; then - VCSVERSION=`cd $srcdir; git rev-parse HEAD` - build_id="-Wl,--build-id=0x$VCSVERSION" - AC_MSG_RESULT([git: $VCSVERSION]) -else - VCSVERSION=`date +%Y%m%d` - AC_MSG_RESULT([date: $VCSVERSION]) -fi -AC_SUBST([VCSVERSION]) -AC_SUBST([build_id]) +ALDOR_GIT_BUILD_ID # Generate Makefiles AC_CONFIG_FILES( diff --git a/aldor/m4/git.m4 b/aldor/m4/git.m4 new file mode 100644 index 000000000..cd080bf0f --- /dev/null +++ b/aldor/m4/git.m4 @@ -0,0 +1,29 @@ +# Force git build id. + +AC_DEFUN([ALDOR_GIT_BUILD_ID], +[git_build_id="" +AC_ARG_ENABLE([git-build-id], + [AS_HELP_STRING([--enable-git-build-id], + [Force git sha1 hash as build id])], + [case "${enableval}" in + yes) gitid=true;; + no) gitid=false;; + *) AC_MSG_ERROR([bad value ${enableval} for --enable-git-build-id]) ;; + esac], + [if test -f $srcdir/../.git/config ; then gitid=true; else gitid=false; fi] + [if test $gitid = true; then git_build_id=1; fi]) + +# Git SHA1 hash as ld build-id. +AC_MSG_CHECKING([build id]) +if test 1 = "$git_build_id"; then + VCSVERSION=`cd $srcdir; git rev-parse HEAD` + build_id="-Wl,--build-id=0x$VCSVERSION" + AC_MSG_RESULT([git: $VCSVERSION]) +else + VCSVERSION=`date +%Y%m%d` + AC_MSG_RESULT([date: $VCSVERSION]) +fi +AC_SUBST([VCSVERSION]) +AC_SUBST([build_id]) +]) + From 37c7c90c865602a805b7ebb5f4fa6bd2e32ffebc Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 28 Mar 2017 23:22:33 +0100 Subject: [PATCH 147/352] Build: Copy source library to $prefix/share/lib - Will be handy for UI stuff --- aldor/aldor/lib/libfoam/al/Makefile.in | 1 + aldor/aldor/lib/libfoamlib/al/Makefile.in | 1 + aldor/lib/aldor/src/common.mk | 1 + aldor/lib/algebra/src/common.mk | 1 + aldor/lib/algebra/src/extree/Makefile.in | 8 ++++++++ aldor/lib/ax0/src/al/Makefile.in | 1 + aldor/lib/axldem/src/al/Makefile.in | 1 + aldor/lib/axllib/src/al/Makefile.in | 1 + aldor/lib/buildlib.mk | 19 ++++++++++++++++++- aldor/lib/config.mk.in | 6 ++++++ 10 files changed, 39 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/lib/libfoam/al/Makefile.in b/aldor/aldor/lib/libfoam/al/Makefile.in index 0f7f671c4..67e4478aa 100644 --- a/aldor/aldor/lib/libfoam/al/Makefile.in +++ b/aldor/aldor/lib/libfoam/al/Makefile.in @@ -12,6 +12,7 @@ srcdir := @srcdir@ abs_srcdir := @abs_srcdir@ top_srcdir := @top_srcdir@ abs_top_srcdir := @abs_top_srcdir@ +abs_libdir := @abs_builddir@ subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) # Build starts here diff --git a/aldor/aldor/lib/libfoamlib/al/Makefile.in b/aldor/aldor/lib/libfoamlib/al/Makefile.in index 6f73393e8..af2de16cd 100644 --- a/aldor/aldor/lib/libfoamlib/al/Makefile.in +++ b/aldor/aldor/lib/libfoamlib/al/Makefile.in @@ -12,6 +12,7 @@ srcdir := @srcdir@ abs_srcdir := @abs_srcdir@ top_srcdir := @top_srcdir@ abs_top_srcdir := @abs_top_srcdir@ +abs_libdir := $(abs_builddir) subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) # Build starts here diff --git a/aldor/lib/aldor/src/common.mk b/aldor/lib/aldor/src/common.mk index d600792db..963ebcc0e 100644 --- a/aldor/lib/aldor/src/common.mk +++ b/aldor/lib/aldor/src/common.mk @@ -1,5 +1,6 @@ aldorincdir := $(top_srcdir)/lib/aldor/include aldorlibdir := $(top_builddir)/lib/aldor/src +abs_libdir := $(abs_top_builddir)/lib/aldor/src libraryname := aldor librarydeps := diff --git a/aldor/lib/algebra/src/common.mk b/aldor/lib/algebra/src/common.mk index 054e6b279..37c9f004a 100644 --- a/aldor/lib/algebra/src/common.mk +++ b/aldor/lib/algebra/src/common.mk @@ -1,5 +1,6 @@ aldorincdir := $(top_srcdir)/lib/aldor/include aldorlibdir := $(top_builddir)/lib/aldor/src +abs_libdir := $(abs_top_builddir)/lib/algebra/src libraryname := algebra librarydeps := aldor diff --git a/aldor/lib/algebra/src/extree/Makefile.in b/aldor/lib/algebra/src/extree/Makefile.in index 8dbc528b9..71bbcde71 100644 --- a/aldor/lib/algebra/src/extree/Makefile.in +++ b/aldor/lib/algebra/src/extree/Makefile.in @@ -19,3 +19,11 @@ library := sit_extree sit_optools otherfiles := alg_leaf alg_op include $(abs_top_srcdir)/lib/algebra/src/common.mk + +install-data: + $(MKDIR_P) $(DESTDIR)$(datarootdir)/aldor/lib/$(libraryname)/$(libsubdir) + for i in $(otherfiles); do \ + if test -f $(abs_srcdir)/$$i.as; then \ + $(INSTALL_DATA) $(abs_srcdir)/$$i.as $(DESTDIR)$(datarootdir)/aldor/lib/$(libraryname)/$(libsubdir)/$$i.as; \ + fi; \ + done diff --git a/aldor/lib/ax0/src/al/Makefile.in b/aldor/lib/ax0/src/al/Makefile.in index d9eac9dcf..40ada2d9c 100644 --- a/aldor/lib/ax0/src/al/Makefile.in +++ b/aldor/lib/ax0/src/al/Makefile.in @@ -12,6 +12,7 @@ srcdir := @srcdir@ abs_srcdir := @abs_srcdir@ top_srcdir := @top_srcdir@ abs_top_srcdir := @abs_top_srcdir@ +abs_libdir := $(abs_top_builddir)/lib/ax0/src/al subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) VPATH := $(VPATH):$(top_srcdir)/lib/axllib/src/al diff --git a/aldor/lib/axldem/src/al/Makefile.in b/aldor/lib/axldem/src/al/Makefile.in index a2a5f4ee5..440256e49 100644 --- a/aldor/lib/axldem/src/al/Makefile.in +++ b/aldor/lib/axldem/src/al/Makefile.in @@ -12,6 +12,7 @@ srcdir := @srcdir@ abs_srcdir := @abs_srcdir@ top_srcdir := @top_srcdir@ abs_top_srcdir := @abs_top_srcdir@ +abs_libdir := $(abs_top_builddir)/lib/axldem/src/al subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) # Build starts here diff --git a/aldor/lib/axllib/src/al/Makefile.in b/aldor/lib/axllib/src/al/Makefile.in index 02a00037b..b910d1c64 100644 --- a/aldor/lib/axllib/src/al/Makefile.in +++ b/aldor/lib/axllib/src/al/Makefile.in @@ -12,6 +12,7 @@ srcdir := @srcdir@ abs_srcdir := @abs_srcdir@ top_srcdir := @top_srcdir@ abs_top_srcdir := @abs_top_srcdir@ +abs_libdir := $(abs_top_builddir)/lib/axllib/src/al subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) # Build starts here diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index 7241ce125..81ee1f02a 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -15,6 +15,8 @@ asdomains := $(internal) $(library) $(tests) axdomains := $(axlibrary) alldomains := $(asdomains) $(axdomains) +libsubdir := $(subst $(abs_libdir)/,,$(abs_builddir)/.) + include $(top_builddir)/lib/config.mk # Aldor @@ -336,9 +338,24 @@ distclean: clean rm Makefile maintainer-clean: distclean +install-data: + $(MKDIR_P) $(DESTDIR)$(datarootdir)/aldor/lib/$(libraryname)/$(libsubdir) + for i in $(library); do \ + if test -f $(abs_srcdir)/$$i.as; then \ + $(INSTALL_DATA) $(abs_srcdir)/$$i.as $(DESTDIR)$(datarootdir)/aldor/lib/$(libraryname)/$(libsubdir)/$$i.as; \ + fi; \ + if test -f $$i.abn; then \ + $(INSTALL_DATA) $$i.abn $(DESTDIR)$(datarootdir)/aldor/lib/$(libraryname)/$(libsubdir)/$$i.abn; \ + fi; \ + done + +uninstall: + rm -rf $(datarootdir)/lib/$(libraryname)/$(libsubdir) + +install: install-data install-exec EMPTY_AUTOMAKE_TARGETS = dvi pdf ps info html tags ctags -EMPTY_AUTOMAKE_TARGETS += install install-data install-exec uninstall +EMPTY_AUTOMAKE_TARGETS += install-exec uninstall EMPTY_AUTOMAKE_TARGETS += install-dvi install-html install-info install-ps install-pdf EMPTY_AUTOMAKE_TARGETS += installdirs EMPTY_AUTOMAKE_TARGETS += check installcheck diff --git a/aldor/lib/config.mk.in b/aldor/lib/config.mk.in index 040d79efd..a5049b06f 100644 --- a/aldor/lib/config.mk.in +++ b/aldor/lib/config.mk.in @@ -1,2 +1,8 @@ @BUILD_JAVA_TRUE@BUILD_JAVA=1 @BUILD_JAVA_FALSE@BUILD_JAVA= + +prefix := @prefix@ +datarootdir := @datarootdir@ +MKDIR_P := @MKDIR_P@ +INSTALL := @INSTALL@ +INSTALL_DATA := @INSTALL_DATA@ From 9cfed387c50e20842abc013f04792d30fa22c722 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Dec 2017 21:53:32 +0000 Subject: [PATCH 148/352] build: Add implicit-fallthrough for gcc-7.2 --- aldor/m4/strict_compile.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/m4/strict_compile.m4 b/aldor/m4/strict_compile.m4 index 0227f0d86..84655efca 100644 --- a/aldor/m4/strict_compile.m4 +++ b/aldor/m4/strict_compile.m4 @@ -18,7 +18,7 @@ AC_DEFUN([ALDOR_STRICT_COMPILE], $cfg_no_sign_compare $cfg_no_shift_negative_value" case "${CC}" in gcc*) - cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -Wno-error=clobbered" + cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -Wno-error=clobbered -Wno-implicit-fallthrough" ;; clang*) cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -fcolor-diagnostics -Wno-error=enum-conversion \ From 37fb1c2d5645fc85bd7e79de76a454270b89f90e Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 17:29:12 +0000 Subject: [PATCH 149/352] src: Fallthrough warnings - abpretty.c --- aldor/aldor/src/abpretty.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/abpretty.c b/aldor/aldor/src/abpretty.c index 06cea772d..775ca56d0 100644 --- a/aldor/aldor/src/abpretty.c +++ b/aldor/aldor/src/abpretty.c @@ -606,7 +606,7 @@ abPPClipped0(Buffer buf, AbSyn ab, long *pmaxchars) case AB_Default: if (abIsNothing(abArgv(ab)[0])) break; - + /* Fall through */ default: { TokenTag tTag = abInfo(abTag(ab)).tokenTag; From 898af0589a1d5b10c3d1675f82c08860613643a8 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 17:29:35 +0000 Subject: [PATCH 150/352] src: Fallthrough warnings - linear.c --- aldor/aldor/src/linear.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/aldor/src/linear.c b/aldor/aldor/src/linear.c index 809c079de..1177496f1 100644 --- a/aldor/aldor/src/linear.c +++ b/aldor/aldor/src/linear.c @@ -22,6 +22,7 @@ #include "store.h" #include "fint.h" #include "comsg.h" +#include "util.h" Bool linDebug = false; #define linDEBUG DEBUG_IF(lin) afprintf @@ -579,6 +580,7 @@ lntFrTL_DoLine(TokenList *ptl) else if (depthDontPileNo) break; #endif + /* Fall through */ default: lnt = lntFrTL_1Tok(&tl0); ll = listCons(LNodeTree)(lnt, ll); From d4510e7c87aeaae614486069d021ea72deb59094 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 17:30:12 +0000 Subject: [PATCH 151/352] src: Fallthrough warnings - tform.c --- 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 0dcec4671..8a5b94112 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -5691,7 +5691,7 @@ tfDefineeSymbol(TForm tf) tf = tfMultiArgN(tf, int0); break; } - /* else fall through to default case. */ + /* fall through */ default: return NULL; } From 97d748a2a3e2a9a72d7bb9ef900df72938825b8f Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 17:37:05 +0000 Subject: [PATCH 152/352] sexpr.c: Add no-return annotation to error function --- aldor/aldor/src/sexpr.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/sexpr.c b/aldor/aldor/src/sexpr.c index d9b02aea0..0bd964f8a 100644 --- a/aldor/aldor/src/sexpr.c +++ b/aldor/aldor/src/sexpr.c @@ -84,7 +84,7 @@ Bool sexprDebug = false; local int sxiIoIsNeedingEscape(String); -local void sxiRdError(int errnum, ...); +local void sxiRdError(int errnum, ...) chk_noreturn; local SExpr sxiUseError(int errnum, ...); local SExpr sxiDefaultHandler(SrcPos, int errnum, va_list argp); From c59cf4290f5f7d012b1b64be27c424fde783cdb5 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 17:37:43 +0000 Subject: [PATCH 153/352] comsgdb.c: Add no return to "fatal" functions --- aldor/aldor/src/comsg.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/comsg.h b/aldor/aldor/src/comsg.h index 3f2901521..6365c6a65 100644 --- a/aldor/aldor/src/comsg.h +++ b/aldor/aldor/src/comsg.h @@ -80,7 +80,7 @@ extern int comsgErrorCount (void); /* * Add messages. */ -extern void comsgFatal (AbSyn, Msg fmt, ...); +extern void comsgFatal (AbSyn, Msg fmt, ...) chk_noreturn; extern void comsgError (AbSyn, Msg fmt, ...); extern void comsgWarning (AbSyn, Msg fmt, ...); extern void comsgRemark (AbSyn, Msg fmt, ...); @@ -88,7 +88,7 @@ extern void comsgWarnPos (SrcPos, Msg fmt, ...); /* * Varargs versions */ -extern void comsgVFatal (AbSyn, Msg fmt, va_list); +extern void comsgVFatal (AbSyn, Msg fmt, va_list) chk_noreturn; extern CoMsg comsgVError (AbSyn, Msg fmt, va_list); extern CoMsg comsgVWarning (AbSyn, Msg fmt, va_list); extern CoMsg comsgVRemark (AbSyn, Msg fmt, va_list); From 38298c511bae881980da1e48d2cfdf5592cc483e Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 17:38:23 +0000 Subject: [PATCH 154/352] ccode.c: Fix fallthrough comment. gcc is a bit fussy --- aldor/aldor/src/ccode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/ccode.c b/aldor/aldor/src/ccode.c index 262af12c5..1ed13be3f 100644 --- a/aldor/aldor/src/ccode.c +++ b/aldor/aldor/src/ccode.c @@ -1143,7 +1143,7 @@ ccoIsWantingElse(CCode cco) switch (ccoTag(cco)) { case CCO_If: if (!ccoArgv(cco)[2]) return true; - /* Seep through. */ + /* fall through. */ case CCO_Switch: case CCO_While: case CCO_For: From 4c6d75f7578422aaa08be3e6bb98288c59a0ba18 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 17:41:39 +0000 Subject: [PATCH 155/352] features.h: Always define chk_noreturn and chk_fallthrough --- aldor/aldor/src/features.h0 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/aldor/aldor/src/features.h0 b/aldor/aldor/src/features.h0 index 4409ec7e0..b2fd637f5 100644 --- a/aldor/aldor/src/features.h0 +++ b/aldor/aldor/src/features.h0 @@ -4,15 +4,13 @@ #if defined(__GNUC__) # define chk_fmt(a, b) __attribute__((format(printf, a, b))) # define chk_nonnull(x) __attribute__((nonnull x)) -# if defined(_ANALYSING) -# define chk_noreturn __attribute__((noreturn)) -# else -# define chk_noreturn -# endif +# define chk_noreturn __attribute__((noreturn)) +# define chk_fallthrough __attribute__((fallthrough)) #else # define chk_fmt(a, b) # define chk_noreturn # define chk_nonnull(x) +# define chk_fallthrough #endif #endif /* FEATURES_H0 */ From 3bad0ec08e226d7598e9cbcbfb91d1b62560f259 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 18:46:54 +0000 Subject: [PATCH 156/352] axlcomp.c: Simplify fallthrough thing (spent too long trying to fix..) --- aldor/aldor/src/axlcomp.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/axlcomp.c b/aldor/aldor/src/axlcomp.c index eed70ba06..f0980576c 100644 --- a/aldor/aldor/src/axlcomp.c +++ b/aldor/aldor/src/axlcomp.c @@ -542,7 +542,9 @@ compFilesLoop(int argc, char **argv) comsgFatal(NULL, ALDOR_F_BadFType, argv[i], fnameType(fn), FTYPE_SRC); } - /* Fall through. */ + if (!isSolo) fprintf(osStdout, "\n%s:\n", argv[i]); + nErrors = compSourceFile(compFinfov[i]); + break; case FTYPENO_NONE: case FTYPENO_SRC: case FTYPENO_INCLUDED: From fcec09c669389d437bc400af90dd8057b213e415 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 18:50:14 +0000 Subject: [PATCH 157/352] fixup: Re-introduce -Mno-implicit-fallthrough in build --- aldor/m4/strict_compile.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/m4/strict_compile.m4 b/aldor/m4/strict_compile.m4 index 84655efca..0227f0d86 100644 --- a/aldor/m4/strict_compile.m4 +++ b/aldor/m4/strict_compile.m4 @@ -18,7 +18,7 @@ AC_DEFUN([ALDOR_STRICT_COMPILE], $cfg_no_sign_compare $cfg_no_shift_negative_value" case "${CC}" in gcc*) - cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -Wno-error=clobbered -Wno-implicit-fallthrough" + cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -Wno-error=clobbered" ;; clang*) cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -fcolor-diagnostics -Wno-error=enum-conversion \ From 30712dce518e8540338696bbb89e0975ce0e8cf7 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 29 May 2018 09:30:20 +0100 Subject: [PATCH 158/352] syme.c: avoid compiler warnings from symeModBit (nb: This should really change symeModBit) --- aldor/aldor/src/syme.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/syme.h b/aldor/aldor/src/syme.h index a541f320c..2a61951a7 100644 --- a/aldor/aldor/src/syme.h +++ b/aldor/aldor/src/syme.h @@ -266,7 +266,7 @@ extern AInt symeSetFieldVal; (symeLocalFieldv(s)[symeIndex(s,f)] = (v)) #define symeGetField(s,f) \ - (symeModBit(f) && !symeHasField(s,f) ? symeFieldDefault(f) : \ + (f < bitsizeof(int) && !symeHasField(s,f) ? symeFieldDefault(f) : \ symeHasLocal(s,f) ? symeGetLocal(s,f) : symeGetFieldFn(s,f)) #define symeSetField(s,f,v) \ From e1b4e0e4cfc5858b412f47a0984fa785b76fa436 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 29 May 2018 09:28:19 +0100 Subject: [PATCH 159/352] fint.c: fallthrough & missing break statement --- aldor/aldor/src/fint.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/aldor/src/fint.c b/aldor/aldor/src/fint.c index 62a13951d..95edfb49b 100644 --- a/aldor/aldor/src/fint.c +++ b/aldor/aldor/src/fint.c @@ -1556,6 +1556,7 @@ fintStmt(DataObj retDataObj) fintSet(type, loc, expr); } + /* fall through */ case FOAM_Free: (void)fintEval(&expr); fintFree0(expr.fiPtr); @@ -4198,6 +4199,7 @@ fintEval_(DataObj retDataObj) break; case FOAM_SInt: retDataObj->fiArr = (Ptr) fiArrNew_SInt(argc+1); + break; case FOAM_SFlo: retDataObj->fiArr = (Ptr) fiArrNew_SFlo(argc+1); break; From 3035464b626d776769e214efc052a3644986f5e5 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 29 May 2018 09:29:16 +0100 Subject: [PATCH 160/352] genc.c: Missing break statements. --- aldor/aldor/src/genc.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/aldor/src/genc.c b/aldor/aldor/src/genc.c index b1eb19728..d25430c85 100644 --- a/aldor/aldor/src/genc.c +++ b/aldor/aldor/src/genc.c @@ -3795,9 +3795,11 @@ gccMFmt(Foam foam) /* Only allowed (Set (Values ...) (MFmt f (Catch ...))) */ bug("gccMFmt: Catch in MFmt missed by gc0Set"); NotReached(cc = 0); + break; default: bugBadCase(foamTag(expr)); NotReached(cc = 0); + break; } return cc; } From d4ad2548acd641667d96a47f7de072a62935b8ff Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 25 Apr 2018 21:57:22 +0100 Subject: [PATCH 161/352] assert.h0: abort_if_fatal can return --- aldor/aldor/src/assert.h0 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/assert.h0 b/aldor/aldor/src/assert.h0 index 0700da058..6db04b88b 100644 --- a/aldor/aldor/src/assert.h0 +++ b/aldor/aldor/src/assert.h0 @@ -18,8 +18,8 @@ #ifndef DO_ASSERT_IS_DECLARED #define DO_ASSERT_IS_DECLARED -void _abort_if_fatal_assert(void) chk_noreturn; -void _do_assert(char *str, char *file, int line) chk_noreturn; +void _abort_if_fatal_assert(void); +void _do_assert(char *str, char *file, int line); #endif #if defined(QASSERT) From e5cda55b1e4a4cb7694e3795483e4a7661f9388b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 17:34:45 +0000 Subject: [PATCH 162/352] sefo.c: sefo hash check on equality won't work. Remove. SefoEqual includes defineValues - which are not used in hash --- aldor/aldor/src/sefo.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/sefo.c b/aldor/aldor/src/sefo.c index 6da5785bc..6b0fc1d30 100644 --- a/aldor/aldor/src/sefo.c +++ b/aldor/aldor/src/sefo.c @@ -106,6 +106,7 @@ local Bool tformEqual0 (SymeList, TForm, TForm); local Bool sefoListEqual0 (SymeList, SefoList, SefoList); local Bool symeListEqual0 (SymeList, SymeList, SymeList); local Bool tformListEqual0 (SymeList,TFormList,TFormList); +local Bool sefoIsDefinedType (Sefo); local Bool symeTypeEqual0 (SymeList, Syme, Syme); local Bool symeExtendEqual0 (SymeList, Syme, Syme); @@ -1436,7 +1437,7 @@ sefoEqual(Sefo sefo1, Sefo sefo2) eq = sefoEqual0(NULL, sefo1, sefo2); sstDoneSefo(sefo1); - if (eq) + if (eq && !sefoIsDefinedType(sefo1) && !sefoIsDefinedType(sefo2)) assert(abHashSefo(sefo1) == abHashSefo(sefo2)); return eq; From 0fbdc1f1a94a8b1a13f077a46ff4dc0efd45ddbc Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 17:40:46 +0000 Subject: [PATCH 163/352] axllib/test: 1248 won't work. It uses lambda which returns a category; I think we're not set up to handle this case. --- aldor/lib/axllib/test/Makefile.am | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/aldor/lib/axllib/test/Makefile.am b/aldor/lib/axllib/test/Makefile.am index 985947f30..2b3d7a8a5 100644 --- a/aldor/lib/axllib/test/Makefile.am +++ b/aldor/lib/axllib/test/Makefile.am @@ -161,7 +161,6 @@ AXLTESTS = \ bug1235 \ bug1237 \ bug1242 \ - bug1248 \ bug1250 \ bug1252 \ bug1253 \ @@ -474,6 +473,7 @@ AXLTESTS = \ BROKEN = \ bug1125 \ bug1190 \ + bug1248 \ fix1 \ opt1 \ pack1 \ @@ -497,6 +497,7 @@ XFAIL_TESTS = \ bug1114/bug1114 \ bug1176/bug1176 \ bug1220/bug1220 \ + bug1248/bug1248 \ bug1252/bug1252 \ bug1290/bug1290 \ depend8/depend8 \ From 91db7c783150f1bf94e156467b254bb5e2ab73b2 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 18:48:13 +0000 Subject: [PATCH 164/352] axllib/test: No need for -Wno-fatal Papering over cracks.. --- aldor/lib/ax0/src/al/Makefile.in | 2 +- aldor/lib/axllib/test/Tests.am | 3 --- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/aldor/lib/ax0/src/al/Makefile.in b/aldor/lib/ax0/src/al/Makefile.in index 40ada2d9c..c3e3ee096 100644 --- a/aldor/lib/ax0/src/al/Makefile.in +++ b/aldor/lib/ax0/src/al/Makefile.in @@ -71,7 +71,7 @@ axllibincdir := $(top_srcdir)/lib/axllib/include libraryname := ax0 Libraryname := Axiom -AXLFLAGS := -Q8 -Wcheck -Wno-fatal +AXLFLAGS := -Q8 -Wcheck AXLFLAGS += -I $(axllibincdir) bytecode_only := true diff --git a/aldor/lib/axllib/test/Tests.am b/aldor/lib/axllib/test/Tests.am index 1b6f54542..70f95bd19 100644 --- a/aldor/lib/axllib/test/Tests.am +++ b/aldor/lib/axllib/test/Tests.am @@ -479,9 +479,6 @@ CLEANFILES += bug1237/bug1237-aldormain.c bug1237/bug1237.c bug1237/bug1237.ao check_PROGRAMS += bug1242/bug1242 bug1242_bug1242_SOURCES = bug1242/bug1242-aldormain.c bug1242/bug1242.c CLEANFILES += bug1242/bug1242-aldormain.c bug1242/bug1242.c bug1242/bug1242.ao -check_PROGRAMS += bug1248/bug1248 -bug1248_bug1248_SOURCES = bug1248/bug1248-aldormain.c bug1248/bug1248.c -CLEANFILES += bug1248/bug1248-aldormain.c bug1248/bug1248.c bug1248/bug1248.ao check_PROGRAMS += bug1250/bug1250 bug1250_bug1250_SOURCES = bug1250/bug1250-aldormain.c bug1250/bug1250.c CLEANFILES += bug1250/bug1250-aldormain.c bug1250/bug1250.c bug1250/bug1250.ao From d07b7202da85ddca08b76078ba29b9615cf6183d Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 17:36:25 +0000 Subject: [PATCH 165/352] bugfix: genfoam.c: gen0NilValue should ignore exceptions. --- aldor/aldor/src/genfoam.c | 1 + 1 file changed, 1 insertion(+) diff --git a/aldor/aldor/src/genfoam.c b/aldor/aldor/src/genfoam.c index 5cd10c905..590c63987 100644 --- a/aldor/aldor/src/genfoam.c +++ b/aldor/aldor/src/genfoam.c @@ -681,6 +681,7 @@ gen0EmbedExit(Foam foam, AbSyn ab, TForm tf) local Foam gen0NilValue(TForm tf) { + tf = tfIgnoreExceptions(tf); if (!tfIsMulti(tf)) { return foamNewNil(); } From 0f1227da53b6a645cc645de0459e0843143681df Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 4 Jul 2018 23:17:59 +0100 Subject: [PATCH 166/352] assert.h: All failed assertions are fatal --- aldor/aldor/src/assert.h0 | 2 -- aldor/aldor/src/cmdline.c | 2 -- aldor/aldor/src/stdc.c | 10 +--------- aldor/aldor/src/util.c | 2 +- aldor/lib/algebra/src/test/Makefile.in | 2 +- aldor/lib/testprog.am | 2 +- 6 files changed, 4 insertions(+), 16 deletions(-) diff --git a/aldor/aldor/src/assert.h0 b/aldor/aldor/src/assert.h0 index 6db04b88b..d47bcb7b7 100644 --- a/aldor/aldor/src/assert.h0 +++ b/aldor/aldor/src/assert.h0 @@ -18,7 +18,6 @@ #ifndef DO_ASSERT_IS_DECLARED #define DO_ASSERT_IS_DECLARED -void _abort_if_fatal_assert(void); void _do_assert(char *str, char *file, int line); #endif @@ -29,7 +28,6 @@ void _do_assert(char *str, char *file, int line); #endif extern int _dont_assert; -extern int _fatal_assert; #if defined(NDEBUG) # define assert(c) diff --git a/aldor/aldor/src/cmdline.c b/aldor/aldor/src/cmdline.c index f6600e801..b120786df 100644 --- a/aldor/aldor/src/cmdline.c +++ b/aldor/aldor/src/cmdline.c @@ -877,8 +877,6 @@ cmdDoOptDeveloper(String arg) _dont_assert = false; /* Test assertions. */ stoCtl(StoCtl_Wash, true); /* Initialize of store. */ } - else if (strAEqual("no-fatal", arg)) - _fatal_assert = false; /* Make assertions non-fatal. */ else if (strAEqual("runtime", arg)) genSetRuntime(); else if (strEqual("debug", arg)) diff --git a/aldor/aldor/src/stdc.c b/aldor/aldor/src/stdc.c index a02d6a64f..29447d396 100644 --- a/aldor/aldor/src/stdc.c +++ b/aldor/aldor/src/stdc.c @@ -9,14 +9,6 @@ #include "stdc.h" int _dont_assert = 0; -int _fatal_assert = 1; - -void -_abort_if_fatal_assert(void) -{ - if (_fatal_assert) - abort(); -} void _do_assert(char *str, char *file, int line) @@ -29,7 +21,7 @@ _do_assert(char *str, char *file, int line) fprintf(stderr, "Assertion failed, file \"%s\" line %d: %s\n", file, line, str); - _abort_if_fatal_assert(); + abort(); } diff --git a/aldor/aldor/src/util.c b/aldor/aldor/src/util.c index 0474d0e51..1a47bc0e5 100644 --- a/aldor/aldor/src/util.c +++ b/aldor/aldor/src/util.c @@ -85,7 +85,7 @@ bug(String fmt, ...) va_start(argp, fmt); vprintf(fmt, argp); va_end(argp); printf("\n"); - _abort_if_fatal_assert(); + abort(); } /***************************************************************************** diff --git a/aldor/lib/algebra/src/test/Makefile.in b/aldor/lib/algebra/src/test/Makefile.in index 4b43ed820..f3685c2b6 100644 --- a/aldor/lib/algebra/src/test/Makefile.in +++ b/aldor/lib/algebra/src/test/Makefile.in @@ -27,7 +27,7 @@ check: $(addsuffix .test,$(tests)) $(addsuffix .test,$(tests)): %.test: %.ao cp $(SUBLIB_DEPEND).al lib$(libraryname)_$*.al; \ ar r lib$(libraryname)_$*.al $(addsuffix .ao, $(shell $(UNIQ) $*.dep)); \ - $(DBG) $(aldorexedir)/aldor -Wcheck \ + $(DBG) $(aldorexedir)/aldor \ -Nfile=$(aldorsrcdir)/aldor.conf \ -Y. \ -Y$(aldorlibdir)/libfoam/al \ diff --git a/aldor/lib/testprog.am b/aldor/lib/testprog.am index 3b0846d7e..8f561e035 100644 --- a/aldor/lib/testprog.am +++ b/aldor/lib/testprog.am @@ -24,7 +24,7 @@ ALDORFLAGS := \ -Nfile=$(aldorsrcdir)/aldor.conf \ $(addprefix -I,$(libraryincdirs)) \ $(addprefix -Y,$(librarylibdirs)) \ - -Waudit -Wcheck -Wno-fatal \ + -Waudit -Wcheck \ $(ALFLAGS) # Aldor silent-rules From 96e12ed8379eac7a44acd012d3ffe8dbfba94360 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 8 May 2017 09:06:03 +0100 Subject: [PATCH 167/352] travis: Build requires fakeroot & debhelper So add them --- .travis.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.travis.yml b/.travis.yml index fbb4cdaf3..500a86c46 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,6 +3,8 @@ script: dpkg-buildpackage -b -us -uc install: - sudo apt-get install libgmp-dev + - sudo apt-get install fakeroot + - sudo apt-get install debhelper # whitelist branches: From c57f7055b60b13038e0d1839824ab587d741035c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 28 Mar 2017 23:23:10 +0100 Subject: [PATCH 168/352] version.c: Bump version number. --- aldor/aldor/src/version.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/version.c b/aldor/aldor/src/version.c index 34afa00bd..ac1f989b7 100644 --- a/aldor/aldor/src/version.c +++ b/aldor/aldor/src/version.c @@ -23,6 +23,6 @@ CString verName = "Aldor"; int verMajorVersion = 1; -int verMinorVersion = 2; +int verMinorVersion = 3; int verMinorFreeze = 0; CString verPatchLevel = VCSVERSION; From 1ccfb481230bb63948a40ad4177504c7a8a368ff Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 24 Jun 2017 20:41:43 +0100 Subject: [PATCH 169/352] gf_imps.c: Don't bother creating a FOAM_Cast when not required --- aldor/aldor/src/gf_imps.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/gf_imps.c b/aldor/aldor/src/gf_imps.c index 1210c463f..86eb593e2 100644 --- a/aldor/aldor/src/gf_imps.c +++ b/aldor/aldor/src/gf_imps.c @@ -349,7 +349,9 @@ gen0GetDomImport(Syme syme, Foam dom) else if (tfSatType(tf)) { /* Don't use lazy gets for imported types. */ call = gen0MakeGetExport(dom, name, type); - call = foamNewCast(fmType, call); + if (fmType != FOAM_Word) { + foamNewCast(fmType, call); + } } else call = gen0LazyConstGet(syme, dom, name, type); @@ -471,7 +473,7 @@ gen0LazyValue(Foam var, Syme syme) "runtime", 1, var); foamSyme(var) = syme; foamPure(foam) = true; - return foamNewCast(type, foam); + return type == FOAM_Word ? foam : foamNewCast(type, foam); } local Foam From 6df76403ed4c0e46bc095c257eac18850bd99df5 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 13 Jun 2018 20:46:23 +0100 Subject: [PATCH 170/352] lib: Ignore "comp" library - not used anywhere --- aldor/lib/.gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/lib/.gitignore b/aldor/lib/.gitignore index 5b89b3cb1..0a1c1e847 100644 --- a/aldor/lib/.gitignore +++ b/aldor/lib/.gitignore @@ -4,3 +4,5 @@ *_test.as # Generated by the build (java test files) *_jtest.as +# Test library +comp From 6c3626e364a7f9748e5106f950642a9dfe9df199 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 24 Jun 2017 20:43:04 +0100 Subject: [PATCH 171/352] int.c: Add absorbing sum function Handy for avoiding integer wrap errors --- aldor/aldor/src/int.c | 7 +++++++ aldor/aldor/src/int.h | 1 + aldor/aldor/src/test/test_int.c | 13 +++++++++++++ 3 files changed, 21 insertions(+) diff --git a/aldor/aldor/src/int.c b/aldor/aldor/src/int.c index 94da839cf..f14cf2d8b 100644 --- a/aldor/aldor/src/int.c +++ b/aldor/aldor/src/int.c @@ -28,3 +28,10 @@ aintHash(AInt n) return n; } +AInt +aintAbsorbingSum(AInt max, AInt i1, AInt i2) +{ + assert(i1 >= 0); + assert(i2 >= 0); + return max - i2 > i1 ? i1 + i2: max; +} diff --git a/aldor/aldor/src/int.h b/aldor/aldor/src/int.h index 0b11eea72..3b3f1cc0a 100644 --- a/aldor/aldor/src/int.h +++ b/aldor/aldor/src/int.h @@ -5,6 +5,7 @@ extern Bool longIsInt32(long n); extern Bool aintEqual(AInt i1, AInt i2); extern Hash aintHash(AInt i1); +extern AInt aintAbsorbingSum(AInt, AInt, AInt); #ifdef CC_long_not_int32 #define IF_LongOver32Bits(x) Statement(x) diff --git a/aldor/aldor/src/test/test_int.c b/aldor/aldor/src/test/test_int.c index a0ec7d035..e2b6747b6 100644 --- a/aldor/aldor/src/test/test_int.c +++ b/aldor/aldor/src/test/test_int.c @@ -5,6 +5,7 @@ local void testLongIs32(void); local void verifyAIntEqual(void); +local void verifyAIntAbsorbingSum(void); void intTestSuite() @@ -13,6 +14,7 @@ intTestSuite() dbInit(); TEST(testLongIs32); TEST(verifyAIntEqual); + TEST(verifyAIntAbsorbingSum); dbFini(); } @@ -41,3 +43,14 @@ verifyAIntEqual() testFalse("t1", aintEqual(0, 1)); testTrue("t1", aintEqual(0, 0)); } + + +local void +verifyAIntAbsorbingSum() +{ + testTrue("t1", aintAbsorbingSum(100, 99, 1) == 100); + testTrue("t2", aintAbsorbingSum(100, 99, 0) == 99); + testTrue("t3", aintAbsorbingSum(100, 99, 10) == 100); + + testTrue("t4", aintAbsorbingSum(1<<30, (1<<30) - 10, 20) == 1<<30); +} From c11e5138490bba36410684e7f7d3aba3b4cf2543 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 24 Jun 2017 21:16:38 +0100 Subject: [PATCH 172/352] inlutil.c: Avoid overflow when calculating function cost --- aldor/aldor/src/inlutil.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/inlutil.c b/aldor/aldor/src/inlutil.c index b22fe812e..097758817 100644 --- a/aldor/aldor/src/inlutil.c +++ b/aldor/aldor/src/inlutil.c @@ -14,6 +14,7 @@ #include "loops.h" #include "optfoam.h" #include "strops.h" +#include "int.h" Bool inuProgDebug = false; @@ -434,10 +435,11 @@ inuAnalyseProg(Foam foam, int constNum) InlUnknownCallsMagicNumber; flogIter(optInfo->flog, bb, { - timeCost += (1 << (bb->iextra * InlLoopMagicNumber)); + int loops = bb->iextra > 5 ? 5 : bb->iextra; + timeCost = aintAbsorbingSum(TIME_MAX, timeCost, (1 << (loops * InlLoopMagicNumber))); }); - foam->foamProg.time = timeCost > TIME_MAX ? TIME_MAX : timeCost; + foam->foamProg.time = timeCost; foamProgSetHasInlineInfo(foam); } From 63150354c76e7ad35990dcdd432357c5b8410466 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 24 Jun 2017 21:20:09 +0100 Subject: [PATCH 173/352] absyn.c: New abNewDefineLhs -- creates a lhs of a define from parsed form eg. Foo(X: Y)(A: I), sym=foo, params = (X: Y, A: I) --- aldor/aldor/src/absyn.c | 16 ++++++++++++++++ aldor/aldor/src/absyn.h | 5 ++++- 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/absyn.c b/aldor/aldor/src/absyn.c index aef1cfbba..92c9d228a 100644 --- a/aldor/aldor/src/absyn.c +++ b/aldor/aldor/src/absyn.c @@ -1095,6 +1095,22 @@ abCopyApplyArg(AbSyn ab) return ab; } +AbSyn +abNewDefineLhs(Symbol sym, AbSynList params) +{ + AbSynList pl, revParams; + AbSyn abd; + + abd = abNewId(sposNone, sym); + revParams = listReverse(AbSyn)(params); + for (pl = revParams; pl; pl = cdr(pl)) + abd = abNewApplyOfComma(abd, car(pl)); + listFree(AbSyn)(revParams); + + return abd; +} + + /* * Return a singleton, otherwise alloc node and fill. */ diff --git a/aldor/aldor/src/absyn.h b/aldor/aldor/src/absyn.h index 66ab7f65b..9c566df94 100644 --- a/aldor/aldor/src/absyn.h +++ b/aldor/aldor/src/absyn.h @@ -1123,7 +1123,10 @@ extern AbSyn abOneOrNewOfList (AbSynTag t, AbSynList args); /* * Return a singleton or make a node from a list of many parts. */ - +extern AbSyn abNewDefineLhs (Symbol sym, AbSynList params); + /* + * Return a new form for the define lhs (eg Foo(X: I)(Y: I)) + */ extern AbSyn abNewDocTextOfList (TokenList); /* * Construct a document text node from a list of doc tokens. From e9ba41d3106a7b782a53ba492b3eafe31769716b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 24 Jun 2017 21:20:54 +0100 Subject: [PATCH 174/352] tinfer.c: Use abNewDefineLHS - no other changes, just a cleanup --- aldor/aldor/src/tinfer.c | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/aldor/aldor/src/tinfer.c b/aldor/aldor/src/tinfer.c index 987a3e603..9372200d7 100644 --- a/aldor/aldor/src/tinfer.c +++ b/aldor/aldor/src/tinfer.c @@ -1614,11 +1614,7 @@ tiTfThird1(Stab stab, TFormUses tfu, TForm tf, AbSynList params) AbSynList pl; Stab nstab = (abStab(abw) ? abStab(abw) : stab); - abd = abNewId(sposNone, sym); - params = listNReverse(AbSyn)(params); - for (pl = params; pl; pl = cdr(pl)) - abd = abNewApplyOfComma(abd, car(pl)); - params = listNReverse(AbSyn)(params); + abd = abNewDefineLhs(sym, params); tfd = tiGetTForm(stab, abd); pp = symeNewExport(ssymSelfSelf, tfd, car(nstab)); symeSetDefault(pp); @@ -1735,11 +1731,7 @@ tiTfCategory1(Stab stab, TFormUses tfu, TForm tf, AbSynList params) if (asyme) { Stab istab = (params ? stab : nstab); - abd = abNewId(sposNone, sym); - params = listNReverse(AbSyn)(params); - for (pl = params; pl; pl = cdr(pl)) - abd = abNewApplyOfComma(abd, car(pl)); - params = listNReverse(AbSyn)(params); + abd = abNewDefineLhs(sym, params); tfd = tfSyntaxFrAbSyn(istab, abd); tfd = tfDefineOfType(tfd); xsyme = stabDefExtend(nstab, ssymSelf, tfd); From 3b43b7611d86a369da010a34afc827ea7b935ea8 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 31 Dec 2017 15:51:16 +0000 Subject: [PATCH 175/352] stab.c: clean formatting of some comments --- aldor/aldor/src/stab.h | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/aldor/aldor/src/stab.h b/aldor/aldor/src/stab.h index 07bae5afa..e43d8acbe 100644 --- a/aldor/aldor/src/stab.h +++ b/aldor/aldor/src/stab.h @@ -78,9 +78,9 @@ struct stabLevel { Table table; /* used for large lvls */ } tformsUsed; - TFormList tformsUnused; /* registered but unused */ - SymeList boundSymes; /* List of bound symes */ - SymeList extendSymes; /* List of extend symes */ + TFormList tformsUnused; /* registered but unused */ + SymeList boundSymes; /* List of bound symes */ + SymeList extendSymes; /* List of extend symes */ }; /****************************************************************************** From 39dd7b45ee0564fe36b7e9567f5e6120b1b9cb10 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 14 Aug 2017 20:22:51 +0100 Subject: [PATCH 176/352] sefo.c: Need to check free vars on substitution tforms --- aldor/aldor/src/sefo.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/aldor/src/sefo.c b/aldor/aldor/src/sefo.c index 6b0fc1d30..d2d02070c 100644 --- a/aldor/aldor/src/sefo.c +++ b/aldor/aldor/src/sefo.c @@ -2588,11 +2588,13 @@ tformFreeVars0(TForm *pa, TForm parent, TForm tf) if (tfIsSubst(tf) && tfFVars(tf) == NULL) { TForm arg = tfSubstArg(tf); + if (sstTFormIsMarked(arg)) { *pa = sfvCommonAncestor(*pa, arg); return; } tformFreeVars(arg); + abSubFreeVars(tfSubstSigma(tf)); tfSetFVars(tf, freeVarSubst0(tfSubstSigma(tf), tfFVars(arg))); sefoFreeDEBUG(dbOut, "FV(subst) %pTForm = %pFreeVar\n", tf, tf->fv); From 304a5cc3ad3eca7820667215cf78a1dd3228a8c8 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 14 Aug 2017 20:23:24 +0100 Subject: [PATCH 177/352] terror.c: Remove a blank line to make error output more parsable. --- aldor/aldor/src/terror.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/terror.c b/aldor/aldor/src/terror.c index 360065bd7..c9b094c36 100644 --- a/aldor/aldor/src/terror.c +++ b/aldor/aldor/src/terror.c @@ -1612,7 +1612,7 @@ bputBadArgType0(TRejectInfo trInfo, Stab stab, Buffer obuf, AbSyn ab, AbSyn op, } else bufPrintf(obuf, fmt, argN+1, fmtOp); - bufPrintf(obuf, "\n"); + /*bufPrintf(obuf, "\n");*/ if (comsgOkDetails()) { abArgi = argf(ab, trArgN(trFirst(trInfo))); From 054ab0e37a4712bbec9a59bba69ec4bce6c979f8 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 14 Aug 2017 20:23:48 +0100 Subject: [PATCH 178/352] tform.c: Note a few things - this is really a todo list before the next release --- aldor/aldor/src/tform.c | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 8a5b94112..348d5e7b4 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -1,3 +1,21 @@ +/* Some issues: +1. Rep == Record(c: Cross(T: TFormSubType, T)) + + import from Rep + anyTForm(T: TFormSubType, t: T): % == per [pair(T, t)] + + local unwrap(atf: %): (T: TFormSubType, t: T) == + pp: Cross(T: TFormSubType, t: T) == rep(atf).c + pp + + local pair(T: TFormSubType, t: T): (T1: TFormSubType, t: T1) == (T, t) + + -- local functions aren't needed + +2. Rep == Foo -> Bar + maps are not equal to defined constants +*/ + /***************************************************************************** * * tform.c: Type forms. From a8bb9e957a6938f4c83c73ee53f5b134a8fa79e5 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 26 Aug 2017 17:21:50 +0100 Subject: [PATCH 179/352] javaobj.c: Consistent variable names --- aldor/aldor/src/java/javaobj.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/aldor/aldor/src/java/javaobj.c b/aldor/aldor/src/java/javaobj.c index abcce3214..7a2a6eb85 100644 --- a/aldor/aldor/src/java/javaobj.c +++ b/aldor/aldor/src/java/javaobj.c @@ -10,16 +10,16 @@ local void jco0Indent(JavaCodePContext ctxt); JavaCode jcoNewNode(JavaCodeClass clss, int argc) { - JavaCode jc = (JavaCode) (stoAlloc( (int) OB_JCode, + JavaCode jco = (JavaCode) (stoAlloc( (int) OB_JCode, fullsizeof(struct jcoNode, argc, JavaCode))); assert(clss); - jcoTag(jc) = JCO_JAVA; - jcoClass(jc) = clss; - jcoPos(jc) = sposNone; - jc->node.argc = argc; + jcoTag(jco) = JCO_JAVA; + jcoClass(jco) = clss; + jcoPos(jco) = sposNone; + jco->node.argc = argc; - return jc; + return jco; } JavaCode From 5f4e834f6728189c89c754cf07a384c6296e7b62 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 26 Aug 2017 17:22:04 +0100 Subject: [PATCH 180/352] javaobj.c: Whitespace fix. --- aldor/aldor/src/java/javaobj.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/java/javaobj.c b/aldor/aldor/src/java/javaobj.c index 7a2a6eb85..3b18bb496 100644 --- a/aldor/aldor/src/java/javaobj.c +++ b/aldor/aldor/src/java/javaobj.c @@ -54,7 +54,7 @@ jcoNewLiteral(JavaCodeClass clss, String txt) } -JavaCode +JavaCode jcoNewImport(JavaCodeClass clss, String pkg, String name, Bool isImported) { JavaCode jco; From c30a7acd94c2fc9b3ca4309d1db98e9c0c530eb1 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 26 Aug 2017 17:23:55 +0100 Subject: [PATCH 181/352] javacode.c: Add jcPackage, jcImport --- aldor/aldor/src/java/javacode.c | 16 ++++++++++++++++ aldor/aldor/src/java/javacode.h | 3 +++ 2 files changed, 19 insertions(+) diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index 1d0e168a2..ac9e7e919 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -1330,6 +1330,22 @@ jcCasePrint(JavaCodePContext ctxt, JavaCode code) jcoPContextWrite(ctxt, ": "); } +/* + * :: Import, Package + */ + +JavaCode +jcImport(JavaCode arg) +{ + return jcSpaceSeqV(2, jcKeyword(symInternConst("import")), arg); +} + +JavaCode +jcPackage(JavaCode arg) +{ + return jcSpaceSeqV(2, jcKeyword(symInternConst("package")), arg); +} + /* * :: Throw, catch */ diff --git a/aldor/aldor/src/java/javacode.h b/aldor/aldor/src/java/javacode.h index a0007305c..e4e570055 100644 --- a/aldor/aldor/src/java/javacode.h +++ b/aldor/aldor/src/java/javacode.h @@ -99,6 +99,9 @@ extern JavaCode jcReturnVoid(); extern JavaCode jcBreak(JavaCode label); extern JavaCode jcContinue(JavaCode label); +extern JavaCode jcPackage(JavaCode pkgName); +extern JavaCode jcImport(JavaCode type); + extern JavaCode jcBlock(JavaCode l); extern JavaCode jcBlockNoNL(JavaCode body); extern JavaCode jcIf(JavaCode test, JavaCode stmt); From 9abde177733b8a46cfe188ccc992f7034f36fbb8 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 26 Aug 2017 17:25:36 +0100 Subject: [PATCH 182/352] genjava.c: Use jcImport --- aldor/aldor/src/java/genjava.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index c8c201065..45a0d65ed 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -291,7 +291,7 @@ gj0CollectImports(JavaCode clss) JavaCodeList tmp = imps; while (tmp) { JavaCode id = car(tmp); - JavaCode stmt = jcStatement(jcSpaceSeqV(2, jcId(strCopy("import")), id)); + JavaCode stmt = jcStatement(jcImport(id));; ids = listCons(JavaCode)(stmt, ids); tmp = cdr(tmp); } From 5d412005478b7b6cbc369ee094f43ba7e574ca02 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 26 Aug 2017 17:26:31 +0100 Subject: [PATCH 183/352] genjava.c: Remove ';;' --- aldor/aldor/src/java/genjava.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index 45a0d65ed..553bb8e1d 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -2572,7 +2572,7 @@ local JavaCode gj0EInfo(Foam foam) { JavaCode stmt; - Foam env = foam->foamEInfo.env;; + Foam env = foam->foamEInfo.env; stmt = jcApplyMethodV(gj0Gen(env), jcId(strCopy("getInfo")), @@ -2584,7 +2584,7 @@ local JavaCode gj0EInfoSet(Foam foam, Foam rhs) { JavaCode stmt; - Foam env = foam->foamEInfo.env;; + Foam env = foam->foamEInfo.env; stmt = jcApplyMethodV(gj0Gen(env), jcId(strCopy("setInfo")), From 6e77575b803c2e3a857a090ef50258e4430e40a6 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 30 Sep 2017 17:15:51 +0100 Subject: [PATCH 184/352] gf_fortran.c: Remove ';;' --- aldor/aldor/src/gf_fortran.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/gf_fortran.c b/aldor/aldor/src/gf_fortran.c index b4168b161..420510f12 100644 --- a/aldor/aldor/src/gf_fortran.c +++ b/aldor/aldor/src/gf_fortran.c @@ -1248,7 +1248,7 @@ gen0ReadPointerTo(FoamTag tag, Foam foam) case FOAM_SFlo: return gen0ReadFloatRecValue(tmpfoam); case FOAM_DFlo: - return gen0DoubleValue(tmpfoam);; + return gen0DoubleValue(tmpfoam); default: return tmpfoam; } @@ -1273,7 +1273,7 @@ gen0WritePointerTo(FoamTag tag, Foam dst, Foam foam) case FOAM_SFlo: return gen0WriteFloatRecValue(dst, tmpfoam); case FOAM_DFlo: - return gen0WriteDoubleValue(dst, tmpfoam);; + return gen0WriteDoubleValue(dst, tmpfoam); default: return dst; } From 8a376c6c568c57de6b4c1e9f087f067bcab98b34 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 30 Sep 2017 17:16:05 +0100 Subject: [PATCH 185/352] store.c: Remove ';;' --- aldor/aldor/src/store.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/store.c b/aldor/aldor/src/store.c index 23883b243..6c65341f4 100644 --- a/aldor/aldor/src/store.c +++ b/aldor/aldor/src/store.c @@ -830,7 +830,7 @@ pgmapExtend(Length count, PgKind kind) PgInfo *oend; Length i; - if (!pgmapNeed(pgMapSize + count)) return 0;; + if (!pgmapNeed(pgMapSize + count)) return 0; oend = pgMap + pgMapSize; From 5fddda43f60da5dd1722ad03c60beca42704a789 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 26 Aug 2017 17:33:26 +0100 Subject: [PATCH 186/352] javacode.c: Reformat javadoc comment /* * Text */ Seems reasonable. --- aldor/aldor/src/java/javacode.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index ac9e7e919..a8c65f5e3 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -622,10 +622,10 @@ jcComment(String comment) local void jcJavaDocPrint(JavaCodePContext ctxt, JavaCode code) { - String s = strReplace(jcoLiteral(code), "\n", "\n *"); - jcoPContextWrite(ctxt, "/** "); + String s = strReplace(jcoLiteral(code), "\n", "\n * "); + jcoPContextWrite(ctxt, "/**\n * "); jcoPContextWrite(ctxt, s); - jcoPContextWrite(ctxt, "*/"); + jcoPContextWrite(ctxt, "\n */"); strFree(s); } From af09717e7fe5908765564bd6f29b41ba4a27e374 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 26 Aug 2017 18:29:51 +0100 Subject: [PATCH 187/352] javacode.c: Add functions to convert ids to strings --- aldor/aldor/src/java/javacode.c | 19 +++++++++++++++++++ aldor/aldor/src/java/javacode.h | 4 ++++ 2 files changed, 23 insertions(+) diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index a8c65f5e3..419582e0d 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -666,6 +666,19 @@ jcImportedStaticId(String pkg, String name) return jcoNewImport(jc0ClassObj(JCO_CLSS_ImportedStatic), pkg, name, false); } +String +jcImportedIdName(JavaCode id) +{ + return jcoImportId(id); +} + +String +jcImportedIdPkg(JavaCode id) +{ + return jcoImportPkg(id); +} + + local void jcImportPrint(JavaCodePContext ctxt, JavaCode code) { @@ -853,6 +866,12 @@ jcId(String name) return jcoNewLiteral(jc0ClassObj(JCO_CLSS_Id), name); } +String +jcIdName(JavaCode id) +{ + return jcoLiteral(id); +} + local SExpr jcIdSExpr(JavaCode code) { diff --git a/aldor/aldor/src/java/javacode.h b/aldor/aldor/src/java/javacode.h index e4e570055..43a622d5a 100644 --- a/aldor/aldor/src/java/javacode.h +++ b/aldor/aldor/src/java/javacode.h @@ -157,5 +157,9 @@ extern SExpr jcNodeSExpr(JavaCode code); extern void jcNodePrint(JavaCodePContext ctxt, JavaCode code); extern Bool jcIsLegalClassName(String word); +extern String jcImportedIdName(JavaCode); +extern String jcImportedIdPkg(JavaCode); + +extern String jcIdName(JavaCode); #endif From 0d0f788c3ffeffd65c2b6f0ba48726747bca6248 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 26 Aug 2017 20:13:45 +0100 Subject: [PATCH 188/352] gf_java: Rename java conversion functions - to/fromJava seem better --- aldor/aldor/lib/libfoamlib/al/bool.as | 8 ++++---- aldor/aldor/lib/libfoamlib/al/sinteger.as | 8 ++++---- aldor/aldor/src/gf_java.c | 8 ++++---- aldor/aldor/src/spesym.c | 8 ++++---- aldor/aldor/src/spesym.h | 4 ++-- aldor/aldor/src/tform.c | 8 ++++---- 6 files changed, 22 insertions(+), 22 deletions(-) diff --git a/aldor/aldor/lib/libfoamlib/al/bool.as b/aldor/aldor/lib/libfoamlib/al/bool.as index 506871d69..75e0e6fa4 100644 --- a/aldor/aldor/lib/libfoamlib/al/bool.as +++ b/aldor/aldor/lib/libfoamlib/al/bool.as @@ -23,8 +23,8 @@ extend Boolean: Join( false: %; ++ false is the constant representing logical falsity. true: %; ++ true is the constant representing logical truth. - java: % -> BBool; - avaj: BBool -> %; + toJava: % -> BBool; + fromJava: BBool -> %; } == add { @@ -54,8 +54,8 @@ extend Boolean: Join( max(a: %, b: %): % == a \/ b; min(a: %, b: %): % == a /\ b; - java(i: %): BBool == rep i; - avaj(i: BBool): % == per i; + toJava(i: %): BBool == rep i; + fromJava(i: BBool): % == per i; test(b: %): Boolean == b; diff --git a/aldor/aldor/lib/libfoamlib/al/sinteger.as b/aldor/aldor/lib/libfoamlib/al/sinteger.as index 96f8df6c4..de77c04e9 100644 --- a/aldor/aldor/lib/libfoamlib/al/sinteger.as +++ b/aldor/aldor/lib/libfoamlib/al/sinteger.as @@ -27,8 +27,8 @@ extend SingleInteger: Join( mod_/: (%,%,%)-> %; mod_^: (%,%,%)-> %; - java: % -> BSInt; - avaj: BSInt -> %; + toJava: % -> BSInt; + fromJava: BSInt -> %; coerce: % -> String; export from Segment %; @@ -48,8 +48,8 @@ extend SingleInteger: Join( #: Integer == (convert rep max - convert rep min + 1)::Integer; - java(i: %): BSInt == rep i; - avaj(i: BSInt): % == per i; + toJava(i: %): BSInt == rep i; + fromJava(i: BSInt): % == per i; integer (l:Literal): % == per convert (l pretend BArr); zero? (i: %): Boolean == zero? (rep i)::Boolean; diff --git a/aldor/aldor/src/gf_java.c b/aldor/aldor/src/gf_java.c index be7db670c..baf3a2f8d 100644 --- a/aldor/aldor/src/gf_java.c +++ b/aldor/aldor/src/gf_java.c @@ -262,7 +262,7 @@ gfjProgAddParams(TForm tf) * :: Java representation * * Java objects are represented as Foam Arrays - these become Object in java. - * Aldor types used in Java imports are assumed to have java and ajav methods + * Aldor types used in Java imports are assumed to have toJava and fromJava methods * which convert to and from java respectively. */ local FoamTag @@ -272,7 +272,7 @@ gfjPCallFoamType(TForm tf) return FOAM_Arr; } else { - Syme javaToSelf = tfGetDomImport(tf, symString(ssymTheJavaDecoder), + Syme javaToSelf = tfGetDomImport(tf, symString(ssymTheFromJava), tfIsJavaDecoder); TForm convTf = symeType(javaToSelf); tfFollow(convTf); @@ -289,7 +289,7 @@ gfjPCallFoamToJava(TForm tf, Foam foam) } else { Syme selfToJava = tfGetDomImport(tf, - symString(ssymTheJava), + symString(ssymTheToJava), tfIsJavaEncoder); FoamTag type = gen0Type(tfMapRetN(symeType(selfToJava), 0), NULL); Foam call; @@ -308,7 +308,7 @@ gfjPCallJavaToFoam(TForm tf, Foam foam) } else { Syme javaToSelf = tfGetDomImport(tf, - symString(ssymTheJavaDecoder), + symString(ssymTheFromJava), tfIsJavaDecoder); Foam call; call = gen0ExtendSyme(javaToSelf); diff --git a/aldor/aldor/src/spesym.c b/aldor/aldor/src/spesym.c index 9fa408691..552f657ea 100644 --- a/aldor/aldor/src/spesym.c +++ b/aldor/aldor/src/spesym.c @@ -74,8 +74,8 @@ Symbol ssymArrow, ssymTheExplode, ssymTheFloat, ssymTheInteger, - ssymTheJava, - ssymTheJavaDecoder, + ssymTheToJava, + ssymTheFromJava, ssymTheGenerator, ssymTheStdout, ssymTheNew, @@ -214,8 +214,8 @@ ssymInit(void) ssymTheExplode = symIntern("explode"); ssymTheFloat = symIntern("float"); ssymTheInteger = symIntern("integer"); - ssymTheJava = symIntern("java"); - ssymTheJavaDecoder= symIntern("avaj"); + ssymTheToJava = symIntern("toJava"); + ssymTheFromJava = symIntern("fromJava"); ssymTheGenerator = symIntern("generator"); ssymTheNew = symIntern("new"); ssymTheRawRecord = symIntern("rawrecord"); diff --git a/aldor/aldor/src/spesym.h b/aldor/aldor/src/spesym.h index d9717f284..13d2c27f7 100644 --- a/aldor/aldor/src/spesym.h +++ b/aldor/aldor/src/spesym.h @@ -82,8 +82,8 @@ extern Symbol ssymArrow, ssymTheFloat, ssymTheGenerator, ssymTheInteger, - ssymTheJava, - ssymTheJavaDecoder, + ssymTheToJava, + ssymTheFromJava, ssymTheNew, ssymTheRawRecord, ssymTheRecord, diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 348d5e7b4..66f94d811 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -8136,11 +8136,11 @@ tfJavaCheckArg(ErrorSet errors, TForm arg) if (tfIsJavaImport(arg)) return; - enc = tfGetDomExport(arg, symString(ssymTheJava), tfIsJavaEncoder); - dec = tfGetDomExport(arg, symString(ssymTheJavaDecoder), tfIsJavaDecoder); - errorSetPrintf(errors, dec != NULL, "The domain %s must export java: %% -> ?", + enc = tfGetDomExport(arg, symString(ssymTheToJava), tfIsJavaEncoder); + dec = tfGetDomExport(arg, symString(ssymTheFromJava), tfIsJavaDecoder); + errorSetPrintf(errors, dec != NULL, "The domain %s must export toJava: %% -> ?", abPretty(tfExpr(arg))); - errorSetPrintf(errors, enc != NULL, "The domain %s must export avaj: ? -> %%", + errorSetPrintf(errors, enc != NULL, "The domain %s must export fromJava: ? -> %%", abPretty(tfExpr(arg))); } From 60fe27724f912ac1717c23990f9d4c239063a7f9 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 26 Aug 2017 20:17:37 +0100 Subject: [PATCH 189/352] foam.c: Add DDecl tag for java classes --- aldor/aldor/src/foam.c | 1 + aldor/aldor/src/foam.h | 1 + 2 files changed, 2 insertions(+) diff --git a/aldor/aldor/src/foam.c b/aldor/aldor/src/foam.c index e46a191da..14db6a694 100644 --- a/aldor/aldor/src/foam.c +++ b/aldor/aldor/src/foam.c @@ -3662,6 +3662,7 @@ struct foamDDecl_info foamDDeclInfoTable[] = { { FOAM_DDecl_FortranSig, 0, "FortranSig" }, { FOAM_DDecl_CSig, 0, "CSig" }, { FOAM_DDecl_JavaSig, 0, "JavaSig" }, + { FOAM_DDecl_JavaClass, 0, "JavaClass" }, }; /***************************************************************************** diff --git a/aldor/aldor/src/foam.h b/aldor/aldor/src/foam.h index 833537da3..ea845cb46 100644 --- a/aldor/aldor/src/foam.h +++ b/aldor/aldor/src/foam.h @@ -467,6 +467,7 @@ enum foamDDeclTag { FOAM_DDecl_FortranSig, FOAM_DDecl_CSig, FOAM_DDecl_JavaSig, + FOAM_DDecl_JavaClass, FOAM_DDECL_LIMIT }; From 77becfa0ba66a75fdba54facbc0900849341a04a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 5 Sep 2017 19:55:27 +0100 Subject: [PATCH 190/352] java: Whitespace, comments cleanup --- aldor/aldor/lib/java/src/foamj/AbstractValue.java | 2 +- aldor/aldor/lib/java/src/foamj/FoamJ.java | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/aldor/aldor/lib/java/src/foamj/AbstractValue.java b/aldor/aldor/lib/java/src/foamj/AbstractValue.java index 236dd6512..11845a069 100644 --- a/aldor/aldor/lib/java/src/foamj/AbstractValue.java +++ b/aldor/aldor/lib/java/src/foamj/AbstractValue.java @@ -62,4 +62,4 @@ public Env toEnv() { public byte toByte() { throw new CastException(this); } -} \ No newline at end of file +} diff --git a/aldor/aldor/lib/java/src/foamj/FoamJ.java b/aldor/aldor/lib/java/src/foamj/FoamJ.java index a6a9bfcdc..df5486ac2 100644 --- a/aldor/aldor/lib/java/src/foamj/FoamJ.java +++ b/aldor/aldor/lib/java/src/foamj/FoamJ.java @@ -6,8 +6,6 @@ public class FoamJ { /** * Array type - rely on casting to retract to base type - * - * @author pab */ static class Array extends AbstractValue implements Value, Word { private Object arr; From 100a79cdf0fa3b42488ecd111ec96200fd38de77 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 5 Sep 2017 20:00:25 +0100 Subject: [PATCH 191/352] aldor/test: Makefile verbose rules incorrect. Off by an underscore.. --- aldor/aldor/test/Makefile.in | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 9906de123..327a68c7e 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -48,8 +48,8 @@ AM_V_JAVAC = $(am__v_JAVAC_$(V)) am__v_JAVAC_ = $(am__v_JAVAC_$(AM_DEFAULT_VERBOSITY)) am__v_JAVAC_0 = @echo " JAVAC " $@; -AM_V_ALDOR_JAVATEST = $(am__v_ALDOR_JAVATEST_$(V)) -am__v_ALDOR_JAVATEST = $(am__v_ALDOR_JAVATEST_$(AM_DEFAULT_VERBOSITY)) +AM_V_ALDOR_JAVATEST = $(am__v_ALDOR_JAVATEST_$(V)) +am__v_ALDOR_JAVATEST_ = $(am__v_ALDOR_JAVATEST_$(AM_DEFAULT_VERBOSITY)) am__v_ALDOR_JAVATEST_0 = @echo " ALDOR-JAVATEST " $@; all: really-all From 3d0a31fd2157fc7d9064a3c5f227d4f7a1a5f5e7 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 9 Sep 2017 16:13:30 +0100 Subject: [PATCH 192/352] lib/java: Add Java object for use by Foam. --- .../lib/java/src/foamj/AbstractValue.java | 4 +++ aldor/aldor/lib/java/src/foamj/FoamJ.java | 29 +++++++++++++++++++ aldor/aldor/lib/java/src/foamj/Word.java | 13 +++++++++ 3 files changed, 46 insertions(+) diff --git a/aldor/aldor/lib/java/src/foamj/AbstractValue.java b/aldor/aldor/lib/java/src/foamj/AbstractValue.java index 11845a069..ecde637fb 100644 --- a/aldor/aldor/lib/java/src/foamj/AbstractValue.java +++ b/aldor/aldor/lib/java/src/foamj/AbstractValue.java @@ -31,6 +31,10 @@ public Object toArray() { throw new CastException(this); } + public T toJavaObj() { + throw new CastException(this); + } + public Record toRecord() { throw new CastException(this); } diff --git a/aldor/aldor/lib/java/src/foamj/FoamJ.java b/aldor/aldor/lib/java/src/foamj/FoamJ.java index df5486ac2..53042481e 100644 --- a/aldor/aldor/lib/java/src/foamj/FoamJ.java +++ b/aldor/aldor/lib/java/src/foamj/FoamJ.java @@ -33,6 +33,35 @@ public String toString() { } + /** + * JavaObj type - rely on casting to retract to base type + */ + static public class JavaObj extends AbstractValue implements Value, Word { + private T obj; + + JavaObj(T obj) { + this.obj = obj; + } + + public T toJavaObj() { + return obj; + } + + @Override + public Value toValue() { + return this; + } + + public Word asWord() { + return this; + } + + public String toString() { + return obj.toString(); + } + + } + /** * a. * T1 = (Add (Cast SInt x) 1) diff --git a/aldor/aldor/lib/java/src/foamj/Word.java b/aldor/aldor/lib/java/src/foamj/Word.java index f905a1b5b..2ef1ade71 100644 --- a/aldor/aldor/lib/java/src/foamj/Word.java +++ b/aldor/aldor/lib/java/src/foamj/Word.java @@ -19,6 +19,8 @@ public interface Word { Object toArray(); + T toJavaObj(); + char toChar(); float toSFlo(); @@ -40,6 +42,13 @@ static public Object toArray(Word word) { return word.toArray(); } + static public T toJavaObj(Word word) { + if (word == null) + return null; + else + return word.toJavaObj(); + } + public static Word fromSInt(int x) { return new SInt(x); } @@ -56,6 +65,10 @@ public static Word fromArray(Object x) { return new Array(x); } + public static Word fromJavaObj(T t) { + return new JavaObj(t); + } + public static Word fromBool(boolean b) { return new Bool(b); } From 4bc0e034e1142b446e84ebf27da6c648e76acbfc Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 9 Sep 2017 18:02:31 +0100 Subject: [PATCH 193/352] java: Add Aldor string to Java string conversion --- aldor/aldor/lib/java/Makefile.am | 2 +- aldor/aldor/lib/java/src/foamj/Foam.java | 11 +++ aldor/aldor/lib/java/test/Makefile.in | 73 +++++++++++++++++++ aldor/aldor/lib/java/test/foamj/FoamTest.java | 15 ++++ aldor/configure.ac | 8 ++ aldor/m4/java-tests.m4 | 8 ++ 6 files changed, 116 insertions(+), 1 deletion(-) create mode 100644 aldor/aldor/lib/java/test/Makefile.in create mode 100644 aldor/aldor/lib/java/test/foamj/FoamTest.java create mode 100644 aldor/m4/java-tests.m4 diff --git a/aldor/aldor/lib/java/Makefile.am b/aldor/aldor/lib/java/Makefile.am index 1bfdcf486..94c452302 100644 --- a/aldor/aldor/lib/java/Makefile.am +++ b/aldor/aldor/lib/java/Makefile.am @@ -1 +1 @@ -SUBDIRS=src +SUBDIRS=src test diff --git a/aldor/aldor/lib/java/src/foamj/Foam.java b/aldor/aldor/lib/java/src/foamj/Foam.java index df61df524..13871750f 100644 --- a/aldor/aldor/lib/java/src/foamj/Foam.java +++ b/aldor/aldor/lib/java/src/foamj/Foam.java @@ -438,4 +438,15 @@ public static double atan2(double a, double b) { return Math.atan2(a, b); } + public static Word stringToJavaString(Word w) { + char[] arr = (char[]) w.toArray(); + return new FoamJ.JavaObj(new String(arr, 0, arr.length-1)); + } + + public static Word javaStringToString(Word w) { + String s = (String) w.toJavaObj(); + Word arr = Word.U.fromArray(("" + s + "\0").toCharArray()); + return arr; + } + } diff --git a/aldor/aldor/lib/java/test/Makefile.in b/aldor/aldor/lib/java/test/Makefile.in new file mode 100644 index 000000000..a24153648 --- /dev/null +++ b/aldor/aldor/lib/java/test/Makefile.in @@ -0,0 +1,73 @@ +# ..From autoconf +@SET_MAKE@ + +VPATH = @srcdir@ +abs_top_builddir = @abs_top_builddir@ +srcdir = @srcdir@ +top_builddir = @top_builddir@ +builddir = @builddir@ +abs_builddir = @abs_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +subdir = aldor/lib/java/test +HAS_JUNIT = @HAS_JUNIT@ +JUNIT_JAR = @JUNIT_JAR@ + +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ '; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ ;; \ + esac; + +buildfiles := $(shell cd $(srcdir); find foamj -type f -name \*Test.java) +@HAS_JUNIT_TRUE@tests := $(patsubst %,test-%,$(subst /,.,$(subst .java,,$(buildfiles)))) + +outdir := $(abs_builddir)/classes +jarfile := $(abs_builddir)/foamj-test.jar + +.PHONY: $(tests) + +$(tests): test-%: $(jarfile) + java -cp $(jarfile):$(abs_builddir)/../src/foamj.jar:$(JUNIT_JAR) \ + org.junit.runner.JUnitCore $* + +test-junit: $(tests) +.PHONY: test-junit + +check: test-junit + +# Build directly to a .jar file (easier than tracking .class files) +$(jarfile): $(buildfiles) + mkdir -p $(outdir) + (cd $(srcdir); javac -cp $(abs_builddir)/../src/foamj.jar:$(JUNIT_JAR) -g -d $(outdir) $(buildfiles)) + (cd $(outdir); jar cf $@ .) + +all: + echo $< + +# +# :: Automake requires this little lot +# +mostlyclean: + rm -rf $(outdir) + rm -f $(jarfile) + +clean: mostlyclean + +distclean: clean + rm Makefile +maintainer-clean: distclean + + +EMPTY_AUTOMAKE_TARGETS = dvi pdf ps info html tags ctags +EMPTY_AUTOMAKE_TARGETS += install install-data install-exec uninstall +EMPTY_AUTOMAKE_TARGETS += install-dvi install-html install-info install-ps install-pdf +EMPTY_AUTOMAKE_TARGETS += installdirs +EMPTY_AUTOMAKE_TARGETS += check installcheck + +.PHONY: $(EMPTY_AUTOMAKE_TARGETS) +$(EMPTY_AUTOMAKE_TARGETS): + diff --git a/aldor/aldor/lib/java/test/foamj/FoamTest.java b/aldor/aldor/lib/java/test/foamj/FoamTest.java new file mode 100644 index 000000000..d589e0207 --- /dev/null +++ b/aldor/aldor/lib/java/test/foamj/FoamTest.java @@ -0,0 +1,15 @@ +package foamj; + +import org.junit.*; +import foamj.Word; + +public class FoamTest { + + @Test + public void testToJavaString() { + Word w = new FoamJ.JavaObj("hello"); + Word aldorString = Foam.javaStringToString(w); + Assert.assertEquals("hello", Foam.stringToJavaString(aldorString).toJavaObj()); + } + +} diff --git a/aldor/configure.ac b/aldor/configure.ac index 9917ce186..1166e747f 100644 --- a/aldor/configure.ac +++ b/aldor/configure.ac @@ -36,6 +36,10 @@ AC_ARG_ENABLE([java], [BUILD_JAVA=false], [BUILD_JAVA=true]) +AC_ARG_WITH([java-junit], + [AS_HELP_STRING([--with-java-junit], [specify location of junit jar file])], + [JUNIT_JAR=$withval], [JUNIT_JAR=/usr/share/java/junit4.jar]) + AM_CONDITIONAL(BUILD_JAVA, test $JAVAC != no -a $BUILD_JAVA = true) AC_ARG_WITH([boehm-gc], @@ -58,6 +62,8 @@ AC_SUBST([LIBTOOL_DEPS]) # Enable extra warnings and -Werror if supported. ALDOR_ERROR_ON_WARN +ALDOR_JAVA_TESTS + ALDOR_GIT_BUILD_ID # Generate Makefiles @@ -70,12 +76,14 @@ AC_CONFIG_FILES( aldor/src/Makefile aldor/src/opsys_port.h aldor/lib/Makefile + aldor/lib/libfoamlib/Makefile aldor/lib/libfoamlib/al/Makefile aldor/lib/libfoam/Makefile aldor/lib/libfoam/al/Makefile aldor/lib/java/Makefile aldor/lib/java/src/Makefile + aldor/lib/java/test/Makefile aldor/test/Makefile aldor/tools/Makefile aldor/tools/unix/Makefile diff --git a/aldor/m4/java-tests.m4 b/aldor/m4/java-tests.m4 new file mode 100644 index 000000000..c1c981770 --- /dev/null +++ b/aldor/m4/java-tests.m4 @@ -0,0 +1,8 @@ +# Find junit library, and if it exists, set JUNIT_JAR to its location +AC_DEFUN([ALDOR_JAVA_TESTS], +[AC_CHECK_FILE([$JUNIT_JAR], + [HAS_JUNIT=yes], [HAS_JUNIT=no]) +AC_SUBST([JUNIT_JAR]) +AC_SUBST([HAS_JUNIT]) +AM_CONDITIONAL(HAS_JUNIT, test $BUILD_JAVA = true -a $HAS_JUNIT != no) +]) From b252eeb6d5651db9fc31766583347ed9f50f3a9a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 9 Sep 2017 18:03:53 +0100 Subject: [PATCH 194/352] javaobj.c: jcoNewImport: Add assertions for non-null arguments --- aldor/aldor/src/java/javaobj.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/aldor/aldor/src/java/javaobj.c b/aldor/aldor/src/java/javaobj.c index 3b18bb496..f0294a014 100644 --- a/aldor/aldor/src/java/javaobj.c +++ b/aldor/aldor/src/java/javaobj.c @@ -58,6 +58,9 @@ JavaCode jcoNewImport(JavaCodeClass clss, String pkg, String name, Bool isImported) { JavaCode jco; + assert(pkg != NULL); + assert(name != NULL); + jco = (JavaCode) stoAlloc((int) OB_JCode, sizeof(struct jcoImport)); assert(clss && pkg && name); From 49bd89be98f0dd04c5167adc67e5d288aa967e2c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 9 Sep 2017 20:12:50 +0100 Subject: [PATCH 195/352] src/java: Add FOAM_JavaObj so we can represent java objects in foam code. --- aldor/aldor/src/foam.c | 5 +++ aldor/aldor/src/foam.h | 1 + aldor/aldor/src/gf_java.c | 49 ++++++++++++++++++++++------- aldor/aldor/src/java/genjava.c | 55 +++++++++++++++++++++++---------- aldor/aldor/src/java/javacode.c | 14 +++++++++ aldor/aldor/src/java/javacode.h | 1 + aldor/aldor/src/of_deadv.c | 44 ++++++++++++++++++++++++++ aldor/aldor/src/of_util.c | 1 + 8 files changed, 142 insertions(+), 28 deletions(-) diff --git a/aldor/aldor/src/foam.c b/aldor/aldor/src/foam.c index 14db6a694..48a7a4459 100644 --- a/aldor/aldor/src/foam.c +++ b/aldor/aldor/src/foam.c @@ -1070,6 +1070,10 @@ foamAuditDecl(Foam decl) if (fmt >= FOAM_DATA_LIMIT && fmt != FOAM_BInt) foamAuditBadDecl(decl); break; + case FOAM_JavaObj: + if (fmt >= faNumFormats) + foamAuditBadDecl(decl); + break; case FOAM_Rec: /* TODO: Fix implicit exports so that they don't @@ -3571,6 +3575,7 @@ struct foam_info foamInfoTable[] = { {FOAM_PopEnv, 0,"PopEnv", 0, "", 0}, {FOAM_MFmt, 0,"MFmt", 2, "iC", 0}, {FOAM_RRFmt, 0,"RRFmt", 1, "C", 0}, + {FOAM_JavaObj, 0,"JavaObj", 0, "", 0}, /* ========> FFO_ORIGIN (start of multi-format instructions) <======== */ diff --git a/aldor/aldor/src/foam.h b/aldor/aldor/src/foam.h index ea845cb46..3dcfa792e 100644 --- a/aldor/aldor/src/foam.h +++ b/aldor/aldor/src/foam.h @@ -74,6 +74,7 @@ enum foamTag { FOAM_PopEnv, FOAM_MFmt, /* Indicate multiple values */ FOAM_RRFmt, /* Raw record (dynamic) format */ + FOAM_JavaObj, /* Java things */ FOAM_CONTROL_LIMIT, diff --git a/aldor/aldor/src/gf_java.c b/aldor/aldor/src/gf_java.c index baf3a2f8d..7b4338ee4 100644 --- a/aldor/aldor/src/gf_java.c +++ b/aldor/aldor/src/gf_java.c @@ -16,12 +16,14 @@ local Foam gfjImportConstructor(Syme syme); local Foam gfjImportStaticCall(Syme syme); local FoamList gfjProgAddParams(TForm tf); -local FoamTag gfjPCallFoamType(TForm tf); +local FoamTag gfjPCallFoamType(TForm tf, AInt *pfmt); local Foam gfjPCallFoamToJava(TForm tf, Foam foam); local Foam gfjPCallJavaToFoam(TForm tf, Foam foam); local AInt gfjPCallDecl(TForm tf, Bool); local Foam gfjPCallDeclArg(TForm tf); +local AInt gj0ClassDDecl(ForeignOrigin origin, String clsName); + void gfjInit() { @@ -97,6 +99,7 @@ gfjImportApplyInner(Syme syme, AInt fmtNum) FoamTag retType; String fnName, globName; AInt gnum, constnum; + AInt clsFmt; constnum = gen0NumProgs; @@ -105,6 +108,8 @@ gfjImportApplyInner(Syme syme, AInt fmtNum) forg = symeForeign(esyme); innerTf = tfMapRet(symeType(syme)); + clsFmt = gj0ClassDDecl(forg, symeString(esyme)); + globName = (forg->file ? strPrintf("%s.%s.%s", forg->file, symeString(esyme), symeJavaApplyName(syme)) : strPrintf("%s.%s", symeString(esyme), symeJavaApplyName(syme))); @@ -116,8 +121,8 @@ gfjImportApplyInner(Syme syme, AInt fmtNum) prog = gen0ProgInitEmpty(fnName, NULL); saved = gen0ProgSaveState(PT_ExFn); - temp = gen0TempLocal0(FOAM_Arr, int0); - gen0AddStmt(foamNewDef(foamCopy(temp), foamNewCast(FOAM_Arr, foamNewLex(1, int0))), NULL); + temp = gen0TempLocal0(FOAM_JavaObj, clsFmt); + gen0AddStmt(foamNewDef(foamCopy(temp), foamNewCast(FOAM_JavaObj, foamNewLex(1, int0))), NULL); params = gfjProgAddParams(innerTf); params = listCons(Foam)(foamCopy(temp), params); @@ -133,7 +138,7 @@ gfjImportApplyInner(Syme syme, AInt fmtNum) else { Foam retval; pcall = foamNewPCallOfList(FOAM_Proto_JavaMethod, - gfjPCallFoamType(tfMapRet(innerTf)), + gfjPCallFoamType(tfMapRet(innerTf), NULL), op, params); retval = gfjPCallJavaToFoam(tfMapRet(innerTf), pcall); gen0AddLexLevels(retval, 2); @@ -181,7 +186,7 @@ gfjImportConstructor(Syme syme) params = gfjProgAddParams(symeType(syme)); pcall = foamNewPCallOfList(FOAM_Proto_JavaConstructor, - gfjPCallFoamType(exporter), + gfjPCallFoamType(exporter, NULL), foamNewGlo(gnum), params); gen0AddLexLevels(pcall, 1); @@ -214,9 +219,14 @@ gfjImportStaticCall(Syme syme) forg = symeForeign(esyme); fnName = strCopy(symeString(syme)); - globName = strPrintf("%s.%s.%s", forg->file, + globName = forg->file == NULL + ? strPrintf("%s.%s", + symString(tfIdSym(exporter)), + symeString(syme)) + : strPrintf("%s.%s.%s", forg->file, symString(tfIdSym(exporter)), symeString(syme)); + constNum = gen0NumProgs; gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(symeType(syme), false), @@ -227,7 +237,7 @@ gfjImportStaticCall(Syme syme) saved = gen0ProgSaveState(PT_ExFn); params = gfjProgAddParams(symeType(syme)); - retType = gfjPCallFoamType(tfMapRet(symeType(syme))); + retType = gfjPCallFoamType(tfMapRet(symeType(syme)), NULL); pcall = foamNewPCallOfList(FOAM_Proto_Java, retType, foamNewGlo(gnum), params); @@ -261,22 +271,28 @@ gfjProgAddParams(TForm tf) /* * :: Java representation * - * Java objects are represented as Foam Arrays - these become Object in java. * Aldor types used in Java imports are assumed to have toJava and fromJava methods * which convert to and from java respectively. */ local FoamTag -gfjPCallFoamType(TForm tf) +gfjPCallFoamType(TForm tf, AInt *pfmt) { if (tfIsJavaImport(tf)) { - return FOAM_Arr; + if (pfmt != NULL) { + Syme syme = tfIdSyme(tf); + TForm exporter = symeExporter(syme); + Syme esyme = tfIdSyme(exporter); + ForeignOrigin forg = symeForeign(esyme); + *pfmt = gj0ClassDDecl(forg, symeString(esyme)); + } + return FOAM_JavaObj; } else { Syme javaToSelf = tfGetDomImport(tf, symString(ssymTheFromJava), tfIsJavaDecoder); TForm convTf = symeType(javaToSelf); tfFollow(convTf); - return gen0Type(tfMapArg(convTf), NULL); + return gen0Type(tfMapArg(convTf), pfmt); } } @@ -285,7 +301,7 @@ local Foam gfjPCallFoamToJava(TForm tf, Foam foam) { if (tfIsJavaImport(tf)) { - return foamNewCast(FOAM_Arr, foam); + return foamNewCast(FOAM_JavaObj, foam); } else { Syme selfToJava = tfGetDomImport(tf, @@ -362,3 +378,12 @@ gfjPCallDeclArg(TForm tf) return decl; } + +AInt +gj0ClassDDecl(ForeignOrigin origin, String clsName) +{ + String name = origin->file == NULL ? strCopy(clsName): strPrintf("%s.%s", origin->file, clsName); + Foam decl = foamNewDecl(FOAM_Word, name, int0); + + return gen0AddRealFormat(foamNewDDecl(FOAM_DDecl_JavaClass, decl, NULL)); +} diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index 553bb8e1d..a6b8d5855 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -157,6 +157,9 @@ local String gj0NameFrString(String fmName); local JavaCodeList gj0ClassHeader(String className); local String gj0InitVar(AInt idx); +local JavaCode gj0TypeFrJavaObj(Foam format); + + enum gjId { GJ_INVALID = -1, @@ -1138,12 +1141,24 @@ gj0TypeFrFmt(AInt id, AInt fmt) return gj0Id(GJ_Object); case FOAM_Values: return gj0Id(GJ_Multi); - + case FOAM_JavaObj: + if (fmt != 0 && fmt != emptyFormatSlot) + return gj0TypeFrJavaObj(gjContext->formats->foamDFmt.argv[fmt]); + else + return gj0Id(GJ_Object); default: return jcId(strCopy(foamStr(id))); } } +local JavaCode +gj0TypeFrJavaObj(Foam format) +{ + String txt = format->foamDDecl.argv[0]->foamDecl.id; + return jcImportedIdFrString(txt); +} + + local JavaCode gj0TypeValueToObj(JavaCode val, FoamTag type, AInt fmt) { @@ -1268,6 +1283,10 @@ gj0TypeObjToValue(JavaCode val, FoamTag type, AInt fmt) jcId(strCopy("U"))), jcId(strCopy("fromByte")), 1, val); + case FOAM_JavaObj: + return jcSpaceSeqV(2, + jcComment(strPrintf("asWord %d %d", type, fmt)), + val); case FOAM_Env: case FOAM_Clos: case FOAM_Rec: @@ -2971,7 +2990,7 @@ local JavaCode gj0CastObjToPtr(JavaCode jc, FoamTag type, AInt fmt); local JavaCode gj0Cast(Foam foam) { - return gj0CastFmt(foam, -1); + return gj0CastFmt(foam, emptyFormatSlot); } local JavaCode @@ -2992,7 +3011,7 @@ gj0CastFmt(Foam foam, AInt cfmt) return gj0CastObjToPtr(jc, iType, fmt); } else if (iType == FOAM_Word) { - return gj0CastWordToObj(jc, type, fmt); + return gj0CastWordToObj(jc, type, cfmt); } else if (iType == type) return jc; @@ -3042,7 +3061,13 @@ gj0CastWordToObj(JavaCode jc, FoamTag type, AInt fmt) case FOAM_Ptr: return jc; case FOAM_Arr: - return jcApplyV(jcMemRef(gj0Id(GJ_FoamWord), jcId(strCopy("U.toArray"))), 1, jc); + return jcApplyMethodV(jcMemRef(gj0Id(GJ_FoamWord), + jcId(strCopy("U"))), + jcId(strCopy("toArray")), 1, jc); + case FOAM_JavaObj: + return jcApplyMethodV(jcMemRef(gj0Id(GJ_FoamWord), + jcId(strCopy("U"))), + jcId(strCopy("toJavaObj")), 1, jc); default: return jcCast(gj0TypeFrFmt(type, fmt), jc); } @@ -3110,6 +3135,11 @@ gj0CastObjToWord(JavaCode val, FoamTag type, AInt fmt) jcId(strCopy("U"))), jcId(strCopy("fromDFlo")), listSingleton(JavaCode)(val)); + case FOAM_JavaObj: + return jcApplyMethod(jcMemRef(gj0Id(GJ_FoamWord), + jcId(strCopy("U"))), + jcId(strCopy("fromJavaObj")), + listSingleton(JavaCode)(val)); case FOAM_Nil: return val; default: @@ -3508,7 +3538,7 @@ gj0PCallJavaStatic(Foam foam) { JavaCodeList args; Foam decl, op; - String id, type, pkg; + String id, type; op = foam->foamPCall.op; @@ -3518,9 +3548,9 @@ gj0PCallJavaStatic(Foam foam) args = gj0GenList(foam->foamPCall.argv, foamPCallArgc(foam)); strSplitLast(strCopy(decl->foamGDecl.id), '.', &type, &id); - strSplitLast(type, '.', &pkg, &type); + JavaCode typeId = jcImportedIdFrString(type); - return jcApply(jcMemRef(jcImportedId(pkg, type), jcId(id)), + return jcApply(jcMemRef(typeId, jcId(id)), gj0PCallCastArgs(op, args)); } @@ -3661,15 +3691,8 @@ gj0BCallApply(Foam foam) inf = gj0BCallBValInfo(foam->foamBCall.op); args = gj0GenList(foam->foamBCall.argv, foamArgc(foam)-1); - p = strLastIndexOf(inf->c1, '.'); - if (p == NULL) - tgtClss = jcId(strCopy(inf->c1)); - else { - String pkg = strCopy(inf->c1); - String id = strCopy(p+1); - pkg[p-inf->c1] = '\0'; - tgtClss = jcImportedId(pkg, id); - } + tgtClss = jcImportedIdFrString(inf->c1); + return jcApplyMethod(tgtClss, jcId(strCopy(inf->c2)), args); } diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index 419582e0d..8e9c5e475 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -1664,3 +1664,17 @@ jcIsId(String word) return true; } + +JavaCode +jcImportedIdFrString(String str) +{ + String p = strLastIndexOf(str, '.'); + if (p == NULL) { + return jcId(strCopy(str)); + } + else { + String pkg = strnCopy(str, p - str); + String id = strCopy(p+1); + return jcImportedId(pkg, id); + } +} diff --git a/aldor/aldor/src/java/javacode.h b/aldor/aldor/src/java/javacode.h index 43a622d5a..6e8e9a885 100644 --- a/aldor/aldor/src/java/javacode.h +++ b/aldor/aldor/src/java/javacode.h @@ -159,6 +159,7 @@ extern void jcNodePrint(JavaCodePContext ctxt, JavaCode code); extern Bool jcIsLegalClassName(String word); extern String jcImportedIdName(JavaCode); extern String jcImportedIdPkg(JavaCode); +extern JavaCode jcImportedIdFrString(String str); extern String jcIdName(JavaCode); diff --git a/aldor/aldor/src/of_deadv.c b/aldor/aldor/src/of_deadv.c index 21ffcd2ad..a289024b4 100644 --- a/aldor/aldor/src/of_deadv.c +++ b/aldor/aldor/src/of_deadv.c @@ -75,6 +75,9 @@ local void dvElimUnusedFormats (Foam unit); local void dvRemoveNops (Foam ufoam); local void dvRemoveSeqNops (Foam seq); +local void dvMarkTypeFormats(Foam unit); +local void dvMarkType(Foam decl); + Bool dvChanged; DvUsage *dvFormatUsage; @@ -149,6 +152,7 @@ dvElim(Foam unit) dvChanged = false; dvSetupUnit(unit); dvMarkUnitUsage(unit); + dvMarkTypeFormats(unit); dvElimUnused(unit); count++; @@ -254,6 +258,7 @@ dvMakeUsageVec(Foam ddecl) * Top of recursive descent of the foam tree, starting at the file * initialization program. */ + local void dvMarkUnitUsage(Foam unit) { @@ -270,6 +275,45 @@ dvMarkUnitUsage(Foam unit) dvMarkExprUsage(dvDefs[i]); } +local void +dvMarkTypeFormats(Foam unit) +{ + int i, j; + for (i=0; ifoamUnit.formats); i++) { + Foam ddecl = unit->foamUnit.formats->foamDFmt.argv[i]; + for (j=0; jfoamDDecl.argv[j]); + } + } + + for (i=0; ifoamUnit.defs); i++) { + Foam prog = dvDefs[i]->foamDef.rhs; + Foam ddecl; + + if (foamTag(prog) != FOAM_Prog) continue; + if (foamOptInfo(prog)->dvState != DV_Checked) continue; + + ddecl = prog->foamProg.locals; + for (j=0; jfoamDDecl.argv[j]); + } + ddecl = prog->foamProg.params; + for (j=0; jfoamDDecl.argv[j]); + } + } +} + +local void +dvMarkType(Foam decl) +{ + int j; + if (decl->foamDecl.type == FOAM_JavaObj) { + dvMarkWholeFormat(decl->foamDecl.format); + } +} + /* * Mark the usages in a program. diff --git a/aldor/aldor/src/of_util.c b/aldor/aldor/src/of_util.c index 00b956019..ef881e6c0 100644 --- a/aldor/aldor/src/of_util.c +++ b/aldor/aldor/src/of_util.c @@ -393,6 +393,7 @@ fpClearFormats(Foam ddecl) decl->foamGDecl.format = emptyFormatSlot; } else if (decl->foamDecl.type != FOAM_Rec + && decl->foamDecl.type != FOAM_JavaObj && decl->foamDecl.type != FOAM_Arr && decl->foamDecl.type != FOAM_TR && decl->foamDecl.type != FOAM_NOp) From 83613ac44372526bf309688c7e1184978de1cee2 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 31 Dec 2017 15:16:23 +0000 Subject: [PATCH 196/352] aldor/test: FIXUP remove generated rectest.java, simple_j.java --- aldor/aldor/test/rectest.java | 1074 -------------------------------- aldor/aldor/test/simple_j.java | 827 ------------------------ 2 files changed, 1901 deletions(-) delete mode 100644 aldor/aldor/test/rectest.java delete mode 100644 aldor/aldor/test/simple_j.java diff --git a/aldor/aldor/test/rectest.java b/aldor/aldor/test/rectest.java deleted file mode 100644 index de8c62c2d..000000000 --- a/aldor/aldor/test/rectest.java +++ /dev/null @@ -1,1074 +0,0 @@ -/*... -(nlseq - (statement (spaceseq "import" (importid "foamj" "EnvRecord"))) - (statement (spaceseq "import" (importid "foamj" "Record"))) - (statement (spaceseq "import" (importid "foamj" "Format"))) - (statement (spaceseq "import" (importid "foamj" "Word"))) - (statement (spaceseq "import" (importid "foamj" "Value"))) - (statement (spaceseq "import" (importid "foamj" "Env"))) - (statement (spaceseq "import" (importid "foamj" "Clos"))) - (statement (spaceseq "import" (importid "foamj" "Globals"))) - (statement (spaceseq "import" (importid "foamj" "Fn"))) - (nlseq - (javadoc "Generated by genjava - rectest\\\\n") - (class - (spaceseq public) - "rectest" - () - (commaseq) - (nlseq - (statement - (declaration - (spaceseq private static) - (importid "foamj" "Format") - (assign - "FORMAT_5" - (new (apply (importid "foamj" "Format") (paren (commaseq 3))) ())))) - (statement - (declaration - (spaceseq private static) - (importid "foamj" "Format") - (assign - "FORMAT_6" - (new (apply (importid "foamj" "Format") (paren (commaseq 1))) ())))) - (nlseq - (statement - (declaration - (spaceseq static) - (importid "foamj" "Fn") - (assign - "C0_rectest" - (new - (apply (importid "foamj" "Fn") (paren (commaseq))) - (nlseq - (method - (declaration - (spaceseq public) - (importid "foamj" "Value") - "ocall" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env") - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Value") |...|) - "vals"))) - (commaseq)) - (nlseq - (statement (apply "c0_rectest" (paren (commaseq "env")))) - (statement (spaceseq return null))))))))) - (method - (declaration - (spaceseq private static) - void - "c0_rectest" - (paren - (commaseq (declaration (spaceseq) (importid "foamj" "Env") "env0"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Word") (sqbracket (spaceseq))) - (commaseq "t1"))) - (statement - (declaration - (spaceseq) - (importid "foamj" "Record") - (commaseq "t2" "t3"))) - (statement - (declaration - (spaceseq) - (spaceseq int (sqbracket (spaceseq))) - (commaseq "t0"))) - (nlseq - (statement - (apply - "ccall_Xx" - (paren - (commaseq - (apply - (memref - (apply - (memref (importid "foamj" "Globals") "getGlobal") - (paren (commaseq "runtime"))) - "toClos") - (paren (commaseq))))))) - (statement - (apply - (memref (importid "foamj" "Globals") "setGlobal") - (paren - (commaseq - "rectest" - (apply - (memref - (apply - (memref (importid "foamj" "Globals") "getGlobal") - (paren (commaseq "noOperation"))) - "toClos") - (paren (commaseq))))))) - (statement - (apply - (memref (importid "foamj" "Globals") "setGlobal") - (paren - (commaseq - "rectest_Rec_743553378" - (apply - (memref - (apply - "ccall_WxC" - (paren - (commaseq - (apply - (memref - (apply - (memref (importid "foamj" "Globals") "getGlobal") - (paren (commaseq "domainMake"))) - "toClos") - (paren (commaseq))) - (new - (apply - (importid "foamj" "Clos") - (paren (commaseq "env0" "C1_addLevel0"))) - ())))) - "toValue") - (paren (commaseq))))))) - (statement (assign "t0" (new (arrayref int 2) ()))) - (statement - (assign "t1" (new (arrayref (importid "foamj" "Word") 2) ()))) - (statement (assign (arrayref "t0" 0) 318528389)) - (statement - (assign - (arrayref "t1" 0) - (apply (memref "new" "toCharArray") (paren (commaseq))))) - (statement (assign (arrayref "t0" 1) 315787127)) - (statement - (assign - (arrayref "t1" 1) - (apply (memref "tag" "toCharArray") (paren (commaseq))))) - (statement - (assign - "t2" - (new - (apply (importid "foamj" "Record") (paren (commaseq "FORMAT_5"))) - ()))) - (statement - (apply - (memref "t2" "setField") - (paren - (commaseq - 0 - "size" - (apply - (memref (memref (importid "foamj" "Value") "U") "fromSInt") - (paren (commaseq 2))))))) - (statement - (apply - (memref "t2" "setField") - (paren - (commaseq - 1 - "nsize" - (apply - (memref (memref (importid "foamj" "Value") "U") "fromSInt") - (paren (commaseq 2))))))) - (statement - (apply - (memref "t2" "setField") - (paren - (commaseq - 2 - "values" - (apply - (memref - (cast (spaceseq (importid "foamj" "Word") (comment "Arr")) "t0") - "toValue") - (paren (commaseq))))))) - (statement - (assign - "t3" - (new - (apply (importid "foamj" "Record") (paren (commaseq "FORMAT_5"))) - ()))) - (statement - (apply - (memref "t3" "setField") - (paren - (commaseq - 0 - "size" - (apply - (memref (memref (importid "foamj" "Value") "U") "fromSInt") - (paren (commaseq 2))))))) - (statement - (apply - (memref "t3" "setField") - (paren - (commaseq - 1 - "nsize" - (apply - (memref (memref (importid "foamj" "Value") "U") "fromSInt") - (paren (commaseq 2))))))) - (statement - (apply - (memref "t3" "setField") - (paren - (commaseq - 2 - "values" - (apply - (memref - (cast (spaceseq (importid "foamj" "Word") (comment "Arr")) "t1") - "toValue") - (paren (commaseq))))))) - (statement - (apply - "ccall_XxWW" - (paren - (commaseq - (apply - (memref - (apply - (memref (importid "foamj" "Globals") "getGlobal") - (paren (commaseq "rtAddStrings"))) - "toClos") - (paren (commaseq))) - (cast (spaceseq (importid "foamj" "Word") (comment "Rec")) "t2") - (cast (spaceseq (importid "foamj" "Word") (comment "Rec")) "t3"))))) - (statement return))))) - (nlseq - (statement - (declaration - (spaceseq static) - (importid "foamj" "Fn") - (assign - "C1_addLevel0" - (new - (apply (importid "foamj" "Fn") (paren (commaseq))) - (nlseq - (method - (declaration - (spaceseq public) - (importid "foamj" "Value") - "ocall" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env") - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Value") |...|) - "vals"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Clos") - (assign - "ret" - (apply - "c1_addLevel0" - (paren - (commaseq - "env" - (apply (memref (arrayref "vals" 0) "asWord") (paren (commaseq))))))))) - (statement (spaceseq return "ret"))))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Clos") - "c1_addLevel0" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env0") - (declaration (spaceseq) (importid "foamj" "Word") "p0_domain"))) - (commaseq)) - (nlseq - (nlseq - (statement - (apply - "ccall_WxWW" - (paren - (commaseq - (apply - (memref - (apply - (memref (importid "foamj" "Globals") "getGlobal") - (paren (commaseq "domainAddNameFn!"))) - "toClos") - (paren (commaseq))) - "p0_domain" - (apply - "ccall_WxA" - (paren - (commaseq - (apply - (memref - (apply - (memref (importid "foamj" "Globals") "getGlobal") - (paren (commaseq "rtConstNameFn"))) - "toClos") - (paren (commaseq))) - (apply (memref "Rec" "toCharArray") (paren (commaseq)))))))))) - (statement - (apply - "ccall_WxWI" - (paren - (commaseq - (apply - (memref - (apply - (memref (importid "foamj" "Globals") "getGlobal") - (paren (commaseq "domainAddHash!"))) - "toClos") - (paren (commaseq))) - "p0_domain" - 316169045)))) - (statement - (spaceseq - return - (new - (apply - (importid "foamj" "Clos") - (paren (commaseq "env0" "C2_addLevel1"))) - ()))))))) - (nlseq - (statement - (declaration - (spaceseq static) - (importid "foamj" "Fn") - (assign - "C2_addLevel1" - (new - (apply (importid "foamj" "Fn") (paren (commaseq))) - (nlseq - (method - (declaration - (spaceseq public) - (importid "foamj" "Value") - "ocall" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env") - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Value") |...|) - "vals"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Word") - (assign - "ret" - (apply - "c2_addLevel1" - (paren - (commaseq - "env" - (apply (memref (arrayref "vals" 0) "asWord") (paren (commaseq))) - (apply (memref (arrayref "vals" 1) "asWord") (paren (commaseq))))))))) - (statement - (spaceseq return (apply (memref "ret" "toValue") (paren (commaseq)))))))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Word") - "c2_addLevel1" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env0") - (declaration (spaceseq) (importid "foamj" "Word") "p0_domain") - (declaration (spaceseq) (importid "foamj" "Word") "p1_hashcode"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Word") (sqbracket (spaceseq))) - (commaseq "t2"))) - (statement - (declaration - (spaceseq) - (importid "foamj" "Record") - (commaseq "t3" "t4" "t5"))) - (statement - (declaration - (spaceseq) - (spaceseq int (sqbracket (spaceseq))) - (commaseq "t0" "t1"))) - (statement (declaration (spaceseq) int (commaseq "t6" "t7"))) - (statement - (declaration - (spaceseq final) - (importid "foamj" "EnvRecord") - (assign "lvl0" (apply (memref "env0" "level") (paren (commaseq)))))) - (nlseq - (statement (assign "t0" (new (arrayref int 2) ()))) - (statement (assign "t1" (new (arrayref int 2) ()))) - (statement - (assign "t2" (new (arrayref (importid "foamj" "Word") 2) ()))) - (statement - (apply - (memref "lvl0" "setField") - (paren - (commaseq - 2 - "" - (apply - (memref (memref (importid "foamj" "Value") "U") "fromSInt") - (paren (commaseq "p1_hashcode"))))))) - (statement - (apply - (memref "lvl0" "setField") - (paren - (commaseq - 1 - "new" - (new - (apply (importid "foamj" "Clos") (paren (commaseq "env0" "C3_new"))) - ()))))) - (statement - (apply - (memref "lvl0" "setField") - (paren - (commaseq - 0 - "tag" - (new - (apply (importid "foamj" "Clos") (paren (commaseq "env0" "C4_tag"))) - ()))))) - (statement - (assign - "t6" - (modulo - (plus - (apply - (memref - (apply (memref "lvl0" "getField") (paren (commaseq 2 ""))) - "toSInt") - (paren (commaseq))) - 447957760) - 1073741789))) - (statement - (assign - "t7" - (modulo - (plus - 376332111 - (shiftup - (and - (modulo - (plus - 32236 - (shiftup - (and - (modulo - (plus - (apply - (memref - (apply (memref "lvl0" "getField") (paren (commaseq 2 ""))) - "toSInt") - (paren (commaseq))) - 74075968) - 1073741789) - 16777215) - 6)) - 1073741789) - 16777215) - 6)) - 1073741789))) - (statement - (assign - "t3" - (new - (apply (importid "foamj" "Record") (paren (commaseq "FORMAT_5"))) - ()))) - (statement - (apply - (memref "t3" "setField") - (paren - (commaseq - 0 - "size" - (apply - (memref (memref (importid "foamj" "Value") "U") "fromSInt") - (paren (commaseq 2))))))) - (statement - (apply - (memref "t3" "setField") - (paren - (commaseq - 1 - "nsize" - (apply - (memref (memref (importid "foamj" "Value") "U") "fromSInt") - (paren (commaseq 2))))))) - (statement - (apply - (memref "t3" "setField") - (paren - (commaseq - 2 - "values" - (apply - (memref - (cast (spaceseq (importid "foamj" "Word") (comment "Arr")) "t0") - "toValue") - (paren (commaseq))))))) - (statement - (assign - "t4" - (new - (apply (importid "foamj" "Record") (paren (commaseq "FORMAT_5"))) - ()))) - (statement - (apply - (memref "t4" "setField") - (paren - (commaseq - 0 - "size" - (apply - (memref (memref (importid "foamj" "Value") "U") "fromSInt") - (paren (commaseq 2))))))) - (statement - (apply - (memref "t4" "setField") - (paren - (commaseq - 1 - "nsize" - (apply - (memref (memref (importid "foamj" "Value") "U") "fromSInt") - (paren (commaseq 2))))))) - (statement - (apply - (memref "t4" "setField") - (paren - (commaseq - 2 - "values" - (apply - (memref - (cast (spaceseq (importid "foamj" "Word") (comment "Arr")) "t1") - "toValue") - (paren (commaseq))))))) - (statement - (assign - "t5" - (new - (apply (importid "foamj" "Record") (paren (commaseq "FORMAT_5"))) - ()))) - (statement - (apply - (memref "t5" "setField") - (paren - (commaseq - 0 - "size" - (apply - (memref (memref (importid "foamj" "Value") "U") "fromSInt") - (paren (commaseq 2))))))) - (statement - (apply - (memref "t5" "setField") - (paren - (commaseq - 1 - "nsize" - (apply - (memref (memref (importid "foamj" "Value") "U") "fromSInt") - (paren (commaseq 2))))))) - (statement - (apply - (memref "t5" "setField") - (paren - (commaseq - 2 - "values" - (apply - (memref - (cast (spaceseq (importid "foamj" "Word") (comment "Arr")) "t2") - "toValue") - (paren (commaseq))))))) - (statement - (apply - "ccall_XxWRRR" - (paren - (commaseq - (apply - (memref - (apply - (memref (importid "foamj" "Globals") "getGlobal") - (paren (commaseq "domainAddExports!"))) - "toClos") - (paren (commaseq))) - "p0_domain" - "t3" - "t4" - "t5")))) - (statement (assign (arrayref "t0" 0) 318528389)) - (statement (assign (arrayref "t1" 0) "t6")) - (statement - (assign - (arrayref "t2" 0) - (apply - (memref - (apply - (memref - (apply (memref "lvl0" "getField") (paren (commaseq 1 "new"))) - "toClos") - (paren (commaseq))) - "asWord") - (paren (commaseq))))) - (statement (assign (arrayref "t0" 1) 315787127)) - (statement (assign (arrayref "t1" 1) "t7")) - (statement - (assign - (arrayref "t2" 1) - (apply - (memref - (apply - (memref - (apply (memref "lvl0" "getField") (paren (commaseq 0 "tag"))) - "toClos") - (paren (commaseq))) - "asWord") - (paren (commaseq))))) - (statement (spaceseq return "p0_domain")))))) - (nlseq - (statement - (declaration - (spaceseq static) - (importid "foamj" "Fn") - (assign - "C3_new" - (new - (apply (importid "foamj" "Fn") (paren (commaseq))) - (nlseq - (method - (declaration - (spaceseq public) - (importid "foamj" "Value") - "ocall" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env") - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Value") |...|) - "vals"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Word") - (assign "ret" (apply "c3_new" (paren (commaseq "env")))))) - (statement - (spaceseq return (apply (memref "ret" "toValue") (paren (commaseq)))))))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Word") - "c3_new" - (paren - (commaseq (declaration (spaceseq) (importid "foamj" "Env") "env0"))) - (commaseq)) - (nlseq - (statement - (declaration (spaceseq) (importid "foamj" "Record") (commaseq "t0"))) - (nlseq - (statement - (assign - "t0" - (new - (apply (importid "foamj" "Record") (paren (commaseq "FORMAT_6"))) - ()))) - (statement - (apply - (memref "t0" "setField") - (paren - (commaseq 0 "t" (apply (memref 0 "toValue") (paren (commaseq))))))) - (statement - (spaceseq - return - (cast (spaceseq (importid "foamj" "Word") (comment "Rec")) "t0"))))))) - (nlseq - (statement - (declaration - (spaceseq static) - (importid "foamj" "Fn") - (assign - "C4_tag" - (new - (apply (importid "foamj" "Fn") (paren (commaseq))) - (nlseq - (method - (declaration - (spaceseq public) - (importid "foamj" "Value") - "ocall" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env") - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Value") |...|) - "vals"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Word") - (assign - "ret" - (apply - "c4_tag" - (paren - (commaseq - "env" - (apply (memref (arrayref "vals" 0) "asWord") (paren (commaseq))))))))) - (statement - (spaceseq return (apply (memref "ret" "toValue") (paren (commaseq)))))))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Word") - "c4_tag" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env0") - (declaration (spaceseq) (importid "foamj" "Word") "p0_x"))) - (commaseq)) - (nlseq - (nlseq - (statement - (spaceseq - return - (apply - (memref - (apply (memref "p0_x" "getField") (paren (commaseq 0 "t"))) - "asWord") - (paren (commaseq))))))))) - (method - (declaration - (spaceseq private static) - void - "ccall_XxWRRR" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Clos") "_0") - (declaration (spaceseq) (importid "foamj" "Word") "_1") - (declaration (spaceseq) (importid "foamj" "Record") "_2") - (declaration (spaceseq) (importid "foamj" "Record") "_3") - (declaration (spaceseq) (importid "foamj" "Record") "_4"))) - (commaseq)) - (nlseq - (statement - (apply - (memref "_0" "call") - (paren - (commaseq - (apply (memref "_1" "toValue") (paren (commaseq))) - "_2" - "_3" - "_4")))) - (statement return))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Word") - "ccall_WxWW" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Clos") "_0") - (declaration (spaceseq) (importid "foamj" "Word") "_1") - (declaration (spaceseq) (importid "foamj" "Word") "_2"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Value") - (assign - "result" - (apply - (memref "_0" "call") - (paren - (commaseq - (apply (memref "_1" "toValue") (paren (commaseq))) - (apply (memref "_2" "toValue") (paren (commaseq))))))))) - (statement - (spaceseq - return - (apply (memref "result" "asWord") (paren (commaseq))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Word") - "ccall_WxA" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Clos") "_0") - (declaration (spaceseq) "Object" "_1"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Value") - (assign "result" (apply (memref "_0" "call") (paren (commaseq "_1")))))) - (statement - (spaceseq - return - (apply (memref "result" "asWord") (paren (commaseq))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Word") - "ccall_WxWI" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Clos") "_0") - (declaration (spaceseq) (importid "foamj" "Word") "_1") - (declaration (spaceseq) int "_2"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Value") - (assign - "result" - (apply - (memref "_0" "call") - (paren - (commaseq - (apply (memref "_1" "toValue") (paren (commaseq))) - (apply - (memref (memref (importid "foamj" "Value") "U") "fromSInt") - (paren (commaseq "_2"))))))))) - (statement - (spaceseq - return - (apply (memref "result" "asWord") (paren (commaseq))))))) - (method - (declaration - (spaceseq private static) - void - "ccall_Xx" - (paren - (commaseq (declaration (spaceseq) (importid "foamj" "Clos") "_0"))) - (commaseq)) - (nlseq - (statement (apply (memref "_0" "call") (paren (commaseq)))) - (statement return))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Word") - "ccall_WxC" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Clos") "_0") - (declaration (spaceseq) (importid "foamj" "Clos") "_1"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Value") - (assign "result" (apply (memref "_0" "call") (paren (commaseq "_1")))))) - (statement - (spaceseq - return - (apply (memref "result" "asWord") (paren (commaseq))))))) - (method - (declaration - (spaceseq private static) - void - "ccall_XxWW" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Clos") "_0") - (declaration (spaceseq) (importid "foamj" "Word") "_1") - (declaration (spaceseq) (importid "foamj" "Word") "_2"))) - (commaseq)) - (nlseq - (statement - (apply - (memref "_0" "call") - (paren - (commaseq - (apply (memref "_1" "toValue") (paren (commaseq))) - (apply (memref "_2" "toValue") (paren (commaseq))))))) - (statement return))))))) -...*/ -import foamj.EnvRecord; -import foamj.Record; -import foamj.Format; -import foamj.Word; -import foamj.Value; -import foamj.Env; -import foamj.Clos; -import foamj.Globals; -import foamj.Fn; -/** Generated by genjava - rectest - **/ -public class rectest { - private static Format FORMAT_5 = new Format(3); - private static Format FORMAT_6 = new Format(1); - static Fn C0_rectest = new Fn() { - public Value ocall(Env env, Value ... vals) { - c0_rectest(env); - return null; - } - - }; - private static void c0_rectest(Env env0) { - Word [] t1; - Record t2, t3; - int [] t0; - ccall_Xx(Globals.getGlobal("runtime").toClos()); - Globals.setGlobal("rectest", Globals.getGlobal("noOperation").toClos()); - Globals.setGlobal("rectest_Rec_743553378", ccall_WxC(Globals.getGlobal("domainMake").toClos(), new Clos(env0, C1_addLevel0)).toValue()); - t0 = new int[2]; - t1 = new Word[2]; - t0[0] = 318528389; - t1[0] = "new".toCharArray(); - t0[1] = 315787127; - t1[1] = "tag".toCharArray(); - t2 = new Record(FORMAT_5); - t2.setField(0, "size", Value.U.fromSInt(2)); - t2.setField(1, "nsize", Value.U.fromSInt(2)); - t2.setField(2, "values", (Word /* Arr*/)t0.toValue()); - t3 = new Record(FORMAT_5); - t3.setField(0, "size", Value.U.fromSInt(2)); - t3.setField(1, "nsize", Value.U.fromSInt(2)); - t3.setField(2, "values", (Word /* Arr*/)t1.toValue()); - ccall_XxWW(Globals.getGlobal("rtAddStrings").toClos(), (Word /* Rec*/)t2, (Word /* Rec*/)t3); - return; - } - - static Fn C1_addLevel0 = new Fn() { - public Value ocall(Env env, Value ... vals) { - Clos ret = c1_addLevel0(env, vals[0].asWord()); - return ret; - } - - }; - private static Clos c1_addLevel0(Env env0, Word p0_domain) { - ccall_WxWW(Globals.getGlobal("domainAddNameFn!").toClos(), p0_domain, ccall_WxA(Globals.getGlobal("rtConstNameFn").toClos(), "Rec".toCharArray())); - ccall_WxWI(Globals.getGlobal("domainAddHash!").toClos(), p0_domain, 316169045); - return new Clos(env0, C2_addLevel1); - } - - static Fn C2_addLevel1 = new Fn() { - public Value ocall(Env env, Value ... vals) { - Word ret = c2_addLevel1(env, vals[0].asWord(), vals[1].asWord()); - return ret.toValue(); - } - - }; - private static Word c2_addLevel1(Env env0, Word p0_domain, Word p1_hashcode) { - Word [] t2; - Record t3, t4, t5; - int [] t0, t1; - int t6, t7; - final EnvRecord lvl0 = env0.level(); - t0 = new int[2]; - t1 = new int[2]; - t2 = new Word[2]; - lvl0.setField(2, "", Value.U.fromSInt(p1_hashcode)); - lvl0.setField(1, "new", new Clos(env0, C3_new)); - lvl0.setField(0, "tag", new Clos(env0, C4_tag)); - t6 = (lvl0.getField(2, "").toSInt() + 447957760)%1073741789; - t7 = (376332111 + (((32236 + (((lvl0.getField(2, "").toSInt() + 74075968)%1073741789 & 16777215)<<6))%1073741789 & 16777215)<<6))%1073741789; - t3 = new Record(FORMAT_5); - t3.setField(0, "size", Value.U.fromSInt(2)); - t3.setField(1, "nsize", Value.U.fromSInt(2)); - t3.setField(2, "values", (Word /* Arr*/)t0.toValue()); - t4 = new Record(FORMAT_5); - t4.setField(0, "size", Value.U.fromSInt(2)); - t4.setField(1, "nsize", Value.U.fromSInt(2)); - t4.setField(2, "values", (Word /* Arr*/)t1.toValue()); - t5 = new Record(FORMAT_5); - t5.setField(0, "size", Value.U.fromSInt(2)); - t5.setField(1, "nsize", Value.U.fromSInt(2)); - t5.setField(2, "values", (Word /* Arr*/)t2.toValue()); - ccall_XxWRRR(Globals.getGlobal("domainAddExports!").toClos(), p0_domain, t3, t4, t5); - t0[0] = 318528389; - t1[0] = t6; - t2[0] = lvl0.getField(1, "new").toClos().asWord(); - t0[1] = 315787127; - t1[1] = t7; - t2[1] = lvl0.getField(0, "tag").toClos().asWord(); - return p0_domain; - } - - static Fn C3_new = new Fn() { - public Value ocall(Env env, Value ... vals) { - Word ret = c3_new(env); - return ret.toValue(); - } - - }; - private static Word c3_new(Env env0) { - Record t0; - t0 = new Record(FORMAT_6); - t0.setField(0, "t", 0.toValue()); - return (Word /* Rec*/)t0; - } - - static Fn C4_tag = new Fn() { - public Value ocall(Env env, Value ... vals) { - Word ret = c4_tag(env, vals[0].asWord()); - return ret.toValue(); - } - - }; - private static Word c4_tag(Env env0, Word p0_x) { - return p0_x.getField(0, "t").asWord(); - } - - private static void ccall_XxWRRR(Clos _0, Word _1, Record _2, Record _3, Record _4) { - _0.call(_1.toValue(), _2, _3, _4); - return; - } - - private static Word ccall_WxWW(Clos _0, Word _1, Word _2) { - Value result = _0.call(_1.toValue(), _2.toValue()); - return result.asWord(); - } - - private static Word ccall_WxA(Clos _0, Object _1) { - Value result = _0.call(_1); - return result.asWord(); - } - - private static Word ccall_WxWI(Clos _0, Word _1, int _2) { - Value result = _0.call(_1.toValue(), Value.U.fromSInt(_2)); - return result.asWord(); - } - - private static void ccall_Xx(Clos _0) { - _0.call(); - return; - } - - private static Word ccall_WxC(Clos _0, Clos _1) { - Value result = _0.call(_1); - return result.asWord(); - } - - private static void ccall_XxWW(Clos _0, Word _1, Word _2) { - _0.call(_1.toValue(), _2.toValue()); - return; - } - -} diff --git a/aldor/aldor/test/simple_j.java b/aldor/aldor/test/simple_j.java deleted file mode 100644 index 944d3b17e..000000000 --- a/aldor/aldor/test/simple_j.java +++ /dev/null @@ -1,827 +0,0 @@ -/*... -(nlseq - (statement (spaceseq "import" (importid "foamj" "EnvRecord"))) - (statement (spaceseq "import" (importid "foamj" "MultiRecord"))) - (statement (spaceseq "import" (importid "foamj" "Format"))) - (statement (spaceseq "import" (importid "foamj" "Word"))) - (statement (spaceseq "import" (importid "foamj" "Value"))) - (statement (spaceseq "import" (importid "foamj" "Env"))) - (statement (spaceseq "import" (importid "foamj" "Clos"))) - (statement (spaceseq "import" (importid "foamj" "Globals"))) - (statement (spaceseq "import" (importid "foamj" "Fn"))) - (nlseq - (javadoc "Generated by genjava - simple_j\\\\n") - (class - (spaceseq public) - "simple_j" - () - (commaseq) - (nlseq - (statement - (declaration - (spaceseq private static) - (importid "foamj" "Format") - (assign - "FORMAT_5" - (new (apply (importid "foamj" "Format") (paren (commaseq 2))) ())))) - (nlseq - (statement - (declaration - (spaceseq static) - (importid "foamj" "Fn") - (assign - "C0_simple__j" - (new - (apply (importid "foamj" "Fn") (paren (commaseq))) - (nlseq - (method - (declaration - (spaceseq public) - (importid "foamj" "Value") - "ocall" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env") - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Value") |...|) - "vals"))) - (commaseq)) - (nlseq - (statement (apply "c0_simple__j" (paren (commaseq "env")))) - (statement (spaceseq return null))))))))) - (method - (declaration - (spaceseq private static) - void - "c0_simple__j" - (paren - (commaseq (declaration (spaceseq) (importid "foamj" "Env") "env0"))) - (commaseq)) - (nlseq - (nlseq - (statement - (apply - "ccall_Xx" - (paren - (commaseq - (apply - (memref - (apply - (memref (importid "foamj" "Globals") "getGlobal") - (paren (commaseq "runtime"))) - "toClos") - (paren (commaseq))))))) - (statement - (apply - (memref (importid "foamj" "Globals") "setGlobal") - (paren - (commaseq - "simple_j" - (apply - (memref - (apply - (memref (importid "foamj" "Globals") "getGlobal") - (paren (commaseq "noOperation"))) - "toClos") - (paren (commaseq))))))) - (statement - (apply - (memref (importid "foamj" "Globals") "setGlobal") - (paren - (commaseq - "simple_j_t1_479859677" - (new - (apply (importid "foamj" "Clos") (paren (commaseq "env0" "C1_t1"))) - ()))))) - (statement - (apply - (memref (importid "foamj" "Globals") "setGlobal") - (paren - (commaseq - "simple_j_t2_494407402" - (new - (apply (importid "foamj" "Clos") (paren (commaseq "env0" "C2_t2"))) - ()))))) - (statement - (apply - (memref (importid "foamj" "Globals") "setGlobal") - (paren - (commaseq - "simple_j_t3_030021108" - (new - (apply (importid "foamj" "Clos") (paren (commaseq "env0" "C3_t3"))) - ()))))) - (statement - (apply - (memref (importid "foamj" "Globals") "setGlobal") - (paren - (commaseq - "simple_j_t4_905089460" - (new - (apply (importid "foamj" "Clos") (paren (commaseq "env0" "C4_t4"))) - ()))))) - (statement - (apply - (memref (importid "foamj" "Globals") "setGlobal") - (paren - (commaseq - "simple_j_t5_264916867" - (new - (apply (importid "foamj" "Clos") (paren (commaseq "env0" "C6_t5"))) - ()))))) - (statement return))))) - (nlseq - (statement - (declaration - (spaceseq static) - (importid "foamj" "Fn") - (assign - "C1_t1" - (new - (apply (importid "foamj" "Fn") (paren (commaseq))) - (nlseq - (method - (declaration - (spaceseq public) - (importid "foamj" "Value") - "ocall" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env") - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Value") |...|) - "vals"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Word") - (assign "ret" (apply "c1_t1" (paren (commaseq "env")))))) - (statement - (spaceseq return (apply (memref "ret" "toValue") (paren (commaseq)))))))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Word") - "c1_t1" - (paren - (commaseq (declaration (spaceseq) (importid "foamj" "Env") "env0"))) - (commaseq)) - (nlseq - (nlseq - (statement - (spaceseq - return - (apply - (memref (memref (importid "foamj" "Word") "U") "fromSInt") - (paren (commaseq 12))))))))) - (nlseq - (statement - (declaration - (spaceseq static) - (importid "foamj" "Fn") - (assign - "C2_t2" - (new - (apply (importid "foamj" "Fn") (paren (commaseq))) - (nlseq - (method - (declaration - (spaceseq public) - (importid "foamj" "Value") - "ocall" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env") - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Value") |...|) - "vals"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Word") - (assign - "ret" - (apply - "c2_t2" - (paren - (commaseq - "env" - (apply (memref (arrayref "vals" 0) "asWord") (paren (commaseq))))))))) - (statement - (spaceseq return (apply (memref "ret" "toValue") (paren (commaseq)))))))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Word") - "c2_t2" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env0") - (declaration (spaceseq) (importid "foamj" "Word") "p0_n"))) - (commaseq)) - (nlseq - (nlseq - (statement - (spaceseq - return - (apply - (memref (memref (importid "foamj" "Word") "U") "fromSInt") - (paren - (commaseq - (plus (apply (memref "p0_n" "toSInt") (paren (commaseq))) 1)))))))))) - (nlseq - (statement - (declaration - (spaceseq static) - (importid "foamj" "Fn") - (assign - "C3_t3" - (new - (apply (importid "foamj" "Fn") (paren (commaseq))) - (nlseq - (method - (declaration - (spaceseq public) - (importid "foamj" "Value") - "ocall" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env") - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Value") |...|) - "vals"))) - (commaseq)) - (nlseq - (statement - (apply - "c3_t3" - (paren - (commaseq - "env" - (apply (memref (arrayref "vals" 0) "asWord") (paren (commaseq))) - (apply (memref (arrayref "vals" 1) "asWord") (paren (commaseq))))))) - (statement (spaceseq return null))))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "MultiRecord") - "c3_t3" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env0") - (declaration (spaceseq) (importid "foamj" "Word") "p0_a") - (declaration (spaceseq) (importid "foamj" "Word") "p1_b"))) - (commaseq)) - (nlseq - (statement (declaration (spaceseq) int (commaseq "t0" "t1"))) - (nlseq - (statement - (assign - "t0" - (plus - (apply (memref "p0_a" "toSInt") (paren (commaseq))) - (apply (memref "p1_b" "toSInt") (paren (commaseq)))))) - (statement - (assign - "t1" - (minus - (apply (memref "p0_a" "toSInt") (paren (commaseq))) - (apply (memref "p1_b" "toSInt") (paren (commaseq)))))) - (statement - (declaration - (spaceseq) - (importid "foamj" "MultiRecord") - (assign - "var0" - (new - (apply (importid "foamj" "MultiRecord") (paren (commaseq "FORMAT_5"))) - ())))) - (statement - (apply - (memref "var0" "setField") - (paren - (commaseq - 0 - "" - (apply - (memref - (apply - (memref (memref (importid "foamj" "Word") "U") "fromSInt") - (paren (commaseq "t0"))) - "toValue") - (paren (commaseq))))))) - (statement - (apply - (memref "var0" "setField") - (paren - (commaseq - 1 - "" - (apply - (memref - (apply - (memref (memref (importid "foamj" "Word") "U") "fromSInt") - (paren (commaseq "t1"))) - "toValue") - (paren (commaseq))))))) - (statement (spaceseq return "var0")))))) - (nlseq - (statement - (declaration - (spaceseq static) - (importid "foamj" "Fn") - (assign - "C4_t4" - (new - (apply (importid "foamj" "Fn") (paren (commaseq))) - (nlseq - (method - (declaration - (spaceseq public) - (importid "foamj" "Value") - "ocall" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env") - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Value") |...|) - "vals"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Clos") - (assign - "ret" - (apply - "c4_t4" - (paren - (commaseq - "env" - (apply (memref (arrayref "vals" 0) "asWord") (paren (commaseq))))))))) - (statement (spaceseq return "ret"))))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Clos") - "c4_t4" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env0") - (declaration (spaceseq) (importid "foamj" "Word") "p0_a"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq final) - (importid "foamj" "EnvRecord") - (assign "lvl0" (apply (memref "env0" "level") (paren (commaseq)))))) - (nlseq - (statement - (apply - (memref "lvl0" "setField") - (paren - (commaseq - 0 - "a" - (apply (memref "p0_a" "toValue") (paren (commaseq))))))) - (statement - (spaceseq - return - (new - (apply (importid "foamj" "Clos") (paren (commaseq "env0" "C5_t4"))) - ()))))))) - (nlseq - (statement - (declaration - (spaceseq static) - (importid "foamj" "Fn") - (assign - "C5_t4" - (new - (apply (importid "foamj" "Fn") (paren (commaseq))) - (nlseq - (method - (declaration - (spaceseq public) - (importid "foamj" "Value") - "ocall" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env") - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Value") |...|) - "vals"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Word") - (assign - "ret" - (apply - "c5_t4" - (paren - (commaseq - "env" - (apply (memref (arrayref "vals" 0) "asWord") (paren (commaseq))))))))) - (statement - (spaceseq return (apply (memref "ret" "toValue") (paren (commaseq)))))))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Word") - "c5_t4" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env0") - (declaration (spaceseq) (importid "foamj" "Word") "p0_x"))) - (commaseq)) - (nlseq - (statement - (declaration (spaceseq) (importid "foamj" "Word") (commaseq "t0"))) - (statement - (declaration - (spaceseq final) - (importid "foamj" "Env") - (assign "env1" (apply (memref "env0" "parent") (paren (commaseq)))))) - (statement - (declaration - (spaceseq final) - (importid "foamj" "EnvRecord") - (assign "lvl1" (apply (memref "env1" "level") (paren (commaseq)))))) - (nlseq - (statement - (assign - "t0" - (apply - (memref - (apply (memref "lvl1" "getField") (paren (commaseq 0 "a"))) - "asWord") - (paren (commaseq))))) - (statement - (spaceseq - return - (apply - (memref (memref (importid "foamj" "Word") "U") "fromSInt") - (paren - (commaseq - (plus - (apply (memref "t0" "toSInt") (paren (commaseq))) - (apply (memref "p0_x" "toSInt") (paren (commaseq))))))))))))) - (nlseq - (statement - (declaration - (spaceseq static) - (importid "foamj" "Fn") - (assign - "C6_t5" - (new - (apply (importid "foamj" "Fn") (paren (commaseq))) - (nlseq - (method - (declaration - (spaceseq public) - (importid "foamj" "Value") - "ocall" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env") - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Value") |...|) - "vals"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Clos") - (assign - "ret" - (apply - "c6_t5" - (paren - (commaseq - "env" - (apply (memref (arrayref "vals" 0) "toClos") (paren (commaseq))))))))) - (statement (spaceseq return "ret"))))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Clos") - "c6_t5" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env0") - (declaration (spaceseq) (importid "foamj" "Clos") "p0_f"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq final) - (importid "foamj" "EnvRecord") - (assign "lvl0" (apply (memref "env0" "level") (paren (commaseq)))))) - (nlseq - (statement - (apply (memref "lvl0" "setField") (paren (commaseq 0 "f" "p0_f")))) - (statement - (spaceseq - return - (new - (apply (importid "foamj" "Clos") (paren (commaseq "env0" "C7_t5"))) - ()))))))) - (nlseq - (statement - (declaration - (spaceseq static) - (importid "foamj" "Fn") - (assign - "C7_t5" - (new - (apply (importid "foamj" "Fn") (paren (commaseq))) - (nlseq - (method - (declaration - (spaceseq public) - (importid "foamj" "Value") - "ocall" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env") - (declaration - (spaceseq) - (spaceseq (importid "foamj" "Value") |...|) - "vals"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Word") - (assign - "ret" - (apply - "c7_t5" - (paren - (commaseq - "env" - (apply (memref (arrayref "vals" 0) "asWord") (paren (commaseq))))))))) - (statement - (spaceseq return (apply (memref "ret" "toValue") (paren (commaseq)))))))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "Word") - "c7_t5" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Env") "env0") - (declaration (spaceseq) (importid "foamj" "Word") "p0_n"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Word") - (commaseq "t0" "t1"))) - (statement - (declaration - (spaceseq final) - (importid "foamj" "Env") - (assign "env1" (apply (memref "env0" "parent") (paren (commaseq)))))) - (statement - (declaration - (spaceseq final) - (importid "foamj" "EnvRecord") - (assign "lvl1" (apply (memref "env1" "level") (paren (commaseq)))))) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "MultiRecord") - (assign - "var0" - (apply - "ccall_WWxW" - (paren - (commaseq - (apply - (memref - (apply (memref "lvl1" "getField") (paren (commaseq 0 "f"))) - "toClos") - (paren (commaseq))) - "p0_n")))))) - (statement - (assign - "t0" - (apply - (memref - (apply (memref "var0" "getField") (paren (commaseq 0 ""))) - "asWord") - (paren (commaseq))))) - (statement - (assign - "t1" - (apply - (memref - (apply (memref "var0" "getField") (paren (commaseq 1 ""))) - "asWord") - (paren (commaseq))))) - (statement - (spaceseq - return - (apply - (memref (memref (importid "foamj" "Word") "U") "fromSInt") - (paren - (commaseq - (plus - (apply (memref "t0" "toSInt") (paren (commaseq))) - (apply (memref "t1" "toSInt") (paren (commaseq))))))))))))) - (method - (declaration - (spaceseq private static) - (importid "foamj" "MultiRecord") - "ccall_WWxW" - (paren - (commaseq - (declaration (spaceseq) (importid "foamj" "Clos") "_0") - (declaration (spaceseq) (importid "foamj" "Word") "_1"))) - (commaseq)) - (nlseq - (statement - (declaration - (spaceseq) - (importid "foamj" "Value") - (assign - "result" - (apply - (memref "_0" "call") - (paren (commaseq (apply (memref "_1" "toValue") (paren (commaseq))))))))) - (statement - (spaceseq - return - (apply (memref "result" "toMulti") (paren (commaseq))))))) - (method - (declaration - (spaceseq private static) - void - "ccall_Xx" - (paren - (commaseq (declaration (spaceseq) (importid "foamj" "Clos") "_0"))) - (commaseq)) - (nlseq - (statement (apply (memref "_0" "call") (paren (commaseq)))) - (statement return))))))) -...*/ -import foamj.EnvRecord; -import foamj.MultiRecord; -import foamj.Format; -import foamj.Word; -import foamj.Value; -import foamj.Env; -import foamj.Clos; -import foamj.Globals; -import foamj.Fn; -/** Generated by genjava - simple_j - **/ -public class simple_j { - private static Format FORMAT_5 = new Format(2); - static Fn C0_simple__j = new Fn() { - public Value ocall(Env env, Value ... vals) { - c0_simple__j(env); - return null; - } - - }; - private static void c0_simple__j(Env env0) { - ccall_Xx(Globals.getGlobal("runtime").toClos()); - Globals.setGlobal("simple_j", Globals.getGlobal("noOperation").toClos()); - Globals.setGlobal("simple_j_t1_479859677", new Clos(env0, C1_t1)); - Globals.setGlobal("simple_j_t2_494407402", new Clos(env0, C2_t2)); - Globals.setGlobal("simple_j_t3_030021108", new Clos(env0, C3_t3)); - Globals.setGlobal("simple_j_t4_905089460", new Clos(env0, C4_t4)); - Globals.setGlobal("simple_j_t5_264916867", new Clos(env0, C6_t5)); - return; - } - - static Fn C1_t1 = new Fn() { - public Value ocall(Env env, Value ... vals) { - Word ret = c1_t1(env); - return ret.toValue(); - } - - }; - private static Word c1_t1(Env env0) { - return Word.U.fromSInt(12); - } - - static Fn C2_t2 = new Fn() { - public Value ocall(Env env, Value ... vals) { - Word ret = c2_t2(env, vals[0].asWord()); - return ret.toValue(); - } - - }; - private static Word c2_t2(Env env0, Word p0_n) { - return Word.U.fromSInt(p0_n.toSInt() + 1); - } - - static Fn C3_t3 = new Fn() { - public Value ocall(Env env, Value ... vals) { - c3_t3(env, vals[0].asWord(), vals[1].asWord()); - return null; - } - - }; - private static MultiRecord c3_t3(Env env0, Word p0_a, Word p1_b) { - int t0, t1; - t0 = p0_a.toSInt() + p1_b.toSInt(); - t1 = p0_a.toSInt() - p1_b.toSInt(); - MultiRecord var0 = new MultiRecord(FORMAT_5); - var0.setField(0, "", Word.U.fromSInt(t0).toValue()); - var0.setField(1, "", Word.U.fromSInt(t1).toValue()); - return var0; - } - - static Fn C4_t4 = new Fn() { - public Value ocall(Env env, Value ... vals) { - Clos ret = c4_t4(env, vals[0].asWord()); - return ret; - } - - }; - private static Clos c4_t4(Env env0, Word p0_a) { - final EnvRecord lvl0 = env0.level(); - lvl0.setField(0, "a", p0_a.toValue()); - return new Clos(env0, C5_t4); - } - - static Fn C5_t4 = new Fn() { - public Value ocall(Env env, Value ... vals) { - Word ret = c5_t4(env, vals[0].asWord()); - return ret.toValue(); - } - - }; - private static Word c5_t4(Env env0, Word p0_x) { - Word t0; - final Env env1 = env0.parent(); - final EnvRecord lvl1 = env1.level(); - t0 = lvl1.getField(0, "a").asWord(); - return Word.U.fromSInt(t0.toSInt() + p0_x.toSInt()); - } - - static Fn C6_t5 = new Fn() { - public Value ocall(Env env, Value ... vals) { - Clos ret = c6_t5(env, vals[0].toClos()); - return ret; - } - - }; - private static Clos c6_t5(Env env0, Clos p0_f) { - final EnvRecord lvl0 = env0.level(); - lvl0.setField(0, "f", p0_f); - return new Clos(env0, C7_t5); - } - - static Fn C7_t5 = new Fn() { - public Value ocall(Env env, Value ... vals) { - Word ret = c7_t5(env, vals[0].asWord()); - return ret.toValue(); - } - - }; - private static Word c7_t5(Env env0, Word p0_n) { - Word t0, t1; - final Env env1 = env0.parent(); - final EnvRecord lvl1 = env1.level(); - MultiRecord var0 = ccall_WWxW(lvl1.getField(0, "f").toClos(), p0_n); - t0 = var0.getField(0, "").asWord(); - t1 = var0.getField(1, "").asWord(); - return Word.U.fromSInt(t0.toSInt() + t1.toSInt()); - } - - private static MultiRecord ccall_WWxW(Clos _0, Word _1) { - Value result = _0.call(_1.toValue()); - return result.toMulti(); - } - - private static void ccall_Xx(Clos _0) { - _0.call(); - return; - } - -} From 0f8e952e857c431b66d859e2c4a2bad8d978b0f2 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 9 Sep 2017 20:13:40 +0100 Subject: [PATCH 197/352] test: Add a test case for imported java objects. --- aldor/aldor/test/Makefile.in | 6 ++-- aldor/aldor/test/jimport.as | 53 ++++++++++++++++++++++++++++----- aldor/aldor/test/jimport_opt.as | 1 + 3 files changed, 50 insertions(+), 10 deletions(-) create mode 100644 aldor/aldor/test/jimport_opt.as diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 327a68c7e..d802d1053 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -80,13 +80,14 @@ fmtests := rectest enumtest clos strtable1 simple apply ctests := rectest enumtest multinever maptuple otests := enumtest xtests := enumtest -@BUILD_JAVA_TRUE@jruntests := jimport +@BUILD_JAVA_TRUE@jruntests := jimport jimport_opt x_extra := rtexns @BUILD_JAVA_TRUE@jtests := simple_j enumtest run_j simple_j_AXLFLAGS=-Q2 +jimport_opt_AXLFLAGS=-Q9 -Qinline-all badtests := opt1 @@ -192,8 +193,7 @@ $(patsubst %, %.exe, $(_xtests)): %.exe: %.o rtexns.o # -Fmain=bobthebuilder.c \ $(patsubst %, %-javatest,$(_jruntests)): %-javatest: out/java/%.class - $(AM_V_ALDOR_JAVATEST) \ - java -cp out/java:$(abs_top_builddir)/aldor/lib/java/src/foamj.jar:$(abs_top_builddir)/aldor/lib/libfoam/al/foam.jar:$(abs_top_builddir)/aldor/lib/libfoamlib/al/foamlib.jar: $* + $(AM_V_ALDOR_JAVATEST) java -cp out/java:$(abs_top_builddir)/aldor/lib/java/src/foamj.jar:$(abs_top_builddir)/aldor/lib/libfoam/al/foam.jar:$(abs_top_builddir)/aldor/lib/libfoamlib/al/foamlib.jar: $* check-java: $(patsubst %,%-javatest,$(_jruntests)) diff --git a/aldor/aldor/test/jimport.as b/aldor/aldor/test/jimport.as index 7e4207f65..ad2be479a 100644 --- a/aldor/aldor/test/jimport.as +++ b/aldor/aldor/test/jimport.as @@ -4,6 +4,25 @@ import from Machine; APPLY(id, rhs) ==> { apply: (%, 'id') -> rhs; export from 'id' } +JString ==> java_.lang_.String; +import JString: with { +} from Foreign Java; + + +extend String: with { + toJava: % -> JString; + fromJava: JString -> %; +} +== add { + import { + javaStringToString: JString -> %; + stringToJavaString: % -> JString; + } from Foreign; + + toJava(x: %): JString == stringToJavaString x; + fromJava(x: JString): % == javaStringToString x; +} + import BitSet: with { new: () -> %; new: SingleInteger -> %; @@ -20,14 +39,27 @@ import BitSet: with { APPLY(equals, % -> Boolean); } from Foreign Java "java.util"; -import Math: with { - abs: SingleInteger -> SingleInteger; -} from Foreign Java "java.lang"; +JMath ==> Math; +import JMath: with { +-- abs: SingleInteger -> SingleInteger; +} from Foreign Java; + +import LocalDate: with { + now: () -> %; + _of: (SingleInteger, Month, SingleInteger) -> %; + APPLY(toString, () -> JString); +} from Foreign Java "java.time"; + +import Month: with { + --JANUARY: %; + valueOf: JString -> %; + _of: SingleInteger -> %; +} from Foreign Java "java.time"; check(f: Boolean): () == if not f then never; test1(): () == { - import from SingleInteger, Math; + import from SingleInteger, JMath; b: BitSet := new(5); print << "BitSet: " << b.get(0) << newline; b.set(0); @@ -39,9 +71,9 @@ test1(): () == { test2(): () == { import from SingleInteger; - print << abs(1)$Math << " " << abs(-1)$Math << newline; - check(abs(1)$Math = abs(-1)$Math); - check(1 = abs(-1)$Math); +-- print << abs(1)$JMath << " " << abs(-1)$JMath << newline; +-- check(abs(1)$JMath = abs(-1)$JMath); +-- check(1 = abs(-1)$JMath); } test3(): () == { @@ -57,6 +89,13 @@ test3(): () == { check(not b1.equals(b2)); } +test4(): () == { + import from String; + dd: LocalDate := now(); + stdout << fromJava(dd.toString()) << newline +} + test1(); test2(); test3(); +test4(); diff --git a/aldor/aldor/test/jimport_opt.as b/aldor/aldor/test/jimport_opt.as new file mode 100644 index 000000000..e03ce0379 --- /dev/null +++ b/aldor/aldor/test/jimport_opt.as @@ -0,0 +1 @@ +#include "jimport.as" From fe3a42d9f2c569296a1d8557da6eaf85784aacbe Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 22 Sep 2017 22:10:04 +0100 Subject: [PATCH 198/352] src/*: Rename AB_Foreign to AB_ForeignImport Gives us space for a foreign export later... --- aldor/aldor/src/abcheck.c | 12 ++++++------ aldor/aldor/src/abnorm.c | 2 +- aldor/aldor/src/abpretty.c | 10 +++++----- aldor/aldor/src/absyn.c | 2 +- aldor/aldor/src/absyn.h | 10 +++++----- aldor/aldor/src/abuse.c | 6 +++--- aldor/aldor/src/genfoam.c | 10 +++++----- aldor/aldor/src/scobind.c | 16 ++++++++-------- aldor/aldor/src/ti_bup.c | 6 +++--- aldor/aldor/src/ti_sef.c | 6 +++--- aldor/aldor/src/ti_tdn.c | 14 +++++++------- aldor/lib/ax0/src/ax/aggcat.ax | 2 +- aldor/lib/ax0/src/ax/array2.ax | 2 +- aldor/lib/ax0/src/ax/basecliq.ax | 2 +- aldor/lib/ax0/src/ax/equation1.ax | 2 +- aldor/lib/ax0/src/ax/equation2.ax | 2 +- aldor/lib/ax0/src/ax/fraction.ax | 2 +- aldor/lib/ax0/src/ax/fspace.ax | 2 +- aldor/lib/ax0/src/ax/matcat.ax | 2 +- aldor/lib/ax0/src/ax/polycat.ax | 2 +- aldor/lib/ax0/src/ax/sf.ax | 2 +- aldor/lib/ax0/src/ax/si.ax | 2 +- aldor/lib/ax0/src/ax/stream.ax | 2 +- aldor/lib/ax0/src/ax/vector.ax | 2 +- 24 files changed, 60 insertions(+), 60 deletions(-) diff --git a/aldor/aldor/src/abcheck.c b/aldor/aldor/src/abcheck.c index ef0690eb8..cb189a2b3 100644 --- a/aldor/aldor/src/abcheck.c +++ b/aldor/aldor/src/abcheck.c @@ -31,7 +31,7 @@ local void abCheckExport (AbSyn); local void abCheckExtend (AbSyn); local void abCheckFluid (AbSyn); local void abCheckFor (AbSyn); -local void abCheckForeign (AbSyn); +local void abCheckForeignImport (AbSyn); local void abCheckFree (AbSyn); local void abCheckImport (AbSyn); local void abCheckLambda (AbSyn); @@ -142,8 +142,8 @@ abCheck(AbSyn absyn) abCheckFor(absyn); break; - case AB_Foreign: - abCheckForeign(absyn); + case AB_ForeignImport: + abCheckForeignImport(absyn); break; case AB_Free: @@ -650,14 +650,14 @@ abCheckFor0_old(AbSyn var) /***************************************************************************** * - * :: abCheckForeign + * :: abCheckForeignImport * ****************************************************************************/ local void -abCheckForeign(AbSyn absyn) +abCheckForeignImport(AbSyn absyn) { - AbSyn what = absyn->abForeign.what; + AbSyn what = absyn->abForeignImport.what; AbSyn *argv = abArgvAs(AB_Sequence, what); Length i, argc = abArgcAs(AB_Sequence, what); diff --git a/aldor/aldor/src/abnorm.c b/aldor/aldor/src/abnorm.c index 8997e5fc2..4ca7b84d8 100644 --- a/aldor/aldor/src/abnorm.c +++ b/aldor/aldor/src/abnorm.c @@ -880,7 +880,7 @@ abn0Import(AbSyn ab, AbSyn what, AbSyn where) /* Replace the import with a foreign */ - ab = abNewForeign(abPos(oab), what, where); + ab = abNewForeignImport(abPos(oab), what, where); /* Release storage associated with the original node */ diff --git a/aldor/aldor/src/abpretty.c b/aldor/aldor/src/abpretty.c index 775ca56d0..f03a458c8 100644 --- a/aldor/aldor/src/abpretty.c +++ b/aldor/aldor/src/abpretty.c @@ -525,20 +525,20 @@ abPPClipped0(Buffer buf, AbSyn ab, long *pmaxchars) } break; - case AB_Foreign: + case AB_ForeignImport: { f = f && abPPPuts(buf, "import ", pmaxchars); - if (! abHasTag(ab->abForeign.what, AB_Sequence)) + if (! abHasTag(ab->abForeignImport.what, AB_Sequence)) f = f && abPPIndent(buf, pmaxchars) && abPPPuts(buf, INDENTATION, pmaxchars); - f = f && abPPClipped0(buf, ab->abForeign.what, pmaxchars); + f = f && abPPClipped0(buf, ab->abForeignImport.what, pmaxchars); f = f && abPPIndent(buf, pmaxchars); f = f && abPPPuts(buf, "from Foreign(", pmaxchars); - if (abIsNotNothing(ab->abForeign.origin)) - f = f && abPPClipped0(buf, ab->abForeign.origin, pmaxchars); + if (abIsNotNothing(ab->abForeignImport.origin)) + f = f && abPPClipped0(buf, ab->abForeignImport.origin, pmaxchars); f = f && abPPPuts(buf, ")", pmaxchars); } break; diff --git a/aldor/aldor/src/absyn.c b/aldor/aldor/src/absyn.c index 92c9d228a..400d5c032 100644 --- a/aldor/aldor/src/absyn.c +++ b/aldor/aldor/src/absyn.c @@ -1551,7 +1551,7 @@ struct ab_info abInfoTable[] = { {AB_Fix, 0, 0, "Fix", KW_Fix }, {AB_Fluid, 0, 0, "Fluid", KW_Fluid }, {AB_For, 0, 0, "For", KW_For }, - {AB_Foreign, 0, 0, "Foreign", TK_LIMIT }, + {AB_ForeignImport,0, 0, "ForeignImport",TK_LIMIT }, {AB_Free, 0, 0, "Free", KW_Free }, {AB_Generate, 0, 0, "Generate", KW_Generate }, {AB_Goto, 0, 0, "Goto", KW_Goto }, diff --git a/aldor/aldor/src/absyn.h b/aldor/aldor/src/absyn.h index 9c566df94..6eb5ff200 100644 --- a/aldor/aldor/src/absyn.h +++ b/aldor/aldor/src/absyn.h @@ -68,7 +68,7 @@ enum abSynTag { AB_Fix, AB_Fluid, AB_For, - AB_Foreign, + AB_ForeignImport, AB_Free, AB_Generate, AB_Goto, @@ -150,7 +150,7 @@ typedef Enum(abSynTag) AbSynTag; # define abNewFluid(p,b) abNew(AB_Fluid, p,1, b) # define abNewFix(p,b) abNew(AB_Fix, p,1, b) # define abNewFor(p,v,i,c) abNew(AB_For, p,3, v,i,c) -# define abNewForeign(p,w,o) abNew(AB_Foreign, p,2, w,o) +# define abNewForeignImport(p,w,o) abNew(AB_ForeignImport,p,2, w,o) # define abNewFree(p,b) abNew(AB_Free, p,1, b) # define abNewGenerate(p,n,e) abNew(AB_Generate, p,2, n,e) # define abNewGoto(p,l) abNew(AB_Goto, p,1, l) @@ -497,7 +497,7 @@ struct abFor { AbSyn test; }; -struct abForeign { +struct abForeignImport { struct abHdr hdr; AbSyn what; AbSyn origin; @@ -770,7 +770,7 @@ union abSyn { struct abFix abFix; struct abFluid abFluid; struct abFor abFor; - struct abForeign abForeign; + struct abForeignImport abForeignImport; struct abFree abFree; struct abGenerate abGenerate; struct abGoto abGoto; @@ -1164,7 +1164,7 @@ extern AbSyn abNewDocTextOfList (TokenList); case AB_Fix: fun##Fix args; break; \ case AB_Fluid: fun##Fluid args; break; \ case AB_For: fun##For args; break; \ - case AB_Foreign: fun##Foreign args; break; \ + case AB_ForeignImport: fun##ForeignImport args; break; \ case AB_Free: fun##Free args; break; \ case AB_Generate: fun##Generate args; break; \ case AB_Goto: fun##Goto args; break; \ diff --git a/aldor/aldor/src/abuse.c b/aldor/aldor/src/abuse.c index d0063a8b0..c9c3ee55c 100644 --- a/aldor/aldor/src/abuse.c +++ b/aldor/aldor/src/abuse.c @@ -143,9 +143,9 @@ abPutUse(AbSyn absyn, AbUse context) for (i = 0; i < abArgc(absyn); i++) abPutUse(absyn->abFree.argv[i], AB_Use_Declaration); break; - case AB_Foreign: - abPutUse(absyn->abForeign.what, AB_Use_Declaration); - abPutUse(absyn->abForeign.origin, AB_Use_Type); + case AB_ForeignImport: + abPutUse(absyn->abForeignImport.what, AB_Use_Declaration); + abPutUse(absyn->abForeignImport.origin, AB_Use_Type); break; case AB_Builtin: abPutUse(absyn->abBuiltin.what, AB_Use_Declaration); diff --git a/aldor/aldor/src/genfoam.c b/aldor/aldor/src/genfoam.c index 590c63987..9b28d67c1 100644 --- a/aldor/aldor/src/genfoam.c +++ b/aldor/aldor/src/genfoam.c @@ -102,7 +102,7 @@ local Foam genNever (AbSyn); local Foam genWhere (AbSyn); local Foam genExport (AbSyn); local Foam genSelect (AbSyn); -local Foam genForeign (AbSyn); +local Foam genForeignImport (AbSyn); local Foam genRestrict (AbSyn); /***************************************************************************** @@ -895,8 +895,8 @@ genFoam(AbSyn absyn) case AB_Nothing: case AB_Inline: break; - case AB_Foreign: - genForeign(absyn); + case AB_ForeignImport: + genForeignImport(absyn); break; case AB_Has: foam = genHas(absyn); @@ -1067,9 +1067,9 @@ gen0ExportToC(AbSyn absyn) * Generate Foreign inclusion hints. */ local Foam -genForeign(AbSyn absyn) +genForeignImport(AbSyn absyn) { - AbSyn origin = absyn->abForeign.origin; + AbSyn origin = absyn->abForeignImport.origin; ForeignOrigin forg; Foam decl; diff --git a/aldor/aldor/src/scobind.c b/aldor/aldor/src/scobind.c index 8906ab112..f4153ff8b 100644 --- a/aldor/aldor/src/scobind.c +++ b/aldor/aldor/src/scobind.c @@ -252,7 +252,7 @@ local void scobindExport (AbSyn); local void scobindExtend (AbSyn); local void scobindFluid (AbSyn); local void scobindFor (AbSyn); -local void scobindForeign (AbSyn); +local void scobindForeignImport (AbSyn); local void scobindFree (AbSyn); local void scobindImport (AbSyn); local void scobindInline (AbSyn); @@ -615,7 +615,7 @@ scobindValue(AbSyn absyn) case AB_Extend: case AB_Fluid: case AB_For: - case AB_Foreign: + case AB_ForeignImport: case AB_Free: case AB_Import: case AB_Inline: @@ -770,8 +770,8 @@ scobindContext(AbSyn absyn) scobindFor(absyn); break; - case AB_Foreign: - scobindForeign(absyn); + case AB_ForeignImport: + scobindForeignImport(absyn); break; case AB_Free: @@ -2560,15 +2560,15 @@ scobindForId(AbSyn id, AbSyn type) /****************************************************************************** * - * :: scobindForeign + * :: scobindForeignImport * *****************************************************************************/ local void -scobindForeign(AbSyn ab) +scobindForeignImport(AbSyn ab) { - AbSyn origin = ab->abForeign.origin; - AbSyn what = ab->abForeign.what; + AbSyn origin = ab->abForeignImport.origin; + AbSyn what = ab->abForeignImport.what; AbSyn *argv = abArgvAs(AB_Sequence, what); Length i, argc = abArgcAs(AB_Sequence, what); diff --git a/aldor/aldor/src/ti_bup.c b/aldor/aldor/src/ti_bup.c index 0f7121b2f..cefb50f08 100644 --- a/aldor/aldor/src/ti_bup.c +++ b/aldor/aldor/src/ti_bup.c @@ -129,7 +129,7 @@ local void tibupExtend (Stab, AbSyn, TForm); local void tibupFix (Stab, AbSyn, TForm); local void tibupFluid (Stab, AbSyn, TForm); local void tibupFor (Stab, AbSyn, TForm); -local void tibupForeign (Stab, AbSyn, TForm); +local void tibupForeignImport(Stab, AbSyn, TForm); local void tibupFree (Stab, AbSyn, TForm); local void tibupGenerate (Stab, AbSyn, TForm); local void tibupReference (Stab, AbSyn, TForm); @@ -2650,9 +2650,9 @@ tibupFor(Stab stab, AbSyn absyn, TForm type) ***************************************************************************/ local void -tibupForeign(Stab stab, AbSyn absyn, TForm type) +tibupForeignImport(Stab stab, AbSyn absyn, TForm type) { - tibup(stab, absyn->abForeign.what, tfUnknown); + tibup(stab, absyn->abForeignImport.what, tfUnknown); abTPoss(absyn) = tpossSingleton(tfNone()); } diff --git a/aldor/aldor/src/ti_sef.c b/aldor/aldor/src/ti_sef.c index 7b0b2d360..b2c1e5a55 100644 --- a/aldor/aldor/src/ti_sef.c +++ b/aldor/aldor/src/ti_sef.c @@ -81,7 +81,7 @@ local void tisefExtend (Stab, Sefo); local void tisefFix (Stab, Sefo); local void tisefFluid (Stab, Sefo); local void tisefFor (Stab, Sefo); -local void tisefForeign (Stab, Sefo); +local void tisefForeignImport(Stab, Sefo); local void tisefFree (Stab, Sefo); local void tisefGenerate (Stab, Sefo); local void tisefReference (Stab, Sefo); @@ -1017,12 +1017,12 @@ tisefFor(Stab stab, Sefo sefo) /**************************************************************************** * - * :: Foreign: import ... from Foreign(...) + * :: ForeignImport: import ... from Foreign(...) * ***************************************************************************/ local void -tisefForeign(Stab stab, Sefo sefo) +tisefForeignImport(Stab stab, Sefo sefo) { tisef0Generic(stab, sefo); } diff --git a/aldor/aldor/src/ti_tdn.c b/aldor/aldor/src/ti_tdn.c index 42ae684e4..cd487193b 100644 --- a/aldor/aldor/src/ti_tdn.c +++ b/aldor/aldor/src/ti_tdn.c @@ -116,7 +116,7 @@ local Bool titdnExtend (Stab, AbSyn, TForm); local Bool titdnFix (Stab, AbSyn, TForm); local Bool titdnFluid (Stab, AbSyn, TForm); local Bool titdnFor (Stab, AbSyn, TForm); -local Bool titdnForeign (Stab, AbSyn, TForm); +local Bool titdnForeignImport(Stab, AbSyn, TForm); local Bool titdnFree (Stab, AbSyn, TForm); local Bool titdnGenerate (Stab, AbSyn, TForm); local Bool titdnGoto (Stab, AbSyn, TForm); @@ -1837,15 +1837,15 @@ local Bool titdnForeignJava(Stab stab, AbSyn absyn); local Bool titdnForeignJavaDeclare(Stab stab, AbSyn decl); local Bool -titdnForeign(Stab stab, AbSyn absyn, TForm type) +titdnForeignImport(Stab stab, AbSyn absyn, TForm type) { - ForeignOrigin forg = forgFrAbSyn(absyn->abForeign.origin); + ForeignOrigin forg = forgFrAbSyn(absyn->abForeignImport.origin); Bool ok; - titdn(stab, absyn->abForeign.what, tfUnknown); + titdn(stab, absyn->abForeignImport.what, tfUnknown); switch (forg->protocol) { case FOAM_Proto_Java: - ok = titdnForeignJava(stab, absyn->abForeign.what); + ok = titdnForeignJava(stab, absyn->abForeignImport.what); break; default: ok = true; @@ -2788,8 +2788,8 @@ titdnError(Stab stab, AbSyn absyn, TForm type) titdnError(stab, absyn->abFor.test, tfBoolean); titdnError(stab, absyn->abFor.lhs, tfUnknown); break; - case AB_Foreign: - titdnError(stab, absyn->abForeign.what, tfUnknown); + case AB_ForeignImport: + titdnError(stab, absyn->abForeignImport.what, tfUnknown); break; case AB_Import: titdnError(stab, absyn->abImport.what, tfUnknown); diff --git a/aldor/lib/ax0/src/ax/aggcat.ax b/aldor/lib/ax0/src/ax/aggcat.ax index f859e4960..0c0f3c7d0 100644 --- a/aldor/lib/ax0/src/ax/aggcat.ax +++ b/aldor/lib/ax0/src/ax/aggcat.ax @@ -2,7 +2,7 @@ (|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) + (|ForeignImport| (|Declare| |dummyDefault| |Exit|) |Lisp|) (|Define| (|Declare| |BitAggregate| |Category|) (|With| diff --git a/aldor/lib/ax0/src/ax/array2.ax b/aldor/lib/ax0/src/ax/array2.ax index 208958f65..0d421fd37 100644 --- a/aldor/lib/ax0/src/ax/array2.ax +++ b/aldor/lib/ax0/src/ax/array2.ax @@ -1,7 +1,7 @@ (|Sequence| (|Import| NIL |AxiomLib|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) + (|ForeignImport| (|Declare| |dummyDefault| |Exit|) |Lisp|) (|Export| (|Declare| |TwoDimensionalArray| diff --git a/aldor/lib/ax0/src/ax/basecliq.ax b/aldor/lib/ax0/src/ax/basecliq.ax index eb8fd8207..5760f3f54 100644 --- a/aldor/lib/ax0/src/ax/basecliq.ax +++ b/aldor/lib/ax0/src/ax/basecliq.ax @@ -2,7 +2,7 @@ (|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) + (|ForeignImport| (|Declare| |dummyDefault| |Exit|) |Lisp|) (|Export| (|Declare| |DoubleFloat| |SetCategory|) NIL NIL) (|Export| (|Declare| |Float| |SetCategory|) NIL NIL) (|Export| (|Declare| |Integer| |IntegralDomain|) NIL NIL) diff --git a/aldor/lib/ax0/src/ax/equation1.ax b/aldor/lib/ax0/src/ax/equation1.ax index 6e983fc24..3e3d54f06 100644 --- a/aldor/lib/ax0/src/ax/equation1.ax +++ b/aldor/lib/ax0/src/ax/equation1.ax @@ -1,7 +1,7 @@ (|Sequence| (|Import| NIL |AxiomLib|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) + (|ForeignImport| (|Declare| |dummyDefault| |Exit|) |Lisp|) (|Define| (|Declare| |Evalable| diff --git a/aldor/lib/ax0/src/ax/equation2.ax b/aldor/lib/ax0/src/ax/equation2.ax index adac54541..e91310f03 100644 --- a/aldor/lib/ax0/src/ax/equation2.ax +++ b/aldor/lib/ax0/src/ax/equation2.ax @@ -2,7 +2,7 @@ (|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) + (|ForeignImport| (|Declare| |dummyDefault| |Exit|) |Lisp|) (|Define| (|Declare| |FullyEvalableOver| diff --git a/aldor/lib/ax0/src/ax/fraction.ax b/aldor/lib/ax0/src/ax/fraction.ax index 365fcdb25..2dda78741 100644 --- a/aldor/lib/ax0/src/ax/fraction.ax +++ b/aldor/lib/ax0/src/ax/fraction.ax @@ -2,7 +2,7 @@ (|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) + (|ForeignImport| (|Declare| |dummyDefault| |Exit|) |Lisp|) (|Export| (|Declare| |FractionFunctions2| diff --git a/aldor/lib/ax0/src/ax/fspace.ax b/aldor/lib/ax0/src/ax/fspace.ax index 616f9bf40..f7365000b 100644 --- a/aldor/lib/ax0/src/ax/fspace.ax +++ b/aldor/lib/ax0/src/ax/fspace.ax @@ -2,7 +2,7 @@ (|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) + (|ForeignImport| (|Declare| |dummyDefault| |Exit|) |Lisp|) (|Export| (|Declare| |FunctionSpaceFunctions2| diff --git a/aldor/lib/ax0/src/ax/matcat.ax b/aldor/lib/ax0/src/ax/matcat.ax index 03d48e38a..f54ec0397 100644 --- a/aldor/lib/ax0/src/ax/matcat.ax +++ b/aldor/lib/ax0/src/ax/matcat.ax @@ -2,7 +2,7 @@ (|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) + (|ForeignImport| (|Declare| |dummyDefault| |Exit|) |Lisp|) (|Define| (|Declare| |SquareMatrixCategory| diff --git a/aldor/lib/ax0/src/ax/polycat.ax b/aldor/lib/ax0/src/ax/polycat.ax index afb1319e3..633f609f2 100644 --- a/aldor/lib/ax0/src/ax/polycat.ax +++ b/aldor/lib/ax0/src/ax/polycat.ax @@ -2,7 +2,7 @@ (|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) + (|ForeignImport| (|Declare| |dummyDefault| |Exit|) |Lisp|) (|Export| (|Declare| |CommuteUnivariatePolynomialCategory| diff --git a/aldor/lib/ax0/src/ax/sf.ax b/aldor/lib/ax0/src/ax/sf.ax index d83f522c6..457617fe4 100644 --- a/aldor/lib/ax0/src/ax/sf.ax +++ b/aldor/lib/ax0/src/ax/sf.ax @@ -2,7 +2,7 @@ (|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) + (|ForeignImport| (|Declare| |dummyDefault| |Exit|) |Lisp|) (|Extend| (|Define| (|Declare| diff --git a/aldor/lib/ax0/src/ax/si.ax b/aldor/lib/ax0/src/ax/si.ax index e7cce1c83..6f1befa74 100644 --- a/aldor/lib/ax0/src/ax/si.ax +++ b/aldor/lib/ax0/src/ax/si.ax @@ -2,7 +2,7 @@ (|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) + (|ForeignImport| (|Declare| |dummyDefault| |Exit|) |Lisp|) (|Extend| (|Define| (|Declare| diff --git a/aldor/lib/ax0/src/ax/stream.ax b/aldor/lib/ax0/src/ax/stream.ax index fc8917777..558b24cf9 100644 --- a/aldor/lib/ax0/src/ax/stream.ax +++ b/aldor/lib/ax0/src/ax/stream.ax @@ -1,7 +1,7 @@ (|Sequence| (|Import| NIL |AxiomLib|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) + (|ForeignImport| (|Declare| |dummyDefault| |Exit|) |Lisp|) (|Export| (|Declare| |StreamFunctions3| diff --git a/aldor/lib/ax0/src/ax/vector.ax b/aldor/lib/ax0/src/ax/vector.ax index 45744ad9c..44fb43f2a 100644 --- a/aldor/lib/ax0/src/ax/vector.ax +++ b/aldor/lib/ax0/src/ax/vector.ax @@ -2,7 +2,7 @@ (|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) + (|ForeignImport| (|Declare| |dummyDefault| |Exit|) |Lisp|) (|Export| (|Declare| |DirectProductFunctions2| From f5c2c98167c5aa6e016410d0c7bbb18f29ceb864 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 30 Sep 2017 16:07:28 +0100 Subject: [PATCH 199/352] aldor/src: Add AB_ForeignExport Similar to imports, but for exports. --- aldor/aldor/src/abnorm.c | 37 ++++++++++++++++++++++++++++++++++++- aldor/aldor/src/absyn.c | 1 + aldor/aldor/src/absyn.h | 10 ++++++++++ aldor/aldor/src/genfoam.c | 34 ++++++++++++++++++++++++++++++++++ aldor/aldor/src/scobind.c | 25 +++++++++++++++++++++++++ aldor/aldor/src/ti_bup.c | 14 ++++++++++++++ aldor/aldor/src/ti_sef.c | 13 +++++++++++++ aldor/aldor/src/ti_tdn.c | 20 ++++++++++++++++++++ 8 files changed, 153 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/abnorm.c b/aldor/aldor/src/abnorm.c index 4ca7b84d8..ef3e45802 100644 --- a/aldor/aldor/src/abnorm.c +++ b/aldor/aldor/src/abnorm.c @@ -990,6 +990,9 @@ abn0ImportSeq(AbSyn ab) * generated statement looks like [Export [With ...] id]. */ +local AbSyn abnExportTo(AbSyn ab); +local AbSyn abnExportToForeign(AbSyn ab); + local AbSyn abnExport(AbSyn ab) { @@ -1000,7 +1003,7 @@ abnExport(AbSyn ab) int i, n = abArgc(ab->abExport.origin); if (!abHasTag(dest, AB_Nothing)) - return ab; + return abnExportTo(ab); if (abHasTag(dest, AB_Nothing) && abHasTag(origin, AB_Nothing)) return ab; @@ -1036,6 +1039,38 @@ abnExport(AbSyn ab) return origin; } +local AbSyn +abnExportTo(AbSyn ab) +{ + AbSyn dest = ab->abExport.destination; + + if (abIsTheId(dest, ssymForeign)) { + return abnExportToForeign(ab); + } + else if (abIsApplyOf(dest, ssymForeign)) { + return abnExportToForeign(ab); + } + else { + return ab; + } +} + +local AbSyn +abnExportToForeign(AbSyn ab) +{ + AbSyn what = ab->abExport.what; + AbSyn dest = ab->abExport.destination; + AbSyn origin = ab->abExport.origin; + SrcPos pos = abPos(ab); + + if (!abIsNothing(origin)) + return ab; + + abFreeNode(ab); + + return abNewForeignExport(pos, what, dest); +} + /***************************************************************************** * * :: Inline diff --git a/aldor/aldor/src/absyn.c b/aldor/aldor/src/absyn.c index 400d5c032..4276432ce 100644 --- a/aldor/aldor/src/absyn.c +++ b/aldor/aldor/src/absyn.c @@ -1552,6 +1552,7 @@ struct ab_info abInfoTable[] = { {AB_Fluid, 0, 0, "Fluid", KW_Fluid }, {AB_For, 0, 0, "For", KW_For }, {AB_ForeignImport,0, 0, "ForeignImport",TK_LIMIT }, + {AB_ForeignExport,0, 0, "ForeignExport",TK_LIMIT }, {AB_Free, 0, 0, "Free", KW_Free }, {AB_Generate, 0, 0, "Generate", KW_Generate }, {AB_Goto, 0, 0, "Goto", KW_Goto }, diff --git a/aldor/aldor/src/absyn.h b/aldor/aldor/src/absyn.h index 6eb5ff200..9ebb55e03 100644 --- a/aldor/aldor/src/absyn.h +++ b/aldor/aldor/src/absyn.h @@ -69,6 +69,7 @@ enum abSynTag { AB_Fluid, AB_For, AB_ForeignImport, + AB_ForeignExport, AB_Free, AB_Generate, AB_Goto, @@ -151,6 +152,7 @@ typedef Enum(abSynTag) AbSynTag; # define abNewFix(p,b) abNew(AB_Fix, p,1, b) # define abNewFor(p,v,i,c) abNew(AB_For, p,3, v,i,c) # define abNewForeignImport(p,w,o) abNew(AB_ForeignImport,p,2, w,o) +# define abNewForeignExport(p,w,o) abNew(AB_ForeignExport,p,2, w,o) # define abNewFree(p,b) abNew(AB_Free, p,1, b) # define abNewGenerate(p,n,e) abNew(AB_Generate, p,2, n,e) # define abNewGoto(p,l) abNew(AB_Goto, p,1, l) @@ -503,6 +505,12 @@ struct abForeignImport { AbSyn origin; }; +struct abForeignExport { + struct abHdr hdr; + AbSyn what; + AbSyn dest; +}; + struct abFree { struct abHdr hdr; AbSyn argv[NARY]; @@ -771,6 +779,7 @@ union abSyn { struct abFluid abFluid; struct abFor abFor; struct abForeignImport abForeignImport; + struct abForeignExport abForeignExport; struct abFree abFree; struct abGenerate abGenerate; struct abGoto abGoto; @@ -1165,6 +1174,7 @@ extern AbSyn abNewDocTextOfList (TokenList); case AB_Fluid: fun##Fluid args; break; \ case AB_For: fun##For args; break; \ case AB_ForeignImport: fun##ForeignImport args; break; \ + case AB_ForeignExport: fun##ForeignExport args; break; \ case AB_Free: fun##Free args; break; \ case AB_Generate: fun##Generate args; break; \ case AB_Goto: fun##Goto args; break; \ diff --git a/aldor/aldor/src/genfoam.c b/aldor/aldor/src/genfoam.c index 9b28d67c1..10d066ff1 100644 --- a/aldor/aldor/src/genfoam.c +++ b/aldor/aldor/src/genfoam.c @@ -103,6 +103,7 @@ local Foam genWhere (AbSyn); local Foam genExport (AbSyn); local Foam genSelect (AbSyn); local Foam genForeignImport (AbSyn); +local Foam genForeignExport (AbSyn); local Foam genRestrict (AbSyn); /***************************************************************************** @@ -898,6 +899,9 @@ genFoam(AbSyn absyn) case AB_ForeignImport: genForeignImport(absyn); break; + case AB_ForeignExport: + genForeignExport(absyn); + break; case AB_Has: foam = genHas(absyn); break; @@ -1099,6 +1103,36 @@ genForeignImport(AbSyn absyn) return (Foam)NULL; } +/* + * Generate Foreign inclusion hints. + */ +local Foam +genForeignExport(AbSyn absyn) +{ + AbSyn what = absyn->abForeignExport.what; + AbSyn dest = absyn->abForeignExport.dest; + AbSyn *argv; + Symbol sym = gen0ExportingTo(dest); + int argc, i; + + AB_SEQ_ITER(what, argc, argv); + + for (i = 0; i < argc; i += 1) { + AbSyn ab = argv[i]; + genFoamStmt(ab); + if (sym == ssymBuiltin) + gen0ExportToBuiltin(ab); + else if (sym == ssymC) + gen0ExportToC(ab); + else if (sym == ssymFortran) + gen0ExportToFortran(ab); + else + comsgFatal(ab, ALDOR_F_Bug, "Export not implemented"); + } + return 0; + +} + local Foam genNever(AbSyn absyn) { diff --git a/aldor/aldor/src/scobind.c b/aldor/aldor/src/scobind.c index f4153ff8b..736bec2af 100644 --- a/aldor/aldor/src/scobind.c +++ b/aldor/aldor/src/scobind.c @@ -253,6 +253,7 @@ local void scobindExtend (AbSyn); local void scobindFluid (AbSyn); local void scobindFor (AbSyn); local void scobindForeignImport (AbSyn); +local void scobindForeignExport (AbSyn); local void scobindFree (AbSyn); local void scobindImport (AbSyn); local void scobindInline (AbSyn); @@ -616,6 +617,7 @@ scobindValue(AbSyn absyn) case AB_Fluid: case AB_For: case AB_ForeignImport: + case AB_ForeignExport: case AB_Free: case AB_Import: case AB_Inline: @@ -774,6 +776,10 @@ scobindContext(AbSyn absyn) scobindForeignImport(absyn); break; + case AB_ForeignExport: + scobindForeignExport(absyn); + break; + case AB_Free: scobindFree(absyn); break; @@ -2379,6 +2385,25 @@ scobindExportId(AbSyn id, AbSyn type, AbSyn val) (AInt) doc); } +/****************************************************************************** + * + * :: scobindForeignExport + * + *****************************************************************************/ + +local void +scobindForeignExport(AbSyn ab) +{ + AbSyn dest = ab->abForeignExport.dest; + AbSyn what = ab->abForeignExport.what; + + scoIsInExport = true; + + scobindLOF(what, SCO_Sig_Local); + + scoIsInExport = false; +} + /****************************************************************************** * * :: scobindFluid diff --git a/aldor/aldor/src/ti_bup.c b/aldor/aldor/src/ti_bup.c index cefb50f08..f6cee3ed9 100644 --- a/aldor/aldor/src/ti_bup.c +++ b/aldor/aldor/src/ti_bup.c @@ -130,6 +130,7 @@ local void tibupFix (Stab, AbSyn, TForm); local void tibupFluid (Stab, AbSyn, TForm); local void tibupFor (Stab, AbSyn, TForm); local void tibupForeignImport(Stab, AbSyn, TForm); +local void tibupForeignExport(Stab, AbSyn, TForm); local void tibupFree (Stab, AbSyn, TForm); local void tibupGenerate (Stab, AbSyn, TForm); local void tibupReference (Stab, AbSyn, TForm); @@ -2656,6 +2657,19 @@ tibupForeignImport(Stab stab, AbSyn absyn, TForm type) abTPoss(absyn) = tpossSingleton(tfNone()); } +/**************************************************************************** + * + * :: Foreign: import ... from Foreign(...) + * + ***************************************************************************/ + +local void +tibupForeignExport(Stab stab, AbSyn absyn, TForm type) +{ + tibup(stab, absyn->abForeignExport.what, tfUnknown); + abTPoss(absyn) = tpossSingleton(tfNone()); +} + /**************************************************************************** * * :: Import: import ... from D diff --git a/aldor/aldor/src/ti_sef.c b/aldor/aldor/src/ti_sef.c index b2c1e5a55..e2f20d170 100644 --- a/aldor/aldor/src/ti_sef.c +++ b/aldor/aldor/src/ti_sef.c @@ -82,6 +82,7 @@ local void tisefFix (Stab, Sefo); local void tisefFluid (Stab, Sefo); local void tisefFor (Stab, Sefo); local void tisefForeignImport(Stab, Sefo); +local void tisefForeignExport(Stab, Sefo); local void tisefFree (Stab, Sefo); local void tisefGenerate (Stab, Sefo); local void tisefReference (Stab, Sefo); @@ -1015,6 +1016,18 @@ tisefFor(Stab stab, Sefo sefo) tisef0ApplySymIfNeeded(stab,sefo,1,abForIterArgf,NULL,tfIsGeneratorFn); } +/**************************************************************************** + * + * :: ForeignExport: export ... from Foreign(...) + * + ***************************************************************************/ + +local void +tisefForeignExport(Stab stab, Sefo sefo) +{ + tisef0Generic(stab, sefo); +} + /**************************************************************************** * * :: ForeignImport: import ... from Foreign(...) diff --git a/aldor/aldor/src/ti_tdn.c b/aldor/aldor/src/ti_tdn.c index cd487193b..5d83dbd7d 100644 --- a/aldor/aldor/src/ti_tdn.c +++ b/aldor/aldor/src/ti_tdn.c @@ -117,6 +117,7 @@ local Bool titdnFix (Stab, AbSyn, TForm); local Bool titdnFluid (Stab, AbSyn, TForm); local Bool titdnFor (Stab, AbSyn, TForm); local Bool titdnForeignImport(Stab, AbSyn, TForm); +local Bool titdnForeignExport(Stab, AbSyn, TForm); local Bool titdnFree (Stab, AbSyn, TForm); local Bool titdnGenerate (Stab, AbSyn, TForm); local Bool titdnGoto (Stab, AbSyn, TForm); @@ -1930,6 +1931,22 @@ titdnForeignJavaDeclare(Stab stab, AbSyn decl) return true; } +/**************************************************************************** + * + * :: export: export ... to D + * + ***************************************************************************/ + +local Bool +titdnForeignExport(Stab stab, AbSyn absyn, TForm type) +{ + AbSyn what = absyn->abForeignExport.what; + + titdn(stab, absyn->abForeignExport.what, tfUnknown); + + abTUnique(absyn) = type; + return true; +} /**************************************************************************** * @@ -2791,6 +2808,9 @@ titdnError(Stab stab, AbSyn absyn, TForm type) case AB_ForeignImport: titdnError(stab, absyn->abForeignImport.what, tfUnknown); break; + case AB_ForeignExport: + titdnError(stab, absyn->abForeignExport.what, tfUnknown); + break; case AB_Import: titdnError(stab, absyn->abImport.what, tfUnknown); break; From 3f44bc7c6605d0feef51be47f9e0b04f072ebc7b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 1 Oct 2017 12:15:11 +0100 Subject: [PATCH 200/352] java/javaobj.c: Add a common jcoAlloc function --- aldor/aldor/src/java/javaobj.c | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/aldor/aldor/src/java/javaobj.c b/aldor/aldor/src/java/javaobj.c index f0294a014..377fc1db3 100644 --- a/aldor/aldor/src/java/javaobj.c +++ b/aldor/aldor/src/java/javaobj.c @@ -7,11 +7,20 @@ CREATE_LIST(JavaCode); local void jco0Indent(JavaCodePContext ctxt); +local JavaCode jcoAlloc(int sz); + +local JavaCode jcoAlloc(int sz) +{ + JavaCode jco = (JavaCode) (stoAlloc(OB_JCode, sz)); + + return jco; +} + + JavaCode jcoNewNode(JavaCodeClass clss, int argc) { - JavaCode jco = (JavaCode) (stoAlloc( (int) OB_JCode, - fullsizeof(struct jcoNode, argc, JavaCode))); + JavaCode jco = jcoAlloc(fullsizeof(struct jcoNode, argc, JavaCode)); assert(clss); jcoTag(jco) = JCO_JAVA; @@ -29,7 +38,7 @@ jcoNewToken(JavaCodeClass clss, Symbol sym) assert(clss && sym); - jco = (JavaCode) stoAlloc((int) OB_JCode, sizeof(struct jcoToken)); + jco = jcoAlloc(sizeof(struct jcoToken)); jcoTag(jco) = JCO_TOKEN; jcoClass(jco) = clss; jcoPos(jco) = sposNone; @@ -43,7 +52,8 @@ jcoNewLiteral(JavaCodeClass clss, String txt) { JavaCode jco; assert(clss && txt); - jco = (JavaCode) stoAlloc((int) OB_JCode, sizeof(struct jcoLiteral)); + jco = jcoAlloc(sizeof(struct jcoLiteral)); + jcoTag(jco) = JCO_LIT; jcoClass(jco) = clss; jcoPos(jco) = sposNone; @@ -61,7 +71,7 @@ jcoNewImport(JavaCodeClass clss, String pkg, String name, Bool isImported) assert(pkg != NULL); assert(name != NULL); - jco = (JavaCode) stoAlloc((int) OB_JCode, sizeof(struct jcoImport)); + jco = jcoAlloc(sizeof(struct jcoImport)); assert(clss && pkg && name); jcoTag(jco) = JCO_IMPORT; From 8d03b0ea6ac8fdb750618606a79c1d8c9e99c028 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 1 Oct 2017 12:23:26 +0100 Subject: [PATCH 201/352] foam.c: Add foamGDecl functions fun facts about globals. --- aldor/aldor/src/foam.c | 25 +++++++++++++++++++++++++ aldor/aldor/src/foam.h | 3 +++ 2 files changed, 28 insertions(+) diff --git a/aldor/aldor/src/foam.c b/aldor/aldor/src/foam.c index 48a7a4459..b67a2a056 100644 --- a/aldor/aldor/src/foam.c +++ b/aldor/aldor/src/foam.c @@ -2073,6 +2073,31 @@ foamFrString(String s) return foam; } +/***************************************************************************** + * + * :: FOAM_GDecl + * + ****************************************************************************/ + +Bool +foamGDeclIsExport(Foam foam) +{ + return foam->foamGDecl.dir == FOAM_GDecl_Export; +} + +Bool +foamGDeclIsImport(Foam foam) +{ + return foam->foamGDecl.dir == FOAM_GDecl_Import; +} + +Bool +foamGDeclIsExportOf(AInt tag, Foam foam) +{ + return foamGDeclIsExport(foam) && foam->foamGDecl.protocol == tag; +} + + /***************************************************************************** * * :: Byte code conversion to/from Buffer diff --git a/aldor/aldor/src/foam.h b/aldor/aldor/src/foam.h index 3dcfa792e..8253f9f41 100644 --- a/aldor/aldor/src/foam.h +++ b/aldor/aldor/src/foam.h @@ -683,6 +683,9 @@ struct foamClos { (AInt)FOAM_Nil,f, \ (AInt)(pr),(AInt)(dir)) #define foamGDeclSetRType(fm,ty) ((fm)->foamGDecl.rtype = (ty)) +extern Bool foamGDeclIsImport(Foam); +extern Bool foamGDeclIsExport(Foam); +extern Bool foamGDeclIsExportOf(AInt, Foam); struct foamGDecl { struct foamHdr hdr; From e7823495f45f1e6d8677656ee14a90503ff9690c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 1 Oct 2017 12:25:31 +0100 Subject: [PATCH 202/352] genc.c: Use foamGDecl functions --- aldor/aldor/src/genc.c | 21 +++++---------------- 1 file changed, 5 insertions(+), 16 deletions(-) diff --git a/aldor/aldor/src/genc.c b/aldor/aldor/src/genc.c index d25430c85..47b4d3deb 100644 --- a/aldor/aldor/src/genc.c +++ b/aldor/aldor/src/genc.c @@ -321,7 +321,6 @@ local int gc0IsNewHeader (String); local void gc0AddHeaderIfNeeded (String); local CCode gc0ModuleInitFun (String, int); -local Bool gc0IsGloExported (int); local CCode gc0ListOf (CCodeTag, CCodeList); local void gc0AddLineFun (CCodeList *, CCode); local Bool gc0IsReturn (CCode); @@ -1147,9 +1146,8 @@ gc0CreateGloList(String name) /* Handle Exports to C/Fortran */ - if (gc0IsGloExported(i) && - (gdecl->foamGDecl.protocol == FOAM_Proto_C || - gdecl->foamGDecl.protocol == FOAM_Proto_Fortran)) { + if (foamGDeclIsExportOf(FOAM_Proto_C, gdecl) + || foamGDeclIsExportOf(FOAM_Proto_Fortran, gdecl)) { Foam fakedecl; CCode cco; @@ -4411,7 +4409,7 @@ gccGetVar(Foam foam) case FOAM_Proto_Foam: case FOAM_Proto_Init: - if (!gc0IsGloExported(idx)) { + if (!foamGDeclIsExport(decl)) { ccode = gc0MultVarId("pG", idx, s); ccode = ccoParen(ccoPreStar(ccode)); } @@ -4423,13 +4421,13 @@ gccGetVar(Foam foam) s = strCopy(s); s = gc0StompOffIncludeFile(s, FOAM_Proto_C); } - if (gc0IsGloExported(idx)) + if (foamGDeclIsExport(decl)) ccode = gc0MultVarId("G", idx, s); else ccode = ccoIdOf(s); break; case FOAM_Proto_Fortran: - if (gc0IsGloExported(idx)) + if (foamGDeclIsExport(decl)) ccode = gc0MultVarId("G", idx, s); else { s = gc0GenFortranName(s); @@ -6654,15 +6652,6 @@ gc0ModuleInitFun(String modName, int n) return gc0MultVarId(gcFiInitModulePrefix, n, modName); } -local Bool -gc0IsGloExported(int i) -{ - Foam decl = gcvGlo->foamDDecl.argv[i]; - - return (decl->foamGDecl.dir == FOAM_GDecl_Export); -} - - void ccodeListPrintDb(CCodeList cl) { From 5e310529d61cfd9e99e6edd98b0165bbc6f23557 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 1 Oct 2017 17:09:10 +0100 Subject: [PATCH 203/352] gf_java.c: Remove unused parameter on gfjPCallDecl --- aldor/aldor/src/gf_java.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/aldor/aldor/src/gf_java.c b/aldor/aldor/src/gf_java.c index 7b4338ee4..3b21c9993 100644 --- a/aldor/aldor/src/gf_java.c +++ b/aldor/aldor/src/gf_java.c @@ -19,7 +19,7 @@ local FoamList gfjProgAddParams(TForm tf); local FoamTag gfjPCallFoamType(TForm tf, AInt *pfmt); local Foam gfjPCallFoamToJava(TForm tf, Foam foam); local Foam gfjPCallJavaToFoam(TForm tf, Foam foam); -local AInt gfjPCallDecl(TForm tf, Bool); +local AInt gfjPCallDecl(TForm tf); local Foam gfjPCallDeclArg(TForm tf); local AInt gj0ClassDDecl(ForeignOrigin origin, String clsName); @@ -113,7 +113,7 @@ gfjImportApplyInner(Syme syme, AInt fmtNum) globName = (forg->file ? strPrintf("%s.%s.%s", forg->file, symeString(esyme), symeJavaApplyName(syme)) : strPrintf("%s.%s", symeString(esyme), symeJavaApplyName(syme))); - gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(innerTf, true), + gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(innerTf), FOAM_GDecl_Import, FOAM_Proto_JavaMethod); gnum = gen0AddGlobal(gdecl); fnName = strPrintf("%s-inner", symeJavaApplyName(syme)); @@ -176,7 +176,7 @@ gfjImportConstructor(Syme syme) symString(tfIdSym(exporter))); constNum = gen0NumProgs; - gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(symeType(syme), false), + gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(symeType(syme)), FOAM_GDecl_Import, FOAM_Proto_JavaConstructor); gnum = gen0AddGlobal(gdecl); @@ -229,7 +229,7 @@ gfjImportStaticCall(Syme syme) constNum = gen0NumProgs; - gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(symeType(syme), false), + gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(symeType(syme)), FOAM_GDecl_Import, FOAM_Proto_Java); gnum = gen0AddGlobal(gdecl); @@ -335,7 +335,7 @@ gfjPCallJavaToFoam(TForm tf, Foam foam) } local AInt -gfjPCallDecl(TForm tf, Bool method) +gfjPCallDecl(TForm tf) { FoamList decls; Foam ddecl; From 00f1bd8eb61688463711329a5681b37218b28822 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 1 Oct 2017 18:42:20 +0100 Subject: [PATCH 204/352] foam.c: Include return type in FOAM_Proto_JavaSig --- aldor/aldor/src/foam.c | 3 ++- aldor/aldor/src/gf_java.c | 6 ++++-- aldor/aldor/src/java/genjava.c | 5 ++++- 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/aldor/aldor/src/foam.c b/aldor/aldor/src/foam.c index b67a2a056..2227884d3 100644 --- a/aldor/aldor/src/foam.c +++ b/aldor/aldor/src/foam.c @@ -1153,7 +1153,8 @@ foamAuditPCallJava(Foam foam) /* Methods have an implicit argument. */ extra = foam->foamPCall.protocol == FOAM_Proto_JavaMethod ? 1 : 0; - if (foamDDeclArgc(ddecl) + extra != foamPCallArgc(foam)) + /* dock one for return type */ + if (foamDDeclArgc(ddecl) + extra - 1 != foamPCallArgc(foam)) foamAuditBadType(foam); } diff --git a/aldor/aldor/src/gf_java.c b/aldor/aldor/src/gf_java.c index 3b21c9993..86050035c 100644 --- a/aldor/aldor/src/gf_java.c +++ b/aldor/aldor/src/gf_java.c @@ -338,7 +338,7 @@ local AInt gfjPCallDecl(TForm tf) { FoamList decls; - Foam ddecl; + Foam ddecl, retdecl; int i; decls = listNil(Foam); @@ -349,7 +349,9 @@ gfjPCallDecl(TForm tf) decls = listCons(Foam)(decl, decls); } - ddecl = foamNewDDeclOfList(FOAM_DDecl_JavaSig, listNReverse(Foam)(decls)); + retdecl = gfjPCallDeclArg(tfMapRet(tf)); + ddecl = foamNewDDeclOfList(FOAM_DDecl_JavaSig, + listCons(Foam)(retdecl, listNReverse(Foam)(decls))); return gen0AddRealFormat(ddecl); diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index a6b8d5855..67c86426e 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -3560,7 +3560,10 @@ gj0PCallCastArgs(Foam op, JavaCodeList argsIn) JavaCodeList args = argsIn; Foam glo = gjContextGlobals->foamDDecl.argv[op->foamGlo.index]; Foam ddecl = gjContext->formats->foamDFmt.argv[glo->foamGDecl.format]; - int i = 0; + int i = 1; + + assert(ddecl->foamDDecl.usage == FOAM_DDecl_JavaSig); + assert(foamDDeclArgc(ddecl) == listLength(JavaCode)(argsIn)); /* Cast java-valued arguments - all other types are not converted */ while (args != listNil(JavaCode)) { From 9c158866a5fd8d7398c7acb625ad0eced7e83d4f Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 1 Oct 2017 18:42:46 +0100 Subject: [PATCH 205/352] test/Makefile: .ao depends on aldor executable. --- 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 d802d1053..0c6b619e9 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -169,6 +169,7 @@ $(patsubst %, out/ap/%.ap, $(_aotests)): out/ap/%.ap: %.as mkdir -p $$(dirname $@); \ $(aldorexedir)/aldor $(nfile) -Fap=$@ $(srcdir)/$*.as +$(patsubst %, out/ao/%.ao, $(_aotests)): $(aldorexedir)/aldor $(patsubst %, out/ao/%.ao, $(_aotests)): out/ao/%.ao: %.as $(AM_V_ALDOR) \ mkdir -p $$(dirname $@); \ From 2fb7914d6c24aae19bea18a4d620f958c06847e9 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Oct 2017 19:28:09 +0100 Subject: [PATCH 206/352] src/list.h: Add ListCopier type --- aldor/aldor/src/list.h | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/list.h b/aldor/aldor/src/list.h index 9a0daa0c8..84d545027 100644 --- a/aldor/aldor/src/list.h +++ b/aldor/aldor/src/list.h @@ -32,6 +32,7 @@ struct ListOpsStructName(Type) const *ListOps(Type) = \ (struct ListOpsStructName(Type) const *) &ptrlistOps +#define ListCopier(Type) Type (*)(Type) /* * Various list operations. @@ -138,9 +139,9 @@ Statement({ \ Bool (*IsLonger) (List(Type), Length); \ List(Type) (*Copy) (List(Type)); \ List(Type) (*CopyTo) (List(Type), List(Type)); \ - List(Type) (*CopyDeeply) (List(Type), Type (*f)(Type)); \ + List(Type) (*CopyDeeply) (List(Type), ListCopier(Type)); \ List(Type) (*CopyDeeplyTo) (List(Type), List(Type), \ - Type (*f) (Type) ); \ + ListCopier(Type)); \ List(Type) (*Map) (Type (*f)(Type), List(Type)); \ List(Type) (*NMap) (Type (*f)(Type), List(Type)); \ List(Type) (*Reverse) (List(Type)); \ From e7ccff5a14cf3c377f296849c5bf7086c1080637 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Oct 2017 19:36:55 +0100 Subject: [PATCH 207/352] javaobj.c: Add path to java imported ids .. An import is 'pkgname.path.Id', where path is a possibly empty list of classnames. --- aldor/aldor/src/java/javacode.c | 72 ++++++++++++++++++++++++--------- aldor/aldor/src/java/javacode.h | 10 ++++- aldor/aldor/src/java/javaobj.c | 19 +++++++-- aldor/aldor/src/java/javaobj.h | 4 +- 4 files changed, 80 insertions(+), 25 deletions(-) diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index 8e9c5e475..ad496e6fa 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -655,17 +655,26 @@ jcCommentSExpr(JavaCode code) */ JavaCode -jcImportedId(String pkg, String name) +jcImportedIdFrString(String str) { - return jcoNewImport(jc0ClassObj(JCO_CLSS_ImportedId), pkg, name, false); + String p = strLastIndexOf(str, '.'); + if (p == NULL) { + return jcId(strCopy(str)); + } + else { + String pkg = strnCopy(str, p - str); + String id = strCopy(p+1); + return jcImportedId(pkg, id); + } } JavaCode -jcImportedStaticId(String pkg, String name) +jcImportedId(String pkg, String name) { - return jcoNewImport(jc0ClassObj(JCO_CLSS_ImportedStatic), pkg, name, false); + return jcoNewImport(jc0ClassObj(JCO_CLSS_ImportedId), pkg, listNil(String), name, false); } + String jcImportedIdName(JavaCode id) { @@ -679,6 +688,47 @@ jcImportedIdPkg(JavaCode id) } +JavaCode +jcImportedStaticId(String pkg, String clss, String name) +{ + assert(strLastIndexOf(clss, '.') == NULL); + assert(strLastIndexOf(name, '.') == NULL); + + return jcoNewImport(jc0ClassObj(JCO_CLSS_ImportedStatic), pkg, + listSingleton(String)(clss), name, false); +} + +JavaCode +jcImportedStaticIdFrString(String str) +{ + String p = strLastIndexOf(str, '.'); + String id = strCopy(p+1); + String pkgClss = strnCopy(str, p - str); + String dclss = strLastIndexOf(pkgClss, '.'); + String clss = strCopy(dclss+1); + String pkg = strnCopy(pkgClss, dclss - pkgClss); + + return jcImportedStaticId(pkg, clss, id); +} + +String +jcImportedStaticIdClass(JavaCode importedId) +{ + return car(jcoImportPath(importedId)); +} + + +String +jcImportedStaticIdPkg(JavaCode importedId) +{ + return jcoImportPkg(importedId); +} + +String +jcImportedStaticIdName(JavaCode importedId) +{ + return jcImportedIdName(importedId); +} local void jcImportPrint(JavaCodePContext ctxt, JavaCode code) { @@ -1664,17 +1714,3 @@ jcIsId(String word) return true; } - -JavaCode -jcImportedIdFrString(String str) -{ - String p = strLastIndexOf(str, '.'); - if (p == NULL) { - return jcId(strCopy(str)); - } - else { - String pkg = strnCopy(str, p - str); - String id = strCopy(p+1); - return jcImportedId(pkg, id); - } -} diff --git a/aldor/aldor/src/java/javacode.h b/aldor/aldor/src/java/javacode.h index 6e8e9a885..1f522ea97 100644 --- a/aldor/aldor/src/java/javacode.h +++ b/aldor/aldor/src/java/javacode.h @@ -85,7 +85,7 @@ extern JavaCodeList jcCollectImports(JavaCode code); extern JavaCode jcDocumented(String comment, JavaCode code); extern JavaCode jcComment(String comment); extern JavaCode jcImportedId(String pkg, String name); -extern JavaCode jcImportedStaticId(String pkg, String name); +extern JavaCode jcImportedStaticId(String pkg, String clss, String name); extern JavaCode jcLiteralString(String s); extern JavaCode jcLiteralStringWithTerminalChar(String s); extern JavaCode jcLiteralChar(String s); @@ -157,9 +157,15 @@ extern SExpr jcNodeSExpr(JavaCode code); extern void jcNodePrint(JavaCodePContext ctxt, JavaCode code); extern Bool jcIsLegalClassName(String word); +extern JavaCode jcIdFrImported(JavaCode id); +extern JavaCode jcImportedIdFrString(String str); extern String jcImportedIdName(JavaCode); extern String jcImportedIdPkg(JavaCode); -extern JavaCode jcImportedIdFrString(String str); + +extern JavaCode jcImportedStaticIdFrString(String str); +extern String jcImportedStaticIdName(JavaCode); +extern String jcImportedStaticIdClass(JavaCode); +extern String jcImportedStaticIdPkg(JavaCode); extern String jcIdName(JavaCode); diff --git a/aldor/aldor/src/java/javaobj.c b/aldor/aldor/src/java/javaobj.c index 377fc1db3..2025918ee 100644 --- a/aldor/aldor/src/java/javaobj.c +++ b/aldor/aldor/src/java/javaobj.c @@ -65,7 +65,7 @@ jcoNewLiteral(JavaCodeClass clss, String txt) JavaCode -jcoNewImport(JavaCodeClass clss, String pkg, String name, Bool isImported) +jcoNewImport(JavaCodeClass clss, String pkg, StringList path, String name, Bool isImported) { JavaCode jco; assert(pkg != NULL); @@ -77,8 +77,9 @@ jcoNewImport(JavaCodeClass clss, String pkg, String name, Bool isImported) jcoTag(jco) = JCO_IMPORT; jcoClass(jco) = clss; jcoPos(jco) = sposNone; - jco->import.pkg = pkg; - jco->import.id = name; + jco->import.pkg = pkg; + jco->import.path = path; + jco->import.id = name; jcoImportSetImported(jco, isImported); return jco; @@ -155,7 +156,10 @@ jcoCopy(JavaCode code) return jcoNewToken(jcoClass(code), jcoToken(code)); if (jcoIsImport(code)) return jcoNewImport(jcoClass(code), - jcoImportPkg(code), jcoImportId(code), + jcoImportPkg(code), + listCopyDeeply(String)(jcoImportPath(code), + (ListCopier(String)) strCopy), + jcoImportId(code), jcoImportIsImported(code)); if (jcoIsNode(code)) { JavaCodeList l = listNil(JavaCode); @@ -209,6 +213,13 @@ jcoImportPkg(JavaCode jco) return jco->import.pkg; } +extern StringList +jcoImportPath(JavaCode jco) +{ + assert(jcoIsImport(jco)); + return jco->import.path; +} + extern String jcoImportId(JavaCode jco) { diff --git a/aldor/aldor/src/java/javaobj.h b/aldor/aldor/src/java/javaobj.h index 49803d1d0..b56b331bf 100644 --- a/aldor/aldor/src/java/javaobj.h +++ b/aldor/aldor/src/java/javaobj.h @@ -793,6 +793,7 @@ struct jcoLiteral { struct jcoImport { struct jcoHdr hdr; String pkg; + StringList path; String id; Bool isImported; }; @@ -819,13 +820,14 @@ extern String jcoLiteral(JavaCode jco); extern String jcoImportPkg(JavaCode jco); extern String jcoImportId(JavaCode jco); +extern StringList jcoImportPath(JavaCode jco); extern Bool jcoImportIsImported(JavaCode jco); extern void jcoImportSetImported(JavaCode jco, Bool flg); extern JavaCode jcoNewNode(JavaCodeClass class, int argc); extern JavaCode jcoNewToken(JavaCodeClass class, Symbol sym); extern JavaCode jcoNewLiteral(JavaCodeClass class, String str); -extern JavaCode jcoNewImport(JavaCodeClass class, String pkg, String id, Bool flg); +extern JavaCode jcoNewImport(JavaCodeClass class, String pkg, StringList path, String id, Bool flg); extern JavaCode jcoNew(JavaCodeClass class, int argc, ...); extern JavaCode jcoNewP(JavaCodeClass clss, int argc, va_list argp); extern JavaCode jcoNewFrList(JavaCodeClass class, JavaCodeList lst); From d1f20e8e0f6bbc1374d6301cadcdbefb6f8c82fc Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 31 Dec 2017 15:03:37 +0000 Subject: [PATCH 208/352] src/java/javacode.c: Correct escaping of quote characters in strings. BUGFIX! --- aldor/aldor/src/java/javacode.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index ad496e6fa..4963380a1 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -1655,9 +1655,6 @@ jc0EscapeString(String s, Bool addTerminalChar) case '\\': bufPuts(buf, "\\\\"); break; - case '\'': - bufPuts(buf, "\\\\"); - break; case '\n': bufPuts(buf, "\\\n"); break; From fa824c9b4d5986fe9c7f12051e2c1de4477aa5e4 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 31 Dec 2017 15:06:23 +0000 Subject: [PATCH 209/352] src/java/javacode.c: Add generic ids and method calls --- aldor/aldor/src/java/javacode.c | 47 ++++++++++++++++++++++++++++++++- aldor/aldor/src/java/javacode.h | 7 +++++ 2 files changed, 53 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index 4963380a1..184b2bdff 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -268,7 +268,7 @@ static struct jclss jcClss[] = { { JCO_CLSS_CommaSeq, jcSequencePrint,jcNodeSExpr, "commaseq", ", "}, { JCO_CLSS_SpaceSeq, jcSequencePrint,jcNodeSExpr, "spaceseq", " "}, { JCO_CLSS_NLSeq, jcSequencePrint,jcNodeSExpr, "nlseq", "\n"}, - { JCO_CLSS_Seq, jcSequencePrint,jcNodeSExpr, "seq"}, + { JCO_CLSS_Seq, jcSequencePrint,jcNodeSExpr, "seq", ""}, { JCO_CLSS_Parens, jcParenPrint, jcNodeSExpr, "paren", "()", 15, JCO_NONE }, { JCO_CLSS_Braces, jcParenPrint, jcNodeSExpr, "braces", "{}", 15, JCO_NONE }, { JCO_CLSS_SqBrackets, jcParenPrint, jcNodeSExpr, "sqbracket", "[]", 15, JCO_NONE }, @@ -557,6 +557,23 @@ jcApplyPrint(JavaCodePContext ctxt, JavaCode code) jcoWrite(ctxt, jcoArgv(code)[1]); } +JavaCode +jcGenericMethodName(JavaCode methodName, JavaCodeList genArgs) +{ + return jcSeqV(2, jcABrackets(jcCommaSeq(genArgs))); +} + +JavaCode +jcGenericMethodNameV(JavaCode methodName, int n, ...) +{ + JavaCode jc; + va_list argp; + va_start(argp, n); + jc = jcSeqV(2, jcABrackets(jcCommaSeqP(n, argp)), methodName); + va_end(argp); + return jc; +} + /* * :: Parens @@ -935,6 +952,17 @@ jcIdPrint(JavaCodePContext ctxt, JavaCode code) jcoPContextWrite(ctxt, name); } + +/* + * :: Generic id + */ +JavaCode +jcGenericId(JavaCode root, JavaCodeList genArgs) +{ + return jcSeqV(2, root, jcABrackets(jcCommaSeq(genArgs))); +} + + /* * :: Constructor Call */ @@ -1296,6 +1324,23 @@ jcCommaSeqP(int n, va_list argp) return jcoNewP(jc0ClassObj(JCO_CLSS_CommaSeq), n, argp); } +JavaCode +jcSeq(JavaCodeList lst) +{ + return jcoNewFrList(jc0ClassObj(JCO_CLSS_Seq), lst); +} + +JavaCode +jcSeqV(int n, ...) +{ + va_list argp; + JavaCode jc; + va_start(argp, n); + jc = jcoNewP(jc0ClassObj(JCO_CLSS_Seq), n, argp); + va_end(argp); + return jc; +} + JavaCode jcNLSeq(JavaCodeList lst) { diff --git a/aldor/aldor/src/java/javacode.h b/aldor/aldor/src/java/javacode.h index 1f522ea97..52be58b21 100644 --- a/aldor/aldor/src/java/javacode.h +++ b/aldor/aldor/src/java/javacode.h @@ -56,6 +56,8 @@ extern JavaCode jcThis(); extern JavaCode jcTrue(); extern JavaCode jcFalse(); +extern JavaCode jcGenericId(JavaCode root, JavaCodeList genArgs); + extern JavaCode jcClass(int modifiers, String comment, JavaCode id, JavaCode superclass, JavaCodeList implList, JavaCodeList body); @@ -120,6 +122,8 @@ extern JavaCode jcMemRef(JavaCode lhs, JavaCode rhs); extern JavaCode jcCast(JavaCode type, JavaCode val); extern JavaCode jcStatement(JavaCode stmt); +extern JavaCode jcSeq(JavaCodeList lst); +extern JavaCode jcSeqV(int n, ...); extern JavaCode jcCommaSeq(JavaCodeList lst); extern JavaCode jcCommaSeqP(int n, va_list l); extern JavaCode jcSpaceSeq(JavaCodeList lst); @@ -138,6 +142,9 @@ extern JavaCode jcApplyP(JavaCode c, int n, va_list argp); extern JavaCode jcApplyMethod(JavaCode obj, JavaCode id, JavaCodeList args); extern JavaCode jcApplyMethodV(JavaCode obj, JavaCode id, int n, ...); +extern JavaCode jcGenericMethodName(JavaCode methodName, JavaCodeList genArgs); +extern JavaCode jcGenericMethodNameV(JavaCode methodName, int n, ...); + extern JavaCode jcNAry(JavaCode t); extern JavaCode jcArrayOf(JavaCode t); extern JavaCode jcArrayNew(JavaCode t, JavaCode sz); From 8be31714a35ff411127d68550e02d0db012d49e9 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 31 Dec 2017 15:08:55 +0000 Subject: [PATCH 210/352] src/java/javacode.c: jcCollectImports needs to track usages So we don't import the same id twice from two packages. Pass around a table to do it nicely --- aldor/aldor/src/java/javacode.c | 37 ++++++++++++++++++++++----------- 1 file changed, 25 insertions(+), 12 deletions(-) diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index 184b2bdff..51adc964e 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -1626,30 +1626,37 @@ jc0ModifierSymbol(int idx) local Bool jc0ImportEq(JavaCode c1, JavaCode c2); -local void jc0CollectImports(Table tbl, JavaCode code); +local void jc0CollectImports(Table tbl, Table nameTbl, JavaCode code); JavaCodeList jcCollectImports(JavaCode code) { Table tbl = tblNew((TblHashFun) jcoHash, (TblEqFun) jc0ImportEq); + Table nameTbl = tblNew((TblHashFun) strHash, (TblEqFun) strEqual); TableIterator it; JavaCodeList resList = listNil(JavaCode); - jc0CollectImports(tbl, code); + jc0CollectImports(tbl, nameTbl, code); for (tblITER(it, tbl); tblMORE(it); tblSTEP(it)) { JavaCode id = (JavaCode) tblKEY(it); JavaCodeList codes = (JavaCodeList) tblELT(it); JavaCodeList tmp; - JavaCode cp = jcImportedId(jcoImportPkg(id), jcoImportId(id)); - resList = listCons(JavaCode)(cp, resList); - tmp = codes; - while (tmp != 0) { - JavaCode imp = car(tmp); - jcoImportSetImported(imp, true); - tmp = cdr(tmp); + JavaCode copy = jcImportedId(jcoImportPkg(id), jcoImportId(id)); + JavaCodeList usages = (JavaCodeList) tblElt(nameTbl, jcoImportId(id), listNil(JavaCode)); + if (cdr(usages) != listNil(JavaCode)) { + continue; + } + else { + resList = listCons(JavaCode)(copy, resList); + tmp = codes; + while (tmp != 0) { + JavaCode imp = car(tmp); + jcoImportSetImported(imp, true); + tmp = cdr(tmp); + } + listFree(JavaCode)(codes); } - listFree(JavaCode)(codes); } return resList; } @@ -1669,7 +1676,7 @@ jc0ImportEq(JavaCode c1, JavaCode c2) local void -jc0CollectImports(Table tbl, JavaCode code) +jc0CollectImports(Table tbl, Table nameTbl, JavaCode code) { if (code == 0) return; @@ -1678,11 +1685,17 @@ jc0CollectImports(Table tbl, JavaCode code) JavaCode key = code; l = listCons(JavaCode)(code, l); tblSetElt(tbl, key, l); + + String name = jcoImportId(code); + JavaCodeList ids = (JavaCodeList) tblElt(nameTbl, name, listNil(JavaCode)); + if (!listMember(JavaCode)(ids, code, jc0ImportEq)) { + tblSetElt(nameTbl, name, (TblElt) listCons(JavaCode)(code, ids)); + } } if (jcoIsNode(code)) { int i=0; for (i=0; i Date: Sun, 31 Dec 2017 15:13:22 +0000 Subject: [PATCH 211/352] src/java/javacode.c: Add try/catch functions --- aldor/aldor/src/java/javacode.c | 50 +++++++++++++++++++++++++++++++++ aldor/aldor/src/java/javacode.h | 3 ++ 2 files changed, 53 insertions(+) diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index 51adc964e..6b972ec41 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -34,6 +34,9 @@ enum jc_clss_enum { JCO_CLSS_Switch, JCO_CLSS_Case, JCO_CLSS_Block, + JCO_CLSS_Try, + JCO_CLSS_Catch, + JCO_CLSS_Finally, JCO_CLSS_ArrRef, JCO_CLSS_MemRef, @@ -193,6 +196,7 @@ local JWriteFn jcApplyPrint; local JWriteFn jcARefPrint; local JWriteFn jcBinOpPrint; local JWriteFn jcBlockHdrPrint; +local JWriteFn jcBlockKeywordPrint; local JWriteFn jcBlockPrint; local JWriteFn jcCasePrint; local JWriteFn jcCastPrint; @@ -288,6 +292,9 @@ static struct jclss jcClss[] = { { JCO_CLSS_Switch, jcBlockHdrPrint, jcNodeSExpr, "switch", "switch"}, { JCO_CLSS_Case, jcCasePrint, jcNodeSExpr, "case", "case"}, { JCO_CLSS_Block, jcBlockPrint, jcNodeSExpr, "block"}, + { JCO_CLSS_Try, jcBlockKeywordPrint, jcNodeSExpr, "try", "try"}, + { JCO_CLSS_Catch, jcBlockHdrPrint, jcNodeSExpr, "catch", "catch"}, + { JCO_CLSS_Finally, jcBlockKeywordPrint, jcNodeSExpr, "finally", "finally"}, { JCO_CLSS_ArrRef, jcARefPrint, jcNodeSExpr, "arrayref", 0, 20, JCO_NONE}, { JCO_CLSS_MemRef, jcBinOpPrint, jcNodeSExpr, "memref", ".", 20, JCO_NONE}, @@ -1444,6 +1451,32 @@ jcCasePrint(JavaCodePContext ctxt, JavaCode code) jcoPContextWrite(ctxt, ": "); } +JavaCode +jcTryCatch(JavaCode body, JavaCode catch, JavaCode finally) +{ + return jcTry(body, listSingleton(JavaCode)(catch), finally); +} + +JavaCode +jcTry(JavaCode body, JavaCodeList catches, JavaCode finally) +{ + JavaCodeList lst = listNil(JavaCode); + lst = listCons(JavaCode)(jcoNew(jc0ClassObj(JCO_CLSS_Try), 1, body), lst); + lst = listNConcat(JavaCode)(lst, catches); + if (finally != NULL) { + lst = listNConcat(JavaCode)(lst, + listSingleton(JavaCode)(jcoNew(jc0ClassObj(JCO_CLSS_Finally), + 1, finally))); + } + return jcNLSeq(lst); +} + +JavaCode +jcCatch(JavaCode decl, JavaCode body) +{ + return jcoNew(jc0ClassObj(JCO_CLSS_Catch), 2, decl, body); +} + /* * :: Import, Package */ @@ -1512,6 +1545,23 @@ jcBlockHdrPrint(JavaCodePContext ctxt, JavaCode code) } +local void +jcBlockKeywordPrint(JavaCodePContext ctxt, JavaCode code) +{ + Bool needsIndent; + char *key = (char *) jcoClass(code)->txt; + jcoPContextWrite(ctxt, key); + jcoPContextWrite(ctxt, " "); + + needsIndent = jcBlockHdrIndent(jcoArgv(code)[0]); + if (needsIndent) + jcoPContextNewlineIndent(ctxt); + jcoWrite(ctxt, jcoArgv(code)[0]); + if (needsIndent) + jcoPContextNewlineUnindent(ctxt); + +} + local Bool jcBlockHdrIndent(JavaCode code) { diff --git a/aldor/aldor/src/java/javacode.h b/aldor/aldor/src/java/javacode.h index 52be58b21..897dd3e3f 100644 --- a/aldor/aldor/src/java/javacode.h +++ b/aldor/aldor/src/java/javacode.h @@ -111,6 +111,9 @@ extern JavaCode jcWhile(JavaCode test, JavaCode stmt); extern JavaCode jcSwitch(JavaCode test, JavaCodeList body); extern JavaCode jcCaseLabel(JavaCode arg); extern JavaCode jcThrow(JavaCode arg); +extern JavaCode jcTry(JavaCode body, JavaCodeList catchers, JavaCode finally); +extern JavaCode jcTryCatch(JavaCode body, JavaCode catch, JavaCode finally); +extern JavaCode jcCatch(JavaCode decl, JavaCode body); extern JavaCode jcOp(JcOperation op, JavaCodeList args); extern JavaCode jcBinOp(JcOperation op, JavaCode e1, JavaCode e2); From 06940a5b22bbc68239d3f2d54560b54a21c45399 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Dec 2017 21:32:53 +0000 Subject: [PATCH 212/352] javacode.c: Support empty list of interfaces --- aldor/aldor/src/java/javacode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index 6b972ec41..de8a6499c 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -353,7 +353,7 @@ jcClass(int modifiers, String comment, 5, jcSpaceSeq(jcmods), id, superclass, - jcCommaSeq(extendList), + extendList == listNil(JavaCode) ? NULL : jcCommaSeq(extendList), jcNLSeq(body)); if (comment == NULL) return clss; From b3ecb9b52bbea18181c30072680f4725883eb5f1 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Oct 2017 19:43:10 +0100 Subject: [PATCH 213/352] java: Add jcLocal/Member/Param declarations (instead of rolling them into one - they do the same thing really). --- aldor/aldor/src/java/genjava.c | 4 ++-- aldor/aldor/src/java/javacode.c | 18 ++++++++++++++---- aldor/aldor/src/java/javacode.h | 2 ++ 3 files changed, 18 insertions(+), 6 deletions(-) diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index 67c86426e..cd7796c7d 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -3197,7 +3197,7 @@ gj0ClassFields() int i; /* private FoamContext ctxt;*/ - ctxtDecl = jcParamDecl(JCO_MOD_Private, + ctxtDecl = jcMemberDecl(JCO_MOD_Private, gj0Id(GJ_FoamContext), gj0Id(GJ_ContextVar)); vars = listNil(JavaCode); @@ -3206,7 +3206,7 @@ gj0ClassFields() if (decl->foamGDecl.protocol != FOAM_Proto_Init) continue; - declJ = jcParamDecl(JCO_MOD_Private, + declJ = jcMemberDecl(JCO_MOD_Private, gj0TypeFrFmt(FOAM_Clos, 0), jcId(gj0InitVar(i))); vars = listCons(JavaCode)(jcStatement(declJ), vars); diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index de8a6499c..3e39d1b43 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -466,10 +466,20 @@ jcDeclaration(int modifiers, return jcoNewFrList(jc0ClassObj(JCO_CLSS_Declaration), l); } -JavaCode -jcParamDecl(int modifiers, - JavaCode type, - JavaCode id) +JavaCode +jcMemberDecl(int modifiers, JavaCode type, JavaCode id) +{ + return jcDeclaration(modifiers, type, id, 0, 0, 0); +} + +JavaCode +jcParamDecl(int modifiers, JavaCode type, JavaCode id) +{ + return jcDeclaration(modifiers, type, id, 0, 0, 0); +} + +JavaCode +jcLocalDecl(int modifiers, JavaCode type, JavaCode id) { return jcDeclaration(modifiers, type, id, 0, 0, 0); } diff --git a/aldor/aldor/src/java/javacode.h b/aldor/aldor/src/java/javacode.h index 897dd3e3f..c59721169 100644 --- a/aldor/aldor/src/java/javacode.h +++ b/aldor/aldor/src/java/javacode.h @@ -78,7 +78,9 @@ extern JavaCode jcDeclaration(int modifiers, JavaCode id, JavaCodeList genArgs, JavaCode args, JavaCodeList exns); +extern JavaCode jcMemberDecl(int modifiers, JavaCode type, JavaCode id); extern JavaCode jcParamDecl(int modifiers, JavaCode type, JavaCode id); +extern JavaCode jcLocalDecl(int modifiers, JavaCode type, JavaCode id); extern JavaCode jcInitialisation(int modifiers, JavaCode type, JavaCode id, JavaCode value); From 84d7b56e2eded3be91d81e2be18844511186484a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 31 Dec 2017 14:56:00 +0000 Subject: [PATCH 214/352] src/formatters.c: Add JavaCode to printable objects --- aldor/aldor/src/formatters.c | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/aldor/aldor/src/formatters.c b/aldor/aldor/src/formatters.c index 9e10954af..b5e2ba572 100644 --- a/aldor/aldor/src/formatters.c +++ b/aldor/aldor/src/formatters.c @@ -5,6 +5,7 @@ #include "symeset.h" #include "freevar.h" #include "bigint.h" +#include "java/javacode.h" #include "ostream.h" #include "format.h" #include "sefo.h" @@ -42,6 +43,7 @@ local int bintFormatter(OStream stream, Pointer p); local int symbolFormatter(OStream stream, Pointer p); local int errorSetFormatter(OStream stream, Pointer p); +local int javaCodeFormatter(OStream stream, Pointer p); void @@ -76,6 +78,7 @@ fmttsInit() fmtRegister("Symbol", symbolFormatter); fmtRegister("ErrorSet", errorSetFormatter); + fmtRegister("JavaCode", javaCodeFormatter); } @@ -201,6 +204,16 @@ errorSetFormatter(OStream ostream, Pointer p) return i; } +local int +javaCodeFormatter(OStream ostream, Pointer p) +{ + JavaCode jco = (JavaCode) p; + int c; + + c = ostreamPrintf(ostream, "%pSExpr", jcoSExpr(jco)); + + return c; +} local int tconstFormatter(OStream ostream, Pointer p) { From 0103330804bf177fa57716ab58dde0e8fe85f1b4 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Oct 2017 20:44:33 +0100 Subject: [PATCH 215/352] gf_java.c: Use base type of domain when building java signatures --- aldor/aldor/src/gf_java.c | 41 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 40 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/gf_java.c b/aldor/aldor/src/gf_java.c index 86050035c..72eb433cd 100644 --- a/aldor/aldor/src/gf_java.c +++ b/aldor/aldor/src/gf_java.c @@ -8,6 +8,7 @@ #include "strops.h" #include "symbol.h" #include "spesym.h" +#include "util.h" local AInt gfjFindConst(Syme syme); local Foam gfjImportApply(Syme syme); @@ -16,6 +17,8 @@ local Foam gfjImportConstructor(Syme syme); local Foam gfjImportStaticCall(Syme syme); local FoamList gfjProgAddParams(TForm tf); +local TForm gfjPCallArgBaseJavaType(TForm tf); +local TForm gfjPCallRetBaseJavaType(TForm tf); local FoamTag gfjPCallFoamType(TForm tf, AInt *pfmt); local Foam gfjPCallFoamToJava(TForm tf, Foam foam); local Foam gfjPCallJavaToFoam(TForm tf, Foam foam); @@ -344,7 +347,7 @@ gfjPCallDecl(TForm tf) decls = listNil(Foam); for (i=0; i Date: Tue, 10 Oct 2017 22:35:51 +0100 Subject: [PATCH 216/352] of_inlin.c: Look through cast a bit better. Fix up transformation of (EElt n (Env m) a b) --> (Lex (m+a) b) --- aldor/aldor/src/inlutil.c | 27 ++++++++++++++++++++++++++- aldor/aldor/src/of_inlin.c | 8 +++++++- 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/inlutil.c b/aldor/aldor/src/inlutil.c index 097758817..297174b50 100644 --- a/aldor/aldor/src/inlutil.c +++ b/aldor/aldor/src/inlutil.c @@ -32,6 +32,8 @@ Bool inuProgDebug = false; #define inuReachingDef(foam) ((Foam) udReachingDefs(foam)) +local Foam inuDereferencePeep(Foam orig); + /* Make one step through the use/def chain. */ local Foam inuDereference(Foam foam) @@ -73,12 +75,35 @@ inuDereferenceSyme(Foam foam) local Foam inuDereferenceClos(Foam foam) { - while (foam && foamTag(foam) != FOAM_Clos && inuIsVar(foam)) + while (foam && foamTag(foam) != FOAM_Clos && inuIsVar(foam)) { foam = inuDereference(foam); + foam = inuDereferencePeep(foam); + } return (foam && foamTag(foam) == FOAM_Clos) ? foam : NULL; } +local Foam +inuDereferencePeep(Foam orig) +{ + Foam foam = orig; + Foam ret = orig; + + if (foam && foamTag(foam) == FOAM_Cast && + foam->foamCast.type == FOAM_Clos) { + foam = foam->foamCast.expr; + while (foamTag(foam) == FOAM_Cast) { + foam = foam->foamCast.expr; + } + if (foamTag(foam) == FOAM_Clos) { + ret = foam; + } + } + + return ret; +} + + /***************************************************************************** * * :: inuGetClos diff --git a/aldor/aldor/src/of_inlin.c b/aldor/aldor/src/of_inlin.c index e97451777..13fc868a8 100644 --- a/aldor/aldor/src/of_inlin.c +++ b/aldor/aldor/src/of_inlin.c @@ -3235,6 +3235,12 @@ inlTransformExpr(Foam expr, Foam *paramArgv, Foam *localArgv) /* Fall through and transform as before */ } + if (foamTag(expr) == FOAM_EElt && + foamTag(expr->foamEElt.ref) == FOAM_Env) { + expr = foamNewLex(expr->foamEElt.level + expr->foamEElt.ref->foamEnv.level, + expr->foamEElt.lex); + tag = FOAM_Lex; + } /* Recursive depth-first transformation of the expression */ foamIter(expr, arg, *arg = inlTransformExpr(*arg,paramArgv,localArgv)); @@ -3250,7 +3256,7 @@ inlTransformExpr(Foam expr, Foam *paramArgv, Foam *localArgv) localArgv[expr->foamLoc.index]->foamLoc.index; break; case FOAM_Lex: - nexpr = inlLex(nexpr); + nexpr = inlLex(expr); break; case FOAM_Env: nexpr = inlEnv(nexpr); From 710f0fdcb0601b6d6c5e2e2ee6700b068a7139ec Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 10 Oct 2017 22:39:28 +0100 Subject: [PATCH 217/352] gf_java: Java PCalls need an explicit "this" in their format Otherwise it just gets too confusing. --- aldor/aldor/src/foam.c | 4 +--- aldor/aldor/src/gf_java.c | 29 ++++++++++++++++++++--------- 2 files changed, 21 insertions(+), 12 deletions(-) diff --git a/aldor/aldor/src/foam.c b/aldor/aldor/src/foam.c index 2227884d3..7e3d67ecf 100644 --- a/aldor/aldor/src/foam.c +++ b/aldor/aldor/src/foam.c @@ -1151,10 +1151,8 @@ foamAuditPCallJava(Foam foam) glo = faGlobalsv[op->foamGlo.index]; ddecl = faFormats->foamDFmt.argv[glo->foamGDecl.format]; - /* Methods have an implicit argument. */ - extra = foam->foamPCall.protocol == FOAM_Proto_JavaMethod ? 1 : 0; /* dock one for return type */ - if (foamDDeclArgc(ddecl) + extra - 1 != foamPCallArgc(foam)) + if (foamDDeclArgc(ddecl) - 1 != foamPCallArgc(foam)) foamAuditBadType(foam); } diff --git a/aldor/aldor/src/gf_java.c b/aldor/aldor/src/gf_java.c index 72eb433cd..fcfb3c3c3 100644 --- a/aldor/aldor/src/gf_java.c +++ b/aldor/aldor/src/gf_java.c @@ -2,6 +2,7 @@ #include "gf_util.h" #include "gf_prog.h" #include "gf_java.h" +#include "gf_syme.h" #include "of_inlin.h" #include "tform.h" #include "sefo.h" @@ -22,7 +23,7 @@ local TForm gfjPCallRetBaseJavaType(TForm tf); local FoamTag gfjPCallFoamType(TForm tf, AInt *pfmt); local Foam gfjPCallFoamToJava(TForm tf, Foam foam); local Foam gfjPCallJavaToFoam(TForm tf, Foam foam); -local AInt gfjPCallDecl(TForm tf); +local AInt gfjPCallDecl(TForm tf, TForm this); local Foam gfjPCallDeclArg(TForm tf); local AInt gj0ClassDDecl(ForeignOrigin origin, String clsName); @@ -86,7 +87,7 @@ gfjImportApply(Syme syme) gen0ProgFiniEmpty(prog, FOAM_Word, emptyFormatSlot); foamOptInfo(prog) = inlInfoNew(NULL, prog, NULL, false); gen0ProgRestoreState(saved); - + genSetConstNum(syme, -1, constNum, true); return foamNewClos(foamNewEnv(int0), foamNewConst(constNum)); } @@ -116,7 +117,8 @@ gfjImportApplyInner(Syme syme, AInt fmtNum) globName = (forg->file ? strPrintf("%s.%s.%s", forg->file, symeString(esyme), symeJavaApplyName(syme)) : strPrintf("%s.%s", symeString(esyme), symeJavaApplyName(syme))); - gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(innerTf), + gdecl = foamNewGDecl(FOAM_Word, globName, + gfjPCallDecl(innerTf, tfMapArgN(symeType(syme), 0)), FOAM_GDecl_Import, FOAM_Proto_JavaMethod); gnum = gen0AddGlobal(gdecl); fnName = strPrintf("%s-inner", symeJavaApplyName(syme)); @@ -179,7 +181,7 @@ gfjImportConstructor(Syme syme) symString(tfIdSym(exporter))); constNum = gen0NumProgs; - gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(symeType(syme)), + gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(symeType(syme), NULL), FOAM_GDecl_Import, FOAM_Proto_JavaConstructor); gnum = gen0AddGlobal(gdecl); @@ -201,6 +203,7 @@ gfjImportConstructor(Syme syme) foamOptInfo(prog) = inlInfoNew(NULL, prog, NULL, false); gen0ProgRestoreState(saved); + genSetConstNum(syme, -1, constNum, true); return foamNewClos(foamNewEnv(int0), foamNewConst(constNum)); } @@ -232,7 +235,7 @@ gfjImportStaticCall(Syme syme) constNum = gen0NumProgs; - gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(symeType(syme)), + gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(symeType(syme), NULL), FOAM_GDecl_Import, FOAM_Proto_Java); gnum = gen0AddGlobal(gdecl); @@ -253,6 +256,7 @@ gfjImportStaticCall(Syme syme) foamOptInfo(prog) = inlInfoNew(NULL, prog, NULL, false); gen0ProgRestoreState(saved); + genSetConstNum(syme, -1, constNum, true); return foamNewClos(foamNewEnv(int0), foamNewConst(constNum)); } @@ -338,7 +342,7 @@ gfjPCallJavaToFoam(TForm tf, Foam foam) } local AInt -gfjPCallDecl(TForm tf) +gfjPCallDecl(TForm tf, TForm this) { FoamList decls; Foam ddecl, retdecl; @@ -346,6 +350,12 @@ gfjPCallDecl(TForm tf) decls = listNil(Foam); + if (this != NULL) { + TForm tfThis = gfjPCallArgBaseJavaType(this); + Foam decl = gfjPCallDeclArg(tfThis); + decls = listCons(Foam)(decl, decls); + } + for (i=0; ifile == NULL ? strCopy(symeString(syme)) - : strPrintf("%s.%s", forg->file, symeString(syme))); - decl = foamNewDecl(FOAM_Ptr, id, emptyFormatSlot); + String name = forg->file == NULL ? strCopy(symeString(syme)) + : strPrintf("%s.%s", forg->file, symeString(syme)); + AInt fmt = gj0ClassDDecl(forg, symeString(syme)); + decl = foamNewDecl(FOAM_JavaObj, name, fmt); } else { FoamTag type; From 0ee0586fdae2f8586baa4681c615688ecff1ad97 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 10 Oct 2017 22:37:02 +0100 Subject: [PATCH 218/352] of_retype: Infer formats and types for java PCalls - This allows aldor to convert most java calls into direct code. --- aldor/aldor/src/of_retyp.h | 1 + aldor/aldor/src/of_retyp2.c | 49 +++++++++++++++++++++++++++++++++++-- 2 files changed, 48 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/of_retyp.h b/aldor/aldor/src/of_retyp.h index 462e6fdf7..19a9e820f 100644 --- a/aldor/aldor/src/of_retyp.h +++ b/aldor/aldor/src/of_retyp.h @@ -19,6 +19,7 @@ void retypeUnit (Foam); typedef struct retypeContext { Foam formats; + Foam globals; Foam prog; int nLocals; Foam *locDecls; diff --git a/aldor/aldor/src/of_retyp2.c b/aldor/aldor/src/of_retyp2.c index 7b50f1da3..065b480ed 100644 --- a/aldor/aldor/src/of_retyp2.c +++ b/aldor/aldor/src/of_retyp2.c @@ -50,6 +50,8 @@ local void retAddUse(RetContext context, FoamTag type, AInt fmt, Foam foam); local void retRetypeProg(RetContext context, Foam prog); local void retMarkCasts(RetContext context, Foam prog); local void retMarkExpr(RetContext context, Foam foam); +local void retMarkPCallJava(RetContext context, Foam foam); +local void retMarkPCall(RetContext context, Foam foam); local Bool retRearrangeProg(RetContext context); local Foam retRearrangeExpr(RetContext context, Foam expr, Bool isLhs); local Foam retRearrangeSet(RetContext context, Foam set); @@ -65,6 +67,7 @@ rtcInit(Foam unit) { RetContext context = (RetContext) stoAlloc(OB_Other, sizeof(*context)); context->formats = unit->foamUnit.formats; + context->globals = unit->foamUnit.formats->foamDFmt.argv[globalsSlot]; context->locDecls = NULL; context->parDecls = NULL; context->parLocs = NULL; @@ -80,7 +83,7 @@ rtcNewProg(RetContext global, Foam prog, int nLocals) int i; RetContext context = (RetContext) stoAlloc(OB_Other, sizeof(*context)); - + context->locDecls = (Foam *) stoAlloc(OB_Other, nLocals * sizeof(Foam)); context->parDecls = (Foam *) stoAlloc(OB_Other, nParams * sizeof(Foam)); context->parLocs = NULL; @@ -88,6 +91,7 @@ rtcNewProg(RetContext global, Foam prog, int nLocals) context->nLocals = nLocals; context->formats = global->formats; + context->globals = global->globals; context->prog = prog; for (i = 0; i < nLocals; i++) { context->locDecls[i] = foamCopy(context->prog->foamProg.locals->foamDDecl.argv[i]); @@ -419,15 +423,56 @@ retMarkExpr(RetContext context, Foam foam) retAddUse(context, FOAM_Rec, foam->foamRElt.format, retLocal(foam)); } break; + case FOAM_PCall: + retMarkPCall(context, foam); + break; case FOAM_Set: case FOAM_Def: break; - + default: break; } } +local void +retMarkPCall(RetContext context, Foam foam) +{ + switch (foam->foamPCall.protocol) { + case FOAM_Proto_Java: + case FOAM_Proto_JavaMethod: + case FOAM_Proto_JavaConstructor: + retMarkPCallJava(context, foam); + default: + break; + } +} + +local void +retMarkPCallJava(RetContext context, Foam foam) +{ + Foam op = foam->foamPCall.op; + + if (foamTag(op) != FOAM_Glo) { + return; + } + + Foam gdecl = context->globals->foamDDecl.argv[op->foamGlo.index]; + Foam ddecl = context->formats->foamDFmt.argv[gdecl->foamGDecl.format]; + + for (int i=0; ifoamPCall.argv[i]; + if (retIsLocal(arg)) { + retAddUse(context, + ddecl->foamDDecl.argv[i+1]->foamDecl.type, + ddecl->foamDDecl.argv[i+1]->foamDecl.format, + retLocal(arg)); + } + } +} + + + Bool rtcRearrangeProg(RetContext context) { From 8296f7f60a585aa3413dee73f84a0cefeedf081d Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 10 Oct 2017 22:40:57 +0100 Subject: [PATCH 219/352] test: Add jimp0 - trivial java import test --- aldor/aldor/test/Makefile.in | 2 +- aldor/aldor/test/jimp0.as | 17 +++++++++++++++++ 2 files changed, 18 insertions(+), 1 deletion(-) create mode 100644 aldor/aldor/test/jimp0.as diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 0c6b619e9..8e2b2cb06 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -80,7 +80,7 @@ fmtests := rectest enumtest clos strtable1 simple apply ctests := rectest enumtest multinever maptuple otests := enumtest xtests := enumtest -@BUILD_JAVA_TRUE@jruntests := jimport jimport_opt +@BUILD_JAVA_TRUE@jruntests := jimport jimport_opt jimp0 x_extra := rtexns diff --git a/aldor/aldor/test/jimp0.as b/aldor/aldor/test/jimp0.as new file mode 100644 index 000000000..cd4828c80 --- /dev/null +++ b/aldor/aldor/test/jimp0.as @@ -0,0 +1,17 @@ +#include "foamlib" +#pile + +import from Machine; + +APPLY(id, rhs) ==> { apply: (%, 'id') -> rhs; export from 'id' } + +import BitSet: with + new: () -> % + new: SingleInteger -> % + APPLY(_and, % -> ()) +from Foreign Java "java.util" + +foo(): () == + import from SingleInteger + bb: BitSet := new 22 + bb._and(bb) From 163f843f52a78c08991e2a0d960cd160b996d305 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 30 Nov 2017 23:25:51 +0000 Subject: [PATCH 220/352] forg.c: Add a free for ForeignOrigin --- aldor/aldor/src/forg.c | 7 +++++++ aldor/aldor/src/forg.h | 2 +- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/forg.c b/aldor/aldor/src/forg.c index 8547213fe..fdde33a4b 100644 --- a/aldor/aldor/src/forg.c +++ b/aldor/aldor/src/forg.c @@ -98,3 +98,10 @@ forgEqual(ForeignOrigin f1, ForeignOrigin f2) return f1->protocol == f2->protocol && strEqual(f1->file, f2->file); } +void +forgFree(ForeignOrigin forg) +{ + /* Not possible to free these as there is a + * pre-initialised cache, and some last-value caching + */ +} diff --git a/aldor/aldor/src/forg.h b/aldor/aldor/src/forg.h index 263d82648..e5ece2134 100644 --- a/aldor/aldor/src/forg.h +++ b/aldor/aldor/src/forg.h @@ -15,5 +15,5 @@ typedef struct foreign_origin * ForeignOrigin; extern ForeignOrigin forgFrAbSyn (AbSyn); extern Bool forgEqual (ForeignOrigin, ForeignOrigin); - +extern void forgFree (ForeignOrigin); #endif From b0ee8e2cfbecd2690f3672a981a5628c46419507 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 9 Dec 2017 21:06:36 +0000 Subject: [PATCH 221/352] forg.c: Add equality, hash and buffer functions --- aldor/aldor/src/forg.c | 58 +++++++++++++++++++++++++++++++++++++++--- aldor/aldor/src/forg.h | 10 ++++++++ 2 files changed, 65 insertions(+), 3 deletions(-) diff --git a/aldor/aldor/src/forg.c b/aldor/aldor/src/forg.c index fdde33a4b..c4e2ef9e2 100644 --- a/aldor/aldor/src/forg.c +++ b/aldor/aldor/src/forg.c @@ -4,6 +4,7 @@ #include "store.h" #include "comsg.h" #include "strops.h" +#include "util.h" /***************************************************************************** * @@ -12,7 +13,6 @@ ****************************************************************************/ local ForeignOrigin forgAlloc (FoamProtoTag, String); -local ForeignOrigin forgNew (FoamProtoTag, String); static ForeignOrigin stdOrig[FOAM_PROTO_LIMIT - FOAM_PROTO_START]; @@ -27,7 +27,7 @@ forgAlloc(FoamProtoTag ptag, String file) return forg; } -local ForeignOrigin +ForeignOrigin forgNew(FoamProtoTag ptag, String file) { static Bool stdOrigAreInit = false; @@ -95,7 +95,14 @@ forgFrAbSyn(AbSyn origin) Bool forgEqual(ForeignOrigin f1, ForeignOrigin f2) { - return f1->protocol == f2->protocol && strEqual(f1->file, f2->file); + if (f1->protocol != f2->protocol) + return false; + + if (f1->file == NULL && f2->file == NULL) + return true; + if (f1->file != NULL && f2->file != NULL) + return strEqual(f1->file, f2->file); + return false; } void @@ -105,3 +112,48 @@ forgFree(ForeignOrigin forg) * pre-initialised cache, and some last-value caching */ } + +AInt +forgHash(ForeignOrigin forg) +{ + if (forg->file == NULL) { + return forg->protocol; + } + return hashCombine(forg->protocol, strHash(forg->file)); +} + +ForeignOrigin +forgFrBuffer(Buffer buf) +{ + FoamProtoTag tag = (FoamProtoTag) bufGetHInt(buf); + String file = NULL; + Bool flg; + flg = bufGetByte(buf); + if (flg) { + file = bufRdString(buf); + } + + return forgNew(tag, file); +} + +void +forgToBuffer(Buffer buf, ForeignOrigin forg) +{ + bufPutHInt(buf, forg->protocol); + bufPutByte(buf, forg->file != NULL); + if (forg->file != NULL) { + bufWrString(buf, forg->file); + } +} + +void +forgBufferSkip(Buffer buf) +{ + String text; + Bool flg; + bufGetHInt(buf); + flg = bufGetByte(buf); + if (flg) { + text = bufRdString(buf); + } +} diff --git a/aldor/aldor/src/forg.h b/aldor/aldor/src/forg.h index e5ece2134..e26da033b 100644 --- a/aldor/aldor/src/forg.h +++ b/aldor/aldor/src/forg.h @@ -1,5 +1,7 @@ #ifndef _FORG_H_ #define _FORG_H_ +#include "foam.h" + /****************************************************************************** * * :: Foreign origin @@ -13,7 +15,15 @@ struct foreign_origin { typedef struct foreign_origin * ForeignOrigin; +extern ForeignOrigin forgNew (FoamProtoTag, String); extern ForeignOrigin forgFrAbSyn (AbSyn); extern Bool forgEqual (ForeignOrigin, ForeignOrigin); +extern AInt forgHash (ForeignOrigin); extern void forgFree (ForeignOrigin); + +extern ForeignOrigin forgFrBuffer (Buffer); +extern void forgToBuffer (Buffer, ForeignOrigin); + +extern void forgBufferSkip (Buffer); + #endif From 788333e08775034f6844724fcdcc0986a6ad7911 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 9 Dec 2017 21:08:28 +0000 Subject: [PATCH 222/352] tests: Add tests for forg.c --- aldor/aldor/src/Makefile.am | 2 ++ aldor/aldor/src/test/test_forg.c | 48 ++++++++++++++++++++++++++++++++ aldor/aldor/src/test/testall.c | 1 + aldor/aldor/src/test/testall.h | 1 + 4 files changed, 52 insertions(+) create mode 100644 aldor/aldor/src/test/test_forg.c diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index 14c23e5b9..6a6ae4e2d 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -54,6 +54,7 @@ aldor_LDADD = libphase.a libstruct.a libgen.a libport.a -lm aldor_LDFLAGS = $(build_id) aldor_CFLAGS = -g $(STRICTCFLAGS) +#aldortest_CFLAGS = -DTEST_STAND_ALONE -DTEST_ALL -save-temps $(STRICTCFLAGS) aldortest_CFLAGS = -DTEST_STAND_ALONE -DTEST_ALL -save-temps $(STRICTCFLAGS) aldortest_SOURCES = test.c aldortest_LDADD = libtest.a libstruct.a libgen.a libport.a -lm @@ -278,6 +279,7 @@ testsuite = \ test/test_flog.c \ test/test_fname.c \ test/test_foam.c \ + test/test_forg.c \ test/test_format.c \ test/test_genfoam.c \ test/test_jflow.c \ diff --git a/aldor/aldor/src/test/test_forg.c b/aldor/aldor/src/test/test_forg.c new file mode 100644 index 000000000..d871ce7a2 --- /dev/null +++ b/aldor/aldor/src/test/test_forg.c @@ -0,0 +1,48 @@ +#include "testall.h" +#include "testlib.h" +#include "buffer.h" +#include "forg.h" +#include "strops.h" + +void forgTest() +{ + Buffer buf = bufNew(); + + ForeignOrigin forg1 = forgNew(FOAM_Proto_Java, strCopy("hello")); + ForeignOrigin forg2 = forgNew(FOAM_Proto_C, strCopy("world")); + ForeignOrigin forg3 = forgNew(FOAM_Proto_C, NULL); + ForeignOrigin forg1_r, forg2_r, forg3_r; + testTrue("1", forgEqual(forg1, forg1)); + testTrue("2", forgEqual(forg2, forg2)); + testFalse("3", forgEqual(forg1, forg2)); + testFalse("4", forgEqual(forg1, forg3)); + + forgToBuffer(buf, forg1); + forgToBuffer(buf, forg2); + bufSetPosition(buf, 0); + + forg1_r = forgFrBuffer(buf); + forg2_r = forgFrBuffer(buf); + + testTrue("5", forgEqual(forg1_r, forg1)); + testTrue("6", forgEqual(forg2_r, forg2)); + + int pos = bufPosition(buf); + bufSetPosition(buf, 0); + forgBufferSkip(buf); + forgBufferSkip(buf); + testIntEqual("7", pos, bufPosition(buf)); + + bufSetPosition(buf, 0); + forgToBuffer(buf, forg3); + forgToBuffer(buf, forg1); + pos = bufPosition(buf); + + bufSetPosition(buf, 0); + forg3_r = forgFrBuffer(buf); + forg1_r = forgFrBuffer(buf); + + testTrue("8", forgEqual(forg3_r, forg3)); + testTrue("8", forgEqual(forg1_r, forg1)); + testIntEqual("10", pos, bufPosition(buf)); +} diff --git a/aldor/aldor/src/test/testall.c b/aldor/aldor/src/test/testall.c index b8b89de03..01478f387 100644 --- a/aldor/aldor/src/test/testall.c +++ b/aldor/aldor/src/test/testall.c @@ -44,6 +44,7 @@ main(int argc, char *argv[]) if (testShouldRun("fname")) fnameTest(); if (testShouldRun("archive")) archiveTestSuite(); if (testShouldRun("foam")) foamTest(); + if (testShouldRun("forg")) forgTest(); if (testShouldRun("format")) formatTest(); if (testShouldRun("flog")) flogTest(); if (testShouldRun("java")) javaTestSuite(); diff --git a/aldor/aldor/src/test/testall.h b/aldor/aldor/src/test/testall.h index 8f7bb60df..95735d2ce 100644 --- a/aldor/aldor/src/test/testall.h +++ b/aldor/aldor/src/test/testall.h @@ -15,6 +15,7 @@ void floatTestSuite(void); void flogTest(void); void fnameTest(void); void foamTest(void); +void forgTest(void); void formatTest(void); void genfoamTestSuite(void); void intTestSuite(void); From 990a6071c5374ad641039e083b42cc82460e97ad Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 31 Dec 2017 15:11:15 +0000 Subject: [PATCH 223/352] src: axlobs.h: Add FoamOrigin --- aldor/aldor/src/axlobs.h | 2 ++ aldor/aldor/src/forg.h | 2 -- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/axlobs.h b/aldor/aldor/src/axlobs.h index a8424ae28..aff99934e 100644 --- a/aldor/aldor/src/axlobs.h +++ b/aldor/aldor/src/axlobs.h @@ -62,6 +62,8 @@ typedef struct foamuses_struct * FoamUses; typedef struct ssa_struct * SSA; typedef struct domtree_struct * DominatorTree; #endif +typedef struct foreign_origin * ForeignOrigin; + /* diff --git a/aldor/aldor/src/forg.h b/aldor/aldor/src/forg.h index e26da033b..271e1924f 100644 --- a/aldor/aldor/src/forg.h +++ b/aldor/aldor/src/forg.h @@ -13,8 +13,6 @@ struct foreign_origin { String file; }; -typedef struct foreign_origin * ForeignOrigin; - extern ForeignOrigin forgNew (FoamProtoTag, String); extern ForeignOrigin forgFrAbSyn (AbSyn); extern Bool forgEqual (ForeignOrigin, ForeignOrigin); From c1687ab8fcc6c65b577ce4f02c6596331ad4cafd Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 30 Nov 2017 23:53:00 +0000 Subject: [PATCH 224/352] foam.c: add Foam -> String conversion --- aldor/aldor/src/foam.c | 23 +++++++++++++++++++++++ aldor/aldor/src/foam.h | 2 ++ aldor/aldor/src/genc.c | 8 +------- 3 files changed, 26 insertions(+), 7 deletions(-) diff --git a/aldor/aldor/src/foam.c b/aldor/aldor/src/foam.c index 7e3d67ecf..ceb7dd0a1 100644 --- a/aldor/aldor/src/foam.c +++ b/aldor/aldor/src/foam.c @@ -2072,6 +2072,29 @@ foamFrString(String s) return foam; } +/***************************************************************************** + * + * :: FOAM_Arr + * + ****************************************************************************/ + +String +foamArrToString(Foam foam) +{ + int i, arrSize; + String str; + assert(foam->foamArr.baseType == FOAM_Char); + + arrSize = foamArgc(foam); + str = strAlloc(arrSize); + for (i = 0; i < arrSize - 1; i++) + str[i] = foam->foamArr.eltv[i]; + str[i] = '\0'; + + return str; +} + + /***************************************************************************** * * :: FOAM_GDecl diff --git a/aldor/aldor/src/foam.h b/aldor/aldor/src/foam.h index 8253f9f41..1deb447ff 100644 --- a/aldor/aldor/src/foam.h +++ b/aldor/aldor/src/foam.h @@ -623,6 +623,8 @@ struct foamArr { AInt eltv[NARY]; }; +extern String foamArrToString(Foam); + struct foamRec { struct foamHdr hdr; AInt format; diff --git a/aldor/aldor/src/genc.c b/aldor/aldor/src/genc.c index 47b4d3deb..f49b5cd6d 100644 --- a/aldor/aldor/src/genc.c +++ b/aldor/aldor/src/genc.c @@ -4002,14 +4002,8 @@ gccBInt(Foam foam) local CCode gccArr(Foam foam) { - int i, arrSize; - String str; + String str = foamArrToString(foam); - arrSize = foamArgc(foam); - str = strAlloc(arrSize); - for (i = 0; i < arrSize - 1; i++) - str[i] = foam->foamArr.eltv[i]; - str[i] = '\0'; return ccoStringOf(str); } From b37e69022f45317e8bdcb25acbc1fb25b58ae39d Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 30 Nov 2017 23:54:22 +0000 Subject: [PATCH 225/352] cmdline.c: Declare use of -J option --- aldor/aldor/src/cmdline.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/cmdline.c b/aldor/aldor/src/cmdline.c index b120786df..c41d7a3f0 100644 --- a/aldor/aldor/src/cmdline.c +++ b/aldor/aldor/src/cmdline.c @@ -57,7 +57,7 @@ int cmdFileCount = 0; * * These are still available: * - * J T + * T */ local void cmdUseError (Msg fmt, String opt); From 2588fe7e0cea4fe5946189542f688a20a575aa79 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Dec 2017 00:11:01 +0000 Subject: [PATCH 226/352] file.c: Add fileEnsureDirectory --- aldor/aldor/src/file.c | 23 +++++++++++++++++++++++ aldor/aldor/src/file.h | 1 + aldor/aldor/src/opsys.h | 5 ++++- aldor/aldor/src/os_unix.c | 17 +++++++++++++++++ 4 files changed, 45 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/file.c b/aldor/aldor/src/file.c index 44488fe79..165a54082 100644 --- a/aldor/aldor/src/file.c +++ b/aldor/aldor/src/file.c @@ -63,6 +63,7 @@ fileMustOpen(FileName fn, IOMode mode) { FILE *stream; + fileEnsureDirectory(fn); stream = fileTryOpen(fn, mode); if (!stream) stream = (*fileError)(fn, mode); return stream; @@ -141,6 +142,28 @@ fileRename(FileName from, FileName to) strFree(name1); } +void +fileEnsureDirectory(FileName fileName) +{ + FileName name; + String dir = fnameDir(fileName); + String nameStr; + + if (strLength(dir) == 0) { + return; + } + if (osDirIsThere(dir)) { + return; + } + + name = fnameParse(dir); + fileEnsureDirectory(name); + if (!osDirIsThere(dir)) { + osDirCreate(dir); + } +} + + /***************************************************************************** * * Save integers in standard byte order. diff --git a/aldor/aldor/src/file.h b/aldor/aldor/src/file.h index f641772f3..37768e376 100644 --- a/aldor/aldor/src/file.h +++ b/aldor/aldor/src/file.h @@ -32,6 +32,7 @@ extern String fileContentsString (FileName); extern void fileFreeContentsString (String); extern void fileRemove (FileName); extern void fileRename (FileName, FileName); +extern void fileEnsureDirectory (FileName); # define fileRdOpen(fn) fileMustOpen(fn,osIoRdMode) # define fileWrOpen(fn) fileMustOpen(fn,osIoWrMode) diff --git a/aldor/aldor/src/opsys.h b/aldor/aldor/src/opsys.h index c4b4e24ce..1d592f3b1 100644 --- a/aldor/aldor/src/opsys.h +++ b/aldor/aldor/src/opsys.h @@ -248,7 +248,8 @@ extern Length osFileSize (String fn); extern Bool osDirIsThere (String dn); extern int osDirSwap (String newwd, String oldwd, Length oldwdlen); - /* +extern void osDirCreate (String dn); +/* * osIsInteractive determines whether an input stream is interactive, * e.g. a keyboard. * @@ -262,6 +263,8 @@ extern int osDirSwap (String newwd, String oldwd, Length oldwdlen); * the name of the original directory. This name can then be used to * swap back or to form file names relative to the original directory. * Returns 0 on success and -1 on failure. + * + * osDirCreate: Creates a directory */ /***************************************************************************** diff --git a/aldor/aldor/src/os_unix.c b/aldor/aldor/src/os_unix.c index 48eaa4887..a3e1d649e 100644 --- a/aldor/aldor/src/os_unix.c +++ b/aldor/aldor/src/os_unix.c @@ -464,6 +464,23 @@ osDirIsThere(String name) } #endif /* OS_UNIX */ +/***************************************************************************** + * + * :: osDirCreate + * + ****************************************************************************/ + +#if defined(OS_UNIX) +#define OS_Has_DirCreate + +void +osDirCreate(String dn) +{ + mkdir(dn, 0777); +} + + +#endif /***************************************************************************** * From 059373519dbc18de91cb870a1cadeea312f0bb6f Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Dec 2017 21:28:07 +0000 Subject: [PATCH 227/352] foam.c: PCall on a primitive type (ie. not String) won't work in java --- aldor/aldor/src/foam.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/aldor/aldor/src/foam.c b/aldor/aldor/src/foam.c index ceb7dd0a1..32266f16c 100644 --- a/aldor/aldor/src/foam.c +++ b/aldor/aldor/src/foam.c @@ -1146,6 +1146,11 @@ foamAuditPCallJava(Foam foam) int extra; op = foam->foamPCall.op; + if (foamTag(op) == FOAM_Arr) { + if (op->foamArr.baseType != FOAM_Char) + bug("incorrect type for java pcall"); + return; + } if (foamTag(op) != FOAM_Glo) foamAuditBadType(foam); glo = faGlobalsv[op->foamGlo.index]; From 75532015dea2473e5724234097e78150fff83f1f Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 22 Apr 2017 19:27:29 +0100 Subject: [PATCH 228/352] libaldor: sal_fold: add foldl, foldr Not really a huge fan of these at the moment - too many exports per category --- aldor/lib/aldor/src/datastruc/sal_fold.as | 28 +++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/aldor/lib/aldor/src/datastruc/sal_fold.as b/aldor/lib/aldor/src/datastruc/sal_fold.as index a776350ee..cb13e70a7 100644 --- a/aldor/lib/aldor/src/datastruc/sal_fold.as +++ b/aldor/lib/aldor/src/datastruc/sal_fold.as @@ -8,6 +8,11 @@ FoldingTransformationCategory(T: with): Category == with { Fold(T: with): FoldingTransformationCategory(T) with { /: (f: (T,T) -> T, List T) -> T; /: (f: (T,T) -> T, Generator T) -> T; + foldl: (f: (T,T) -> T, List T) -> T; + foldl: (f: (T,T) -> T, Generator T) -> T; + foldr: (f: (T,T) -> T, List T) -> T; + foldr: (f: (T,T) -> T, Generator T) -> T; + folder: ((T, T) -> T) -> % } == add { Rep ==> (T, T) -> T; @@ -17,6 +22,15 @@ Fold(T: with): FoldingTransformationCategory(T) with { (f: (T,T) -> T) / (l: List T): T == (per f)/l; (f: (T,T) -> T) / (g: Generator T): T == (per f)/g; + foldl(f: (T,T) -> T, l: List T): T == f/l; + foldr(f: (T,T) -> T, l: List T): T == ((a: T, b: T): T +-> f(b, a))/(reverse l); + + foldl(f: (T,T) -> T, g: Generator T): T == f/g; + foldr(f: (T,T) -> T, g: Generator T): T == { + import from List T; + f/reverse [g]; + } + (folder: %) / (l: List T): T == { empty? l => never; acc := first l; @@ -149,6 +163,19 @@ testFold(): () == { assertEquals(6, (+)/(x for x in 1..3)); } +testFoldR(): () == { +-- foldl: a + b + c --> (a + b) + c +-- foldr: a + b + c --> a + (b + c) + import from Fold Integer; + import from List Integer; + import from Integer; + import from Assert Integer; + f(n: Integer, m: Integer): Integer == 2*n + m; + assertEquals(9, foldr(f, [1,2,3])$Fold(Integer)); + assertEquals(11, foldl(f, [1,2,3])$Fold(Integer)); +} + + testFold2(): () == { import from Fold2(Integer, SortedSet Integer); import from SortedSet Integer; @@ -193,6 +220,7 @@ testLazyBoolean(): () == { testSum(); testFold(); +testFoldR(); testFold2(); testLazyBoolean(); testBoolean(); From e3edea012dd0c5bc5b0a308ac136ad9e14820c9f Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 14 Aug 2017 20:32:16 +0100 Subject: [PATCH 229/352] libaldor: Add Directory/Filename operations Mostly swiped off the axiom type. --- aldor/aldor/lib/libfoam/Makefile.am | 1 + aldor/aldor/src/Makefile.am | 2 + aldor/aldor/src/aldorlib.c | 8 +++ aldor/aldor/src/aldorlib.h | 7 ++ aldor/lib/aldor/src/Makefile.am | 2 + aldor/lib/aldor/src/util/Makefile.deps | 3 +- aldor/lib/aldor/src/util/Makefile.in | 8 ++- aldor/lib/aldor/src/util/sal_dir.as | 49 ++++++++++++++ aldor/lib/aldor/src/util/sal_fname.as | 94 ++++++++++++++++++++++++++ 9 files changed, 170 insertions(+), 4 deletions(-) create mode 100644 aldor/aldor/src/aldorlib.c create mode 100644 aldor/aldor/src/aldorlib.h create mode 100644 aldor/lib/aldor/src/util/sal_dir.as create mode 100644 aldor/lib/aldor/src/util/sal_fname.as diff --git a/aldor/aldor/lib/libfoam/Makefile.am b/aldor/aldor/lib/libfoam/Makefile.am index b8e7e1dba..783f9613d 100644 --- a/aldor/aldor/lib/libfoam/Makefile.am +++ b/aldor/aldor/lib/libfoam/Makefile.am @@ -6,6 +6,7 @@ runtime_CFLAGS = -I $(aldorsrcdir) -I ../../src runtime_ALDOR = al/runtime.c runtime_CSOURCES = \ + aldorlib.c \ btree.c \ compopt.c \ dword.c \ diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index 6a6ae4e2d..2c5406b08 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -16,6 +16,7 @@ include_HEADERS = \ basic.typ \ cconfig.h \ foam_c.h \ + aldorlib.h \ foamopt.h \ optcfg.h \ platform.h @@ -96,6 +97,7 @@ libtest_a_SOURCES = \ # Foam stuff does not belong! libgen_a_SOURCES = \ + aldorlib.c \ bigint.c \ bitv.c \ btree.c \ diff --git a/aldor/aldor/src/aldorlib.c b/aldor/aldor/src/aldorlib.c new file mode 100644 index 000000000..6e2f7931d --- /dev/null +++ b/aldor/aldor/src/aldorlib.c @@ -0,0 +1,8 @@ +#include +#include "aldorlib.h" + +FiPtr direntName(FiPtr ptr) +{ + struct dirent *ent = (struct dirent *) ptr; + return ent->d_name; +} diff --git a/aldor/aldor/src/aldorlib.h b/aldor/aldor/src/aldorlib.h new file mode 100644 index 000000000..dea8c5486 --- /dev/null +++ b/aldor/aldor/src/aldorlib.h @@ -0,0 +1,7 @@ +#ifndef ALDORLIB_H +#define ALDORLIB_H +#include "foam_c.h" + +FiPtr direntName(FiPtr); + +#endif diff --git a/aldor/lib/aldor/src/Makefile.am b/aldor/lib/aldor/src/Makefile.am index dc3df68cf..0c936e2ea 100644 --- a/aldor/lib/aldor/src/Makefile.am +++ b/aldor/lib/aldor/src/Makefile.am @@ -79,6 +79,8 @@ libaldor_a_SOURCES = \ util/sal_agat.c \ util/sal_cmdline.c \ util/sal_file.c \ + util/sal_fname.c \ + util/sal_dir.c \ util/sal_timer.c \ util/sal_util.c \ util/sal_version.c diff --git a/aldor/lib/aldor/src/util/Makefile.deps b/aldor/lib/aldor/src/util/Makefile.deps index 7c4f0e604..aa4b59468 100644 --- a/aldor/lib/aldor/src/util/Makefile.deps +++ b/aldor/lib/aldor/src/util/Makefile.deps @@ -1,3 +1,4 @@ rtexns_deps := ald_trace - +sal_dir_deps := sal_fname library_deps := lang base arith datastruc +sal_fname_deps := sal_file diff --git a/aldor/lib/aldor/src/util/Makefile.in b/aldor/lib/aldor/src/util/Makefile.in index 9f0522116..8aeed07f5 100644 --- a/aldor/lib/aldor/src/util/Makefile.in +++ b/aldor/lib/aldor/src/util/Makefile.in @@ -15,11 +15,13 @@ abs_top_srcdir := @abs_top_srcdir@ subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) # Build starts here -library = ald_trace eio_rsto rtexns sal_agat sal_cmdline sal_file \ - sal_timer sal_version +library = ald_trace eio_rsto rtexns sal_agat sal_cmdline sal_file sal_dir \ + sal_timer sal_version sal_fname + +java_exclude = sal_dir XFAIL=sal_cmdline -@BUILD_JAVA_TRUE@javalibrary := $(library) +@BUILD_JAVA_TRUE@javalibrary := $(filter-out $(java_exclude), $(library)) include $(abs_top_srcdir)/lib/aldor/src/common.mk diff --git a/aldor/lib/aldor/src/util/sal_dir.as b/aldor/lib/aldor/src/util/sal_dir.as new file mode 100644 index 000000000..16a7d6d0e --- /dev/null +++ b/aldor/lib/aldor/src/util/sal_dir.as @@ -0,0 +1,49 @@ +#include "aldor" +#pile + + +Directory: with + open: String -> % + read: % -> Partial Pointer + close: % -> () + readName: % -> Partial String + listDirectory: String -> List FileName +== add + Rep == Pointer + import + readdir: Pointer -> Pointer + opendir: String -> Pointer + closedir: Pointer -> MachineInteger + from Foreign C "" + import + direntName: Pointer -> Pointer + from Foreign C "aldorlib.h" + + open(p: String): % == per opendir(p) + read(dir: %): Partial Pointer == + import from Pointer + ptr := readdir(rep dir) + nil? ptr => failed + [ptr] + + readName(dir: %): Partial String == + import from Partial Pointer + ent := read dir + failed? ent => failed + [direntName(retract read dir) pretend String] + + close(dir: %): () == closedir(dir pretend Pointer) + + listDirectory(path: String): List FileName == + import from Partial String, FileName + dir := open path + lst: List FileName := [] + done := false + while not done repeat + name := readName dir + if failed? name then + done := true + else + lst := cons(filename(path, retract name), lst) + close dir + return lst diff --git a/aldor/lib/aldor/src/util/sal_fname.as b/aldor/lib/aldor/src/util/sal_fname.as new file mode 100644 index 000000000..942e74f7b --- /dev/null +++ b/aldor/lib/aldor/src/util/sal_fname.as @@ -0,0 +1,94 @@ +#include "aldor" +#include "aldorio" +#pile + ++++ This category provides an interface to names in the file system. +FileNameCategory : Category == with + PrimitiveType + OutputType + + coerce : String -> % + ++ coerce(s) converts a string to a file name + ++ according to operating system-dependent conventions. + coerce : % -> String + ++ coerce(fn) produces a string for a file name + ++ according to operating system-dependent conventions. + + filename : (String, String, String) -> % + ++ filename(d, n, e) creates a file name with + ++ d as its directory, n as its name and e as its extension. + ++ This is a portable way to create file names. + ++ When d or e is the empty string, a default is used. + + filename : (String, String) -> % + ++ filename(d, n) creates a file name with + ++ d as its directory, n as its name and optional extension + ++ This is a portable way to create file names. + ++ When d is the empty string, a default is used. + + directory : % -> String + ++ directory(f) returns the directory part of the file name. + name : % -> String + ++ name(f) returns the name part of the file name. + extension : % -> String + ++ extension(f) returns the type part of the file name. + + exists? : % -> Boolean + ++ exists?(f) tests if the file exists in the file system. + readable? : % -> Boolean + ++ readable?(f) tests if the named file exist and can it be opened + ++ for reading. + writable? : % -> Boolean + ++ writable?(f) tests if the named file be opened for writing. + ++ The named file need not already exist. + + new : (String, String, String) -> % + ++ new(d, pref, e) constructs the name of a new writable file with + ++ d as its directory, pref as a prefix of its name and + ++ e as its extension. + ++ When d or t is the empty string, a default is used. + ++ An error occurs if a new file cannot be written in the given + ++ directory. + ++++ This domain provides an interface to names in the file system. ++++ +FileName : FileNameCategory == add + Rep == Record(p: String, name: String, ext: String) + import from Rep + import from MachineInteger + + default f, f1, f2: % + f1 = f2: Boolean == never + + coerce(f : %) : String == directory(f) + "/" + name(f) + "." + extension(f) + coerce(s : String) : % == + (flg1, lastSlash, c) := linearReverseSearch(char "/", s) + (flg2, lastDot, c) := linearReverseSearch(char ".", s) + stdout << "coerce " << s << " " << flg1 << flg2 << newline + if flg1 and flg2 and lastDot > lastSlash then + filename(substring(s, 0, lastSlash), + substring(s, lastSlash+1, lastDot), + substring(s, lastDot + 1)) + else if flg2 then + filename("", substring(s, 0, lastDot), substring(s, lastDot + 1)) + else if flg1 then + filename(substring(s, 0, lastSlash), substring(s, lastSlash+1), "") + else + filename("", s, "") + + filename(d: String, n: String, e: String): % == per [d, n, e] + filename(d: String, full: String): % == + (flg2, lastDot, c) := linearReverseSearch(char ".", full) + not flg2 => filename(d, full, ""); + filename(d, substring(full, 0, lastDot), substring(full, lastDot+1)) + + directory(f : %) : String == rep(f).p + name(f : %) : String == rep(f).name + extension(f : %) : String == rep(f).ext + exists? f: Boolean == never + readable? f: Boolean == never + writable? f: Boolean == never + + new(d: String, pref: String, e: String): % == filename(d, pref, e) + + (o: TextWriter) << (f: %): TextWriter == o << "{fn: " << directory f << "/" << name f << "." << extension f << "}" From 85b0930361f09836f71c6b9da07730643344b569 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 14 Aug 2017 20:34:29 +0100 Subject: [PATCH 230/352] libaldor: sal_array.as: Add reverse linear search -- Needs to be swapped with prev commit --- aldor/lib/aldor/src/datastruc/sal_array.as | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/aldor/lib/aldor/src/datastruc/sal_array.as b/aldor/lib/aldor/src/datastruc/sal_array.as index 38c3a796c..f967d01a2 100644 --- a/aldor/lib/aldor/src/datastruc/sal_array.as +++ b/aldor/lib/aldor/src/datastruc/sal_array.as @@ -5,7 +5,7 @@ -- -- Copyright (c) Manuel Bronstein 1998 -- Copyright (c) INRIA 1998, Version 29-10-98 --- Logiciel Salli ©INRIA 1998, dans sa version du 29/10/1998 +-- Logiciel Salli �INRIA 1998, dans sa version du 29/10/1998 ----------------------------------------------------------------------------- #include "aldor" @@ -207,6 +207,10 @@ $x < y \iff f(x,y)$. The comparison function $f$ is optional if $T$ has \altype{TotallyOrderedType}, in which case the order function of $T$ is taken.} #endif + if T has PrimitiveType then { + linearReverseSearch: (T, %) -> (Boolean, Z, T); + linearReverseSearch: (T, %, Z) -> (Boolean, Z, T); + } default { import from PT; @@ -278,6 +282,22 @@ function of $T$ is taken.} } (false, prev firstIndex, t); } + linearReverseSearch(t:T, a:%):(Boolean, Z, T) == { + p := data a; -- optimizes code generation + for n in prev(#a) + firstIndex..firstIndex by -1 repeat { + p.n=t => return(true,n,p.n); + } + (false, prev firstIndex, t); + } + + linearReverseSearch(t:T, a:%, end:Z):(Boolean, Z, T) == { + assert(end >= firstIndex); + p := data a; -- optimizes code generation + for n in end..firstIndex by -1 repeat { + p.n=t => return(true,n,p.n); + } + (false, prev firstIndex, t); + } (a:%) = (b:%):Boolean == { import from Z, T; From 91e0b7e712e71f6d01be0b9c1dd86d89bacb6ece Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 14 Aug 2017 20:37:43 +0100 Subject: [PATCH 231/352] libaldor: sal_sexpr: Add some more char prefixes, some errors, string read fix --- aldor/lib/aldor/src/lisp/sal_sexpr.as | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/aldor/lib/aldor/src/lisp/sal_sexpr.as b/aldor/lib/aldor/src/lisp/sal_sexpr.as index 58791ed78..ffe46d26a 100644 --- a/aldor/lib/aldor/src/lisp/sal_sexpr.as +++ b/aldor/lib/aldor/src/lisp/sal_sexpr.as @@ -36,7 +36,8 @@ CharSets: with char "*", char "/", char "<", char ">", char "%", char "$", - char "?"] + char "~", char "?", + char "=", char "#" ] symStart?(c): Boolean == letter? c or member?(c, symStarts) whitespace?(c): Boolean == c = space or c = newline or c = tab @@ -302,16 +303,17 @@ SExpressionReader: with c = char "_"" => [readString s] symStart? c => [readSymbol s] numberStart? c => [readNumber s] + stdout << "Unknown token prefix " << c << newline failed readString(s: TextLStream): Token == - done := false text := "" next! s while hasNext? s and peek s ~= char "_"" repeat text := text + peek(s)::String next! s not hasNext? s => [error, "eof inside string"] + next! s [str, text] readWhitespace(s: TextLStream): Token == @@ -354,22 +356,29 @@ SExpressionReader: with next! s readList(): Partial SExpression == - not hasNext? s => failed + not hasNext? s => + stdout << "no next" << newline + failed peek(s).type = cparen => next! s [nil] tmp := read() - failed? tmp => failed + failed? tmp => + stdout << "failed rec call" << newline + failed head: Cons := cons(retract tmp, nil) last := head done := false while not done repeat skipWhitespace!() - if not hasNext? s then return failed + not hasNext? s => + stdout << "no next" << newline + return failed if peek(s).type = dot then next! s final := read() - failed? final => return failed + failed? final => + return failed setRest!(last, retract final) done := true else if peek(s).type = cparen then @@ -387,16 +396,20 @@ SExpressionReader: with import from Integer skipWhitespace!() not hasNext? s => + stdout << "no next" << newline failed tok := peek s; next! s if tok.type = oparen then readList() - else if tok.type = cparen then failed + else if tok.type = cparen then + stdout << "cparen" << newline + failed else if tok.type = str then [sexpr tok.txt] else if tok.type = sym then [sexpr (-tok.txt)] else if tok.type = number then [sexpr integer literal tok.txt] else + stdout << "gawd knows" << tok.type << newline failed read() From 49e8fcd868c2683206abbe4eacd81798590bf3d6 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 24 Jun 2017 20:44:58 +0100 Subject: [PATCH 232/352] aldor library: fix printing of arrays which don't have OutputType --- 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 ebe2b5fff..2969bee74 100644 --- a/aldor/lib/aldor/src/aldor_gloop.as +++ b/aldor/lib/aldor/src/aldor_gloop.as @@ -35,7 +35,7 @@ extend List(T:Type): with { <<: (TextWriter, %) -> TextWriter } == add { } extend Array(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; zero?(n := #a) => p << "[]"; From 03eb10b1f0952c929b129bbad778455c532008fc Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 26 Aug 2017 17:49:31 +0100 Subject: [PATCH 233/352] libaldor: Symbol needs to be sure there is only one symbol table --- aldor/lib/aldor/src/datastruc/ald_symbol.as | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/aldor/lib/aldor/src/datastruc/ald_symbol.as b/aldor/lib/aldor/src/datastruc/ald_symbol.as index 93b2ea393..934d41039 100644 --- a/aldor/lib/aldor/src/datastruc/ald_symbol.as +++ b/aldor/lib/aldor/src/datastruc/ald_symbol.as @@ -32,6 +32,8 @@ macro { H == HashTable(String, String); } +local rootTable: H == table(); + Symbol: Join(HashType, InputType, OutputType, SerializableType) with { -: String -> %; #if ALDOC @@ -63,7 +65,7 @@ symbols: () -> H; Rep == String; -- This hash-table makes this type non-reentrant - local stable:H == table(); + local stable:H == rootTable; local enter(s:String):% == { stable.s := s; per s } local root:String == "%v"; local buffer:String == { import from Z; new 21 } -- enough for 2^64 From 96349b1470448e191f0eff9b57b47a666d8a6799 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Dec 2017 21:44:39 +0000 Subject: [PATCH 234/352] libaldor: Need to copy return from direntName --- aldor/lib/aldor/src/util/sal_dir.as | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/lib/aldor/src/util/sal_dir.as b/aldor/lib/aldor/src/util/sal_dir.as index 16a7d6d0e..548a0997c 100644 --- a/aldor/lib/aldor/src/util/sal_dir.as +++ b/aldor/lib/aldor/src/util/sal_dir.as @@ -27,10 +27,10 @@ Directory: with [ptr] readName(dir: %): Partial String == - import from Partial Pointer + import from Partial Pointer, String ent := read dir failed? ent => failed - [direntName(retract read dir) pretend String] + [copy(direntName(retract ent) pretend String)] close(dir: %): () == closedir(dir pretend Pointer) From c694f9ef102d45e952c6f9db0edc67d0adaca91b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 2 Dec 2017 19:29:00 +0000 Subject: [PATCH 235/352] libaldor: Add Assert(List, Integer) Really do need some kind of universal type.. --- aldor/lib/aldor/src/test/tst_assert.as | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/aldor/lib/aldor/src/test/tst_assert.as b/aldor/lib/aldor/src/test/tst_assert.as index f17eb1d3c..bd7297d02 100644 --- a/aldor/lib/aldor/src/test/tst_assert.as +++ b/aldor/lib/aldor/src/test/tst_assert.as @@ -85,5 +85,22 @@ Assert(T: with): with { } +Assert(F: (X: Type) -> BoundedFiniteDataStructureType X, D: Type): with { + assertSizeEquals: (MachineInteger, F D) -> (); + if D has PrimitiveType then { + assertMember: (D, F D) -> () + } + export from Assert F D +} +== add { + import from Assert D, Assert F D, Assert MachineInteger, MachineInteger; + + assertSizeEquals(n: MachineInteger, a: F D): () == assertEquals(n, #a)$Assert(MachineInteger); + + if D has PrimitiveType then { + assertMember(d: D, a: F D): () == assertTrue(member?(d, a))$GeneralAssert + } +} + import from MachineInteger, RandomNumberGenerator; seed(randomGenerator(0), 1); From 9c82c443734d4da2c94ffcfc7efebfd6c4500488 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 31 Dec 2017 14:58:31 +0000 Subject: [PATCH 236/352] libaldor::sal_fname: Correct use of substring() and add a test --- aldor/lib/aldor/src/util/sal_fname.as | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/aldor/lib/aldor/src/util/sal_fname.as b/aldor/lib/aldor/src/util/sal_fname.as index 942e74f7b..4db336fc6 100644 --- a/aldor/lib/aldor/src/util/sal_fname.as +++ b/aldor/lib/aldor/src/util/sal_fname.as @@ -67,7 +67,7 @@ FileName : FileNameCategory == add stdout << "coerce " << s << " " << flg1 << flg2 << newline if flg1 and flg2 and lastDot > lastSlash then filename(substring(s, 0, lastSlash), - substring(s, lastSlash+1, lastDot), + substring(s, lastSlash+1, lastDot - lastSlash - 1), substring(s, lastDot + 1)) else if flg2 then filename("", substring(s, 0, lastDot), substring(s, lastDot + 1)) @@ -92,3 +92,25 @@ FileName : FileNameCategory == add new(d: String, pref: String, e: String): % == filename(d, pref, e) (o: TextWriter) << (f: %): TextWriter == o << "{fn: " << directory f << "/" << name f << "." << extension f << "}" + +#if ALDORTEST +---------------------- test sal_command.as -------------------------- +#include "aldor" +#include "aldortest" +#pile + +local testFile(): () == + import from Assert String + fname: FileName := "/foo/bar/wibble.txt"::FileName + assertEquals("/foo/bar", directory fname); + assertEquals("wibble", name fname); + assertEquals("txt", extension fname); + + fname: FileName := "wibble.txt"::FileName + assertEquals("", directory fname); + assertEquals("wibble", name fname); + assertEquals("txt", extension fname); + +testFile() + +#endif From 404f613c1b2bfcf9b51c0a5a060995435c6ca708 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 29 Apr 2018 13:47:28 +0100 Subject: [PATCH 237/352] lib/aldor/fname.as: allow for missing filename extensions --- aldor/lib/aldor/src/util/sal_fname.as | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/aldor/lib/aldor/src/util/sal_fname.as b/aldor/lib/aldor/src/util/sal_fname.as index 4db336fc6..8eba6b0eb 100644 --- a/aldor/lib/aldor/src/util/sal_fname.as +++ b/aldor/lib/aldor/src/util/sal_fname.as @@ -60,7 +60,10 @@ FileName : FileNameCategory == add default f, f1, f2: % f1 = f2: Boolean == never - coerce(f : %) : String == directory(f) + "/" + name(f) + "." + extension(f) + coerce(f : %) : String == + filePart := name(f) + (if extension f = "" then "" else ("." + extension(f))) + if directory(f) = "" then filePart else directory(f) + "/" + filePart + coerce(s : String) : % == (flg1, lastSlash, c) := linearReverseSearch(char "/", s) (flg2, lastDot, c) := linearReverseSearch(char ".", s) @@ -111,6 +114,12 @@ local testFile(): () == assertEquals("wibble", name fname); assertEquals("txt", extension fname); + fname: FileName := "wibble"::FileName + assertEquals("", directory fname); + assertEquals("wibble", name fname); + assertEquals("", extension fname); + assertEquals("wibble", fname::String) + testFile() #endif From 0575ad5f1016882f615a761d0ec2611891808cdb Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Dec 2017 21:46:00 +0000 Subject: [PATCH 238/352] sal_hashset.c: Use member? instead of contains? member? already exists. --- aldor/lib/aldor/src/datastruc/sal_hashset.as | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/aldor/lib/aldor/src/datastruc/sal_hashset.as b/aldor/lib/aldor/src/datastruc/sal_hashset.as index e8b671974..b3939cf16 100644 --- a/aldor/lib/aldor/src/datastruc/sal_hashset.as +++ b/aldor/lib/aldor/src/datastruc/sal_hashset.as @@ -3,7 +3,6 @@ HashSet(T: HashType): BoundedFiniteDataStructureType T with { bracket: Tuple T -> %; bracket: Generator T -> %; - contains?: (%, T) -> Boolean; insert!: (%, T) -> (); empty: () -> %; } @@ -15,7 +14,7 @@ HashSet(T: HashType): BoundedFiniteDataStructureType T with { (a: %) = (b: %): Boolean == { import from MachineInteger; import from BooleanFold; - # a = #b and (_and)/(contains?(a, elt) for elt in b) + # a = #b and (_and)/(member?(elt, a) for elt in b) } generator set: Generator T == { @@ -31,7 +30,7 @@ HashSet(T: HashType): BoundedFiniteDataStructureType T with { set!(rep set, e, true); } - contains?(set, e: T): Boolean == { + member?(e: T, set): Boolean == { import from Partial Boolean; not failed? find(e, rep set); } From e133fefff8b5b817ea79847de5ec06cc2c0cac2d Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Dec 2017 21:47:58 +0000 Subject: [PATCH 239/352] sal_sexpr.c: Quote and dot expressions --- aldor/lib/aldor/src/lisp/sal_sexpr.as | 53 ++++++++++++++++++++++++++- 1 file changed, 51 insertions(+), 2 deletions(-) diff --git a/aldor/lib/aldor/src/lisp/sal_sexpr.as b/aldor/lib/aldor/src/lisp/sal_sexpr.as index ffe46d26a..8fa1e77af 100644 --- a/aldor/lib/aldor/src/lisp/sal_sexpr.as +++ b/aldor/lib/aldor/src/lisp/sal_sexpr.as @@ -37,7 +37,8 @@ CharSets: with char "<", char ">", char "%", char "$", char "~", char "?", - char "=", char "#" ] + char "=", char "#", + char "^", char "__", char ":"] symStart?(c): Boolean == letter? c or member?(c, symStarts) whitespace?(c): Boolean == c = space or c = newline or c = tab @@ -269,7 +270,7 @@ FnLStream(T: Type): LStream T with SExpressionReader: with read: (TextReader) -> Partial SExpression; == add - Token == Record(type: 'sym,number,str,ws,oparen,cparen,dot,error', txt: String); + Token == Record(type: 'sym,number,str,ws,oparen,cparen,dot,quote,error', txt: String); import from Token import from CharSets readOneToken(rdr: TextReader): Partial Token == @@ -300,6 +301,9 @@ SExpressionReader: with c = char "." => next! s [[dot, c::String]] + c = char "'" => + next! s + [[quote, c::String]] c = char "_"" => [readString s] symStart? c => [readSymbol s] numberStart? c => [readNumber s] @@ -310,8 +314,11 @@ SExpressionReader: with text := "" next! s while hasNext? s and peek s ~= char "_"" repeat + if peek s = char "\" then + next! s text := text + peek(s)::String next! s + not hasNext? s => [error, "eof inside string"] not hasNext? s => [error, "eof inside string"] next! s [str, text] @@ -330,6 +337,8 @@ SExpressionReader: with next! s text := "" while peek s ~= char "|" repeat + if peek(s) = char "\" then + next! s text := text + peek(s)::String next! s next! s @@ -380,6 +389,10 @@ SExpressionReader: with failed? final => return failed setRest!(last, retract final) + skipWhitespace!() + if peek(s).type ~= cparen then + return failed + next! s done := true else if peek(s).type = cparen then done := true @@ -391,6 +404,11 @@ SExpressionReader: with setRest!(last, sexpr nextCell) last := nextCell return [sexpr head] + + readQuoted(): Partial SExpression == + sx := read() + failed? sx => failed + [[sexpr(-"QUOTE"), retract sx]] read(): Partial SExpression == import from Integer @@ -405,6 +423,7 @@ SExpressionReader: with stdout << "cparen" << newline failed else if tok.type = str then [sexpr tok.txt] + else if tok.type = quote then readQuoted() else if tok.type = sym then [sexpr (-tok.txt)] else if tok.type = number then [sexpr integer literal tok.txt] @@ -476,6 +495,36 @@ test(): () == assertFalse failed? sxMaybe assertEquals(sexpr(-"symbol?"), retract sxMaybe) + sxMaybe := readOne("_"hello\_"_"") + stdout << "strsx: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals(sexpr("hello_""), retract sxMaybe) + + sxMaybe := readOne("_"\\_"") + stdout << "strsx: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals(sexpr("\"), retract sxMaybe) + + sxMaybe := readOne("|\||") + stdout << "strsx: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals(sexpr(-"|"), retract sxMaybe) + + sxMaybe := readOne("|__\|__|") + stdout << "strsx: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals(sexpr(-"__|__"), retract sxMaybe) + + sxMaybe := readOne("'x") + stdout << "strsx: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals([sexpr(-"QUOTE"), sexpr(-"x")], retract sxMaybe) + + sxMaybe := readOne("(((foo) . 1) ((bar) . 2))") + stdout << "strsx: " << sxMaybe << newline + assertFalse failed? sxMaybe + assertEquals([cons([sexpr(-"foo")], sexpr 1), cons([sexpr(-"bar")], sexpr 2)], retract sxMaybe) + test() test2(): () == From 52e70239f38b254427b4aa7fca75ef904366a79e Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Jun 2018 14:29:52 +0100 Subject: [PATCH 240/352] sal_sexpr.as: Handle blackslash escapes & remove test from blacklist --- aldor/lib/aldor/src/lisp/Makefile.in | 3 ++- aldor/lib/aldor/src/lisp/sal_sexpr.as | 33 ++++++++++++++++++++++++++- 2 files changed, 34 insertions(+), 2 deletions(-) diff --git a/aldor/lib/aldor/src/lisp/Makefile.in b/aldor/lib/aldor/src/lisp/Makefile.in index 94ef2e284..de1a2c312 100644 --- a/aldor/lib/aldor/src/lisp/Makefile.in +++ b/aldor/lib/aldor/src/lisp/Makefile.in @@ -18,7 +18,8 @@ subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) library = sal_sexpr @BUILD_JAVA_TRUE@javalibrary := $(library) -java_test_blacklist := sal_sexpr + +#java_test_blacklist := sal_sexpr include $(abs_top_srcdir)/lib/aldor/src/common.mk diff --git a/aldor/lib/aldor/src/lisp/sal_sexpr.as b/aldor/lib/aldor/src/lisp/sal_sexpr.as index 8fa1e77af..2894074b8 100644 --- a/aldor/lib/aldor/src/lisp/sal_sexpr.as +++ b/aldor/lib/aldor/src/lisp/sal_sexpr.as @@ -304,6 +304,8 @@ SExpressionReader: with c = char "'" => next! s [[quote, c::String]] + c = char "\" => + [readBackslashEscaped s] c = char "_"" => [readString s] symStart? c => [readSymbol s] numberStart? c => [readNumber s] @@ -344,6 +346,12 @@ SExpressionReader: with next! s [sym, text] + readBackslashEscaped(s: TextLStream): Token == + next! s + text := peek(s)::String + next! s + [sym, text] + readNumber(s: TextLStream): Token == text := "" while hasNext? s and numberPart? peek s repeat @@ -532,11 +540,12 @@ test2(): () == import from SExpression import from SExpressionReader import from Partial SExpression + import from Assert SExpression rdr := open("sal__sexpr.asy")::TextReader sx := read(rdr) - stdout << sx << newline + assertFalse(failed? sx) testBracket(): () == import from Assert SExpression @@ -593,4 +602,26 @@ nada: SExpression := nil testAppend2() +testFileStuff(): () == + import from SExpression, Symbol, MachineInteger + import from Assert SExpression + file: File := open("foo.lsp", fileWrite) + w: TextWriter := file::TextWriter + w << [sexpr(-"hello"), sexpr(-"world")]@SExpression << newline + w << [sexpr(-"goodbye"), sexpr(-"world")]@SExpression << newline + close! file + + infile := open("foo.lsp", fileRead) + r := infile::TextReader + sx: SExpression := << r + assertEquals(sx, [sexpr(-"hello"), sexpr(-"world")]@SExpression) + + infile := open("foo.lsp", fileRead) + r := infile::TextReader + setPosition!(infile, 14) + sx: SExpression := << r + assertEquals(sx, [sexpr(-"goodbye"), sexpr(-"world")]@SExpression) + +testFileStuff() + #endif From 3945286b43700bb3626a8428614c898defa2c950 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 29 Apr 2018 11:09:34 +0100 Subject: [PATCH 241/352] sal_sexpr.as: Use buffer when reading, instead of string concat --- aldor/lib/aldor/src/lisp/sal_sexpr.as | 37 ++++++++++++++++----------- 1 file changed, 22 insertions(+), 15 deletions(-) diff --git a/aldor/lib/aldor/src/lisp/sal_sexpr.as b/aldor/lib/aldor/src/lisp/sal_sexpr.as index 2894074b8..e1a1958dd 100644 --- a/aldor/lib/aldor/src/lisp/sal_sexpr.as +++ b/aldor/lib/aldor/src/lisp/sal_sexpr.as @@ -313,38 +313,43 @@ SExpressionReader: with failed readString(s: TextLStream): Token == - text := "" + buffer: StringBuffer := new() + writer: TextWriter := coerce buffer next! s while hasNext? s and peek s ~= char "_"" repeat if peek s = char "\" then next! s - text := text + peek(s)::String + writer << peek(s) next! s not hasNext? s => [error, "eof inside string"] not hasNext? s => [error, "eof inside string"] next! s - [str, text] + [str, string buffer] + readWhitespace(s: TextLStream): Token == + buffer: StringBuffer := new() + writer: TextWriter := coerce buffer import from Character - text := peek(s)::String + writer << peek s next! s while whitespace? peek s repeat - text := text + peek(s)::String + writer << peek s next! s - [ws, text] + [ws, string buffer] readEscaped(s: TextLStream): Token == import from Character + buffer: StringBuffer := new() + writer: TextWriter := coerce buffer next! s - text := "" while peek s ~= char "|" repeat if peek(s) = char "\" then next! s - text := text + peek(s)::String + writer << peek s next! s next! s - [sym, text] + [escsym, string buffer] readBackslashEscaped(s: TextLStream): Token == next! s @@ -353,18 +358,20 @@ SExpressionReader: with [sym, text] readNumber(s: TextLStream): Token == - text := "" + buffer: StringBuffer := new() + writer: TextWriter := coerce buffer while hasNext? s and numberPart? peek s repeat - text := text + peek(s)::String + writer << peek(s) next! s - [number, text] + [number, string buffer] readSymbol(s: TextLStream): Token == - text := "" + buffer: StringBuffer := new() + writer: TextWriter := coerce buffer while hasNext? s and symPart? peek s repeat - text := text + peek(s)::String + writer << peek(s) next! s - [sym, text] + [sym, string buffer] read(s: FnLStream Token): Partial SExpression == import from SExpression, Symbol From 9008a636b97fb105fa435bb1585b6fbeb8c63a79 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 29 Apr 2018 11:15:38 +0100 Subject: [PATCH 242/352] sal_sexpr.as: Support references --- aldor/lib/aldor/src/lisp/sal_sexpr.as | 44 +++++++++++++++++++++++++-- 1 file changed, 42 insertions(+), 2 deletions(-) diff --git a/aldor/lib/aldor/src/lisp/sal_sexpr.as b/aldor/lib/aldor/src/lisp/sal_sexpr.as index e1a1958dd..f36dbc594 100644 --- a/aldor/lib/aldor/src/lisp/sal_sexpr.as +++ b/aldor/lib/aldor/src/lisp/sal_sexpr.as @@ -37,7 +37,7 @@ CharSets: with char "<", char ">", char "%", char "$", char "~", char "?", - char "=", char "#", + char "=", char "^", char "__", char ":"] symStart?(c): Boolean == letter? c or member?(c, symStarts) @@ -270,9 +270,10 @@ FnLStream(T: Type): LStream T with SExpressionReader: with read: (TextReader) -> Partial SExpression; == add - Token == Record(type: 'sym,number,str,ws,oparen,cparen,dot,quote,error', txt: String); + Token == Record(type: 'sym,number,str,ws,oparen,cparen,dot,quote,error,getref,setref', txt: String); import from Token import from CharSets + readOneToken(rdr: TextReader): Partial Token == import from TextLStream s := tstream rdr @@ -306,6 +307,7 @@ SExpressionReader: with [[quote, c::String]] c = char "\" => [readBackslashEscaped s] + c = char "#" => [readReference s] c = char "_"" => [readString s] symStart? c => [readSymbol s] numberStart? c => [readNumber s] @@ -326,6 +328,17 @@ SExpressionReader: with next! s [str, string buffer] + readReference(s: TextLStream): Token == + next! s + text := "" + while hasNext? s and digit? peek s repeat + text := text + peek(s)::String + next! s + peek s = char "=" => + next! s + return [setref, text] + if peek s = char "#" then next! s + [getref, text] readWhitespace(s: TextLStream): Token == buffer: StringBuffer := new() @@ -375,6 +388,11 @@ SExpressionReader: with read(s: FnLStream Token): Partial SExpression == import from SExpression, Symbol + tbl: HashTable(String, SExpression) := table() + setref!(id: String, psx: Partial SExpression): Partial SExpression == + if not failed? psx then tbl.id := retract psx + psx + getref(id: String): Partial SExpression == find(id, tbl) skipWhitespace!(): () == while hasNext? s and peek(s).type = ws repeat next! s @@ -442,6 +460,10 @@ SExpressionReader: with else if tok.type = sym then [sexpr (-tok.txt)] else if tok.type = number then [sexpr integer literal tok.txt] + else if tok.type = setref then + setref!(tok.txt, read()) + else if tok.type = getref then + getref(tok.txt) else stdout << "gawd knows" << tok.type << newline failed @@ -592,11 +614,29 @@ testGenerator(): () == sum := (+)/(int elt for elt in sx) assertEquals(6, sum) +testReadRef(): () == + import from Assert SExpression + import from Partial SExpression, SExpression, Symbol + sxMaybe := readOne("(#1=(a) #1)") + assertFalse failed? sxMaybe + a: SExpression := [sexpr.(-"a")] + assertEquals([a, a], retract sxMaybe) + +testReadRef2(): () == + import from Assert SExpression + import from Partial SExpression, SExpression, Symbol + sxMaybe := readOne("(#1=(a) #1#)") + assertFalse failed? sxMaybe + a: SExpression := [sexpr.(-"a")] + assertEquals([a, a], retract sxMaybe) + test2() testBracket() testAppend() testNth() testGenerator() +testReadRef() +testReadRef2() import from Integer nada: SExpression := cons(sexpr 1, sexpr 2) From 572e2242f26a0f95c54f3e42738e0a9d9f79be6d Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 29 Apr 2018 11:17:48 +0100 Subject: [PATCH 243/352] sal_sexpr.as: Unescaped lisp symbols are upper-case internally --- aldor/lib/aldor/src/datastruc/sal_string.as | 28 ++++++++++++++++++++ aldor/lib/aldor/src/lisp/sal_sexpr.as | 29 ++++++++++++--------- 2 files changed, 45 insertions(+), 12 deletions(-) diff --git a/aldor/lib/aldor/src/datastruc/sal_string.as b/aldor/lib/aldor/src/datastruc/sal_string.as index 1940c11f8..629b5842a 100644 --- a/aldor/lib/aldor/src/datastruc/sal_string.as +++ b/aldor/lib/aldor/src/datastruc/sal_string.as @@ -192,6 +192,8 @@ when using C--functions in \salli clients.} substring: (%, Z) -> %; substring: (%, Z, Z) -> %; literal: % -> Literal; + upper: % -> %; + lower: % -> %; #if ALDOC \alpage{substring} \Usage{\name(s, n)\\ \name(s, n, m)} @@ -431,6 +433,22 @@ of \emph{s}, while \name(s,n,m) returns a copy of the substring of length true; } + upper(s: %): % == { + empty? s => ""; + n: Z := #s; + s := new(n); + for i in 0..prev n repeat s.i := upper s.i; + s + } + + lower(s: %): % == { + empty? s => ""; + n: Z := #s; + s := new(n); + for i in 0..prev n repeat s.i := lower s.i; + s + } + (p:TextWriter) << (s:%):TextWriter == { import from Ch; for c in s repeat p << c; @@ -673,6 +691,16 @@ testToFromString(): () == { assertEquals(99, fromString(toString(99))); } +testUpper(): () == { + import from MachineInteger, String; + assertEquals("hello", lower "HELLO"); + assertEquals("HELLO", lower "hello"); + assertEquals("h", lower "H"); + assertEquals("abcdef", lower "AbCdEf"); + assertEquals("", lower ""); + assertEquals("", upper ""); +} + testBasics(); testIterate(); testToString(); diff --git a/aldor/lib/aldor/src/lisp/sal_sexpr.as b/aldor/lib/aldor/src/lisp/sal_sexpr.as index f36dbc594..dd124b7be 100644 --- a/aldor/lib/aldor/src/lisp/sal_sexpr.as +++ b/aldor/lib/aldor/src/lisp/sal_sexpr.as @@ -270,7 +270,7 @@ FnLStream(T: Type): LStream T with SExpressionReader: with read: (TextReader) -> Partial SExpression; == add - Token == Record(type: 'sym,number,str,ws,oparen,cparen,dot,quote,error,getref,setref', txt: String); + Token == Record(type: 'sym,escsym,number,str,ws,oparen,cparen,dot,quote,error,getref,setref', txt: String); import from Token import from CharSets @@ -368,7 +368,7 @@ SExpressionReader: with next! s text := peek(s)::String next! s - [sym, text] + [escsym, text] readNumber(s: TextLStream): Token == buffer: StringBuffer := new() @@ -458,12 +458,17 @@ SExpressionReader: with else if tok.type = str then [sexpr tok.txt] else if tok.type = quote then readQuoted() else if tok.type = sym then + [sexpr (-[upper x for x in tok.txt])] + else if tok.type = escsym then [sexpr (-tok.txt)] else if tok.type = number then [sexpr integer literal tok.txt] else if tok.type = setref then setref!(tok.txt, read()) else if tok.type = getref then getref(tok.txt) + else if tok.type = error then + stdout << "Error " << tok.txt << newline + failed else stdout << "gawd knows" << tok.type << newline failed @@ -489,7 +494,7 @@ test(): () == sxMaybe := readOne("foo") assertFalse failed? sxMaybe - foo := sexpr (-"foo") + foo := sexpr (-"FOO") assertEquals(foo, retract sxMaybe) sxMaybe := readOne("23") @@ -525,12 +530,12 @@ test(): () == sxMaybe := readOne("(foo () 2)") stdout << "SX: " << sxMaybe << newline assertFalse failed? sxMaybe - assertEquals([sexpr(-"foo"), [], sexpr 2], retract sxMaybe) + assertEquals([sexpr(-"FOO"), [], sexpr 2], retract sxMaybe) sxMaybe := readOne("symbol?") stdout << "SX: " << sxMaybe << newline assertFalse failed? sxMaybe - assertEquals(sexpr(-"symbol?"), retract sxMaybe) + assertEquals(sexpr(-"SYMBOL?"), retract sxMaybe) sxMaybe := readOne("_"hello\_"_"") stdout << "strsx: " << sxMaybe << newline @@ -555,12 +560,12 @@ test(): () == sxMaybe := readOne("'x") stdout << "strsx: " << sxMaybe << newline assertFalse failed? sxMaybe - assertEquals([sexpr(-"QUOTE"), sexpr(-"x")], retract sxMaybe) + assertEquals([sexpr(-"QUOTE"), sexpr(-"X")], retract sxMaybe) - sxMaybe := readOne("(((foo) . 1) ((bar) . 2))") + sxMaybe := readOne("(((foo) . 1) ((|bar|) . 2))") stdout << "strsx: " << sxMaybe << newline assertFalse failed? sxMaybe - assertEquals([cons([sexpr(-"foo")], sexpr 1), cons([sexpr(-"bar")], sexpr 2)], retract sxMaybe) + assertEquals([cons([sexpr(-"FOO")], sexpr 1), cons([sexpr(-"bar")], sexpr 2)], retract sxMaybe) test() @@ -619,7 +624,7 @@ testReadRef(): () == import from Partial SExpression, SExpression, Symbol sxMaybe := readOne("(#1=(a) #1)") assertFalse failed? sxMaybe - a: SExpression := [sexpr.(-"a")] + a: SExpression := [sexpr.(-"A")] assertEquals([a, a], retract sxMaybe) testReadRef2(): () == @@ -627,7 +632,7 @@ testReadRef2(): () == import from Partial SExpression, SExpression, Symbol sxMaybe := readOne("(#1=(a) #1#)") assertFalse failed? sxMaybe - a: SExpression := [sexpr.(-"a")] + a: SExpression := [sexpr.(-"A")] assertEquals([a, a], retract sxMaybe) test2() @@ -661,13 +666,13 @@ testFileStuff(): () == infile := open("foo.lsp", fileRead) r := infile::TextReader sx: SExpression := << r - assertEquals(sx, [sexpr(-"hello"), sexpr(-"world")]@SExpression) + assertEquals(sx, [sexpr(-"HELLO"), sexpr(-"WORLD")]@SExpression) infile := open("foo.lsp", fileRead) r := infile::TextReader setPosition!(infile, 14) sx: SExpression := << r - assertEquals(sx, [sexpr(-"goodbye"), sexpr(-"world")]@SExpression) + assertEquals(sx, [sexpr(-"GOODBYE"), sexpr(-"WORLD")]@SExpression) testFileStuff() From 4fc2801f5a270bfb3de78a941b2bfbdb932b2268 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 17:32:42 +0000 Subject: [PATCH 244/352] fint.c: bugfix - Add some missing break statements --- aldor/aldor/src/fint.c | 1 + 1 file changed, 1 insertion(+) diff --git a/aldor/aldor/src/fint.c b/aldor/aldor/src/fint.c index 95edfb49b..151eb8317 100644 --- a/aldor/aldor/src/fint.c +++ b/aldor/aldor/src/fint.c @@ -1555,6 +1555,7 @@ fintStmt(DataObj retDataObj) } fintSet(type, loc, expr); + break; } /* fall through */ case FOAM_Free: From 7e7b7d79dcd2bcf25c96a9cbe4a444f75aa10251 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 31 Dec 2017 15:01:39 +0000 Subject: [PATCH 245/352] src/fint.c: Add some more built in functions (used in aldor library) --- aldor/aldor/src/fint.c | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/aldor/aldor/src/fint.c b/aldor/aldor/src/fint.c index 151eb8317..0b3dc6227 100644 --- a/aldor/aldor/src/fint.c +++ b/aldor/aldor/src/fint.c @@ -698,7 +698,9 @@ enum fintForeignTag { FINT_FOREIGN_fclose, FINT_FOREIGN_fflush, FINT_FOREIGN_fgetc, + FINT_FOREIGN_lfputc, FINT_FOREIGN_fseek, + FINT_FOREIGN_fseekset, FINT_FOREIGN_ftell, FINT_FOREIGN_mainArgc, FINT_FOREIGN_mainArgv, @@ -872,7 +874,9 @@ fintForeign fintForeignTable [] = { DECL_FOREIGN(fclose), DECL_FOREIGN(fflush), DECL_FOREIGN(fgetc), + DECL_FOREIGN(lfputc), DECL_FOREIGN(fseek), + DECL_FOREIGN(fseekset), DECL_FOREIGN(ftell), DECL_FOREIGN(mainArgc), DECL_FOREIGN(mainArgv), @@ -4529,6 +4533,13 @@ fintEval_(DataObj retDataObj) fputc((int)expr1.fiSInt, (FILE *) expr2.fiWord); break; + case FINT_FOREIGN_lfputc: + fintTypedEval(&expr1, FOAM_SInt); + fintTypedEval(&expr2, FOAM_Word); + retDataObj->fiWord = (FiWord) + fputc((int)expr1.fiSInt, (FILE *) expr2.fiWord); + break; + case FINT_FOREIGN_sqrt: fintTypedEval(&expr1, FOAM_DFlo); retDataObj->fiDFlo = (FiDFlo) @@ -4656,6 +4667,15 @@ fintEval_(DataObj retDataObj) expr3.fiWord); break; + case FINT_FOREIGN_fseekset: + fintTypedEval(&expr1, FOAM_Word); + fintTypedEval(&expr2, FOAM_Word); + retDataObj->fiSInt = (FiSInt) + fseek((FILE *)expr1.fiWord, + expr2.fiWord, + SEEK_SET); + break; + case FINT_FOREIGN_ftell: fintTypedEval(&expr1, FOAM_Word); retDataObj->fiSInt = (FiSInt)ftell((FILE *)expr1.fiWord); From eb16c9cdfc1cc7c66fd99a2cff920c9299982131 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 31 Dec 2017 15:42:01 +0000 Subject: [PATCH 246/352] lib/java: Add various functions to Foam.java Mostly file read & write --- aldor/aldor/lib/java/src/foamj/Foam.java | 118 ++++++++++++++++-- .../lib/java/src/foamj/JavaException.java | 8 ++ 2 files changed, 113 insertions(+), 13 deletions(-) create mode 100644 aldor/aldor/lib/java/src/foamj/JavaException.java diff --git a/aldor/aldor/lib/java/src/foamj/Foam.java b/aldor/aldor/lib/java/src/foamj/Foam.java index 13871750f..dcbd37567 100644 --- a/aldor/aldor/lib/java/src/foamj/Foam.java +++ b/aldor/aldor/lib/java/src/foamj/Foam.java @@ -1,6 +1,15 @@ package foamj; -import java.io.PrintStream; +import java.io.BufferedInputStream; +import java.io.BufferedOutputStream; +import java.io.InputStream; +import java.io.OutputStream; +import java.io.File; +import java.io.FileInputStream; +import java.io.FileOutputStream; +import java.io.InputStream; +import java.io.IOException; +import java.io.OutputStream; import java.lang.Math; import java.math.BigInteger; @@ -9,7 +18,16 @@ public class Foam { public final static int PlatformOS = 1; public static void fputc(Word cw, Word w) { - PrintStream ps = (PrintStream) Word.U.toArray(w); + try { + fputc0(cw, w); + } + catch (IOException e) { + throw new JavaException(e); + } + } + + public static void fputc0(Word cw, Word w) throws IOException { + OutputStream ps = (OutputStream) Word.U.toJavaObj(w); char c = (char) cw.toSInt(); ps.write(c); } @@ -19,11 +37,26 @@ public static Word fgetss(Word w1, Word w2, Word w3, Word w4) { } public static Word fgetc(Word cw) { - throw new RuntimeException(); + InputStream instream = Word.U.toJavaObj(cw); + try { + return Word.U.fromSInt(instream.read()); + } + catch (IOException e) { + throw new JavaException(e); + } } public static void fputs(Word s, Word w) { - PrintStream ps = (PrintStream) Word.U.toArray(s); + try { + fputs0(s, w); + } + catch (IOException e) { + throw new JavaException(e); + } + } + + public static void fputs0(Word s, Word w) throws IOException{ + OutputStream ps = (OutputStream) Word.U.toJavaObj(s); char[] arr = (char[]) w.toArray(); for (int i = 0; i < arr.length - 1; i++) { ps.write(arr[i]); @@ -36,7 +69,7 @@ public static Word fputss(Word w1, Word w2, Word w3, Word w4) { int start = w2.toSInt(); int limit = w3.toSInt(); if (limit == -1) { - System.out.print(new String(arr).substring(start)); + System.out.print(new String(arr, start, arr.length-1)); return Word.U.fromSInt(arr.length - 1 - start); } else { System.out.print(new String(arr, start, limit - start)); @@ -45,24 +78,51 @@ public static Word fputss(Word w1, Word w2, Word w3, Word w4) { } public static Word stdoutFile() { - return Word.U.fromArray(System.out); + return Word.U.fromJavaObj(System.out); } public static Word stderrFile() { - return Word.U.fromArray(System.err); + return Word.U.fromJavaObj(System.err); } public static Word stdinFile() { - return Word.U.fromArray(System.in); + return Word.U.fromJavaObj(System.in); } public static Word fopen(Word w1, Word w2) { + try { + return fopen0(w1, w2); + } + catch (IOException e) { + throw new JavaException(e); + } + } + + private static Word fopen0(Word w1, Word w2) throws IOException { + char[] aname = (char[]) w1.toArray(); + char[] aopts = (char[]) w2.toArray(); + String name = new String(aname, 0, aname.length -1); + String opts = new String(aopts, 0, aopts.length -1); + + if ("r".equals(opts)) { + InputStream instream = new FileInputStream(new File(name)); + return Word.U.fromJavaObj(instream); + } + else if ("w".equals(opts)) { + OutputStream outstream = new BufferedOutputStream(new FileOutputStream(new File(name))); + return Word.U.fromJavaObj(outstream); + } throw new RuntimeException(); } public static Word fflush(Word w1) { - PrintStream ps = (PrintStream) Word.U.toArray(w1); - ps.flush(); + OutputStream ps = (OutputStream) Word.U.toJavaObj(w1); + try { + ps.flush(); + } + catch (IOException e) { + throw new JavaException(e); + } return w1; } @@ -71,7 +131,24 @@ public static void lungetc(Word w1, Word w2) { } public static Word fclose(Word w1) { - throw new RuntimeException(); + try { + return fclose0(w1); + } + catch (IOException e) { + throw new JavaException(e); + } + + } + + public static Word fclose0(Word w1) throws IOException { + Object o = Word.U.toJavaObj(w1); + if (o instanceof InputStream) { + ((InputStream) o).close(); + } + if (o instanceof OutputStream) { + ((OutputStream) o).close(); + } + return Word.U.fromSInt(0); } public static Word formatBInt(BigInteger a) { @@ -354,7 +431,21 @@ public static Word ftell(Word w) { } public static Word fseekset(Word w1, Word w2) { - throw new RuntimeException(); + try { + return fseekset0(w1, w2); + } + catch (IOException e) { + throw new JavaException(e); + } + } + + private static Word fseekset0(Word w1, Word w2) throws IOException { + InputStream instream = Word.U.toJavaObj(w1); + int posn = w2.toSInt(); + + instream.read(new byte[posn]); + + return Word.U.fromSInt(0); } public static Word fseekend(Word w1, Word w2) { @@ -370,7 +461,8 @@ public static Word mkstemp(Word w1) { } public static Word lfputc(Word w1, Word w2) { - throw new RuntimeException(); + fputc(w1, w2); + return w1; } public static Word unlink(Word w) { diff --git a/aldor/aldor/lib/java/src/foamj/JavaException.java b/aldor/aldor/lib/java/src/foamj/JavaException.java new file mode 100644 index 000000000..a8da264ff --- /dev/null +++ b/aldor/aldor/lib/java/src/foamj/JavaException.java @@ -0,0 +1,8 @@ +package foamj; + +public class JavaException extends RuntimeException +{ + public JavaException(Exception e) { + super(e); + } +} From ea87a39628faf09e87ab8205fea9c0459cb278a3 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 2 Jul 2018 22:42:04 +0100 Subject: [PATCH 247/352] javaFoam: make sure nul-chars in foam strings are used as string terminators --- aldor/aldor/lib/java/src/foamj/Foam.java | 21 ++++++++++------ aldor/aldor/lib/java/test/foamj/FoamTest.java | 25 ++++++++++++++++++- 2 files changed, 38 insertions(+), 8 deletions(-) diff --git a/aldor/aldor/lib/java/src/foamj/Foam.java b/aldor/aldor/lib/java/src/foamj/Foam.java index dcbd37567..682fc4e38 100644 --- a/aldor/aldor/lib/java/src/foamj/Foam.java +++ b/aldor/aldor/lib/java/src/foamj/Foam.java @@ -362,26 +362,25 @@ public static void fiRaiseException(Word w) { public static float arrToSFlo(Object o) { char[] arr = (char[]) o; - return new Float(new String(arr, 0, arr.length - 1)); + return new Float(arrToString(arr)); } public static double arrToDFlo(Object o) { char[] arr = (char[]) o; - return new Double(new String(arr, 0, arr.length - 1)); + return new Double(arrToString(arr)); } public static int arrToSInt(Object o) { char[] arr = (char[]) o; - return Integer.parseInt(new String(arr, 0, arr.length - 1)); + return Integer.parseInt(arrToString(arr)); } public static BigInteger arrToBInt(Object o) { char[] arr = (char[]) o; - return new BigInteger(new String(arr, 0, arr.length - 1)); + return new BigInteger(arrToString(arr)); } - public static Word powf(Word w1, Word w2) { throw new RuntimeException(); } @@ -532,13 +531,21 @@ public static double atan2(double a, double b) { public static Word stringToJavaString(Word w) { char[] arr = (char[]) w.toArray(); - return new FoamJ.JavaObj(new String(arr, 0, arr.length-1)); + return new FoamJ.JavaObj(arrToString(arr)); } public static Word javaStringToString(Word w) { - String s = (String) w.toJavaObj(); + String s = (String) ((Word) w).toJavaObj(); Word arr = Word.U.fromArray(("" + s + "\0").toCharArray()); return arr; } + public static String arrToString(char[] arr) { + String s = new String(arr); + int idx = s.indexOf("\0"); + if (idx == -1) { + return s; + } + return s.substring(0, idx); + } } diff --git a/aldor/aldor/lib/java/test/foamj/FoamTest.java b/aldor/aldor/lib/java/test/foamj/FoamTest.java index d589e0207..1c2acc0c4 100644 --- a/aldor/aldor/lib/java/test/foamj/FoamTest.java +++ b/aldor/aldor/lib/java/test/foamj/FoamTest.java @@ -3,13 +3,36 @@ import org.junit.*; import foamj.Word; +import java.math.BigInteger; + public class FoamTest { @Test public void testToJavaString() { Word w = new FoamJ.JavaObj("hello"); Word aldorString = Foam.javaStringToString(w); - Assert.assertEquals("hello", Foam.stringToJavaString(aldorString).toJavaObj()); + Assert.assertEquals("hello", Foam.stringToJavaString(aldorString).toJavaObj()); + } + + @Test + public void testMakeBigInt() { + char[] arr = "1234".toCharArray(); + BigInteger number = Foam.arrToBInt(arr); + Assert.assertEquals(new BigInteger("1234"), number); + } + + @Test + public void testMakeBigInt2() { + char[] arr = "1234\0foo".toCharArray(); + BigInteger number = Foam.arrToBInt(arr); + Assert.assertEquals(new BigInteger("1234"), number); + } + + @Test + public void testMakeDFlo() { + char[] arr = "1234.5\0foo\0bar".toCharArray(); + Double number = Foam.arrToDFlo(arr); + Assert.assertEquals(new Double("1234.5"), number); } } From 151cc25546cccb9f1379337caac2caa168c77289 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Jun 2018 20:00:46 +0100 Subject: [PATCH 248/352] Blacklist jimport_opt as a test for the moment --- aldor/aldor/test/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 8e2b2cb06..6bc1546c9 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -80,7 +80,7 @@ fmtests := rectest enumtest clos strtable1 simple apply ctests := rectest enumtest multinever maptuple otests := enumtest xtests := enumtest -@BUILD_JAVA_TRUE@jruntests := jimport jimport_opt jimp0 +@BUILD_JAVA_TRUE@jruntests := jimport jimp0 x_extra := rtexns From 17b80d0084d5e9efe02b32c93c105a31e5a246fa Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 2 Dec 2017 19:59:34 +0000 Subject: [PATCH 249/352] genfoam: add hash for java imports --- aldor/aldor/src/gf_add.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/gf_add.c b/aldor/aldor/src/gf_add.c index a0109f131..16c90cb61 100644 --- a/aldor/aldor/src/gf_add.c +++ b/aldor/aldor/src/gf_add.c @@ -2227,7 +2227,9 @@ gen0RtSefoHashId(Sefo sf, Sefo osf) } hash = gen0RtDomainHash(genFoamType(sf)); } - + else if (abTForm(sf) && tfIsJavaImport(abTForm(sf))) { + hash = foamNewSInt(gen0StrHash(symeString(syme))); + } else if (kind == FOAM_LIMIT) { if (DEBUG(genfHash)) { fprintf(dbOut, "Ugh: Found weird syme: "); From d3d6e56f3800d9bed61843ef7af3347a2ec9f1cf Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 00:03:41 +0000 Subject: [PATCH 250/352] tform.c: Add "self" type to java argument checking --- aldor/aldor/src/syme.c | 6 +++--- aldor/aldor/src/tform.c | 10 ++++++---- aldor/aldor/src/tform.h | 2 +- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c index 9630e4298..ec5cc1ba7 100644 --- a/aldor/aldor/src/syme.c +++ b/aldor/aldor/src/syme.c @@ -766,14 +766,14 @@ symeIsJavaExport(Syme syme) tfFollow(inner); if (errorSetCheck(errors, tfIsMap(inner), "apply must return a map")) { - tfJavaCheckArgs(errors, tfMapArg(inner)); - tfJavaCheckArgs(errors, tfMapRet(inner)); + tfJavaCheckArgs(errors, 0, tfMapArg(inner)); + tfJavaCheckArgs(errors, 0, tfMapRet(inner)); } } if (symeId(syme) == ssymTheNew) { errorSetCheck(errors, tfMapRetc(tf) == 1 && tfIsSelf(tfMapRetN(tf, 0)), "new must return %"); - tfJavaCheckArgs(errors, tfMapArg(tf)); + tfJavaCheckArgs(errors, 0, tfMapArg(tf)); } return errors; } diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 66f94d811..760cae562 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -8083,7 +8083,7 @@ tfConditionalStab(TForm tf) * :: Java * *****************************************************************************/ -local void tfJavaCheckArg(ErrorSet errors, TForm arg); +local void tfJavaCheckArg(ErrorSet errors, TForm self, TForm arg); Bool tfIsJavaImport(TForm tf) @@ -8108,7 +8108,7 @@ tfIsJavaImport(TForm tf) } void -tfJavaCheckArgs(ErrorSet errors, TForm tf) +tfJavaCheckArgs(ErrorSet errors, TForm self, TForm tf) { Length argc = tfAsMultiArgc(tf); int i; @@ -8120,14 +8120,14 @@ tfJavaCheckArgs(ErrorSet errors, TForm tf) if (!errorSetPrintf(errors, !tfIsNotDomain(arg), "Position %d must be a domain", i)) { continue; } - tfJavaCheckArg(errors, arg); + tfJavaCheckArg(errors, self, arg); } return; } local void -tfJavaCheckArg(ErrorSet errors, TForm arg) +tfJavaCheckArg(ErrorSet errors, TForm self, TForm arg) { Syme enc, dec; @@ -8135,6 +8135,8 @@ tfJavaCheckArg(ErrorSet errors, TForm arg) return; if (tfIsJavaImport(arg)) return; + if (self && tfEqual(self, arg)) + return; enc = tfGetDomExport(arg, symString(ssymTheToJava), tfIsJavaEncoder); dec = tfGetDomExport(arg, symString(ssymTheFromJava), tfIsJavaDecoder); diff --git a/aldor/aldor/src/tform.h b/aldor/aldor/src/tform.h index 0fb4ad3a9..c8060a2b6 100644 --- a/aldor/aldor/src/tform.h +++ b/aldor/aldor/src/tform.h @@ -922,7 +922,7 @@ extern Syme tfImplicitExport(Stab, SymeList, Syme); ****************************************************************************/ extern Bool tfIsJavaImport(TForm tf); -extern void tfJavaCheckArgs(ErrorSet errors, TForm tf); +extern void tfJavaCheckArgs(ErrorSet errors, TForm self, TForm tf); extern Bool tfIsJavaEncoder(TForm tf); extern Bool tfIsJavaDecoder(TForm tf); #endif /* !_TFORM_H_ */ From 52b4e439b3cd7fb8b73aa7e8f8bc2c73563aef24 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 13:49:06 +0000 Subject: [PATCH 251/352] lib/java: Add foamHelper - allows for a thread-local context for runtime So we can call aldor methods in a moderately thread-safe way. --- aldor/aldor/lib/java/src/foamj/FoamContext.java | 5 +++++ aldor/aldor/lib/java/src/foamj/FoamHelper.java | 13 +++++++++++++ 2 files changed, 18 insertions(+) create mode 100644 aldor/aldor/lib/java/src/foamj/FoamHelper.java diff --git a/aldor/aldor/lib/java/src/foamj/FoamContext.java b/aldor/aldor/lib/java/src/foamj/FoamContext.java index 1bb4d7dc4..ffdecb72d 100644 --- a/aldor/aldor/lib/java/src/foamj/FoamContext.java +++ b/aldor/aldor/lib/java/src/foamj/FoamContext.java @@ -6,6 +6,7 @@ public class FoamContext { ConcurrentHashMap loadFns = new ConcurrentHashMap<>(); + ConcurrentHashMap, FoamClass> classInstances = new ConcurrentHashMap<>(); public void startFoam(FoamClass c, String[] args) { Word[] mainArgv = new Word[1]; @@ -24,6 +25,9 @@ private static char[] literalCharArray(String s) { return arr; } + public T instanceForClass(Class clss) { + return (T) classInstances.get(clss); + } @SuppressWarnings("unchecked") public Clos createLoadFn(final String name) { @@ -41,6 +45,7 @@ public Value ocall(Env env, Value... vals) { c = (Class) ClassLoader.getSystemClassLoader().loadClass(name); Constructor cons = c.getConstructor(FoamContext.class); FoamClass fc = cons.newInstance(FoamContext.this); + classInstances.put(c, fc); fc.run(); } catch (ClassNotFoundException e) { throw new RuntimeException(e); diff --git a/aldor/aldor/lib/java/src/foamj/FoamHelper.java b/aldor/aldor/lib/java/src/foamj/FoamHelper.java new file mode 100644 index 000000000..1bbaee7a7 --- /dev/null +++ b/aldor/aldor/lib/java/src/foamj/FoamHelper.java @@ -0,0 +1,13 @@ +package foamj; + +public class FoamHelper { + static private final ThreadLocal contextForThread = new ThreadLocal(); + + static public void setContext(FoamContext context) { + contextForThread.set(context); + } + + static public T instanceForClass(Class clss) { + return contextForThread.get().instanceForClass(clss); + } +} From 5c52a86e94b5a10ad37058bc312e7906d4d2fd46 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 13:49:59 +0000 Subject: [PATCH 252/352] lib/java: Add to/from javaObject For converting to values - we want to be able to pass these as first class. --- aldor/aldor/lib/java/src/foamj/Value.java | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/aldor/aldor/lib/java/src/foamj/Value.java b/aldor/aldor/lib/java/src/foamj/Value.java index b7dfa52a5..a80f3fbc3 100644 --- a/aldor/aldor/lib/java/src/foamj/Value.java +++ b/aldor/aldor/lib/java/src/foamj/Value.java @@ -41,6 +41,8 @@ public interface Value { Env toEnv(); + T toJavaObj(); + public class U { static public Record toRecord(Value value) { if (value == null) @@ -88,5 +90,9 @@ public static Value fromByte(byte o) { public static Value fromHInt(short o) { return new HInt(o); } + + public static Value fromJavaObj(T obj) { + return new JavaObj(obj); + } } } From 3ca16d15d310382ede570436118b4ed7f912dc8e Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 14:10:49 +0000 Subject: [PATCH 253/352] tform.c: Add tfJavaCanExport Identifies operations suitable for java export --- aldor/aldor/src/tform.c | 26 +++++++++++++++++++++++++- aldor/aldor/src/tform.h | 1 + 2 files changed, 26 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 760cae562..687706e4f 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -8107,6 +8107,29 @@ tfIsJavaImport(TForm tf) return true; } +Bool +tfJavaCanExport(TForm self, TForm tf) +{ + Bool result = true; + + tfFollow(tf); + + if (!tfIsMap(tf)) { + return false; + } + ErrorSet errorSink = errorSetNew(); + tfJavaCheckArgs(errorSink, self, tfMapArg(tf)); + tfJavaCheckArgs(errorSink, self, tfMapRet(tf)); + + if (errorSetHasErrors(errorSink)) { + result = false; + } + errorSetFree(errorSink); + + return result; +} + + void tfJavaCheckArgs(ErrorSet errors, TForm self, TForm tf) { @@ -8168,10 +8191,11 @@ tfIsJavaDecoder(TForm tf) return false; if (!tfIsSelf(tfMapRet(tf))) return false; + if (tfMapRetc(tf) != 1) + return false; return true; } - /****************************************************************************** * * :: Table of information about type form tags diff --git a/aldor/aldor/src/tform.h b/aldor/aldor/src/tform.h index c8060a2b6..f0973c619 100644 --- a/aldor/aldor/src/tform.h +++ b/aldor/aldor/src/tform.h @@ -925,4 +925,5 @@ extern Bool tfIsJavaImport(TForm tf); extern void tfJavaCheckArgs(ErrorSet errors, TForm self, TForm tf); extern Bool tfIsJavaEncoder(TForm tf); extern Bool tfIsJavaDecoder(TForm tf); +extern Bool tfJavaCanExport(TForm self, TForm tf); #endif /* !_TFORM_H_ */ From 5efc7974ca6d3016875a1b1ea2a07691e9a0806e Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 14:12:59 +0000 Subject: [PATCH 254/352] src/abcheck.c: Add java export check - package is required. --- aldor/aldor/src/abcheck.c | 27 +++++++++++++++++++++++++++ aldor/aldor/src/comsgdb.msg | 2 ++ 2 files changed, 29 insertions(+) diff --git a/aldor/aldor/src/abcheck.c b/aldor/aldor/src/abcheck.c index cb189a2b3..47a817e36 100644 --- a/aldor/aldor/src/abcheck.c +++ b/aldor/aldor/src/abcheck.c @@ -11,6 +11,7 @@ #include "phase.h" #include "spesym.h" #include "util.h" +#include "forg.h" #include "comsg.h" #include "comsgdb.h" @@ -32,6 +33,7 @@ local void abCheckExtend (AbSyn); local void abCheckFluid (AbSyn); local void abCheckFor (AbSyn); local void abCheckForeignImport (AbSyn); +local void abCheckForeignExport (AbSyn); local void abCheckFree (AbSyn); local void abCheckImport (AbSyn); local void abCheckLambda (AbSyn); @@ -146,6 +148,10 @@ abCheck(AbSyn absyn) abCheckForeignImport(absyn); break; + case AB_ForeignExport: + abCheckForeignExport(absyn); + break; + case AB_Free: abCheckFree(absyn); break; @@ -681,6 +687,27 @@ abCheckForeignImport(AbSyn absyn) } } +/***************************************************************************** + * + * :: abCheckForeignExport + * + ****************************************************************************/ + +local void +abCheckForeignExport(AbSyn absyn) +{ + AbSyn what = absyn->abForeignExport.what; + AbSyn dest = absyn->abForeignExport.dest; + ForeignOrigin forg = forgFrAbSyn(dest->abApply.argv[0]); + + if (forg->protocol == FOAM_Proto_Java + && forg->file == NULL) { + comsgError(dest, ALDOR_E_ChkMustExportJavaToPackage, dest); + } + + forgFree(forg); +} + /***************************************************************************** * * :: abCheckImport diff --git a/aldor/aldor/src/comsgdb.msg b/aldor/aldor/src/comsgdb.msg index 682568986..8d2671e34 100644 --- a/aldor/aldor/src/comsgdb.msg +++ b/aldor/aldor/src/comsgdb.msg @@ -136,6 +136,8 @@ ALDOR_E_ChkMissingRetType "Function return type must be specified." ALDOR_D_ChkUseFromHint " Maybe you want to use `import from ...'." ALDOR_E_ChkSelectSeq "`select in' must be followed by a sequence." ALDOR_E_ChkSelectExits "Unexpected `=>' in select" +ALDOR_E_ChkMustExportJavaToPackage "Java exports must specify a package"; + ALDOR_W_FunnyJuxta "Suspicious juxtaposition. Check for missing `;'.\n\ Check indentation if you are using `#pile'." ALDOR_W_FunnyColon "Suspicious `:'. Do you mean `local' or `default'?" From c234ed57223722a80c8e240805c755add8691113 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 14:29:13 +0000 Subject: [PATCH 255/352] javacode.c: Fixup imports to allow for null packages Shouldn't happen, but might as well cater for it. --- aldor/aldor/src/java/javacode.c | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index 3e39d1b43..32ef1c62b 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -763,14 +763,17 @@ jcImportedStaticIdName(JavaCode importedId) { return jcImportedIdName(importedId); } + local void jcImportPrint(JavaCodePContext ctxt, JavaCode code) { if (jcoImportIsImported(code)) jcoPContextWrite(ctxt, jcoImportId(code)); else { - jcoPContextWrite(ctxt, jcoImportPkg(code)); - jcoPContextWrite(ctxt, "."); + if (strlen(jcoImportPkg(code)) != 0) { + jcoPContextWrite(ctxt, jcoImportPkg(code)); + jcoPContextWrite(ctxt, "."); + } jcoPContextWrite(ctxt, jcoImportId(code)); } } @@ -779,11 +782,15 @@ local SExpr jcImportSExpr(JavaCode code) { SExpr sym = sxiFrSymbol(symIntern(jcoClass(code)->name)); + if (jcoImportPkg(code) == NULL) { + return sxiList(2, sym, sxiFrString(jcoImportId(code))); + } return sxiList(3, sym, sxiFrString(jcoImportPkg(code)), sxiFrString(jcoImportId(code))); } + /* * :: String literals */ From 039079e694b07d94083cbcfd72e9370c857dafb6 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Tue, 19 Jun 2018 22:54:49 +0100 Subject: [PATCH 256/352] test/Makefile.in: Simplify logging Use a common macro... --- aldor/aldor/test/Makefile.in | 49 ++++++++++-------------------------- 1 file changed, 13 insertions(+), 36 deletions(-) diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 6bc1546c9..84f71692b 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -12,45 +12,22 @@ builddir = @builddir@ abs_top_srcdir = @abs_top_srcdir@ subdir = aldor/test -AM_V_ALDOR = $(am__v_ALDOR_$(V)) -am__v_ALDOR_ = $(am__v_ALDOR_$(AM_DEFAULT_VERBOSITY)) -am__v_ALDOR_0 = @echo " ALDOR " $@; - -AM_V_ALDOR_AP = $(am__v_ALDOR_AP_$(V)) -am__v_ALDOR_AP_ = $(am__v_ALDOR_AP_$(AM_DEFAULT_VERBOSITY)) -am__v_ALDOR_AP_0 = @echo " ALDOR-AP " $@; - -AM_V_ALDOR_EXE = $(am__v_ALDOR_EXE_$(V)) -am__v_ALDOR_EXE_ = $(am__v_ALDOR_EXE_$(AM_DEFAULT_VERBOSITY)) -am__v_ALDOR_EXE_0 = @echo " ALDOR-EXE " $@; - -AM_V_ALDOR_OBJ = $(am__v_ALDOR_OBJ_$(V)) -am__v_ALDOR_OBJ_ = $(am__v_ALDOR_OBJ_$(AM_DEFAULT_VERBOSITY)) -am__v_ALDOR_OBJ_0 = @echo " ALDOR-OBJ " $@; - -AM_V_ALDOR_GENC = $(am__v_ALDOR_GENC_$(V)) -am__v_ALDOR_GENC_ = $(am__v_ALDOR_GENC_$(AM_DEFAULT_VERBOSITY)) -am__v_ALDOR_GENC_0 = @echo " ALDOR-GENC " $@; - -AM_V_ALDOR_FM = $(am__v_ALDOR_FM_$(V)) -am__v_ALDOR_FM_ = $(am__v_ALDOR_GENC_$(AM_DEFAULT_VERBOSITY)) -am__v_ALDOR_FM_0 = @echo " ALDOR-FM " $@; - -AM_V_ALDOR_CMD = $(am__v_ALDOR_CMD_$(V)) -am__v_ALDOR_CMD_ = $(am__v_ALDOR_CMD_$(AM_DEFAULT_VERBOSITY)) -am__v_ALDOR_CMD_0 = @echo " ALDOR-CMD " $@; +define am_auto_template +AM_V_$(1) = $$(am__v_$(1)_$$(V)) +am__v_$(1)_ = $$(am__v_$(1)_$$(AM_DEFAULT_VERBOSITY)) +am__v_$(1)_0 = @echo " $(subst _,-,$(1)) " $$@; +endef -AM_V_ALDOR_JAVA = $(am__v_ALDOR_JAVA_$(V)) -am__v_ALDOR_JAVA_ = $(am__v_ALDOR_JAVA_$(AM_DEFAULT_VERBOSITY)) -am__v_ALDOR_JAVA_0 = @echo " ALDOR-JAVA " $@; +STEPS := ALDOR ALDOR_AP ALDOR_CMD ALDOR_EXE ALDOR_FM ALDOR_GENC \ + ALDOR_JAVATEST ALDOR_OBJ JAVAC ALDOR_JAVA JAVA_CP JUNIT -AM_V_JAVAC = $(am__v_JAVAC_$(V)) -am__v_JAVAC_ = $(am__v_JAVAC_$(AM_DEFAULT_VERBOSITY)) -am__v_JAVAC_0 = @echo " JAVAC " $@; +$(foreach rule,$(STEPS),$(eval $(call am_auto_template,$(rule)))) -AM_V_ALDOR_JAVATEST = $(am__v_ALDOR_JAVATEST_$(V)) -am__v_ALDOR_JAVATEST_ = $(am__v_ALDOR_JAVATEST_$(AM_DEFAULT_VERBOSITY)) -am__v_ALDOR_JAVATEST_0 = @echo " ALDOR-JAVATEST " $@; +define am_auto_template +AM_V_$(1) = $$(am__v_$(1)_$$(V)) +am__v_$(1)_ = $$(am__v_$(1)_$$(AM_DEFAULT_VERBOSITY)) +am__v_$(1)_0 = @echo " $(1) " $@; +endef all: really-all From 44a6863b1f2fa820d92a4b5bab6bf91b9b7bb167 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 31 Dec 2017 15:14:54 +0000 Subject: [PATCH 257/352] src/test: Add simple javacode test (for try/catch) --- aldor/aldor/src/Makefile.am | 1 + aldor/aldor/src/test/test_jcode.c | 44 +++++++++++++++++++++++++++++++ aldor/aldor/src/test/testall.c | 1 + aldor/aldor/src/test/testall.h | 1 + 4 files changed, 47 insertions(+) create mode 100644 aldor/aldor/src/test/test_jcode.c diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index 2c5406b08..ade8d846a 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -286,6 +286,7 @@ testsuite = \ test/test_genfoam.c \ test/test_jflow.c \ test/test_java.c \ + test/test_jcode.c \ test/test_int.c \ test/test_list.c \ test/test_ostream.c \ diff --git a/aldor/aldor/src/test/test_jcode.c b/aldor/aldor/src/test/test_jcode.c new file mode 100644 index 000000000..977150242 --- /dev/null +++ b/aldor/aldor/src/test/test_jcode.c @@ -0,0 +1,44 @@ +#include "axlobs.h" +#include "buffer.h" +#include "debug.h" +#include "format.h" +#include "formatters.h" +#include "java/javacode.h" +#include "opsys.h" +#include "sexpr.h" +#include "testlib.h" + +local void testTry(); +#define ID(name) jcId(strCopy(name)) + +void +jcodeTest() +{ + osInit(); + dbInit(); + fmttsInit(); + sxiInit(); + TEST(testTry); + dbFini(); +} + +void +testTry() +{ + JavaCode code; + Buffer buf = bufNew(); + char *txt; + JavaCodePContext ctxt = jcoPContextNew(ostreamNewFrBuffer(buf), true); + code = jcTry(jcBlock(jcStatement(jcAssign(ID("r"), + jcApplyMethodV(ID("obj"), ID("foo"), 0)))), + listSingleton(JavaCode)(jcCatch(jcLocalDecl(0, ID("Exn"), ID("e")), + jcBlock(jcStatement(jcReturnVoid())))), + 0); + + afprintf(dbOut, "%pJavaCode\n", code); + jcoWrite(ctxt, code); + txt = bufLiberate(buf); + afprintf(dbOut, "%s\n", txt); + + testStringEqual("", "try {\n r = obj.foo();\n}\ncatch (Exn e) {\n return;\n}", txt); +} diff --git a/aldor/aldor/src/test/testall.c b/aldor/aldor/src/test/testall.c index 01478f387..b1e984513 100644 --- a/aldor/aldor/src/test/testall.c +++ b/aldor/aldor/src/test/testall.c @@ -49,6 +49,7 @@ main(int argc, char *argv[]) if (testShouldRun("flog")) flogTest(); if (testShouldRun("java")) javaTestSuite(); if (testShouldRun("jflow")) jflowTest(); + if (testShouldRun("jcode")) jcodeTest(); if (testShouldRun("tinfer")) tinferTest(); if (testShouldRun("stab")) stabTest(); if (testShouldRun("srcpos")) srcposTest(); diff --git a/aldor/aldor/src/test/testall.h b/aldor/aldor/src/test/testall.h index 95735d2ce..19d28ac70 100644 --- a/aldor/aldor/src/test/testall.h +++ b/aldor/aldor/src/test/testall.h @@ -20,6 +20,7 @@ void formatTest(void); void genfoamTestSuite(void); void intTestSuite(void); void javaTestSuite(void); +void jcodeTest(void); void jflowTest(void); void listTestSuite(void); void ostreamTest(void); From 984bee3186a792b86626a466b27bc09f6a016a0b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 25 Apr 2018 22:01:03 +0100 Subject: [PATCH 258/352] genjava.c: if statement as part of "halt" was backward - FIXUP --- aldor/aldor/src/java/genjava.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index cd7796c7d..598869d36 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -1867,7 +1867,7 @@ gj0SeqBucketToJava(GjSeqBucket bucket) if (bucket->label == GJ_SEQ_Halt) { if (listLength(JavaCode)(l) > 1) - car(l) = jcIf(jcFalse(), car(l)); + car(l) = jcIf(jcTrue(), car(l)); } return l; From 593d6900eb319b121e4e7b776118caf708c8e8b9 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 21 Apr 2018 18:47:36 +0100 Subject: [PATCH 259/352] genjava.c: gen0SeqGen: Top level vars references can be ignored. So ignore them. --- aldor/aldor/src/java/genjava.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index 598869d36..7eb0120b0 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -1555,6 +1555,10 @@ gj0SeqGen(GjSeqStore seqs, Foam foam) case FOAM_Cast: gj0SeqGen(seqs, foam->foamCast.expr); break; + case FOAM_Loc: + case FOAM_Lex: + case FOAM_Glo: + break; case FOAM_Values: gj0SeqValues(seqs, foam); break; From 370e16648897b97b0c67e1cdb8f5502a5b6ef570 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Dec 2017 21:35:35 +0000 Subject: [PATCH 260/352] java: Add javasig - convention for Foam Java types Format is return type first, then arguments. Can be converted to foam sigs --- aldor/aldor/src/Makefile.am | 2 ++ aldor/aldor/src/java/Makefile.am | 2 +- aldor/aldor/src/java/javasig.c | 18 ++++++++++++++++++ aldor/aldor/src/java/javasig.h | 17 +++++++++++++++++ 4 files changed, 38 insertions(+), 1 deletion(-) create mode 100644 aldor/aldor/src/java/javasig.c create mode 100644 aldor/aldor/src/java/javasig.h diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index ade8d846a..661b53f5e 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -34,6 +34,7 @@ javagen_SOURCES = \ java/genjava.c \ java/javacode.c \ java/javaobj.c \ + java/javasig.c \ java/main.c \ axlcomp.c \ cmdline.c @@ -213,6 +214,7 @@ libphase_a_SOURCES = \ genfoam.c \ genlisp.c \ java/genjava.c \ + java/javasig.c \ gf_add.c \ gf_excpt.c \ gf_fortran.c \ diff --git a/aldor/aldor/src/java/Makefile.am b/aldor/aldor/src/java/Makefile.am index bfe81e16b..b045a85bc 100644 --- a/aldor/aldor/src/java/Makefile.am +++ b/aldor/aldor/src/java/Makefile.am @@ -1,6 +1,6 @@ bin_PROGRAMS = javatest -javatest_SOURCES = main.c genjava.c javacode.c javaobj.c +javatest_SOURCES = main.c genjava.c javacode.c javaobj.c javasig.c javatest_LDADD = ../libphase.a ../libstruct.a ../libgen.a ../libport.a javatest_LDFLAGS = -lm diff --git a/aldor/aldor/src/java/javasig.c b/aldor/aldor/src/java/javasig.c new file mode 100644 index 000000000..703a84340 --- /dev/null +++ b/aldor/aldor/src/java/javasig.c @@ -0,0 +1,18 @@ +#include "javasig.h" + +FoamSig +javaSigCreateFoamSig(Foam sig) +{ + AIntList inArgs; + FoamTag retType; + + inArgs = listNil(AInt); + for (int i=0; ifoamDecl.type, inArgs); + } + inArgs = listNReverse(AInt)(inArgs); + return foamSigNew(inArgs, javaSigRet(sig)->foamDecl.type, 0, NULL); +} + + diff --git a/aldor/aldor/src/java/javasig.h b/aldor/aldor/src/java/javasig.h new file mode 100644 index 000000000..4992cfce4 --- /dev/null +++ b/aldor/aldor/src/java/javasig.h @@ -0,0 +1,17 @@ +#ifndef _JAVASIG_H_ +#define _JAVASIG_H_ + +#include "foam.h" +#include "foamsig.h" +/* + * Special macros for FOAM_DDECL_JavaSig + */ +#define javaSigArgc(ddecl) (foamDDeclArgc(ddecl) - 1) +#define javaSigArgN(ddecl, n) ((ddecl)->foamDDecl.argv[n+1]) +#define javaSigRet(ddecl) ((ddecl)->foamDDecl.argv[0]) + +FoamSig javaSigCreateFoamSig(Foam args); + + +#endif + From 099471b2d577dda0383b020b610895e546a0c394 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 17:35:46 +0000 Subject: [PATCH 261/352] gf_gener.c: Include util.h for NotReached() --- aldor/aldor/src/gf_gener.c | 1 + 1 file changed, 1 insertion(+) diff --git a/aldor/aldor/src/gf_gener.c b/aldor/aldor/src/gf_gener.c index 3ef0123d3..689af24a7 100644 --- a/aldor/aldor/src/gf_gener.c +++ b/aldor/aldor/src/gf_gener.c @@ -16,6 +16,7 @@ #include "store.h" #include "tform.h" #include "comsg.h" +#include "util.h" #define GenerBetterGuesses From ea2671c009486c173c9a0280036db4a7891be512 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 3 Dec 2017 18:49:05 +0000 Subject: [PATCH 262/352] build: Don't use -Wno-fatal --- aldor/aldor/src/cport.h | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/aldor/aldor/src/cport.h b/aldor/aldor/src/cport.h index 2c579b7af..7ce9b7937 100644 --- a/aldor/aldor/src/cport.h +++ b/aldor/aldor/src/cport.h @@ -505,8 +505,7 @@ typedef double MostAlignedType; ****************************************************************************/ # define NotReached(stat) \ - {(void)printf("Not supposed to reach line %d in file: %s\n",__LINE__, __FILE__); \ - stat;} + {(void)bug("Not supposed to reach line %d in file: %s\n",__LINE__, __FILE__);} /***************************************************************************** * From 231f57eb7890be9a4215f9fa8a78045aff6e9366 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 28 May 2018 18:07:28 +0100 Subject: [PATCH 263/352] symeset.c: free(null) should be ok with nulls --- aldor/aldor/src/symeset.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/aldor/aldor/src/symeset.c b/aldor/aldor/src/symeset.c index 22a53ecee..ab4b34df8 100644 --- a/aldor/aldor/src/symeset.c +++ b/aldor/aldor/src/symeset.c @@ -35,6 +35,9 @@ symeSetEmpty() void symeSetFree(SymeSet symeSet) { + if (symeSet == NULL) { + return; + } tsetFree(Symbol)(symeSet->names); listFree(Syme)(symeSet->symes); stoFree(symeSet); From 450b89c584cd8d82ed73d30f0dad38b584c4618a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 9 Dec 2017 21:12:03 +0000 Subject: [PATCH 264/352] lib.c: Add code to save and restore symeForeign This way we can refer to a foreign import in a second file. --- aldor/aldor/src/lib.c | 85 +++++++++++++++++++++++++++++++++++++++++++ aldor/aldor/src/lib.h | 1 + 2 files changed, 86 insertions(+) diff --git a/aldor/aldor/src/lib.c b/aldor/aldor/src/lib.c index a9bb46661..6a886724b 100644 --- a/aldor/aldor/src/lib.c +++ b/aldor/aldor/src/lib.c @@ -125,6 +125,7 @@ struct _libSectInfo libSectInfoTable[] = { {LIB_Twins, "twins", "twins"}, {LIB_Extend, "extend", "ext"}, {LIB_Doc, "doc", "doc"}, + {LIB_Foreign, "foreign","forgn"}, {LIB_Id, "fileid", "id"}, {LIB_Macros, "macros", "macros"} }; @@ -1297,6 +1298,7 @@ local void libPutSymeSymes (Lib); local void libPutSymeTwins (Lib); local void libPutSymeExts (Lib); local void libPutSymeDocs (Lib); +local void libPutSymeForeign (Lib); local void libPutSymev (Lib); extern void libCheckSymes (Lib); @@ -1351,6 +1353,9 @@ libPutSymes(Lib lib, SymeList symes, Foam foam) /* Compute the doc offset information. */ libPutSymeDocs(lib); + /* Compute the foreign origin information. */ + libPutSymeForeign(lib); + /* Produce the constant-sized information section. */ libPutSymev(lib); @@ -1832,6 +1837,36 @@ libPutSymeDocs(Lib lib) libPutSection(lib, LIB_Doc, buf); } +local void +libPutSymeForeign(Lib lib) +{ + UShort i, symec = lib->symec; + Buffer buf = libAddSection(lib, LIB_Foreign); + Table tbl = tblNew((TblHashFun) forgHash, (TblEqFun) forgEqual); + + if (!buf) return; + + for (i=0; i < symec; i++) { + Syme syme = lib->symev[i]; + ForeignOrigin forg; + Length pos; + + if (symeKind(syme) != SYME_Foreign) continue; + forg = symeForeign(syme); + if (forg == NULL) continue; + bufPutHInt(buf, i); + pos = (Length) tblElt(tbl, (TblKey) forg, (TblElt) 0x7FFFFFFF); + bufPutSInt(buf, pos); + if (pos == 0x7FFFFFFF) + forgToBuffer(buf, forg); + tblSetElt(tbl, (TblKey) forg, (TblElt) (UAInt) i); + } + bufPutHInt(buf, symec); + tblFree(tbl); + libPutSection(lib, LIB_Foreign, buf); +} + + /***************************************************************************** * * lib0GetSymes - first pass for libGetSymes @@ -1850,6 +1885,7 @@ local void lib0GetSymeSymes (Lib); local void lib0GetSymeTwins (Lib); local void lib0GetSymeExts (Lib); local void lib0GetSymeDocs (Lib); +local void lib0GetSymeForeign (Lib); local void lib0FiniSymev (Lib); local SymeList @@ -1925,6 +1961,10 @@ lib0GetSymes(Lib lib) /* This pass sets up triggers for symeComment(lib->symev[i]). */ lib0GetSymeDocs(lib); + /* Retrieve the docs. */ + /* This pass sets up triggers for symeForeign(lib->symev[i]). */ + lib0GetSymeForeign(lib); + /* Retrieve the syme list from the vector. */ /* This pass fills in lib->symes. */ lib0FiniSymev(lib); @@ -2308,6 +2348,24 @@ lib0GetSymeDocs(Lib lib) } } +local void +lib0GetSymeForeign(Lib lib) +{ + UShort i, topc = lib->topc; + Buffer buf = libGetSection(lib, LIB_Foreign, true); + + for (libGetSymeIndex(buf, i); i < topc; libGetSymeIndex(buf, i)) { + Syme syme = lib->symev[i]; + ForeignOrigin forg; + int pos; + + symeSetFieldTrigger(syme, SYFI_Foreign); + pos = bufGetSInt(buf); + if (pos == 0x7FFFFFFF) + forgBufferSkip(buf); + } +} + local void lib0FiniSymev(Lib lib) { @@ -2341,6 +2399,7 @@ local void lib1GetSymeSymes (Lib); local void lib1GetSymeTwins (Lib); local void lib1GetSymeExts (Lib); local void lib1GetSymeDocs (Lib); +local void lib1GetSymeForeign (Lib); local void lib1GetSymeTypec (Lib); local void lib1FillTypeNumbers (Lib, int); @@ -2391,6 +2450,10 @@ lib1GetSymes(Lib lib) /* This pass fills in symeComment(lib->symev[i]). */ lib1GetSymeDocs(lib); + /* Retrieve the foreign origins. */ + /* This pass fills in symeForeign(lib->symev[i]). */ + lib1GetSymeForeign(lib); + if (DEBUG(lib)) { fprintf(dbOut, "lib1GetSymes: %s", fnameUnparse(lib->name)); fnewline(dbOut); @@ -2744,6 +2807,28 @@ lib1GetSymeDocs(Lib lib) } } + +local void +lib1GetSymeForeign(Lib lib) +{ + UShort i, symec = lib->symec; + Buffer buf = libGetSection(lib, LIB_Foreign, true); + + for (libGetSymeIndex(buf, i); i < symec; libGetSymeIndex(buf, i)) { + Syme syme = lib->symev[i]; + ForeignOrigin forg; + int pos; + + pos = bufGetSInt(buf); + if (pos == 0x7FFFFFFF) + forg = forgFrBuffer(buf); + else + forg = symeForeign(lib->symev[pos]); + assert(symeIsForeign(syme)); + symeSetForeign(syme, forg); + } +} + local void lib1GetSymeTypec(Lib lib) { diff --git a/aldor/aldor/src/lib.h b/aldor/aldor/src/lib.h index d3a0221ab..d3933bfac 100644 --- a/aldor/aldor/src/lib.h +++ b/aldor/aldor/src/lib.h @@ -40,6 +40,7 @@ enum libSectName { LIB_Twins, /* Syme twins. */ LIB_Extend, /* Extendee syme lists. */ LIB_Doc, /* Documentation. */ + LIB_Foreign, /* ForeignOrigin table. */ LIB_Id, /* Name of the library. */ LIB_Macros, /* Macros exported */ LIB_NAME_LIMIT From 9864530495b94aea343d04419a3566e366a5cabb Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 31 Dec 2017 14:54:55 +0000 Subject: [PATCH 265/352] build: add foamj.jar to installdir --- aldor/aldor/lib/java/Makefile.am | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/aldor/aldor/lib/java/Makefile.am b/aldor/aldor/lib/java/Makefile.am index 94c452302..ed6a11069 100644 --- a/aldor/aldor/lib/java/Makefile.am +++ b/aldor/aldor/lib/java/Makefile.am @@ -1 +1,6 @@ SUBDIRS=src test + +@BUILD_JAVA_TRUE@JAVA_TARGET = src/foamj.jar + +datalibdir = $(datadir)/lib +datalib_DATA = $(JAVA_TARGET) From 1fc28bb4b2abd7cdcda183acd3a2da27f6cb4554 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 29 Apr 2018 13:39:31 +0100 Subject: [PATCH 266/352] foam.c: Add foamProtoBase - mapping JavaX to Java --- aldor/aldor/src/foam.c | 20 ++++++++++---------- aldor/aldor/src/foam.h | 2 ++ 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/aldor/aldor/src/foam.c b/aldor/aldor/src/foam.c index 32266f16c..15bf09add 100644 --- a/aldor/aldor/src/foam.c +++ b/aldor/aldor/src/foam.c @@ -3686,16 +3686,16 @@ struct foam_info foamInfoTable[] = { ****************************************************************************/ struct foamProto_info foamProtoInfoTable[] = { - {FOAM_Proto_Foam, 0,"Foam"}, - {FOAM_Proto_Fortran,0,"Fortran"}, - {FOAM_Proto_C, 0,"C"}, - {FOAM_Proto_Java, 0,"Java"}, - {FOAM_Proto_JavaConstructor, 0,"JavaConstructor"}, - {FOAM_Proto_JavaMethod, 0,"JavaMethod"}, - {FOAM_Proto_Lisp, 0,"Lisp"}, - {FOAM_Proto_Init, 0,"Init"}, - {FOAM_Proto_Include,0,"Include"}, - {FOAM_Proto_Other, 0,"Other"} + {FOAM_Proto_Foam, 0,"Foam", FOAM_Proto_Foam}, + {FOAM_Proto_Fortran, 0,"Fortran", FOAM_Proto_Fortran}, + {FOAM_Proto_C, 0,"C", FOAM_Proto_C}, + {FOAM_Proto_Java, 0,"Java", FOAM_Proto_Java}, + {FOAM_Proto_JavaConstructor, 0,"JavaConstructor", FOAM_Proto_Java}, + {FOAM_Proto_JavaMethod, 0,"JavaMethod", FOAM_Proto_Java}, + {FOAM_Proto_Lisp, 0,"Lisp", FOAM_Proto_Lisp}, + {FOAM_Proto_Init, 0,"Init", FOAM_Proto_Init}, + {FOAM_Proto_Include, 0,"Include", FOAM_Proto_Include}, + {FOAM_Proto_Other, 0,"Other", FOAM_Proto_Other} }; /***************************************************************************** diff --git a/aldor/aldor/src/foam.h b/aldor/aldor/src/foam.h index 1deb447ff..6b217b4c6 100644 --- a/aldor/aldor/src/foam.h +++ b/aldor/aldor/src/foam.h @@ -1322,6 +1322,7 @@ struct foamProto_info { FoamProtoTag tag; SExpr sxsym; String str; + FoamProtoTag base; }; struct foamDDecl_info { @@ -1344,6 +1345,7 @@ extern struct foamDDecl_info foamDDeclInfoTable[]; #define foamBValStr(tag) (foamBValInfo(tag).str) #define foamBValRetType(tag)(foamBValInfo(tag).retType) #define foamProtoStr(tag) (foamProtoInfo(tag).str) +#define foamProtoBase(tag) (foamProtoInfo(tag).base) #define foamSExpr(tag) (foamInfo(tag).sxsym) #define foamBValSExpr(tag) (foamBValInfo(tag).sxsym) From 4c3adbec85de69f57ada558247a688ba5bb70c39 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 10 Jun 2018 22:22:25 +0100 Subject: [PATCH 267/352] of_inlin.c: Ensure that java types are correctly updated in formats. --- aldor/aldor/src/of_inlin.c | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/aldor/aldor/src/of_inlin.c b/aldor/aldor/src/of_inlin.c index 13fc868a8..cef7f2387 100644 --- a/aldor/aldor/src/of_inlin.c +++ b/aldor/aldor/src/of_inlin.c @@ -2269,10 +2269,11 @@ inlTransformGlobal(Foam glo) decl = foamCopy(decl0); decl->foamGDecl.dir = FOAM_GDecl_Import; - /* Fortran and C PCalls use formats */ - switch (decl->foamGDecl.protocol) { + /* Fortran, C and Java PCalls use formats */ + switch (foamProtoBase(decl->foamGDecl.protocol)) { case FOAM_Proto_Fortran: /*FALLTHROUGH*/ case FOAM_Proto_C: /*FALLTHROUGH*/ + case FOAM_Proto_Java: /*FALLTHROUGH*/ if (decl->foamGDecl.type == FOAM_Clos) { AInt fmt = inlGetFormat(decl->foamGDecl.format); decl->foamGDecl.format = fmt; @@ -2709,6 +2710,7 @@ inlUpdateDDecl(Foam ddecl) switch (ddecl->foamDDecl.usage) { case FOAM_DDecl_FortranSig: /*FALLTHROUGH*/ case FOAM_DDecl_CSig: /*FALLTHROUGH*/ + case FOAM_DDecl_JavaSig: /*FALLTHROUGH*/ sigDecl = true; default: break; @@ -2717,7 +2719,8 @@ inlUpdateDDecl(Foam ddecl) for(i=0; i< foamDDeclArgc(ddecl); i++) { decl = ddecl->foamDDecl.argv[i]; if (decl->foamDecl.type == FOAM_Rec - || decl->foamDecl.type == FOAM_TR) + || decl->foamDecl.type == FOAM_TR + || decl->foamDecl.type == FOAM_JavaObj) decl->foamDecl.format = inlGetFormat(decl->foamDecl.format); if (sigDecl && decl->foamDecl.type == FOAM_Clos) From c4b0239ddf793f9d47c601c99bd12484b665de17 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 28 May 2018 21:01:39 +0100 Subject: [PATCH 268/352] src: Use javaSig functions when creating java calls --- aldor/aldor/src/Makefile.am | 3 +- aldor/aldor/src/foam.c | 7 ++-- aldor/aldor/src/gf_java.c | 9 ++--- aldor/aldor/src/java/genjava.c | 8 +++-- aldor/aldor/src/java/javasig.c | 18 ---------- aldor/aldor/src/java/javasig.h | 17 --------- aldor/aldor/src/javasig.c | 65 ++++++++++++++++++++++++++++++++++ aldor/aldor/src/javasig.h | 17 +++++++++ aldor/aldor/src/of_retyp2.c | 7 ++-- 9 files changed, 103 insertions(+), 48 deletions(-) delete mode 100644 aldor/aldor/src/java/javasig.c delete mode 100644 aldor/aldor/src/java/javasig.h create mode 100644 aldor/aldor/src/javasig.c create mode 100644 aldor/aldor/src/javasig.h diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index 661b53f5e..6b818c530 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -34,7 +34,6 @@ javagen_SOURCES = \ java/genjava.c \ java/javacode.c \ java/javaobj.c \ - java/javasig.c \ java/main.c \ axlcomp.c \ cmdline.c @@ -173,6 +172,7 @@ libstruct_a_SOURCES = \ formatters.c \ ftype.c \ gf_syme.c \ + javasig.c \ lib.c \ loops.c \ output.c \ @@ -214,7 +214,6 @@ libphase_a_SOURCES = \ genfoam.c \ genlisp.c \ java/genjava.c \ - java/javasig.c \ gf_add.c \ gf_excpt.c \ gf_fortran.c \ diff --git a/aldor/aldor/src/foam.c b/aldor/aldor/src/foam.c index 15bf09add..af7be91ac 100644 --- a/aldor/aldor/src/foam.c +++ b/aldor/aldor/src/foam.c @@ -35,6 +35,7 @@ #include "foamsig.h" #include "format.h" #include "int.h" +#include "javasig.h" #include "opsys.h" #include "sexpr.h" #include "store.h" @@ -1156,8 +1157,10 @@ foamAuditPCallJava(Foam foam) glo = faGlobalsv[op->foamGlo.index]; ddecl = faFormats->foamDFmt.argv[glo->foamGDecl.format]; - /* dock one for return type */ - if (foamDDeclArgc(ddecl) - 1 != foamPCallArgc(foam)) + if (ddecl->foamDDecl.usage != FOAM_DDecl_JavaSig) + foamAuditBadType(foam); + + if (javaSigArgc(ddecl) != foamPCallArgc(foam)) foamAuditBadType(foam); } diff --git a/aldor/aldor/src/gf_java.c b/aldor/aldor/src/gf_java.c index fcfb3c3c3..9c4e85172 100644 --- a/aldor/aldor/src/gf_java.c +++ b/aldor/aldor/src/gf_java.c @@ -3,6 +3,7 @@ #include "gf_prog.h" #include "gf_java.h" #include "gf_syme.h" +#include "javasig.h" #include "of_inlin.h" #include "tform.h" #include "sefo.h" @@ -345,7 +346,7 @@ local AInt gfjPCallDecl(TForm tf, TForm this) { FoamList decls; - Foam ddecl, retdecl; + Foam ddecl, retdecl, exndecl; int i; decls = listNil(Foam); @@ -363,11 +364,11 @@ gfjPCallDecl(TForm tf, TForm this) } retdecl = gfjPCallDeclArg(tfMapRet(tf)); - ddecl = foamNewDDeclOfList(FOAM_DDecl_JavaSig, - listCons(Foam)(retdecl, listNReverse(Foam)(decls))); + exndecl = foamNewDecl(FOAM_NOp, strCopy(""), emptyFormatSlot); - return gen0AddRealFormat(ddecl); + ddecl = javaSigNew(retdecl, exndecl, listNReverse(Foam)(decls)); + return gen0AddRealFormat(ddecl); } local TForm diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index 7eb0120b0..630934522 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -4,6 +4,7 @@ #include "foamsig.h" #include "intset.h" #include "javacode.h" +#include "javasig.h" #include "sexpr.h" #include "store.h" #include "syme.h" @@ -3564,15 +3565,16 @@ gj0PCallCastArgs(Foam op, JavaCodeList argsIn) JavaCodeList args = argsIn; Foam glo = gjContextGlobals->foamDDecl.argv[op->foamGlo.index]; Foam ddecl = gjContext->formats->foamDFmt.argv[glo->foamGDecl.format]; - int i = 1; + int i = 0; assert(ddecl->foamDDecl.usage == FOAM_DDecl_JavaSig); - assert(foamDDeclArgc(ddecl) == listLength(JavaCode)(argsIn)); + assert(javaSigArgc(ddecl) == listLength(JavaCode)(argsIn)); /* Cast java-valued arguments - all other types are not converted */ while (args != listNil(JavaCode)) { - Foam decl = ddecl->foamDDecl.argv[i]; + Foam decl = javaSigArgN(ddecl, i); String pkg, type; + // FIXME: This is probably not needed if (decl->foamDecl.type == FOAM_Ptr) { strSplitLast(strCopy(decl->foamGDecl.id), '.', &pkg, &type); car(args) = jcCast(jcImportedId(pkg, type), car(args)); diff --git a/aldor/aldor/src/java/javasig.c b/aldor/aldor/src/java/javasig.c deleted file mode 100644 index 703a84340..000000000 --- a/aldor/aldor/src/java/javasig.c +++ /dev/null @@ -1,18 +0,0 @@ -#include "javasig.h" - -FoamSig -javaSigCreateFoamSig(Foam sig) -{ - AIntList inArgs; - FoamTag retType; - - inArgs = listNil(AInt); - for (int i=0; ifoamDecl.type, inArgs); - } - inArgs = listNReverse(AInt)(inArgs); - return foamSigNew(inArgs, javaSigRet(sig)->foamDecl.type, 0, NULL); -} - - diff --git a/aldor/aldor/src/java/javasig.h b/aldor/aldor/src/java/javasig.h deleted file mode 100644 index 4992cfce4..000000000 --- a/aldor/aldor/src/java/javasig.h +++ /dev/null @@ -1,17 +0,0 @@ -#ifndef _JAVASIG_H_ -#define _JAVASIG_H_ - -#include "foam.h" -#include "foamsig.h" -/* - * Special macros for FOAM_DDECL_JavaSig - */ -#define javaSigArgc(ddecl) (foamDDeclArgc(ddecl) - 1) -#define javaSigArgN(ddecl, n) ((ddecl)->foamDDecl.argv[n+1]) -#define javaSigRet(ddecl) ((ddecl)->foamDDecl.argv[0]) - -FoamSig javaSigCreateFoamSig(Foam args); - - -#endif - diff --git a/aldor/aldor/src/javasig.c b/aldor/aldor/src/javasig.c new file mode 100644 index 000000000..7754507f6 --- /dev/null +++ b/aldor/aldor/src/javasig.c @@ -0,0 +1,65 @@ +#include "foam.h" +#include "syme.h" +#include "javasig.h" +#include "strops.h" + +Foam +javaSigNew(Foam retdecl, Foam exndecl, FoamList args) +{ + Foam nodecl = foamNewDecl(FOAM_NOp, strCopy("extra"), int0); + + return foamNewDDeclOfList(FOAM_DDecl_JavaSig, + listNConcat(Foam)(listList(Foam)(3, nodecl, retdecl, exndecl), + args)); + +} + +FoamSig +javaSigCreateFoamSig(Foam sig) +{ + AIntList inArgs; + FoamTag retType; + + inArgs = listNil(AInt); + for (int i=0; ifoamDecl.type, inArgs); + } + inArgs = listNReverse(AInt)(inArgs); + return foamSigNew(inArgs, javaSigRet(sig)->foamDecl.type, 0, NULL); +} + +int +javaSigArgc(Foam sig) +{ + assert(sig->foamDDecl.usage == FOAM_DDecl_JavaSig); + return foamDDeclArgc(sig) - 3; +} + +Foam +javaSigArgN(Foam sig, int n) +{ + assert(sig->foamDDecl.usage == FOAM_DDecl_JavaSig); + return sig->foamDDecl.argv[n+3]; +} + +Foam +javaSigRet(Foam sig) +{ + assert(sig->foamDDecl.usage == FOAM_DDecl_JavaSig); + return sig->foamDDecl.argv[1]; +} + +Foam +javaSigExn(Foam sig) +{ + assert(sig->foamDDecl.usage == FOAM_DDecl_JavaSig); + return sig->foamDDecl.argv[2]; +} + +int +javaSigToDDeclArgIdx(int n) +{ + return n+3; +} + diff --git a/aldor/aldor/src/javasig.h b/aldor/aldor/src/javasig.h new file mode 100644 index 000000000..13771d84e --- /dev/null +++ b/aldor/aldor/src/javasig.h @@ -0,0 +1,17 @@ +#ifndef _JAVASIG_H_ +#define _JAVASIG_H_ + +#include "foam.h" +#include "foamsig.h" + +Foam javaSigNew(Foam retdecl, Foam exndecl, FoamList args); + +FoamSig javaSigCreateFoamSig(Foam args); +int javaSigArgc(Foam sig); +Foam javaSigArgN(Foam sig, int n); +Foam javaSigRet(Foam sig); +Foam javaSigExn(Foam sig); +int javaSigToDDeclArgIdx(int n); + + +#endif diff --git a/aldor/aldor/src/of_retyp2.c b/aldor/aldor/src/of_retyp2.c index 065b480ed..d072e6419 100644 --- a/aldor/aldor/src/of_retyp2.c +++ b/aldor/aldor/src/of_retyp2.c @@ -1,5 +1,6 @@ #include "foam.h" #include "debug.h" +#include "javasig.h" #include "of_peep.h" #include "of_retyp.h" #include "of_util.h" @@ -464,8 +465,10 @@ retMarkPCallJava(RetContext context, Foam foam) Foam arg = foam->foamPCall.argv[i]; if (retIsLocal(arg)) { retAddUse(context, - ddecl->foamDDecl.argv[i+1]->foamDecl.type, - ddecl->foamDDecl.argv[i+1]->foamDecl.format, + javaSigArgN(ddecl, i)->foamDecl.type, + javaSigArgN(ddecl, i)->foamDecl.format, + //ddecl->foamDDecl.argv[i+1]->foamDecl.type, + //ddecl->foamDDecl.argv[i+1]->foamDecl.format, retLocal(arg)); } } From bf3e31eaf3beae12446dba7bbbb05d2021fbed33 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 21 Apr 2018 18:49:39 +0100 Subject: [PATCH 269/352] src/foamsig.c: Add foamSigEqualModFmt For when the format isn't important --- aldor/aldor/src/foamsig.c | 33 +++++++++++++++++++++++++++++++-- aldor/aldor/src/foamsig.h | 1 + 2 files changed, 32 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/foamsig.c b/aldor/aldor/src/foamsig.c index d2ce57a3a..789082d24 100644 --- a/aldor/aldor/src/foamsig.c +++ b/aldor/aldor/src/foamsig.c @@ -4,6 +4,9 @@ #include "util.h" #include "int.h" +local Bool foamSigEqual0(FoamSig sig1, FoamSig sig2, Bool ignoreFmt); +local Bool foamSigEqualArgs(AIntList args1, AIntList args2, Bool ignoreFmt); + FoamSig foamSigNew(AIntList inArgs, FoamTag retType, int nRets, FoamTag *rets) { @@ -32,16 +35,27 @@ foamSigFree(FoamSig sig) Bool foamSigEqual(FoamSig sig1, FoamSig sig2) +{ + return foamSigEqual0(sig1, sig2, false); +} + +Bool +foamSigEqualModFmt(FoamSig sig1, FoamSig sig2) +{ + return foamSigEqual0(sig1, sig2, true); +} + +local Bool +foamSigEqual0(FoamSig sig1, FoamSig sig2, Bool ignoreFmt) { int i; - if (sig1->retType != sig2->retType) return false; if (sig1->nRets != sig2->nRets) return false; - if (!listEqual(AInt)(sig1->inArgs, sig2->inArgs, aintEqual)) + if (!foamSigEqualArgs(sig1->inArgs, sig2->inArgs, ignoreFmt)) return false; if (sig1->rets != sig2->rets) { @@ -55,6 +69,21 @@ foamSigEqual(FoamSig sig1, FoamSig sig2) return true; } +local Bool +foamSigEqualArgs(AIntList args1, AIntList args2, Bool ignoreFmt) +{ + if (!ignoreFmt) + return listEqual(AInt)(args1, args2, aintEqual); + + while (args1 != listNil(AInt) && args2 != listNil(AInt)) { + if ((car(args1) & 0xFF) != (car(args2) & 0xFF)) + return false; + args1 = cdr(args1); + args2 = cdr(args2); + } + return args1 == args2; +} + Hash foamSigHash(FoamSig s1) { diff --git a/aldor/aldor/src/foamsig.h b/aldor/aldor/src/foamsig.h index 21acc03b9..2b47aba0a 100644 --- a/aldor/aldor/src/foamsig.h +++ b/aldor/aldor/src/foamsig.h @@ -20,6 +20,7 @@ DECLARE_LIST(FoamSig); void foamSigFree (FoamSig); Bool foamSigEqual (FoamSig, FoamSig); +Bool foamSigEqualModFmt(FoamSig, FoamSig); FoamSig foamSigNew (AIntList inArgs, FoamTag retType, int nRets, FoamTag *rets); Hash foamSigHash (FoamSig s); From 5b09e38456724d391a6db930881dcd51691c1d1e Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 29 Apr 2018 13:41:14 +0100 Subject: [PATCH 270/352] test/Makefile.in: Add DBG_C as per DBG_J --- 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 84f71692b..bee6e8a76 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -43,6 +43,7 @@ Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status AM_DBG := $(if $(filter 1,$(DBG)), gdb --args, $(DBG)) AM_DBG_J := $(if $(filter 1,$(DBG_J)), gdb --args, $(DBG_J)) +AM_DBG_C := $(if $(filter 1,$(DBG_C)), gdb --args, $(DBG_C)) aldorsrcdir = $(abs_top_srcdir)/aldor/src aldorexedir = $(abs_top_builddir)/aldor/src From 25457430c95a8bb15bfae8de37c8f5a8ae1ee6f9 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 10 Jun 2018 22:21:36 +0100 Subject: [PATCH 271/352] gf_add.c: Hash java types to 999 for want of a better number --- aldor/aldor/src/gf_add.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/aldor/aldor/src/gf_add.c b/aldor/aldor/src/gf_add.c index 16c90cb61..0e3bdebb6 100644 --- a/aldor/aldor/src/gf_add.c +++ b/aldor/aldor/src/gf_add.c @@ -2258,6 +2258,9 @@ gen0RtSefoHashApply(Sefo sf, Sefo osf) { if (gen0RtSefoIsSpecialOp(sf)) return gen0RtSefoHashSpecialApply(sf); + else if (abTForm(sf) && tfIsJavaImport(abTForm(sf))) { + return foamNewSInt(999); + } else return gen0RtSefoHashStdApply(sf, osf); } From cfa2e65021f7c6de900f784cadc6f897c0d89389 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 10 Jun 2018 22:24:23 +0100 Subject: [PATCH 272/352] genjava.c: Propagate format information across signatures --- aldor/aldor/src/java/genjava.c | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index 630934522..6a6e2873c 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -2793,8 +2793,11 @@ gj0FoamSigFrCCall(Foam ccall) inArgList = listNil(AInt); foamIter(ccall, elt, { - FoamTag type = gj0FoamExprType(*elt); - inArgList = listCons(AInt)(type, inArgList); + AInt fmt; + FoamTag type = gj0FoamExprTypeWFmt(*elt, &fmt); + AInt val = type + (fmt << 8); + assert(val != 0); + inArgList = listCons(AInt)(val, inArgList); }); /* FIXME: Not sure how to get return types. */ @@ -2853,7 +2856,7 @@ gj0CCallStubAdd(FoamSigList list, FoamSig sig) FoamSigList tmp = list; while (tmp) { FoamSig osig = car(tmp); - if (foamSigEqual(sig, osig)) + if (foamSigEqualModFmt(sig, osig)) break; tmp = cdr(tmp); } @@ -2887,9 +2890,11 @@ gj0CCallStubGenFrSig(FoamSig sig) paramList = listNil(JavaCode); idx = 0; while (argList != listNil(AInt)) { - AInt type = car(argList); + AInt typeAndFmt = car(argList); + AInt type = typeAndFmt & 0xFF; + AInt fmt = typeAndFmt >> 8; String id = gj0CCallStubParam(idx+1); - JavaCode decl = jcParamDecl(0, gj0TypeFrFmt(type, 0), + JavaCode decl = jcParamDecl(0, gj0TypeFrFmt(type, fmt), jcId(strCopy(id))); JavaCode asValue = gj0TypeObjToValue(jcId(strCopy(id)), type, 0); @@ -2975,7 +2980,8 @@ gj0CCallStubName(FoamSig call) suffix = strNConcat(suffix, "x"); tmp = call->inArgs; while (tmp != listNil(AInt)) { - suffix=strNConcat(suffix, gj0TypeAbbrev(car(tmp))); + AInt type = car(tmp) & 0xFF; + suffix=strNConcat(suffix, gj0TypeAbbrev(type)); tmp = cdr(tmp); } From d3dd5fa1773a4e42a4f7dbe97c2cf785c9d81f86 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 13 Jun 2018 23:05:17 +0100 Subject: [PATCH 273/352] libfoam: distribute foam jar too --- aldor/aldor/lib/libfoam/Makefile.am | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/lib/libfoam/Makefile.am b/aldor/aldor/lib/libfoam/Makefile.am index 783f9613d..fd663a897 100644 --- a/aldor/aldor/lib/libfoam/Makefile.am +++ b/aldor/aldor/lib/libfoam/Makefile.am @@ -1,5 +1,7 @@ SUBDIRS = al +@BUILD_JAVA_TRUE@JAVA_TARGET = al/foam.jar + aldorsrcdir = $(top_srcdir)/aldor/src runtime_CFLAGS = -I $(aldorsrcdir) -I ../../src @@ -68,4 +70,4 @@ libfoam_gmp_a_SOURCES = \ ############################################################################# datalibdir = $(datadir)/lib -datalib_DATA = al/libfoam.al +datalib_DATA = al/libfoam.al $(JAVA_TARGET) From 562fef4e7f1c3e932da728b2a16e19054974f87e Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 28 May 2018 12:15:58 +0100 Subject: [PATCH 274/352] syme.c: Bits allocated wrongly - cond checked & incomplete are different --- aldor/aldor/src/syme.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/syme.h b/aldor/aldor/src/syme.h index 2a61951a7..28f51f732 100644 --- a/aldor/aldor/src/syme.h +++ b/aldor/aldor/src/syme.h @@ -536,7 +536,7 @@ extern Hash gen0SymeTypeCode (Syme); #define SYME_XBIT_IMPLICIT 0x0001 /* Implicit */ #define SYME_XBIT_MULTICOND 0x0002 /* Multi-value cond */ #define SYME_XBIT_CONDINCOMPLETE 0x0004 /* we gave up in symeCheckCondition */ -#define SYME_XBIT_CONDCHECKED 0x0004 /* symeCheckCondition has been called */ +#define SYME_XBIT_CONDCHECKED 0x0008 /* symeCheckCondition has been called */ #define symeGetXBit(s,b) (symeExtraBits(s) & (b)) #define symeSetXBit(s,b) symeSetExtraBits(s, symeExtraBits(s) | (b)); From 87946056efaf0f9729af90c1282613f1f21c61ac Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 10 Jun 2018 22:21:06 +0100 Subject: [PATCH 275/352] genjava.c: Deal with Foam type of Nil in object names --- aldor/aldor/src/java/genjava.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index 6a6e2873c..dfe51ca12 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -1254,6 +1254,7 @@ gj0TypeObjToValue(JavaCode val, FoamTag type, AInt fmt) jcId(strCopy("U"))), jcId(strCopy("fromArray")), 1, val); + case FOAM_Nil: case FOAM_Ptr: return jcApplyMethodV(jcMemRef(gj0Id(GJ_FoamValue), jcId(strCopy("U"))), @@ -2015,6 +2016,7 @@ gj0TypeAbbrev(FoamTag tag) return "N"; case FOAM_Char: return "L"; + case FOAM_Nil: case FOAM_Ptr: return "P"; case FOAM_SFlo: From 6db13a40a9bc2f2542ef24fca6df1ebf8af53225 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 28 May 2018 21:25:55 +0100 Subject: [PATCH 276/352] Use new symeExtension functions --- aldor/aldor/src/genfoam.c | 4 ++-- aldor/aldor/src/lib.c | 2 +- aldor/aldor/src/sefo.c | 4 ++-- aldor/aldor/src/syme.c | 32 +++++++++++++++++++++++++++++--- aldor/aldor/src/syme.h | 9 ++++++--- 5 files changed, 40 insertions(+), 11 deletions(-) diff --git a/aldor/aldor/src/genfoam.c b/aldor/aldor/src/genfoam.c index 10d066ff1..bc0fb73d5 100644 --- a/aldor/aldor/src/genfoam.c +++ b/aldor/aldor/src/genfoam.c @@ -4553,7 +4553,7 @@ gen0ParamIndex(Syme param) Foam gen0ExtendSyme(Syme syme) { - while (symeExtension(syme)) syme = symeExtension(syme); + while (symeExtensionFirst(syme)) syme = symeExtensionFirst(syme); return gen0Syme(syme); } @@ -6014,7 +6014,7 @@ gen0MaxLevel(AbSyn ab) { Syme syme = abSyme(ab); if (!syme) break; - while (symeExtension(syme)) syme = symeExtension(syme); + while (symeExtensionFirst(syme)) syme = symeExtensionFirst(syme); if (symeLib(syme) && (symeIsExport(syme) || symeIsExtend(syme))) level = 1; diff --git a/aldor/aldor/src/lib.c b/aldor/aldor/src/lib.c index 6a886724b..e94a3d113 100644 --- a/aldor/aldor/src/lib.c +++ b/aldor/aldor/src/lib.c @@ -2701,7 +2701,7 @@ lib1GetSymeExtensions(Lib lib) for (i=0; isymec; i++) { Syme syme = lib->symev[i]; - Syme ext = symeExtension(syme); + Syme ext = (Syme) symeGetFieldFn(syme, SYFI_Extension); if ( ((UAInt) ext) & 1) symeSetExtension(syme, lib->symev[ ((UAInt) ext) >> 1]); } diff --git a/aldor/aldor/src/sefo.c b/aldor/aldor/src/sefo.c index d2d02070c..13daabb34 100644 --- a/aldor/aldor/src/sefo.c +++ b/aldor/aldor/src/sefo.c @@ -2012,8 +2012,8 @@ symeExtendEqual0(SymeList mods, Syme syme1, Syme syme2) /* Check the extension, if any. */ - e1 = symeExtension(syme1); - e2 = symeExtension(syme2); + e1 = symeExtensionFirst(syme1); + e2 = symeExtensionFirst(syme2); if (e1 || e2) { Bool result; diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c index ec5cc1ba7..1f8f9f2a4 100644 --- a/aldor/aldor/src/syme.c +++ b/aldor/aldor/src/syme.c @@ -296,7 +296,7 @@ symeType(Syme syme) TForm tf; /* Use the type of the extension if present. */ - ext = symeExtension(syme); + ext = symeExtensionFirst(syme); if (ext) return symeType(ext); /* Trigger symes from other libraries. */ @@ -382,6 +382,33 @@ symeCondition(Syme syme) return (SefoList) symeGetField(syme, SYFI_Condition); } +Syme +symeExtension(Syme syme) +{ + Syme ext = symeExtensionFirst(syme); + if (ext && ((Syme) symeExtensionFirst(ext)) != NULL) { + afprintf(dbOut, "More extensions for %pSyme\n", syme); + } + return ext; +} + +Syme +symeExtensionFirst(Syme syme) +{ + Syme ext = (Syme) symeGetField(syme, SYFI_Extension); + return ext; +} + +Syme +symeExtensionFull(Syme syme) +{ + Syme ext = symeExtensionFirst(syme); + if (ext == NULL) { + return syme; + } + return symeExtensionFull(ext); +} + local SymeList symeLocalTwins(Syme syme) { @@ -1820,11 +1847,10 @@ symeXSImpl(Syme s) * *****************************************************************************/ -int +void symeXSetExtension(Syme s, AInt v) { symeSetField(s, SYFI_Extension, v); - return 0; } diff --git a/aldor/aldor/src/syme.h b/aldor/aldor/src/syme.h index 28f51f732..93f61f21f 100644 --- a/aldor/aldor/src/syme.h +++ b/aldor/aldor/src/syme.h @@ -320,6 +320,9 @@ extern SymeList symeTwins (Syme); extern StabLevel symeDefLevel (Syme); extern SymeList symeInlined (Syme); extern Lib symeConstLib (Syme); +extern Syme symeExtension (Syme); +extern Syme symeExtensionFull (Syme); +extern Syme symeExtensionFirst (Syme); #define symeOrigin(s) ((Pointer) symeGetField(s, SYFI_Origin)) #define symeLibrary(s) ((Lib) symeGetField(s, SYFI_Library)) @@ -327,7 +330,6 @@ extern Lib symeConstLib (Syme); #define symeBuiltin(s) ((FoamBValTag) symeGetField(s, SYFI_Builtin)) #define symeForeign(s) ((ForeignOrigin) symeGetField(s, SYFI_Foreign)) #define symeFoam(s) ((Foam) symeGetField(s, SYFI_Foam)) -#define symeExtension(s) ((Syme) symeGetField(s, SYFI_Extension)) #define symeDepths(s) ((AIntList) symeGetField(s, SYFI_Depths)) #define symeMark(s) ((SefoMark) symeGetLocal(s, SYFI_Mark)) #define symeLibNum(s) ((UShort) symeGetField(s, SYFI_LibNum)) @@ -427,8 +429,9 @@ extern AInt symeGetFieldX (Syme, AInt); #define symeSetFoam(s,v) symeSetField(s, SYFI_Foam, v) #define symeSetOriginal(s,v) symeSetField(s, SYFI_Original, v) -#define symeSetExtension(s,v) symeSetField(s, SYFI_Extension, v) -/*#define symeSetExtension(s,v) symeXSetExtension(s, v)*/ +//#define symeSetExtension(s,v) symeSetField(s, SYFI_Extension, v) +#define symeSetExtension(s,v) symeXSetExtension(s, (AInt) v) +extern void symeXSetExtension(Syme, AInt); extern void symeSetCondition(Syme syme, SefoList sefoList); #define symeSetTwins(s,v) symeSetField(s, SYFI_Twins, v) From ca76d9831c236303b14ee625d3ab9da9f085ca69 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 23 Jun 2018 20:31:58 +0100 Subject: [PATCH 277/352] test/Makefile.in: add junit rules, & java dependencies --- aldor/aldor/test/Makefile.in | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index bee6e8a76..e38369efa 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -58,12 +58,12 @@ fmtests := rectest enumtest clos strtable1 simple apply ctests := rectest enumtest multinever maptuple otests := enumtest xtests := enumtest +@BUILD_JAVA_TRUE@junittests := @BUILD_JAVA_TRUE@jruntests := jimport jimp0 +@BUILD_JAVA_TRUE@jtests := simple_j enumtest run_j x_extra := rtexns -@BUILD_JAVA_TRUE@jtests := simple_j enumtest run_j - simple_j_AXLFLAGS=-Q2 jimport_opt_AXLFLAGS=-Q9 -Qinline-all @@ -84,6 +84,7 @@ _ctests := $(sort $(ctests) $(otests)) _jruntests := $(sort $(jruntests)) _jtests := $(sort $(jtests) $(_jruntests)) +_junittests := $(sort $(junittests)) _xtests := $(sort $(xtests)) _fmtests := $(sort $(fmtests) $(_jtests) $(_ctests)) _otests := $(sort $(otests) $(x_extra)) @@ -112,9 +113,29 @@ $(patsubst %, out/java/%.java, $(_jtests)): out/java/%.java: out/fm/%.fm javaopts=-cp $(abs_top_builddir)/aldor/lib/java/src/foamj.jar +define java_import_dependency_template +out/java/$1.class: $(patsubst %,out/java/%.java,$(subst .,/,$($(1)_srcjava))) +endef + +define junit_class_dependency_template +out/java/$1.class: $(patsubst %,out/java/%.java,$(subst .,/,$($(1)_classes))) +endef + +$(foreach jtest,$(_jtests), $(eval $(call java_import_dependency_template,$(jtest)))) +$(foreach junit,$(_junittests), $(eval $(call junit_class_dependency_template,$(junit)))) + +allsrcjava := $(foreach jtest,$(_jtests),$(patsubst %,out/java/%.java,$(subst .,/,$($(jtest)_srcjava)))) + +$(allsrcjava): out/java/%.java: $(srcdir)/%.java + $(AM_V_JAVA_CP) \ + (mkdir -p $(dir $@); cp $(srcdir)/$*.java $@) + $(patsubst %, out/java/%.class, $(_jtests)): out/java/%.class: out/java/%.java $(AM_V_JAVAC) \ - (cd $(builddir)/out/java; javac $(javaopts) $*.java) + (cd $(builddir)/out/java; \ + javac $(javaopts) $*.java \ + $(addsuffix .java,$(subst .,/,$($*_extjava) $($*_srcjava))) \ + ) # Create .o files locally as unicl creates files in the # current directory... From 073aa05cb6d50335a721dc232cbdf13fed68df45 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sat, 16 Jun 2018 00:35:14 +0100 Subject: [PATCH 278/352] genjava.c: Flatten code such that "throw" is top level --- aldor/aldor/src/java/genjava.c | 174 ++++++++++++++++++++++++++++++++- 1 file changed, 172 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index dfe51ca12..7566789e4 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -1,6 +1,7 @@ #include "comsg.h" #include "debug.h" #include "flog.h" +#include "fbox.h" #include "foamsig.h" #include "intset.h" #include "javacode.h" @@ -104,6 +105,8 @@ local JavaCode gj0CCall(Foam call); local JavaCode gj0OCall(Foam call); local JavaCode gj0BCall(Foam call); local JavaCode gj0PCall(Foam call); +local Bool gj0PCallThrowsException(Foam foam); +local JavaCode gj0PCallCatchException(JavaCode code); local JavaCode gj0MFmt(Foam mfmt); local JavaCode gj0Const(Foam foam); @@ -179,9 +182,13 @@ enum gjId { GJ_Format, GJ_EnvRecord, + GJ_JavaException, + GJ_FoamUserException, + GJ_Object, GJ_String, GJ_BigInteger, + GJ_LangException, GJ_NullPointerException, GJ_ClassCastException, @@ -553,7 +560,7 @@ local void gj0ProgInitVars(IntSet set, Foam body); local JavaCode gj0ProgDecl(Foam ddecl, int idx, Bool isSet); local JavaCode gj0ProgDeclDefaultValue(Foam decl); local void gj0SeqHaltFlush(Foam foam); - +local Foam gj0FlattenProg(Foam rhs); local JavaCode gj0Prog(Foam lhs, Foam rhs) @@ -561,7 +568,8 @@ gj0Prog(Foam lhs, Foam rhs) GjProgResult r; JavaCode code; assert(foamTag(rhs) == FOAM_Prog); - + + rhs = gj0FlattenProg(rhs); gj0ProgInit(lhs, rhs); r = gj0ProgMain(rhs); code = gj0ProgResultToJava(r); @@ -1071,6 +1079,124 @@ gj0ProgFnMethodBody(Foam lhs, Foam prog) return jcNLSeq(ret); } +/* + * :: Flatten + */ + +/* + * Idea here is that java pcalls which can throw exceptions have to be + * at top level. So we need to scan the prog and lift anything + * embedded in an expression. + */ + +typedef struct gjFlattenResult { + FoamList stmts; + FoamBox locals; +} *GjFlattenResult; + +local Foam gj0FlattenStmt(GjFlattenResult changes, Foam expr); +local Foam gj0FlattenExpr(GjFlattenResult changes, Foam expr, Bool topLevel); + +local GjFlattenResult gj0FlattenNewResult(Foam prog); +local Foam gj0FlattenNewLocal(GjFlattenResult changes, Foam pcall); +local void gj0FlattenAddStmt(GjFlattenResult changes, Foam stmt); + +local Foam +gj0FlattenProg(Foam prog) +{ + GjFlattenResult changes; + Foam seq; + int i; + + assert(foamTag(prog) == FOAM_Prog); + if (!foamFindFirst(gj0PCallThrowsException, prog)) { + return prog; + } + + changes = gj0FlattenNewResult(prog); + seq = prog->foamProg.body; + + for (i=0; ifoamSeq.argv[i])); + } + + prog->foamProg.locals = fboxMake(changes->locals); + prog->foamProg.body = foamNewOfList(FOAM_Seq, listNReverse(Foam)(changes->stmts)); + + return prog; +} + +local Foam +gj0FlattenStmt(GjFlattenResult changes, Foam expr) +{ + return gj0FlattenExpr(changes, expr, true); +} + +local Foam +gj0FlattenExpr(GjFlattenResult changes, Foam expr, Bool topLevel) +{ + if (topLevel) { + switch (foamTag(expr)) { + case FOAM_Set: + case FOAM_Def: + case FOAM_PCall: + if (gj0PCallThrowsException(expr)) { + topLevel = true; + } + break; + default: + topLevel = false; + } + } + + foamIter(expr, psubexpr, { + *psubexpr = gj0FlattenExpr(changes, *psubexpr, topLevel); + }); + + if (!topLevel && gj0PCallThrowsException(expr)) { + Foam loc = gj0FlattenNewLocal(changes, expr); + Foam def = foamNewDef(loc, expr); + return loc; + } + return expr; +} + +local GjFlattenResult +gj0FlattenNewResult(Foam prog) +{ + GjFlattenResult result; + + result = (GjFlattenResult) stoAlloc(OB_Other, sizeof(*result)); + result->stmts = listNil(Foam); + result->locals = fboxNew(prog->foamProg.locals); + + return result; +} + +local Foam +gj0FlattenNewLocal(GjFlattenResult changes, Foam pcall) +{ + Foam gdecl, sig, newdecl, def, retdecl; + int idx; + gdecl = gjContextGlobal(pcall->foamPCall.op->foamGlo.index); + retdecl = javaSigRet(gjContext->formats->foamDFmt.argv[gdecl->foamGDecl.format]); + + newdecl = foamNewDecl(retdecl->foamDecl.type, strCopy("val"), retdecl->foamDecl.format); + idx = fboxAdd(changes->locals, newdecl); + + def = foamNewDef(foamNewLoc(idx), pcall); + gj0FlattenAddStmt(changes, def); + + return foamNewLoc(idx); +} + +local void +gj0FlattenAddStmt(GjFlattenResult changes, Foam stmt) +{ + changes->stmts = listCons(Foam)(stmt, changes->stmts); +} + + /* * :: Java Types @@ -3420,9 +3546,13 @@ struct gjIdInfo gjIdInfo[] = { {GJ_Format, "foamj", "Format"}, {GJ_EnvRecord, "foamj", "EnvRecord"}, + {GJ_JavaException, "foamj", "JavaException"}, + {GJ_FoamUserException, "foamj", "FoamUserException"}, + {GJ_Object, 0, "Object"}, {GJ_String, 0, "String"}, {GJ_BigInteger, "java.math", "BigInteger"}, + {GJ_LangException, 0, "Exception"}, {GJ_NullPointerException, 0, "NullPointerException"}, {GJ_ClassCastException, 0, "ClassCastException"}, @@ -3595,6 +3725,46 @@ gj0PCallCastArgs(Foam op, JavaCodeList argsIn) } + +local Bool +gj0PCallThrowsException(Foam foam) +{ + if (foamTag(foam) != FOAM_PCall) + return false; + switch (foam->foamPCall.protocol) { + case FOAM_Proto_Java: + case FOAM_Proto_JavaMethod: + case FOAM_Proto_JavaConstructor: + break; + default: + return false; + } + + Foam op = foam->foamPCall.op; + if (foamTag(op) != FOAM_Glo) + return false; + Foam gdecl = gjContextGlobal(op->foamGlo.index); + Foam fmt = gjContext->formats->foamDFmt.argv[gdecl->foamDecl.format]; + + if (javaSigExn(fmt)->foamDecl.type != FOAM_NOp) { + return true; + } + return false; +} + +local JavaCode +gj0PCallCatchException(JavaCode code) +{ + code = jcTryCatch(jcBlock(jcStatement(code)), + jcCatch(jcLocalDecl(0, gj0Id(GJ_LangException), jcId(strCopy("exn"))), + jcBlock(jcStatement(jcThrow(jcConstructV(gj0Id(GJ_JavaException), 1, + jcId(strCopy("exn"))))))), + NULL); + return code; +} + + + /* * :: BCall */ From fadb46cbf0af49430eeb762a65fc097df78f16d5 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 13 Jun 2018 23:05:41 +0100 Subject: [PATCH 279/352] genc.c: deal with Java a little better --- aldor/aldor/src/genc.c | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/aldor/aldor/src/genc.c b/aldor/aldor/src/genc.c index f49b5cd6d..0d4f86923 100644 --- a/aldor/aldor/src/genc.c +++ b/aldor/aldor/src/genc.c @@ -637,6 +637,7 @@ gc0ExternDecls(String name) /* Some formats must not have a typedef */ case FOAM_DDecl_FortranSig: /*FALLTHROUGH*/ case FOAM_DDecl_CSig: /*FALLTHROUGH*/ + case FOAM_DDecl_JavaClass: /*FALLTHROUGH*/ break; default: gc0LFmtDef(i); @@ -654,6 +655,8 @@ gc0ExternDecls(String name) /* Some formats must not have a typedef */ case FOAM_DDecl_FortranSig: /*FALLTHROUGH*/ case FOAM_DDecl_CSig: /*FALLTHROUGH*/ + case FOAM_DDecl_JavaClass: /*FALLTHROUGH*/ + case FOAM_DDecl_JavaSig: /*FALLTHROUGH*/ break; default: gc0LFmtDecl(i, foamArgv(gcvFmt)[i].code); @@ -1270,6 +1273,7 @@ gc0FluidDecl(int i) ****************************************************************************/ local CCodeList gc0DeclList(int n, Foam *argv); +local Bool gc0ProgIsC(Foam foam); static CCodeList gc0DeclStmts; @@ -1292,6 +1296,8 @@ gc0ConstDecl(int idx) val = progDef->foamDef.rhs; if (foamTag(val) != FOAM_Prog) return ; + if (!gc0ProgIsC(val)) return; + decl = gcvConst->foamDDecl.argv[idx]; str = decl->foamDecl.id; if (gc0OverSMax()) { @@ -1328,6 +1334,30 @@ gc0ConstDecl(int idx) #endif } +local Bool +gc0ProgIsC(Foam foam) +{ + int i; + if (foam->foamProg.retType == FOAM_JavaObj) { + return false; + } + + for (int i=0; ifoamProg.params); i++) { + Foam param = foam->foamProg.params->foamDDecl.argv[i]; + if (param->foamDecl.type == FOAM_JavaObj) { + return false; + } + } + for (int i=0; ifoamProg.locals); i++) { + Foam param = foam->foamProg.locals->foamDDecl.argv[i]; + if (param->foamDecl.type == FOAM_JavaObj) { + return false; + } + } + return true; +} + + local void gc0InitDeclList() { From 079a37eea79a240eeda3d671486b2695148f0a14 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 29 Apr 2018 13:37:51 +0100 Subject: [PATCH 280/352] tform.c: Look for extensions when getting exports --- aldor/aldor/src/tform.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 687706e4f..970b48e81 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -3787,6 +3787,10 @@ tfGetDomExports(TForm tf) tf = tfIgnoreExceptions(tf); + if (tfHasSelf(tf) && tfIsId(tf) && symeExtension(tfIdSyme(tf))) { + return tfGetDomExports(tfFrSyme(stabFile(), symeExtensionFull(tfIdSyme(tf)))); + } + if (tfDomExports(tf) || tfIsUnknown(tf) || tfIsNone(tf)) return tfDomExports(tf); From a5c414900dde6c602e57970af8f1ad3326a48095 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 4 May 2018 22:26:30 +0100 Subject: [PATCH 281/352] genc.c: Make (bad) attempt at dealing with non-C (ie. java) code in foam --- aldor/aldor/src/genc.c | 121 +++++++++++++++++++++++++++++------------ 1 file changed, 86 insertions(+), 35 deletions(-) diff --git a/aldor/aldor/src/genc.c b/aldor/aldor/src/genc.c index 0d4f86923..29bea3af3 100644 --- a/aldor/aldor/src/genc.c +++ b/aldor/aldor/src/genc.c @@ -1054,7 +1054,7 @@ gc0GloDecl(int idx) buf = strPrintf("Cannot declare %s of protocol %s.", decl->foamGDecl.id, foamProtoStr(decl->foamGDecl.protocol)); - cco = ccoCppLine(ccoIdOf("error"), ccoStringOf(buf)); + cco = ccoCppLine(ccoIdOf("warning"), ccoStringOf(buf)); } return cco; } @@ -1273,7 +1273,6 @@ gc0FluidDecl(int i) ****************************************************************************/ local CCodeList gc0DeclList(int n, Foam *argv); -local Bool gc0ProgIsC(Foam foam); static CCodeList gc0DeclStmts; @@ -1296,8 +1295,6 @@ gc0ConstDecl(int idx) val = progDef->foamDef.rhs; if (foamTag(val) != FOAM_Prog) return ; - if (!gc0ProgIsC(val)) return; - decl = gcvConst->foamDDecl.argv[idx]; str = decl->foamDecl.id; if (gc0OverSMax()) { @@ -1334,30 +1331,6 @@ gc0ConstDecl(int idx) #endif } -local Bool -gc0ProgIsC(Foam foam) -{ - int i; - if (foam->foamProg.retType == FOAM_JavaObj) { - return false; - } - - for (int i=0; ifoamProg.params); i++) { - Foam param = foam->foamProg.params->foamDDecl.argv[i]; - if (param->foamDecl.type == FOAM_JavaObj) { - return false; - } - } - for (int i=0; ifoamProg.locals); i++) { - Foam param = foam->foamProg.locals->foamDDecl.argv[i]; - if (param->foamDecl.type == FOAM_JavaObj) { - return false; - } - } - return true; -} - - local void gc0InitDeclList() { @@ -2328,12 +2301,18 @@ gccDef(Foam foam) * ****************************************************************************/ +local Bool gc0ProgIsC(Foam foam); +local Bool gc0FoamIsJavaPCall(Foam foam); +local CCode gc0ProgBody(Foam ref, Foam prog); +local CCode gc0ProgBodyC(Foam ref, Foam prog); +local CCode gc0ProgBodyOther(Foam ref, Foam prog); + local CCode gc0Prog(Foam ref, Foam foam) { Scope("gc0Prog"); int type, progFmt; - Foam params, locals, lexicals, body; + Foam params, locals, lexicals; Foam fluids; CCode ccBody, ccParams, ccLeft, ccRight; CCodeList codeProg = listNil(CCode); @@ -2369,7 +2348,6 @@ gc0Prog(Foam ref, Foam foam) locals = foam->foamProg.locals; lexicals = foamArgv(gcvFmt)[progFmt].code; fluids = foam->foamProg.fluids; - body = foam->foamProg.body; gcvProg = foam; gcvLvl = gcvLvl+1; @@ -2389,8 +2367,8 @@ gc0Prog(Foam ref, Foam foam) } ccParams = gc0Param(foam, params); gcvIsLeaf = foamProgIsLeaf(foam); - ccBody = ccoCompound(gc0Compound(locals, body, ref, progFmt, - gcvIsLeaf)); + + ccBody = gc0ProgBody(ref, foam); listFreeCons(Foam)(gcvLexStk); @@ -2410,13 +2388,79 @@ gc0Prog(Foam ref, Foam foam) gc0AddLine(gcvInitProgCC, ccoStat(ccoAsst(gccId(ref), ccoPreAnd(ccoCopy(ccLeft))))); - - retval = ccoMany2(ccoFDef(gcvSpec, gccProgId(ref), ccParams, ccBody), gc0ListOf(CCO_Many, codeProg)); Return(retval); } +local CCode +gc0ProgBody(Foam ref, Foam prog) +{ + if (!gc0ProgIsC(prog)) { + return gc0ProgBodyOther(ref, prog); + } + else { + return gc0ProgBodyC(ref, prog); + } +} + +local CCode +gc0ProgBodyC(Foam ref, Foam foam) +{ + Foam locals = foam->foamProg.locals; + Foam body = foam->foamProg.body; + AInt progFmt = foamProgIndex(foam); + + CCode ccBody = ccoCompound(gc0Compound(locals, body, ref, progFmt, + gcvIsLeaf)); + return ccBody; +} + +local CCode +gc0ProgBodyOther(Foam ref, Foam prog) +{ + return ccoCompound(ccoStat(gcFiHalt(ccoIdOf("100")))); +} + +local Bool +gc0ProgIsC(Foam foam) +{ + int i; + if (foam->foamProg.retType == FOAM_JavaObj) { + return false; + } + + for (int i=0; ifoamProg.params); i++) { + Foam param = foam->foamProg.params->foamDDecl.argv[i]; + if (param->foamDecl.type == FOAM_JavaObj) { + return false; + } + } + + for (int i=0; ifoamProg.locals); i++) { + Foam param = foam->foamProg.locals->foamDDecl.argv[i]; + if (param->foamDecl.type == FOAM_JavaObj) { + return false; + } + } + if (foamFindFirst(gc0FoamIsJavaPCall, foam->foamProg.body) != NULL) { + return false; + } + + return true; +} + +local Bool +gc0FoamIsJavaPCall(Foam foam) +{ + if (foamTag(foam) != FOAM_PCall) + return false; + + return foam->foamPCall.protocol == FOAM_Proto_Java + || foam->foamPCall.protocol == FOAM_Proto_JavaConstructor + || foam->foamPCall.protocol == FOAM_Proto_JavaMethod; +} + /***************************************************************************** * * :: Create the C program parameters list for the Foam program 'foam', @@ -4429,7 +4473,7 @@ gccGetVar(Foam foam) switch (foamTag(foam)) { case FOAM_Glo: idx = foam->foamGlo.index; - switch (decl->foamGDecl.protocol) { + switch (foamProtoBase(decl->foamGDecl.protocol)) { case FOAM_Proto_Foam: case FOAM_Proto_Init: @@ -4458,6 +4502,9 @@ gccGetVar(Foam foam) ccode = ccoIdOf(s); } break; + case FOAM_Proto_Java: + ccode = gc0MultVarId("J", idx, "java"); + break; case FOAM_Proto_Other: ccode = ccoIdOf(s); break; @@ -4736,6 +4783,7 @@ gc0ClosInit(Foam ref, Foam val) CCode ccClos, ccLeft, ccRight, type; decl = gc0GetDecl(ref); + if (foamTag(val) != FOAM_Clos) { int fmt = decl->foamDecl.format; @@ -6127,6 +6175,9 @@ gc0TypeId(AInt t, AInt fmt) case FOAM_Arb: cc = ccoTypeIdOf(gcFiArb); break; + case FOAM_JavaObj: + cc = ccoTypeIdOf(gcFiWord); + break; default: bugBadCase(t); NotReached(return 0); From 1779f6068736951530143dccae32604b8f29f945 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 2 Jul 2018 22:44:55 +0100 Subject: [PATCH 282/352] aldor: Implement java exports Bigger commit than it should be: - Allow compiler to produce multiple java files per unit - Add code generation for java exports Further TODO: - Remove FOAM_Ptr code in PCallCastArgs - PCall to Array - should die. - Equals should override Object.equals(Object other) - not equals(%) --- .../aldor/lib/java/src/foamj/AldorObject.java | 3 + aldor/aldor/lib/java/src/foamj/Foam.java | 7 +- .../aldor/lib/java/src/foamj/FoamContext.java | 2 +- .../lib/java/src/foamj/FoamUserException.java | 12 + aldor/aldor/lib/java/test/foamj/FoamTest.java | 5 +- aldor/aldor/src/axlcomp.c | 9 +- aldor/aldor/src/emit.c | 64 +- aldor/aldor/src/emit.h | 2 +- aldor/aldor/src/genfoam.c | 30 +- aldor/aldor/src/gf_java.c | 697 +++++++++++++++-- aldor/aldor/src/gf_java.h | 4 + aldor/aldor/src/java/genjava.c | 700 ++++++++++++++++-- aldor/aldor/src/java/genjava.h | 2 +- aldor/aldor/src/java/javacode.c | 46 +- aldor/aldor/src/java/javacode.h | 2 + aldor/aldor/src/java/main.c | 2 +- aldor/aldor/src/scobind.c | 9 +- aldor/aldor/src/stab.c | 37 + aldor/aldor/src/stab.h | 5 + aldor/aldor/src/syme.c | 9 +- aldor/aldor/src/tform.c | 146 +++- aldor/aldor/src/tform.h | 4 +- aldor/aldor/src/ti_tdn.c | 8 +- aldor/aldor/test/JExportTest.java | 25 + aldor/aldor/test/JThrowTest.java | 59 ++ aldor/aldor/test/Makefile.in | 73 +- .../test/aldor/test/ExceptionExample.java | 24 + aldor/aldor/test/envname.as | 12 + aldor/aldor/test/halt.as | 8 + aldor/aldor/test/jcatch.as | 16 + aldor/aldor/test/jexn.as | 39 + aldor/aldor/test/jexport.as | 63 ++ aldor/aldor/test/jexport1.as | 28 + aldor/aldor/test/jexport2.as | 8 + aldor/aldor/test/jimport.as | 24 +- aldor/aldor/test/jlist.as | 79 ++ aldor/aldor/test/jthrow.as | 20 + aldor/lib/buildlib.mk | 17 +- 38 files changed, 2033 insertions(+), 267 deletions(-) create mode 100644 aldor/aldor/lib/java/src/foamj/AldorObject.java create mode 100644 aldor/aldor/lib/java/src/foamj/FoamUserException.java create mode 100644 aldor/aldor/test/JExportTest.java create mode 100644 aldor/aldor/test/JThrowTest.java create mode 100644 aldor/aldor/test/aldor/test/ExceptionExample.java create mode 100644 aldor/aldor/test/envname.as create mode 100644 aldor/aldor/test/halt.as create mode 100644 aldor/aldor/test/jcatch.as create mode 100644 aldor/aldor/test/jexn.as create mode 100644 aldor/aldor/test/jexport.as create mode 100644 aldor/aldor/test/jexport1.as create mode 100644 aldor/aldor/test/jexport2.as create mode 100644 aldor/aldor/test/jlist.as create mode 100644 aldor/aldor/test/jthrow.as diff --git a/aldor/aldor/lib/java/src/foamj/AldorObject.java b/aldor/aldor/lib/java/src/foamj/AldorObject.java new file mode 100644 index 000000000..c8b772ce7 --- /dev/null +++ b/aldor/aldor/lib/java/src/foamj/AldorObject.java @@ -0,0 +1,3 @@ +package foamj; + +public class AldorObject {} diff --git a/aldor/aldor/lib/java/src/foamj/Foam.java b/aldor/aldor/lib/java/src/foamj/Foam.java index 682fc4e38..95f97f0fc 100644 --- a/aldor/aldor/lib/java/src/foamj/Foam.java +++ b/aldor/aldor/lib/java/src/foamj/Foam.java @@ -529,13 +529,12 @@ public static double atan2(double a, double b) { return Math.atan2(a, b); } - public static Word stringToJavaString(Word w) { + public static String stringToJavaString(Word w) { char[] arr = (char[]) w.toArray(); - return new FoamJ.JavaObj(arrToString(arr)); + return arrToString(arr); } - public static Word javaStringToString(Word w) { - String s = (String) ((Word) w).toJavaObj(); + public static Word javaStringToString(String s) { Word arr = Word.U.fromArray(("" + s + "\0").toCharArray()); return arr; } diff --git a/aldor/aldor/lib/java/src/foamj/FoamContext.java b/aldor/aldor/lib/java/src/foamj/FoamContext.java index ffdecb72d..a26db62d5 100644 --- a/aldor/aldor/lib/java/src/foamj/FoamContext.java +++ b/aldor/aldor/lib/java/src/foamj/FoamContext.java @@ -42,7 +42,7 @@ public Value ocall(Env env, Value... vals) { called = true; Class c; try { - c = (Class) ClassLoader.getSystemClassLoader().loadClass(name); + c = (Class) getClass().getClassLoader().loadClass("aldorcode." + name); Constructor cons = c.getConstructor(FoamContext.class); FoamClass fc = cons.newInstance(FoamContext.this); classInstances.put(c, fc); diff --git a/aldor/aldor/lib/java/src/foamj/FoamUserException.java b/aldor/aldor/lib/java/src/foamj/FoamUserException.java new file mode 100644 index 000000000..9e8d4baad --- /dev/null +++ b/aldor/aldor/lib/java/src/foamj/FoamUserException.java @@ -0,0 +1,12 @@ +package foamj; + +public class FoamUserException extends RuntimeException +{ + Word theException; + private int tag; + + public FoamUserException(int tag, Word w) { + this.tag = tag; + this.theException = w; + } +} diff --git a/aldor/aldor/lib/java/test/foamj/FoamTest.java b/aldor/aldor/lib/java/test/foamj/FoamTest.java index 1c2acc0c4..cde7a3546 100644 --- a/aldor/aldor/lib/java/test/foamj/FoamTest.java +++ b/aldor/aldor/lib/java/test/foamj/FoamTest.java @@ -9,9 +9,8 @@ public class FoamTest { @Test public void testToJavaString() { - Word w = new FoamJ.JavaObj("hello"); - Word aldorString = Foam.javaStringToString(w); - Assert.assertEquals("hello", Foam.stringToJavaString(aldorString).toJavaObj()); + Word aldorString = Foam.javaStringToString("hello"); + Assert.assertEquals("hello", Foam.stringToJavaString(aldorString)); } @Test diff --git a/aldor/aldor/src/axlcomp.c b/aldor/aldor/src/axlcomp.c index f0980576c..91dd46553 100644 --- a/aldor/aldor/src/axlcomp.c +++ b/aldor/aldor/src/axlcomp.c @@ -1226,16 +1226,17 @@ compPhasePutLisp(EmitInfo finfo, Foam foam) void compPhasePutJava(EmitInfo finfo, Foam foam) { - JavaCode java; + JavaCodeList javaFiles; String fnstring; phStart(PH_PutJava); fnstring = emitGetFileIdName(finfo); + if (emitIsOutputNeededOrWarn(finfo, FTYPENO_JAVA)) { - java = genJavaUnit(foam, fnstring); - emitTheJava(finfo, java); - jcoFree(java); + javaFiles = genJavaUnit(foam, fnstring); + emitTheJava(finfo, javaFiles); + listFreeDeeply(JavaCode)(javaFiles, jcoFree); } phEnd((PhPrFun) 0, (PhPrFun) 0, (Pointer) NULL); diff --git a/aldor/aldor/src/emit.c b/aldor/aldor/src/emit.c index 1265dad59..78d185d17 100644 --- a/aldor/aldor/src/emit.c +++ b/aldor/aldor/src/emit.c @@ -13,6 +13,7 @@ #include "emit.h" #include "file.h" #include "fint.h" +#include "format.h" #include "genlisp.h" #include "include.h" #include "lib.h" @@ -22,6 +23,7 @@ #include "store.h" #include "util.h" #include "java/genjava.h" +#include "java/javacode.h" #include "java/javaobj.h" /**************************************************************************** @@ -1170,39 +1172,59 @@ emitTheObject(EmitInfo finfo) * ****************************************************************************/ -String emitJavaHeader = "//\n// Java generated by aldor from file %s\n//\n"; +static String emitJavaHeader = "//\n// Java generated by aldor from file %s\n//\n"; + +local void emitOneJavaFile (EmitInfo finfo, JavaCode javaFile); +local FileName emitJavaFileName(EmitInfo finfo, JavaCode javaFile); void -emitTheJava(EmitInfo finfo, JavaCode java) +emitTheJava(EmitInfo finfo, JavaCodeList javaFiles) { - OStream o; - FileName srcfn; - FileName fn; - FILE *fout; - String fnstring; - JavaCodePContext ctxt; - - srcfn = emitSrcFile(finfo); - fn = emitFileName(finfo, FTYPENO_JAVA); - emitInfoInUse(finfo, FTYPENO_JAVA) = true; - fout = fileWrOpen(fn); - fnstring = fnameUnparseStaticWithout(srcfn); - fprintf(fout, emitJavaHeader, fnstring); + while (javaFiles != listNil(JavaCode)) { + emitOneJavaFile(finfo, car(javaFiles)); + javaFiles = cdr(javaFiles); + } - o = ostreamNewFrFile(fout); - ctxt = jcoPContextNew(o, false); - jcoWrite(ctxt, java); - jcoPContextFree(ctxt); - ostreamClose(o); - fclose(fout); emitInfoInUse(finfo, FTYPENO_JAVA) = false; emitSetDone(FTYPENO_JAVA); +} + +local void +emitOneJavaFile(EmitInfo finfo, JavaCode javaFile) +{ + JavaCodePContext ctxt; + FileName fn, srcfn; + OStream ostream; + FILE *fout; + + srcfn = emitSrcFile(finfo); + fn = emitJavaFileName(finfo, javaFile); + + fout = fileWrOpen(fn); + ostream = ostreamNewFrFile(fout); + ostreamPrintf(ostream, emitJavaHeader, fnameUnparseStaticWithout(srcfn)); + + ctxt = jcoPContextNew(ostream, false); + jcoWrite(ctxt, javaFile); + jcoPContextFree(ctxt); + ostreamClose(ostream); + fclose(fout); } +local FileName +emitJavaFileName(EmitInfo finfo, JavaCode javaFile) +{ + FileName javaFileName = emitFileName(finfo, FTYPENO_JAVA); + String fileName = jcFileClassName(javaFile); + String pkgName = strReplace(jcFilePackageName(javaFile), ".", "/"); + String destDir = strPrintf("%s/%s", fnameDir(javaFileName), + pkgName == NULL ? "" : pkgName); + return fnameNew(destDir, fileName, FTYPE_JAVA); +} /***************************************************************************** * diff --git a/aldor/aldor/src/emit.h b/aldor/aldor/src/emit.h index 5f246d9dd..b09ad84c2 100644 --- a/aldor/aldor/src/emit.h +++ b/aldor/aldor/src/emit.h @@ -94,7 +94,7 @@ extern void emitTheLisp (EmitInfo, SExpr); extern void emitTheC (EmitInfo, CCodeList); extern void emitTheCpp (); extern void emitTheObject (EmitInfo); -extern void emitTheJava (EmitInfo, JavaCode); +extern void emitTheJava (EmitInfo, JavaCodeList); /* * Linkage, execution, and cleanup. diff --git a/aldor/aldor/src/genfoam.c b/aldor/aldor/src/genfoam.c index bc0fb73d5..d1fa15a64 100644 --- a/aldor/aldor/src/genfoam.c +++ b/aldor/aldor/src/genfoam.c @@ -977,10 +977,19 @@ local Symbol gen0ExportingTo(AbSyn absyn) { if (abIsApplyOf(absyn, ssymForeign) && - abApplyArgc(absyn) == 1 && - abTag(abApplyArg(absyn, int0)) == AB_Id) - return abApplyArg(absyn, int0)->abId.sym; - else + abApplyArgc(absyn) == 1) { + AbSyn fType = abApplyArg(absyn, int0); + if (abTag(fType) == AB_Id) { + return fType->abId.sym; + } + else if (abTag(fType) == AB_Apply && + abIsId(abApplyOp(fType))) { + return abIdSym(abApplyOp(fType)); + } + else + return NULL; + } + else return NULL; } @@ -1094,6 +1103,10 @@ genForeignImport(AbSyn absyn) if (!forg->file) return (Foam)NULL; + /* Java stuff doesn't count */ + if (foamProtoBase(forg->protocol) == FOAM_Proto_Java) + return (Foam) NULL; + /* Global declaration */ decl = foamNewGDecl(FOAM_Word, strCopy(forg->file), emptyFormatSlot, FOAM_GDecl_Import, FOAM_Proto_Include); @@ -1126,6 +1139,8 @@ genForeignExport(AbSyn absyn) gen0ExportToC(ab); else if (sym == ssymFortran) gen0ExportToFortran(ab); + else if (sym == ssymJava) + gfjExportToJava(ab, dest); else comsgFatal(ab, ALDOR_F_Bug, "Export not implemented"); } @@ -8123,6 +8138,7 @@ gen0AddRealFormat(Foam ddecl) local Bool gen0CompareFormats(Foam dd1, Foam dd2) { + FoamDDeclTag usage; Length i, argc; assert(foamTag(dd1) == FOAM_DDecl); @@ -8131,6 +8147,8 @@ gen0CompareFormats(Foam dd1, Foam dd2) if (dd1->foamDDecl.usage != dd2->foamDDecl.usage) return false; + usage = dd1->foamDDecl.usage; + argc = foamDDeclArgc(dd1); if (foamDDeclArgc(dd2) != argc) return false; @@ -8148,7 +8166,9 @@ gen0CompareFormats(Foam dd1, Foam dd2) * otherwise we get problems with the * foreign Fortran interface. */ - if (t1 == FOAM_Clos) + if (t1 == FOAM_Clos + || usage == FOAM_DDecl_JavaClass + || usage == FOAM_DDecl_JavaSig) { /* Can't merge if different signatures ... */ AInt f1 = d1->foamDecl.format; AInt f2 = d2->foamDecl.format; diff --git a/aldor/aldor/src/gf_java.c b/aldor/aldor/src/gf_java.c index 9c4e85172..f2eb27f84 100644 --- a/aldor/aldor/src/gf_java.c +++ b/aldor/aldor/src/gf_java.c @@ -1,12 +1,17 @@ #include "axlobs.h" +#include "debug.h" +#include "format.h" #include "gf_util.h" #include "gf_prog.h" #include "gf_java.h" #include "gf_syme.h" #include "javasig.h" #include "of_inlin.h" +#include "table.h" +#include "tinfer.h" #include "tform.h" -#include "sefo.h" +#include "tqual.h" +#include "stab.h" #include "strops.h" #include "symbol.h" #include "spesym.h" @@ -22,21 +27,45 @@ local FoamList gfjProgAddParams(TForm tf); local TForm gfjPCallArgBaseJavaType(TForm tf); local TForm gfjPCallRetBaseJavaType(TForm tf); local FoamTag gfjPCallFoamType(TForm tf, AInt *pfmt); +local AInt gfjPCallFoamTypeDDecl(TForm tf); local Foam gfjPCallFoamToJava(TForm tf, Foam foam); local Foam gfjPCallJavaToFoam(TForm tf, Foam foam); -local AInt gfjPCallDecl(TForm tf, TForm this); +local AInt gfjPCallDeclImport(TForm tf, TForm this); +local AInt gfjPCallDeclExport(TForm tf, FoamProtoTag tag); local Foam gfjPCallDeclArg(TForm tf); +local Foam gfjPCallDeclExn(TForm tf); +local Foam gfjPCallJavaToFoamForExport(TForm tf, Foam foam); +local Foam gfjPCallFoamToJavaForExport(TForm tf, Foam foam); +local AInt gj0ClassDDeclFull(String fullyQualifiedName); local AInt gj0ClassDDecl(ForeignOrigin origin, String clsName); +local Foam gj0ClassDecl(ForeignOrigin origin, String clsName); + +local String gfjDeclMethodNameForType(TForm tf, String methodName); +local String gfjDeclMethodName(String typeName, ForeignOrigin forg, String methodName); +local String gfjDeclClassNameForType(TForm tf); +local String gfjDeclClassName(String typeName, ForeignOrigin forg); + +local AInt gfjExportDecoder(TForm tf); +local AInt gfjExportEncoder(TForm tf); + +static Table gfjExportEncoderForTForm; +static Table gfjExportDecoderForTForm; void gfjInit() { + gfjExportEncoderForTForm = tblNew((TblHashFun) tfHash, (TblEqFun) tfEqual); + gfjExportDecoderForTForm = tblNew((TblHashFun) tfHash, (TblEqFun) tfEqual); } void gfjFini() { + tblFree(gfjExportEncoderForTForm); + tblFree(gfjExportDecoderForTForm); + gfjExportEncoderForTForm = NULL; + gfjExportDecoderForTForm = NULL; } @@ -97,8 +126,6 @@ gfjImportApplyInner(Syme syme, AInt fmtNum) { GenFoamState saved; TForm exporter, innerTf; - Syme esyme; - ForeignOrigin forg; FoamList params; Foam gdecl, prog, pcall, temp, op; FoamTag retType; @@ -109,17 +136,14 @@ gfjImportApplyInner(Syme syme, AInt fmtNum) constnum = gen0NumProgs; exporter = symeExporter(syme); - esyme = tfIdSyme(exporter); - forg = symeForeign(esyme); innerTf = tfMapRet(symeType(syme)); - clsFmt = gj0ClassDDecl(forg, symeString(esyme)); + clsFmt = gfjPCallFoamTypeDDecl(exporter); + + globName = gfjDeclMethodNameForType(exporter, symeJavaApplyName(syme)); - globName = (forg->file ? strPrintf("%s.%s.%s", - forg->file, symeString(esyme), symeJavaApplyName(syme)) - : strPrintf("%s.%s", symeString(esyme), symeJavaApplyName(syme))); - gdecl = foamNewGDecl(FOAM_Word, globName, - gfjPCallDecl(innerTf, tfMapArgN(symeType(syme), 0)), + gdecl = foamNewGDecl(FOAM_Clos, globName, + gfjPCallDeclImport(innerTf, tfMapArgN(symeType(syme), 0)), FOAM_GDecl_Import, FOAM_Proto_JavaMethod); gnum = gen0AddGlobal(gdecl); fnName = strPrintf("%s-inner", symeJavaApplyName(syme)); @@ -136,17 +160,16 @@ gfjImportApplyInner(Syme syme, AInt fmtNum) retType = tfMapRetc(innerTf) == 0 ? FOAM_NOp: FOAM_Word; if (retType == FOAM_NOp) { - pcall = foamNewPCallOfList(FOAM_Proto_JavaMethod, + pcall = foamNewPCallOfList(FOAM_Proto_JavaMethod, FOAM_NOp, op, params); gen0AddLexLevels(pcall, 2); gen0AddStmt(pcall, NULL); } else { - Foam retval; - pcall = foamNewPCallOfList(FOAM_Proto_JavaMethod, - gfjPCallFoamType(tfMapRet(innerTf), NULL), - op, params); - retval = gfjPCallJavaToFoam(tfMapRet(innerTf), pcall); + FoamTag type = gfjPCallFoamType(tfMapRet(innerTf), NULL); + Foam pcall = foamNewPCallOfList(FOAM_Proto_JavaMethod, + type, op, params); + Foam retval = gfjPCallJavaToFoam(tfMapRet(innerTf), pcall); gen0AddLexLevels(retval, 2); gen0AddStmt(foamNewReturn(retval), NULL); } @@ -165,24 +188,19 @@ local Foam gfjImportConstructor(Syme syme) { GenFoamState saved; - ForeignOrigin forg; TForm exporter; - Syme esyme; FoamList params; Foam prog, gdecl, pcall; String fnName, globName; AInt fmtNum, innerConstNum, constNum, gnum; exporter = symeExporter(syme); - esyme = tfIdSyme(exporter); - forg = symeForeign(esyme); + globName = gfjDeclClassNameForType(exporter); + fnName = strCopy(globName); - fnName = strCopy(symString(tfIdSym(exporter))); - globName = strPrintf("%s.%s", forg->file, - symString(tfIdSym(exporter))); constNum = gen0NumProgs; - gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(symeType(syme), NULL), + gdecl = foamNewGDecl(FOAM_Clos, globName, gfjPCallDeclImport(symeType(syme), NULL), FOAM_GDecl_Import, FOAM_Proto_JavaConstructor); gnum = gen0AddGlobal(gdecl); @@ -222,21 +240,13 @@ gfjImportStaticCall(Syme syme) AInt fmtNum, innerConstNum, constNum, gnum; exporter = symeExporter(syme); - esyme = tfIdSyme(exporter); - forg = symeForeign(esyme); - fnName = strCopy(symeString(syme)); - globName = forg->file == NULL - ? strPrintf("%s.%s", - symString(tfIdSym(exporter)), - symeString(syme)) - : strPrintf("%s.%s.%s", forg->file, - symString(tfIdSym(exporter)), - symeString(syme)); + + globName = gfjDeclMethodNameForType(exporter, symeString(syme)); constNum = gen0NumProgs; - gdecl = foamNewGDecl(FOAM_Word, globName, gfjPCallDecl(symeType(syme), NULL), + gdecl = foamNewGDecl(FOAM_Clos, globName, gfjPCallDeclImport(symeType(syme), NULL), FOAM_GDecl_Import, FOAM_Proto_Java); gnum = gen0AddGlobal(gdecl); @@ -285,22 +295,31 @@ gfjProgAddParams(TForm tf) local FoamTag gfjPCallFoamType(TForm tf, AInt *pfmt) { + tf = tfIgnoreExceptions(tf); if (tfIsJavaImport(tf)) { if (pfmt != NULL) { - Syme syme = tfIdSyme(tf); - TForm exporter = symeExporter(syme); - Syme esyme = tfIdSyme(exporter); - ForeignOrigin forg = symeForeign(esyme); - *pfmt = gj0ClassDDecl(forg, symeString(esyme)); + *pfmt = gfjPCallFoamTypeDDecl(tf); + } + return FOAM_JavaObj; + } + else if (stabIsForeignExport(gen0State->stab, tf)) { + if (pfmt != NULL) { + ForeignOrigin forg = stabForeignExportLocation(gen0State->stab, tf); + *pfmt = gj0ClassDDecl(forg, symeString(tfIdSyme(tf))); } return FOAM_JavaObj; } else { Syme javaToSelf = tfGetDomImport(tf, symString(ssymTheFromJava), tfIsJavaDecoder); - TForm convTf = symeType(javaToSelf); - tfFollow(convTf); - return gen0Type(tfMapArg(convTf), pfmt); + if (javaToSelf != NULL) { + TForm convTf = symeType(javaToSelf); + tfFollow(convTf); + return gfjPCallFoamType(tfMapArg(convTf), pfmt); + } + else { + return gen0Type(tf, pfmt); + } } } @@ -308,29 +327,58 @@ gfjPCallFoamType(TForm tf, AInt *pfmt) local Foam gfjPCallFoamToJava(TForm tf, Foam foam) { + tf = tfIgnoreExceptions(tf); + if (tfIsJavaImport(tf)) { return foamNewCast(FOAM_JavaObj, foam); } + else if (stabIsForeignExport(gen0State->stab, tf)) { + return gfjPCallFoamToJavaForExport(tf, foam); + } else { - Syme selfToJava = tfGetDomImport(tf, + if (tfIsId(tf) && symeExtension(tfIdSyme(tf))) { + Syme syme = tfIdSyme(tf); + syme = symeExtensionFull(syme); + tf = tfFrSyme(stabFile(), syme); + } + + Syme selfToJava = tfGetDomImport(tf, symString(ssymTheToJava), tfIsJavaEncoder); - FoamTag type = gen0Type(tfMapRetN(symeType(selfToJava), 0), NULL); - Foam call; - call = gen0ExtendSyme(selfToJava); - call = foamNewCCall(type, call, foam, NULL); - - return call; + if (selfToJava != NULL) { + TForm convTf = symeType(selfToJava); + tfFollow(convTf); + TForm retTf = tfMapRetN(convTf, 0); + FoamTag type = gen0Type(retTf, NULL); + Foam call; + call = gen0ExtendSyme(selfToJava); + call = foamNewCCall(type, call, foam, NULL); + return gfjPCallFoamToJava(retTf, call); + } + else { + return foam; + } } } local Foam gfjPCallJavaToFoam(TForm tf, Foam foam) { + tf = tfIgnoreExceptions(tf); + if (tfIsJavaImport(tf)) { return foamNewCast(FOAM_Word, foam); } + else if (stabIsForeignExport(gen0State->stab, tf)) { + return gfjPCallJavaToFoamForExport(tf, foam); + } else { + if (tfIsId(tf) && symeExtension(tfIdSyme(tf))) { + Syme syme = tfIdSyme(tf); + syme = symeExtensionFull(syme); + tf = tfFrSyme(stabFile(), syme); + } + Syme javaToSelf = tfGetDomImport(tf, symString(ssymTheFromJava), tfIsJavaDecoder); @@ -342,9 +390,29 @@ gfjPCallJavaToFoam(TForm tf, Foam foam) } } +local Foam +gfjPCallJavaToFoamForExport(TForm tf, Foam foam) +{ + AInt gnum = gfjExportDecoder(tf); + return foamNewPCallOfList(FOAM_Proto_JavaMethod, FOAM_Word, + foamNewGlo(gnum), + listSingleton(Foam)(foam)); +} + +local Foam +gfjPCallFoamToJavaForExport(TForm tf, Foam foam) +{ + AInt gnum = gfjExportEncoder(tf); + return foamNewPCallOfList(FOAM_Proto_JavaConstructor, FOAM_JavaObj, + foamNewGlo(gnum), + listSingleton(Foam)(foam)); +} + + local AInt -gfjPCallDecl(TForm tf, TForm this) +gfjPCallDeclImport(TForm tf, TForm this) { + TForm retTf; FoamList decls; Foam ddecl, retdecl, exndecl; int i; @@ -363,8 +431,36 @@ gfjPCallDecl(TForm tf, TForm this) decls = listCons(Foam)(decl, decls); } - retdecl = gfjPCallDeclArg(tfMapRet(tf)); - exndecl = foamNewDecl(FOAM_NOp, strCopy(""), emptyFormatSlot); + retTf = tfMapRet(tf); + retdecl = gfjPCallDeclArg(gfjPCallRetBaseJavaType(retTf)); + exndecl = gfjPCallDeclExn(tfIsExcept(retTf) ? tfExceptExcept(retTf): NULL); + + ddecl = javaSigNew(retdecl, exndecl, listNReverse(Foam)(decls)); + + return gen0AddRealFormat(ddecl); + +} + +local AInt +gfjPCallDeclExport(TForm tf, FoamProtoTag protocol) +{ + FoamList decls; + Foam ddecl, retdecl, exndecl; + int i; + + decls = listNil(Foam); + + for (i=0; ifile == NULL ? strCopy(symeString(syme)) - : strPrintf("%s.%s", forg->file, symeString(syme)); + AInt fmt = gfjPCallFoamTypeDDecl(tf); + decl = foamNewDecl(FOAM_JavaObj, strCopy(id), fmt); + } + else if (stabIsForeignExport(gen0State->stab, tf)) { + assert(tfIsId(tf)); + ForeignOrigin forg = stabForeignExportLocation(gen0State->stab, tf); + Syme syme = abSyme(tfExpr(tf)); AInt fmt = gj0ClassDDecl(forg, symeString(syme)); - decl = foamNewDecl(FOAM_JavaObj, name, fmt); + decl = foamNewDecl(FOAM_JavaObj, strCopy(id), fmt); } else { FoamTag type; AInt fmt; type = gen0Type(tf, &fmt); - decl = foamNewDecl(type, strCopy(""), fmt); + decl = foamNewDecl(type, strCopy(id), fmt); } return decl; } -AInt +local Foam +gfjPCallDeclExn(TForm tf) +{ + Foam decl; + + if (tf == NULL) { + decl = foamNewDecl(FOAM_NOp, strCopy(""), emptyFormatSlot); + } + else { + // For the moment, everything maps to exception. + decl = foamNewDecl(FOAM_JavaObj, strCopy("exn"), + gj0ClassDDeclFull(strCopy("java.lang.Exception"))); + } + return decl; +} + +local AInt gfjPCallFoamTypeDDeclAbSyn(AbSyn); +local AInt gfjPCallFoamTypeDDeclId (AbSyn); + +local AInt +gfjPCallFoamTypeDDecl(TForm tf) +{ + return gfjPCallFoamTypeDDeclAbSyn(tfExpr(tf)); +} + +local AInt +gfjPCallFoamTypeDDeclAbSyn(AbSyn ab) +{ + AInt fmt; + if (abIsId(ab)) { + return gfjPCallFoamTypeDDeclId(ab); + } + else if (abIsApply(ab)) { + Syme opSyme = abSyme(ab->abApply.op); + ForeignOrigin forg = symeForeign(opSyme); + String name = gfjDeclClassName(symeString(opSyme), forg); + Foam opDecl = foamNewDecl(FOAM_JavaObj, name, int0); + FoamList args = listNil(Foam); + int i; + for (i=0; istab, abApplyArg(ab, i)); + AInt fmt; + FoamTag tag = gfjPCallFoamType(argTf, &fmt); + Foam decl = foamNewDecl(tag, aStrPrintf("%d", i), fmt); + args = listCons(Foam)(decl, args); + } + args = listNReverse(Foam)(args); + return gen0AddRealFormat(foamNewDDeclOfList(FOAM_DDecl_JavaClass, + listCons(Foam)(opDecl, args))); + } + else { + afprintf(dbOut, "%pAbSyn\n", ab); + bug("Unknown conversion"); + } +} + +local AInt +gfjPCallFoamTypeDDeclId(AbSyn id) +{ + TForm tf = abTForm(id) ? abTForm(id): tiGetTForm(gen0State->stab, id); + Syme syme = tfIdSyme(tf); + ForeignOrigin forg = symeForeign(syme); + String name = gfjDeclClassName(symeString(syme), forg); + AInt fmt = gj0ClassDDecl(forg, symeString(syme)); + + return fmt; +} + + +local AInt gj0ClassDDecl(ForeignOrigin origin, String clsName) { - String name = origin->file == NULL ? strCopy(clsName): strPrintf("%s.%s", origin->file, clsName); - Foam decl = foamNewDecl(FOAM_Word, name, int0); + String name = gfjDeclClassName(clsName, origin); + return gj0ClassDDeclFull(name); +} + +local AInt +gj0ClassDDeclFull(String fullyQualifiedName) +{ + Foam decl = foamNewDecl(FOAM_JavaObj, fullyQualifiedName, int0); return gen0AddRealFormat(foamNewDDecl(FOAM_DDecl_JavaClass, decl, NULL)); } + +local Foam +gj0ClassDecl(ForeignOrigin origin, String clsName) +{ + return foamNewDecl(FOAM_JavaObj, strCopy(clsName), gj0ClassDDecl(origin, clsName)); +} + +/* + * :: Export to java + */ + +local void gfjExportToJavaClass(AbSyn syme, ForeignOrigin forg); +local void gfjExportToJavaSyme(TForm tf, Syme syme, Foam clos); +local String gfjExportToJavaSymeMethodName(Syme syme); +local AInt gfjExportToJavaSymeProtocol(TForm exporter, Syme syme); +local Foam gfjExportToJavaFn(ForeignOrigin forg, String clssName, TForm tf, Syme syme); + +/* + * AbSyn: export Foo to Foreign Java("aldor.types") + * + * FOAM_Proto_JavaType: + * (DDecl Globals + * (GDecl Word "aldor.types.Foo" JavaMethod) + * ... + * (Def (Glo n) (Clos 0 (const blah)) + */ + +void +gfjExportToJava(AbSyn absyn, AbSyn dest) +{ + AbSyn name = abDefineeId(absyn); + Syme syme = abSyme(name); + TForm tf; + Foam decl; + FoamTag rtype; + AInt index; + ForeignOrigin forg = forgFrAbSyn(abApplyArg(dest, 0)); + + if (abIsId(absyn) && abSyme(absyn) != NULL) { + gfjExportToJavaClass(absyn, forg); + } + else { + bug("Unknown java export"); + } +} + +local void +gfjExportToJavaClass(AbSyn absyn, ForeignOrigin forg) +{ + TForm tf; + SymeList imports; + String clssName; + + if (!abIsId(absyn)) { + return; + } + + clssName = symString(abIdSym(absyn)); + + tf = tiGetTForm(stabFile(), absyn); + // Normal imports + imports = tfGetDomImports(tf); + while (imports != listNil(Syme)) { + Syme import = car(imports); + imports = cdr(imports); + if (tfJavaCanExport(gen0State->stab, tf, symeType(import))) { + Foam clos = gfjExportToJavaFn(forg, clssName, tf, import); + gfjExportToJavaSyme(tf, import, clos); + } + } + + TQualList cascades = tfGetDomCascades(tf); + // Qualified imports + while (cascades != listNil(TQual)) { + TQual tq = car(cascades); + + // Currently, ignore imports from qualified sources + // - more code, and we only want toString at the moment. + if (tqIsQualified(tq)) continue; + SymeList sl = tfGetDomImports(tqBase(tq)); + + while (sl != listNil(Syme)) { + Syme import = car(sl); + if (strEqual(symeString(import), "toString") + && tfJavaCanExport(gen0State->stab, tf, symeType(import))) { + Foam clos = gfjExportToJavaFn(forg, clssName, tf, import); + gfjExportToJavaSyme(tf, import, clos); + } + sl = cdr(sl); + } + cascades = cdr(cascades); + } +} + +local void +gfjExportToJavaSyme(TForm exporter, Syme syme, Foam clos) +{ + TForm tf = symeType(syme); + Foam decl; + AInt index; + + assert(syme); + + if (!tfIsMap(tf)) + return; + + /* Generate a java style function matching this symbol's type */ + ForeignOrigin forg = stabForeignExportLocation(gen0State->stab, exporter); + AInt protocol = gfjExportToJavaSymeProtocol(exporter, syme); + AInt declFmt = gfjPCallDeclExport(tf, protocol); + AInt rtype = gen0Type(tfMapRet(tf), NULL); + String methodName = gfjExportToJavaSymeMethodName(syme); + String foamName = gfjDeclMethodName(symeString(tfIdSyme(exporter)), forg, methodName); + + strFree(methodName); + decl = foamNewGDecl(FOAM_Clos, foamName, + declFmt, FOAM_GDecl_Export, protocol); + + foamGDeclSetRType(decl, rtype); + + index = gen0AddGlobal(decl); + gen0BuiltinExports = listCons(AInt)(index, gen0BuiltinExports); + gen0BuiltinExports = listCons(AInt)(int0, gen0BuiltinExports); + + gen0AddStmt(foamNewSet(foamNewGlo(index), clos), NULL); +} + +local AInt +gfjExportToJavaSymeProtocol(TForm exporter, Syme syme) +{ + TForm tf = symeType(syme); + assert(tfIsMap(tf)); + assert(symeIsImport(syme)); + + if (tfMapRetc(tf) == 1 + && symeId(syme) == ssymTheNew + && tfEqual(exporter, tfMapRetN(tf, 0))) { + return FOAM_Proto_JavaConstructor; + } + else if (tfMapArgc(tf) > 0 && tfEqual(exporter, tfMapArgN(tf, 0))) { + return FOAM_Proto_JavaMethod; + } + else { + return FOAM_Proto_Java; + } +} + + +local String +gfjExportToJavaSymeMethodName(Syme syme) +{ + TForm fullType = symeType(syme); + TForm type = tfMapArgc(fullType) == 0 ? tfNone() : tfMapRetN(fullType, 0); + String name = symeString(syme); + + if (name[strLength(name) - 1] == '?' + && tfEqual(type, tfBoolean)) { + name = strPrintf("is%c%s", toupper(name[0]), name+1); + name[strLength(name)-1] = '\0'; + } + if (strEqual(name, "=")) { + return strCopy("equals"); + } + + if (strEqual(name, "~=")) { + return strCopy("notEquals"); + } + + return strCopy(name); +} + +local Foam +gfjExportToJavaFn(ForeignOrigin forg, String clssName, TForm this, Syme syme) +{ + GenFoamState saved; + FoamList args; + TForm tf; + Foam prog, clos; + String fnName; + AInt index; + int i; + + AInt protocol = gfjExportToJavaSymeProtocol(this, syme); + + tf = symeType(syme); + fnName = aStrPrintf("%s-wrapper", symeString(syme)); + clos = gen0ProgClosEmpty(); + prog = gen0ProgInitEmpty(fnName, NULL); + index = car(gen0State->envFormatStack); + saved = gen0ProgSaveState(PT_ExFn); + + /* + * Generate a method which calls the syme, with args matching outer. + * Idea is that this can (probably) be inlined away. + */ + + for (i=0; istab, tfi)) { + foam = foamNewPCall(FOAM_Proto_JavaMethod, + FOAM_Word, + gen0CharArray("rep"), foamNewPar(i), NULL); + } + else { + foam = gfjPCallJavaToFoam(tfi, foamNewPar(i)); + } + args = listCons(Foam)(foam, args); + } + args = listNReverse(Foam)(args); + + TForm retTf = tfMapRet(tf); + FoamTag retType = gen0Type(retTf, NULL); + Foam ccall = foamNewCCallOfList(retType, gen0Syme(syme), args); + + Foam retVal; + AInt fmt; + FoamTag type; + + retTf = tfIgnoreExceptions(retTf); + if (protocol == FOAM_Proto_JavaConstructor) { + type = FOAM_Word; + fmt = emptyFormatSlot; + gen0AddStmt(foamNewReturn(ccall), NULL); + } + else if (tfIsNone(retTf)) { + gen0AddStmt(ccall, NULL); + type = FOAM_NOp; + fmt = emptyFormatSlot; + } + else if (tfEqual(retTf, this)) { + retVal = foamNewPCall(FOAM_Proto_JavaConstructor, FOAM_JavaObj, + gen0CharArray(gfjDeclClassName(clssName, forg)), + ccall, NULL); + Foam retDecl = gj0ClassDecl(forg, clssName); + type = retDecl->foamDecl.type; + fmt = retDecl->foamDecl.format; + gen0AddStmt(foamNewReturn(retVal), NULL); + } + else if (stabIsForeignExport(gen0State->stab, retTf)) { + ForeignOrigin forgRet = stabForeignExportLocation(gen0State->stab, retTf); + type = gfjPCallFoamType(retTf, &fmt); + + retVal = foamNewPCall(FOAM_Proto_JavaConstructor, FOAM_JavaObj, + gen0CharArray(gfjDeclClassName(symeString(tfIdSyme(retTf)), forgRet)), + ccall, NULL); + gen0AddStmt(foamNewReturn(retVal), NULL); + } + else { + Foam retVal = gfjPCallFoamToJava(retTf, ccall); + type = gfjPCallFoamType(retTf, &fmt); + gen0AddStmt(foamNewReturn(retVal), NULL); + } + + gen0ProgPushFormat(emptyFormatSlot); + + gen0ProgFiniEmpty(prog, type, fmt); + gen0AddLexLevels(prog, 1); + + foamOptInfo(prog) = inlInfoNew(NULL, prog, NULL, false); + gen0ProgRestoreState(saved); + + return clos; +} + +/* + * :: Utils + */ + +local String +gfjDeclMethodNameForType(TForm tf, String methodName) +{ + assert(tfIsApply(tf) || tfIsId(tf)); + + Syme esyme = tfIsApply(tf) + ? abSyme(tfExpr(tf)->abApply.op) + : tfIdSyme(tf); + ForeignOrigin forg = symeForeign(esyme); + + return gfjDeclMethodName(symeString(esyme), forg, methodName); +} + +local String +gfjDeclMethodName(String typeName, ForeignOrigin forg, String methodName) +{ + String name = forg->file + ? strPrintf("%s.%s.%s", forg->file, typeName, methodName) + : strPrintf("%s.%s", typeName, methodName); + return name; +} + +local String +gfjDeclClassNameForType(TForm tf) +{ + assert(tfIsApply(tf) || tfIsId(tf)); + + Syme esyme = tfIsApply(tf) + ? abSyme(tfExpr(tf)->abApply.op) + : tfIdSyme(tf); + ForeignOrigin forg = symeForeign(esyme); + + return gfjDeclClassName(symeString(esyme), forg); +} + +local String +gfjDeclClassName(String typeName, ForeignOrigin forg) +{ + String name = forg->file + ? strPrintf("%s.%s", forg->file, typeName) + : strCopy(typeName); + return name; +} + +local AInt +gfjExportDecoder(TForm tf) +{ + Foam gdecl; + AInt cached; + + cached = (AInt) tblElt(gfjExportDecoderForTForm, (TblKey) tf, (TblElt) -1); + if (cached != -1) { + return cached; + } + // Need a global that converts a java object to tf. + // This will be .rep() + String globName = gfjDeclMethodName(symeString(tfIdSyme(tf)), + stabForeignExportLocation(gen0State->stab, tf), + "rep");; + + Foam ddecl = javaSigNew(foamNewDecl(FOAM_Word, strCopy(""), emptyFormatSlot), + foamNewDecl(FOAM_NOp, strCopy(""), emptyFormatSlot), + listSingleton(Foam)(gfjPCallDeclArg(tf))); + AInt sigIdx = gen0AddRealFormat(ddecl); + gdecl = foamNewGDecl(FOAM_Clos, globName, sigIdx, + FOAM_GDecl_Import, FOAM_Proto_JavaMethod); + + AInt idx = gen0AddGlobal(gdecl); + + tblSetElt(gfjExportDecoderForTForm, (TblKey) tf, (TblElt) idx); + + return idx; +} + +local AInt +gfjExportEncoder(TForm tf) +{ + Foam gdecl; + AInt cached; + + cached = (AInt) tblElt(gfjExportEncoderForTForm, (TblKey) tf, (TblElt) -1); + if (cached != -1) { + return cached; + } + // Need a global that converts a tf to a java object + // This will be new (); + String globName = gfjDeclClassName(symeString(tfIdSyme(tf)), stabForeignExportLocation(gen0State->stab, tf)); + + Foam ddecl = javaSigNew(gfjPCallDeclArg(tf), + foamNewDecl(FOAM_NOp, strCopy(""), emptyFormatSlot), + listSingleton(Foam)(foamNewDecl(FOAM_Word, strCopy(""), emptyFormatSlot))); + AInt sigIdx = gen0AddRealFormat(ddecl); + + gdecl = foamNewGDecl(FOAM_Clos, globName, sigIdx, + FOAM_GDecl_Import, FOAM_Proto_JavaMethod); + + AInt idx = gen0AddGlobal(gdecl); + + tblSetElt(gfjExportEncoderForTForm, (TblKey) tf, (TblElt) idx); + + return idx; +} diff --git a/aldor/aldor/src/gf_java.h b/aldor/aldor/src/gf_java.h index 8a07f5346..95bd8d3ad 100644 --- a/aldor/aldor/src/gf_java.h +++ b/aldor/aldor/src/gf_java.h @@ -8,5 +8,9 @@ extern void gfjInit (void); extern void gfjFini (void); extern void gfjVarImport (Syme syme, Stab stab); +extern void gfjExportToJava (AbSyn what, AbSyn dest); + +extern void gfjClassFormatNumber(AbSyn); + #endif diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index 7566789e4..39eaf6eb1 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -33,7 +33,8 @@ local String gj0ClassDocumentation(Foam foam, String name); local JavaCodeList gj0CollectImports(JavaCode clss); local JavaCodeList gj0DDef(Foam foam); local JavaCode gj0Gen(Foam foam); -local JavaCode gj0Gen(Foam foam); +local JavaCode gj0Gen0(Foam foam); +local JavaCode gj0GenFmt(Foam foam, AInt fmt); local JavaCodeList gj0GenList(Foam *p, AInt n); local JavaCode gj0Def(Foam foam); local JavaCode gj0Default(Foam foam, String s); @@ -47,7 +48,10 @@ local JavaCode gj0Loc(Foam seq); local JavaCode gj0LocSet(Foam ref, Foam rhs); local JavaCode gj0Glo(Foam ref); local JavaCode gj0GloSet(Foam ref, Foam rhs); +local JavaCode gj0GloSetJava(Foam lhs, Foam rhs); local JavaCode gj0GloRegister(Foam lhs, Foam rhs); +local JavaCode gj0GloJavaId(AInt id); +local JavaCode gj0GloJavaMethodId(AInt id); local JavaCode gj0Nil(Foam foam); local JavaCode gj0Throw(Foam foam); @@ -123,10 +127,13 @@ local JavaCodeList gj0ProgExceptions(); local int gj0ProgModifiers(); local String gj0ProgMethodName(Foam var); local String gj0ProgFnName(int idx); +local void gj0ProgAddStub(FoamSig sigList); local void gj0ProgAddStubs(FoamSigList sigList); local JavaCodeList gj0ProgDeclarations(Foam ddecl, Foam body); +local String gj0JavaSigName(CString prefix, Foam fmt, int idx); local String gj0Name(CString prefix, Foam fmt, int idx); +local String gj0JavaSigName(CString prefix, Foam fmt, int idx); local JavaCode gj0ProgRetnType(Foam rhs); local JavaCode gj0TopConst(Foam lhs, Foam rhs); @@ -140,13 +147,12 @@ local JavaCode gj0TypeValueToRec(JavaCode value, AInt fmt); local FoamTag gj0FoamExprType(Foam foam); local FoamTag gj0FoamExprTypeWFmt(Foam foam, AInt *fmt); -local FoamSigList gj0CCallStubAdd(FoamSigList list, FoamSig sig); - local FoamSig gj0FoamSigFrCCall(Foam ccall); local JavaCodeList gj0CCallStubGen(FoamSigList sigs); local FoamSigList gj0CCallStubAdd(FoamSigList l, FoamSig sig); local JavaCode gj0CCallStubGenFrSig(FoamSig sig); local String gj0CCallStubName(FoamSig call); +local JavaCode gj0CCallSig(FoamSig sig, JavaCode op, JavaCodeList args); local JavaCode gj0SeqNode(JavaCodeList l); local Bool gj0IsSeqNode(JavaCode jc); @@ -163,6 +169,18 @@ local String gj0InitVar(AInt idx); local JavaCode gj0TypeFrJavaObj(Foam format); +local JavaCodeList gj0ExportClassCreateAll(void); +local JavaCode gj0ExportClassCreate(JavaCode className, AIntList decls); +local JavaCode gj0ExportClassName(String id); +local JavaCode gj0ExportMethodName(String id); +local JavaCodeList gj0ExportClassMethods(JavaCode className, AIntList decls); +local JavaCode gj0ExportClassMethod(AInt id); +local JavaCodeList gj0ExportClassInternalMethods(void); +local JavaCode gj0ExportClassInternalMethod(int i); +local JavaCodeList gj0ExportClassMemberVars(void); + +local JavaCodeList gj0ExportClassMethodParams(Foam sig, AInt proto); +local JavaCodeList gj0ExportClassMethodArgs(Foam sig, AInt proto); enum gjId { GJ_INVALID = -1, @@ -174,6 +192,7 @@ enum gjId { GJ_FoamEnv, GJ_FoamClass, GJ_FoamContext, + GJ_FoamHelper, GJ_FoamFn, GJ_FoamValue, @@ -181,6 +200,7 @@ enum gjId { GJ_FoamGlobals, GJ_Format, GJ_EnvRecord, + GJ_AldorObject, GJ_JavaException, GJ_FoamUserException, @@ -194,6 +214,8 @@ enum gjId { GJ_ContextVar, GJ_Main, + GJ_class, + GJ_Instance, GJ_LIMIT }; @@ -210,6 +232,7 @@ struct gjArgs { String name; Bool createMain; int lineWidth; + String pkg; }; typedef struct gjArgs GjArgs; @@ -234,7 +257,7 @@ struct gjContext { int multVarIdx; /* in codegen */ AInt mfmt; - AInt afmt; + AInt contextFmt; }; #define gjContextGlobals (gjContext->formats->foamDFmt.argv[globalsSlot]) @@ -253,34 +276,54 @@ Bool genJavaDebug = false; /* Functions... */ -JavaCode +JavaCodeList genJavaUnit(Foam foam, String name) { - JavaCodeList imps, code, mainImpl, interfaces, fmts, body; - JavaCode clss; + JavaCodeList imps, javaExportDecls, javaExportMeths, code, stubs; + JavaCodeList mainImpl, interfaces, fmts, body; + JavaCodeList exportedClassFiles; + JavaCode clss, mainFile; String className, comment; gjArgs->name = name; + gjArgs->pkg = "aldorcode"; gjInit(foam, name); className = gj0ClassName(foam, name); if (!jcIsLegalClassName(className)) { comsgFatal(NULL, ALDOR_F_BadJavaFileName, className); } + strFree(className); + code = gj0DDef(foam->foamUnit.defs); mainImpl = gj0ClassHeader(name); + javaExportDecls = gj0ExportClassMemberVars(); + javaExportMeths = gj0ExportClassInternalMethods(); + stubs = gj0CCallStubGen(gjContext->ccallStubSigList); + comment = gj0ClassDocumentation(foam, name); fmts = gj0FmtInits(); - body = listNConcat(JavaCode)(fmts, mainImpl); + + body = listNil(JavaCode); + body = listNConcat(JavaCode)(body, fmts); + body = listNConcat(JavaCode)(body, javaExportDecls); + body = listNConcat(JavaCode)(body, mainImpl); body = listNConcat(JavaCode)(body, code); + body = listNConcat(JavaCode)(body, javaExportMeths); + body = listNConcat(JavaCode)(body, stubs); interfaces = listSingleton(JavaCode)(gj0Id(GJ_FoamClass)); clss = jcClass(JCO_MOD_Public, comment, - jcId(className), NULL, interfaces, body); + jcId(gj0ClassName(foam, name)), NULL, interfaces, body); imps = gj0CollectImports(clss); - return jcFile(NULL, jcId(className), imps, clss); + + mainFile = jcFile(gjArgs->pkg == NULL ? NULL : jcId(strCopy(gjArgs->pkg)), + jcId(gj0ClassName(foam, name)), imps, clss); + exportedClassFiles = gj0ExportClassCreateAll(); + + return listCons(JavaCode)(mainFile, exportedClassFiles); } /* @@ -302,7 +345,7 @@ gj0CollectImports(JavaCode clss) JavaCodeList tmp = imps; while (tmp) { JavaCode id = car(tmp); - JavaCode stmt = jcStatement(jcImport(id));; + JavaCode stmt = jcStatement(jcImport(id)); ids = listCons(JavaCode)(stmt, ids); tmp = cdr(tmp); } @@ -326,6 +369,7 @@ gjInit(Foam foam, String name) gjContext->gloRegList = listNil(JavaCode); gjContext->fmtSet = intSetNew(foamArgc(gjContext->formats)); gjContext->mfmt = 0; + gjContext->contextFmt = 0; } local String @@ -337,7 +381,7 @@ gj0ClassName(Foam foam, String name) local String gj0ClassDocumentation(Foam foam, String name) { - return strPrintf("Generated by genjava - %s\n", name); + return strPrintf("Generated by genjava - %s", name); } @@ -357,14 +401,351 @@ gj0DDef(Foam foam) lst = listNReverse(JavaCode)(lst); - stubs = gj0CCallStubGen(gjContext->ccallStubSigList); - lst = listNConcat(JavaCode)(lst, stubs); - return lst; } +local JavaCodeList +gj0ExportClassCreateAll() +{ + Foam globals = gjContextGlobals; + AIntList exportedMethods = listNil(AInt); + AIntList list; + JavaCodeList allClasses = listNil(JavaCode); + int i; + Table tbl; + + tbl = tblNew((TblHashFun) jcoHash, (TblEqFun) jcoEqual); + for (i=0; ifoamDDecl.argv[i]; + if (foamGDeclIsExportOf(FOAM_Proto_Java, decl) + || foamGDeclIsExportOf(FOAM_Proto_JavaConstructor, decl) + || foamGDeclIsExportOf(FOAM_Proto_JavaMethod, decl)) { + exportedMethods = listCons(AInt)(i, exportedMethods); + } + } + + list = exportedMethods; + while (list != listNil(AInt)) { + JavaCode class; + AInt id = car(list); + Foam decl = globals->foamDDecl.argv[id]; + list = cdr(list); + class = gj0ExportClassName(decl->foamGDecl.id); + tblSetElt(tbl, class, listCons(AInt)(id, + tblElt(tbl, class, listNil(AInt)))); + } + + TableIterator it; + for (tblITER(it, tbl); tblMORE(it); tblSTEP(it)) { + JavaCode className = tblKEY(it); + AIntList ids = tblELT(it); + + JavaCode clss = gj0ExportClassCreate(className, ids); + allClasses = listCons(JavaCode)(clss, allClasses); + } + + return allClasses; +} + +local JavaCode +gj0ExportClassCreate(JavaCode classId, AIntList ids) +{ + /* + * class Foo { + * Object rep; + * Foo(Word w) { + * this.rep = w; + * } + * } + */ + JavaCodeList body, imports, methods; + JavaCode file, clss, constructor, rep; + JavaCode className = jcId(jcImportedIdName(classId)); + JavaCode repVar = jcId(strCopy("rep")); + + constructor = jcConstructor(JCO_MOD_Public, NULL, + jcoCopy(className), listNil(JavaCode), + listSingleton(JavaCode)(jcMemberDecl(0, + gj0TypeFrFmt(FOAM_Word, 0), + jcoCopy(repVar))), + listNil(JavaCode), + jcStatement(jcAssign(jcMemRef(jcThis(), jcoCopy(repVar)), + jcoCopy(repVar))) + ); + + rep = jcMethod(JCO_MOD_Public, NULL, gj0Id(GJ_FoamWord), jcId(strCopy("rep")), listNil(JavaCode), + listNil(JavaCode), listNil(JavaCode), + jcStatement(jcReturn(jcId(strCopy("rep"))))); + + body = listList(JavaCode)(3, + jcStatement(jcMemberDecl(JCO_MOD_Final|JCO_MOD_Private, + gj0TypeFrFmt(FOAM_Word, 0), + jcoCopy(repVar))), + constructor, + rep); + + methods = gj0ExportClassMethods(className, ids); + + body = listNConcat(JavaCode)(body, methods); + + clss = jcClass(JCO_MOD_Public|JCO_MOD_Final, + strCopy(".. ++ docco goes here"), + jcoCopy(className), + gj0Id(GJ_AldorObject), + listNil(JavaCode), body); + + imports = gj0CollectImports(clss); + + file = jcFile(jcId(strCopy(jcImportedIdPkg(classId))), + jcId(strCopy(jcImportedIdName(classId))), imports, clss); + + jcoFree(repVar); + jcoFree(classId); + + return file; +} + +local JavaCodeList +gj0ExportClassMethods(JavaCode className, AIntList decls) +{ + JavaCodeList methods = listNil(JavaCode); + int i = 0; + while (decls != listNil(AInt)) { + AInt id = car(decls); + Foam decl = gjContextGlobals->foamDDecl.argv[id]; + JavaCode method; + + method = gj0ExportClassMethod(id); + + methods = listCons(JavaCode)(method, methods); + decls = cdr(decls); + i++; + } + + return listNReverse(JavaCode)(methods); +} + +local JavaCode +gj0ExportClassMethod(AInt i) +{ + /* + * Generate this for "foo: (A, B) -> C + * public static C foo(A a, B b) { + * Word ret = file.fooConst(a, b); + * return "something"(ret) + * } + */ + + Foam decl = gjContextGlobals->foamDDecl.argv[i]; + + Foam sig = gjContext->formats->foamDFmt.argv[decl->foamGDecl.format]; + AInt protocol = decl->foamGDecl.protocol; + JavaCode retType = gj0Type(javaSigRet(sig)); + + JavaCodeList params = gj0ExportClassMethodParams(sig, protocol); + + JavaCodeList args = gj0ExportClassMethodArgs(sig, protocol); + JavaCode className = gj0ExportClassName(decl->foamDecl.id); + JavaCode methodName = gj0ExportMethodName(decl->foamDecl.id); + JavaCode instance = jcApplyMethod(gj0Id(GJ_FoamHelper), gj0Id(GJ_Instance), + listSingleton(JavaCode)(jcMemRef(jcImportedId(strCopy(gjArgs->pkg), + strCopy(gjArgs->name)), + gj0Id(GJ_class)))); + JavaCode fnCall = jcApplyMethod(instance, gj0GloJavaMethodId(i), args); + JavaCode body; + AInt flgs; + + switch (protocol) { + case FOAM_Proto_JavaMethod: + flgs = JCO_MOD_Public|JCO_MOD_Final; + body = (javaSigRet(sig)->foamDecl.type == FOAM_NOp) + ? jcStatement(fnCall) + : jcNLSeqV(1, jcStatement(jcReturn(fnCall))); + return jcMethod(flgs, strCopy("Method wrapper for... "), + retType, methodName, listNil(JavaCode), + params, listNil(JavaCode), body); + break; + case FOAM_Proto_Java: + flgs = JCO_MOD_Public|JCO_MOD_Static; + body = (javaSigRet(sig)->foamDecl.type == FOAM_NOp) + ? jcStatement(fnCall) + : jcNLSeqV(1, jcStatement(jcReturn(fnCall))); + return jcMethod(flgs, strCopy("Method wrapper for... "), + retType, methodName, listNil(JavaCode), + params, listNil(JavaCode), body); + break; + case FOAM_Proto_JavaConstructor: { + flgs = JCO_MOD_Public; + body = jcNLSeqV(1, jcStatement(jcApplyV(jcThis(), 1, fnCall))); + return jcConstructor(flgs, strCopy("Method wrapper for... "), + className, listNil(JavaCode), + params, listNil(JavaCode), body); + } + default: + bug("Unknown java protocol for export"); + break; + } +} + +local JavaCode +gj0ExportClassName(String id) +{ + JavaCode fullName = jcImportedStaticIdFrString(id); + JavaCode className = jcImportedId(strCopy(jcImportedStaticIdPkg(fullName)), + strCopy(jcImportedStaticIdClass(fullName))); + + jcoFree(fullName); + + return className; +} + +local JavaCode +gj0ExportMethodName(String id) +{ + JavaCode fullName = jcImportedStaticIdFrString(id); + String methodName = jcImportedStaticIdName(fullName); + + jcoFree(fullName); + + return jcId(gj0NameFrString(methodName)); +} + +local JavaCodeList +gj0ExportClassMemberVars() +{ + Foam globals = gjContextGlobals; + JavaCodeList vars = listNil(JavaCode); + int i; + + for (i=0; ifoamDDecl.argv[i]; + if (foamGDeclIsExportOf(FOAM_Proto_Java, decl) + || foamGDeclIsExportOf(FOAM_Proto_JavaConstructor, decl) + || foamGDeclIsExportOf(FOAM_Proto_JavaMethod, decl)) { + JavaCode decl = jcMemberDecl(JCO_MOD_Private, gj0Id(GJ_FoamClos), gj0GloJavaId(i)); + vars = listCons(JavaCode)(jcStatement(decl), vars); + } + } + return listNReverse(JavaCode)(vars); +} + +local JavaCodeList +gj0ExportClassInternalMethods() +{ + JavaCodeList methods = listNil(JavaCode); + int i; + + for (i=0; ifoamDDecl.argv[i]; + if (foamGDeclIsExportOf(FOAM_Proto_Java, decl) + || foamGDeclIsExportOf(FOAM_Proto_JavaConstructor, decl) + || foamGDeclIsExportOf(FOAM_Proto_JavaMethod, decl)) { + JavaCode method = gj0ExportClassInternalMethod(i); + methods = listCons(JavaCode)(method, methods); + } + } + gj0ProgAddStubs(gjContext->progSigList); + + return listNReverse(JavaCode)(methods); +} + +local JavaCode +gj0ExportClassInternalMethod(int index) +{ + Foam decl = gjContextGlobals->foamDDecl.argv[index]; + /* + * Call the global containing the exported method. + * The code is a top level method, called as a static java method + * hence args are given by FOAM_Proto_Java + */ + AInt protocol = decl->foamGDecl.protocol; + Foam sig = gjContext->formats->foamDFmt.argv[decl->foamGDecl.format]; + JavaCodeList params = gj0ExportClassMethodParams(sig, FOAM_Proto_Java); + JavaCodeList args = gj0ExportClassMethodArgs(sig, FOAM_Proto_Java); + + FoamSig foamSig = javaSigCreateFoamSig(sig); + JavaCode base = gj0CCallSig(foamSig, gj0GloJavaId(index), args); + JavaCode body; + if (foamSig->retType == FOAM_NOp) { + body = jcStatement(base); + } + else if (protocol == FOAM_Proto_JavaConstructor) { + body = jcStatement(jcReturn(base)); + } + else { + JavaCode call = jcCast(gj0Type(javaSigRet(sig)), base); + body = jcStatement(jcReturn(call)); + } + JavaCode method = jcMethod(JCO_MOD_Public, 0, + gj0Type(javaSigRet(sig)), + gj0GloJavaMethodId(index), + listNil(JavaCode), + params, + listNil(JavaCode), + body); + gj0ProgAddStub(foamSig); + + return method; +} + +local JavaCodeList +gj0ExportClassMethodParams(Foam sig, AInt proto) +{ + JavaCodeList params = listNil(JavaCode); + int offs = proto == FOAM_Proto_JavaMethod ? 1 : 0; + for (int i=0; icontextFmt; + gjContext->contextFmt = fmt; + jc = gj0Gen0(foam); + gjContext->contextFmt = oldFmt; + return jc; +} + +local JavaCode +gj0Gen0(Foam foam) { switch (foamTag(foam)) { case FOAM_NOp: @@ -755,7 +1136,7 @@ gj0ProgDeclarations(Foam ddecl, Foam body) for (tblITER(it, tbl); tblMORE(it); tblSTEP(it)) { JavaCode type = tblKEY(it); JavaCodeList vars = listNReverse(JavaCode)(tblELT(it)); - JavaCode decl = jcParamDecl(0, type, jcCommaSeq(vars)); + JavaCode decl = jcLocalDecl(0, type, jcCommaSeq(vars)); decls = listCons(JavaCode)(jcStatement(decl), decls); } @@ -858,6 +1239,12 @@ gj0ProgAddStubs(FoamSigList sigList) } } +local void +gj0ProgAddStub(FoamSig sig) +{ + gjContext->ccallStubSigList = gj0CCallStubAdd(gjContext->ccallStubSigList, sig); +} + local JavaCodeList gj0ProgEnvInitCreate(Foam f) { @@ -1282,7 +1669,18 @@ local JavaCode gj0TypeFrJavaObj(Foam format) { String txt = format->foamDDecl.argv[0]->foamDecl.id; - return jcImportedIdFrString(txt); + if (foamDDeclArgc(format) == 1) { + return jcImportedIdFrString(txt); + } + else { + JavaCodeList genArgs = listNil(JavaCode); + int i; + for (i=1; ifoamDDecl.argv[i]), genArgs); + } + return jcGenericId(jcImportedIdFrString(txt), + listNReverse(JavaCode)(genArgs)); + } } @@ -1326,6 +1724,11 @@ gj0TypeValueToObj(JavaCode val, FoamTag type, AInt fmt) return jcApplyMethodV(val, jcId(strCopy("toPtr")), 0); case FOAM_Env: return jcApplyMethodV(val, jcId(strCopy("toEnv")), 0); + case FOAM_JavaObj: { + // maybe cast to fmt + JavaCode jtype = gj0TypeFrFmt(type, fmt); + return jcApplyMethodV(val, jcGenericMethodNameV(jcId(strCopy("toJavaObj")), 1, jtype), 0); + } default: return jcCast(jcSpaceSeqV(2, gj0Id(GJ_FoamValue), jcComment(strCopy(foamStr(type)))), @@ -1412,9 +1815,10 @@ gj0TypeObjToValue(JavaCode val, FoamTag type, AInt fmt) jcId(strCopy("fromByte")), 1, val); case FOAM_JavaObj: - return jcSpaceSeqV(2, - jcComment(strPrintf("asWord %d %d", type, fmt)), - val); + return jcApplyMethodV(jcMemRef(gj0Id(GJ_FoamValue), + jcId(strCopy("U"))), + jcId(strCopy("fromJavaObj")), 1, + val); case FOAM_Env: case FOAM_Clos: case FOAM_Rec: @@ -1427,6 +1831,7 @@ gj0TypeObjToValue(JavaCode val, FoamTag type, AInt fmt) } + local JavaCode gj0Set(Foam lhs, Foam rhs) { @@ -1531,18 +1936,56 @@ gj0GloSet(Foam lhs, Foam rhs) String id; decl = gjContextGlobal(lhs->foamGlo.index); - id = decl->foamDecl.id; + if (foamGDeclIsExportOf(FOAM_Proto_Java, decl) + || foamGDeclIsExportOf(FOAM_Proto_JavaConstructor, decl) + || foamGDeclIsExportOf(FOAM_Proto_JavaMethod, decl)) { + jc = gj0GloSetJava(lhs, rhs); + } + else { + id = decl->foamDecl.id; - jc = gj0TypeObjToValue(gj0SetGenRhs(rhs, decl), + jc = gj0TypeObjToValue(gj0SetGenRhs(rhs, decl), decl->foamDecl.type, decl->foamDecl.format); - jc = jcApplyMethodV(gj0Id(GJ_FoamGlobals), - jcId(strCopy("setGlobal")), - 2, jcLiteralString(strCopy(id)), jc); + jc = jcApplyMethodV(gj0Id(GJ_FoamGlobals), + jcId(strCopy("setGlobal")), + 2, jcLiteralString(strCopy(id)), jc); + } return jc; } +local JavaCode +gj0GloSetJava(Foam lhs, Foam rhs) +{ + JavaCode member = gj0GloJavaId(lhs->foamGlo.index); + Foam decl = gjContextGlobal(lhs->foamGlo.index); + + return jcAssign(jcMemRef(jcThis(), member), + gj0SetGenRhs(rhs, decl)); +} + +local JavaCode +gj0GloJavaId(AInt id) +{ + Foam decl = gjContextGlobal(id); + + return jcId(gj0Name("M", gjContextGlobals, id)); +} + +local JavaCode +gj0GloJavaMethodId(AInt id) +{ + Foam decl = gjContextGlobal(id); + JavaCode methodName = jcImportedStaticIdFrString(decl->foamGDecl.id); + String name = gj0NameFrString(jcImportedStaticIdName(methodName)); + JavaCode jc = jcId(strPrintf("_%d_%s", id, name)); + jcoFree(methodName); + return jc; +} + + + /* * :: Control flow * @@ -1589,8 +2032,11 @@ local void gj0SeqSelect2(GjSeqStore store, Foam foam); local void gj0SeqGenDefault(GjSeqStore store, Foam foam); local void gj0SeqSelectMulti(GjSeqStore store, Foam foam); local void gj0SeqIf(GjSeqStore store, Foam foam); +local void gj0SeqSet(GjSeqStore store, Foam foam); local void gj0SeqBCall(GjSeqStore store, Foam foam); +local void gj0SeqPCall(GjSeqStore store, Foam foam); local void gj0SeqValues(GjSeqStore store, Foam foam); +local void gj0SeqThrow(GjSeqStore store, Foam foam); local JavaCode gj0SeqSwitchId(); @@ -1636,13 +2082,21 @@ gj0Seq(Foam seq) local JavaCode gj0Return(Foam r) { - if (foamTag(r->foamReturn.value) == FOAM_Values) - return gj0ValuesReturn(r->foamReturn.value); + JavaCode jc; - if (gjContext->prog->foamProg.retType == FOAM_Arr) - return gj0ReturnArray(r->foamReturn.value); + gjContext->contextFmt = gjContext->prog->foamProg.format; + if (foamTag(r->foamReturn.value) == FOAM_Values) { + jc = gj0ValuesReturn(r->foamReturn.value); + } + else if (gjContext->prog->foamProg.retType == FOAM_Arr) { + jc = gj0ReturnArray(r->foamReturn.value); + } + else { + jc = jcReturn(gj0Gen0(r->foamReturn.value)); + } - return jcReturn(gj0Gen(r->foamReturn.value)); + gjContext->contextFmt = -1; + return jc; } local JavaCode @@ -1654,9 +2108,9 @@ gj0ReturnArray(Foam foam) tag = gj0FoamExprTypeWFmt(foam, &fmt); if (tag == FOAM_Arr || fmt == gjContext->prog->foamProg.format) - return jcReturn(gj0Gen(foam)); + return jcReturn(gj0Gen0(foam)); - v = jcCast(gj0TypeFrFmt(tag, fmt), gj0Gen(foam)); + v = jcCast(gj0TypeFrFmt(tag, fmt), gj0Gen0(foam)); return jcReturn(v); } @@ -1680,6 +2134,12 @@ gj0SeqGen(GjSeqStore seqs, Foam foam) case FOAM_BCall: gj0SeqBCall(seqs, foam); break; + case FOAM_Throw: + gj0SeqThrow(seqs, foam); + break; + case FOAM_PCall: + gj0SeqPCall(seqs, foam); + break; case FOAM_Cast: gj0SeqGen(seqs, foam->foamCast.expr); break; @@ -1690,6 +2150,10 @@ gj0SeqGen(GjSeqStore seqs, Foam foam) case FOAM_Values: gj0SeqValues(seqs, foam); break; + case FOAM_Set: + case FOAM_Def: + gj0SeqSet(seqs, foam); + break; default: gj0SeqGenDefault(seqs, foam); break; @@ -1811,6 +2275,47 @@ gj0SeqBCall(GjSeqStore seqs, Foam foam) gj0SeqStoreAddHalt(seqs, jc); } +local void +gj0SeqPCall(GjSeqStore seqs, Foam foam) +{ + JavaCode jc; + if (gj0PCallThrowsException(foam)) { + gj0SeqStoreAddStmt(seqs, gj0PCallCatchException(gj0Gen(foam))); + return; + } + else { + jc = jcStatement(gj0Gen(foam)); + gj0SeqStoreAddStmt(seqs, jc); + } +} + +local void +gj0SeqThrow(GjSeqStore seqs, Foam foam) +{ + JavaCode jc = jcStatement(gj0Gen(foam)); + + gj0SeqStoreAddHalt(seqs, jc); +} + + +local void +gj0SeqSet(GjSeqStore seqs, Foam foam) +{ + JavaCode code; + + code = gj0Gen(foam); + + if (!gj0PCallThrowsException(foam->foamSet.rhs)) { + gj0SeqGenDefault(seqs, foam); + } + else { + code = gj0PCallCatchException(code); + gj0SeqStoreAddStmt(seqs, code); + } + +} + + local void gj0SeqValues(GjSeqStore store, Foam foam) { @@ -2034,12 +2539,10 @@ gj0SeqBucketIsHalt(GjSeqBucket bucket) local JavaCode gj0Throw(Foam foam) { - SExpr sx = foamToSExpr(foam); - String s = sxiFormat(sx); - - sxiFree(sx); + JavaCode tag = gj0Gen(foam->foamThrow.tag); + JavaCode val = gj0Gen(foam->foamThrow.val); - return jcComment(s); + return jcThrow(jcConstructV(gj0Id(GJ_FoamUserException), 2, tag, val)); } @@ -2105,13 +2608,21 @@ gj0SeqIsBCallHalt(Foam f) local JavaCode gj0CCall(Foam call) +{ + FoamSig sig = gj0FoamSigFrCCall(call); + JavaCodeList args = gj0GenList(call->foamCCall.argv, foamCCallArgc(call)); + JavaCode res = gj0CCallSig(sig, gj0Gen(call->foamCCall.op), args); + gjContext->progSigList = gj0CCallStubAdd(gjContext->progSigList, sig); + return res; +} + +local JavaCode +gj0CCallSig(FoamSig sig, JavaCode op, JavaCodeList args) { JavaCode code; - FoamSig sig = gj0FoamSigFrCCall(call); String id = gj0CCallStubName(sig); - gjContext->progSigList = gj0CCallStubAdd(gjContext->progSigList, sig); - code = jcApply(jcId(id), gj0GenList(&call->foamCCall.op, foamArgc(call)-1)); + code = jcApply(jcId(id), listCons(JavaCode)(op, args)); return code; } @@ -2149,6 +2660,8 @@ gj0TypeAbbrev(FoamTag tag) return "S"; case FOAM_DFlo: return "D"; + case FOAM_JavaObj: + return "J"; default: return "?"; } @@ -2478,13 +2991,7 @@ local JavaCode gj0ArrChar(Foam foam) { int i, arrSize; - String str; - - arrSize = foamArgc(foam); - str = strAlloc(arrSize); - for (i = 0; i < arrSize - 1; i++) - str[i] = foam->foamArr.eltv[i]; - str[i] = '\0'; + String str = foamArrToString(foam); return jcApplyMethodV(jcLiteralStringWithTerminalChar(str), jcId(strCopy("toCharArray")), 0); } @@ -3129,7 +3636,7 @@ local JavaCode gj0CastObjToPtr(JavaCode jc, FoamTag type, AInt fmt); local JavaCode gj0Cast(Foam foam) { - return gj0CastFmt(foam, emptyFormatSlot); + return gj0CastFmt(foam, gjContext->contextFmt == -1 ? emptyFormatSlot : gjContext->contextFmt); } local JavaCode @@ -3203,10 +3710,14 @@ gj0CastWordToObj(JavaCode jc, FoamTag type, AInt fmt) return jcApplyMethodV(jcMemRef(gj0Id(GJ_FoamWord), jcId(strCopy("U"))), jcId(strCopy("toArray")), 1, jc); - case FOAM_JavaObj: + case FOAM_JavaObj: { + // maybe cast to fmt + JavaCode jtype = gj0TypeFrFmt(type, fmt); return jcApplyMethodV(jcMemRef(gj0Id(GJ_FoamWord), jcId(strCopy("U"))), - jcId(strCopy("toJavaObj")), 1, jc); + jcGenericMethodNameV(jcId(strCopy("toJavaObj")), 1, jtype), + 1, jc); + } default: return jcCast(gj0TypeFrFmt(type, fmt), jc); } @@ -3537,6 +4048,7 @@ struct gjIdInfo gjIdInfo[] = { {GJ_FoamEnv, "foamj", "Env"}, {GJ_FoamClass, "foamj", "FoamClass"}, {GJ_FoamContext,"foamj", "FoamContext"}, + {GJ_FoamHelper, "foamj", "FoamHelper"}, {GJ_FoamFn, "foamj", "Fn"}, @@ -3545,6 +4057,7 @@ struct gjIdInfo gjIdInfo[] = { {GJ_FoamGlobals,"foamj", "Globals"}, {GJ_Format, "foamj", "Format"}, {GJ_EnvRecord, "foamj", "EnvRecord"}, + {GJ_AldorObject,"foamj", "AldorObject"}, {GJ_JavaException, "foamj", "JavaException"}, {GJ_FoamUserException, "foamj", "FoamUserException"}, @@ -3558,6 +4071,8 @@ struct gjIdInfo gjIdInfo[] = { {GJ_ContextVar, 0, "ctxt"}, {GJ_Main, 0, "main"}, + {GJ_class, 0, "class"}, + {GJ_Instance, 0, "instanceForClass"}, {GJ_INVALID, 0, 0 }, }; @@ -3590,8 +4105,11 @@ gj0Id(GjId id) local JavaCode gj0PCallOther(Foam foam); local JavaCode gj0PCallJavaMethod(Foam foam); local JavaCode gj0PCallJavaConstructor(Foam foam); +local JavaCode gj0PCallJavaConstructorGlo(Foam foam); local JavaCode gj0PCallJavaStatic(Foam foam); local JavaCodeList gj0PCallCastArgs(Foam op, JavaCodeList args); +local JavaCodeList gj0PCallGenArgs(Foam op, int offs, Foam *argv); + local JavaCode gj0PCall(Foam foam) @@ -3631,31 +4149,54 @@ local JavaCode gj0PCallJavaMethod(Foam foam) { JavaCodeList args; - JavaCode target; - Foam decl, op; + JavaCode result, target; + Foam decl, op, sig; String type, opName, pkg; op = foam->foamPCall.op; - assert(foamTag(op) == FOAM_Glo); - assert(foamPCallArgc(foam) > 0); - decl = gjContextGlobal(op->foamGlo.index); - args = gj0GenList(foam->foamPCall.argv+1, foamPCallArgc(foam)-1); - target = gj0Gen(foam->foamPCall.argv[0]); + if (foamTag(op) == FOAM_Arr) { + return jcApplyMethod(gj0Gen(foam->foamPCall.argv[0]), jcId(strCopy("rep")), + listNil(JavaCode)); + } + else { + decl = gjContextGlobal(op->foamGlo.index); + sig = gjContext->formats->foamDFmt.argv[decl->foamGDecl.format]; - strSplitLast(strCopy(decl->foamGDecl.id), '.', &type, &opName); - assert(type != 0); - strSplitLast(type, '.', &pkg, &type); + target = gj0GenFmt(foam->foamPCall.argv[0], javaSigArgN(sig, 0)->foamDecl.format); + args = gj0PCallGenArgs(op, 1, foam->foamPCall.argv); - return jcApplyMethod(jcCast(jcImportedId(pkg, type), target), - jcId(opName), - gj0PCallCastArgs(op, args)); + strSplitLast(strCopy(decl->foamGDecl.id), '.', &type, &opName); + assert(type != 0); + strSplitLast(type, '.', &pkg, &type); + + return jcApplyMethod(jcCast(jcImportedId(pkg, type), target), + jcId(opName), + foamTag(op) != FOAM_Glo ? args : gj0PCallCastArgs(op, args)); + } } local JavaCode gj0PCallJavaConstructor(Foam foam) +{ + Foam op = foam->foamPCall.op; + if (foamTag(op) == FOAM_Glo) { + return gj0PCallJavaConstructorGlo(foam); + } + else if (foamTag(op) == FOAM_Arr) { + JavaCodeList args = gj0GenList(foam->foamPCall.argv, foamPCallArgc(foam)); + return jcConstruct(jcImportedIdFrString(foamArrToString(op)), args); + } + else { + bug("unknown pcall"); + return NULL; + } +} + +local JavaCode +gj0PCallJavaConstructorGlo(Foam foam) { JavaCodeList args; Foam decl, op; @@ -3663,12 +4204,11 @@ gj0PCallJavaConstructor(Foam foam) op = foam->foamPCall.op; - assert(foamTag(op) == FOAM_Glo); - assert(foamPCallArgc(foam) > 1); decl = gjContextGlobal(op->foamGlo.index); - args = gj0GenList(foam->foamPCall.argv, foamPCallArgc(foam)); + //args = gj0GenList(foam->foamPCall.argv, foamPCallArgc(foam)); + args = gj0PCallGenArgs(op, 0, foam->foamPCall.argv); strSplitLast(strCopy(decl->foamGDecl.id), '.', &pkg, &type); @@ -3688,13 +4228,13 @@ gj0PCallJavaStatic(Foam foam) assert(foamTag(op) == FOAM_Glo); decl = gjContextGlobal(op->foamGlo.index); - args = gj0GenList(foam->foamPCall.argv, foamPCallArgc(foam)); + //args = gj0GenList(foam->foamPCall.argv, foamPCallArgc(foam)); + args = gj0PCallGenArgs(op, 0, foam->foamPCall.argv); strSplitLast(strCopy(decl->foamGDecl.id), '.', &type, &id); JavaCode typeId = jcImportedIdFrString(type); - return jcApply(jcMemRef(typeId, jcId(id)), - gj0PCallCastArgs(op, args)); + return jcApply(jcMemRef(typeId, jcId(id)), gj0PCallCastArgs(op, args)); } local JavaCodeList @@ -3724,6 +4264,19 @@ gj0PCallCastArgs(Foam op, JavaCodeList argsIn) return argsIn; } +local JavaCodeList +gj0PCallGenArgs(Foam op, int offs, Foam *argv) +{ + Foam glo = gjContextGlobals->foamDDecl.argv[op->foamGlo.index]; + Foam ddecl = gjContext->formats->foamDFmt.argv[glo->foamGDecl.format]; + JavaCodeList args = listNil(JavaCode); + int i; + + for (i=offs; ifoamDecl.format), args); + } + return listNReverse(JavaCode)(args); +} local Bool @@ -3783,6 +4336,7 @@ enum gj_BCallMethod { GJ_NegConst, GJ_Cast, GJ_Exception, + GJ_NotImpl }; @@ -4371,6 +4925,14 @@ gj0NameInit() } } +local String +gj0JavaSigName(CString prefix, Foam fmt, int idx) +{ + Foam decl = javaSigArgN(fmt, idx); + assert(idx < javaSigArgc(fmt)); + return aStrPrintf("_%d_%s", idx, gj0NameFrString(decl->foamDecl.id)); +} + local String gj0Name(CString prefix, Foam fmt, int idx) { diff --git a/aldor/aldor/src/java/genjava.h b/aldor/aldor/src/java/genjava.h index 21a0399d8..6e4a95822 100644 --- a/aldor/aldor/src/java/genjava.h +++ b/aldor/aldor/src/java/genjava.h @@ -3,7 +3,7 @@ #include "javacode.h" -JavaCode genJavaUnit(Foam foam, String name); +JavaCodeList genJavaUnit(Foam foam, String name); void gjGenSetMain(Bool flg); extern Bool genJavaDebug; diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index 32ef1c62b..c8978232f 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -28,6 +28,7 @@ enum jc_clss_enum { JCO_CLSS_Method, JCO_CLSS_Declaration, JCO_CLSS_Statement, + JCO_CLSS_File, JCO_CLSS_If, JCO_CLSS_While, @@ -214,6 +215,7 @@ local JWriteFn jcMethodPrint; local JWriteFn jcParenPrint; local JWriteFn jcSequencePrint; local JWriteFn jcStatementPrint; +local JWriteFn jcFilePrint; local JWriteFn jcStringPrint; local JWriteFn jcUnaryOpPrint; @@ -286,6 +288,7 @@ static struct jclss jcClss[] = { { JCO_CLSS_Method, jcMethodPrint, jcNodeSExpr, "method", 0}, { JCO_CLSS_Declaration,jcDeclarationPrint, jcNodeSExpr,"declaration", 0}, { JCO_CLSS_Statement, jcStatementPrint, jcNodeSExpr, "statement", 0}, + { JCO_CLSS_File, jcFilePrint, jcNodeSExpr, "file", 0}, { JCO_CLSS_If, jcBlockHdrPrint, jcNodeSExpr, "if", "if"}, { JCO_CLSS_While, jcBlockHdrPrint, jcNodeSExpr, "while", "while"}, @@ -751,7 +754,6 @@ jcImportedStaticIdClass(JavaCode importedId) return car(jcoImportPath(importedId)); } - String jcImportedStaticIdPkg(JavaCode importedId) { @@ -1315,7 +1317,6 @@ jcCondPrint(JavaCodePContext ctxt, JavaCode code) jc0PrintWithParens(ctxt, thisClss, arg3); } - /* * :: Statements */ @@ -1593,11 +1594,46 @@ jcBlockHdrIndent(JavaCode code) JavaCode jcFile(JavaCode pkg, JavaCode name, JavaCodeList imports, JavaCode body) { - /* FIXME: Very temporary */ - listNConcat(JavaCode)(imports, listSingleton(JavaCode)(body)); - return jcNLSeq(imports); + JavaCodeList whole; + JavaCode file; + + whole = listNil(JavaCode); + if (pkg != NULL) { + whole = listSingleton(JavaCode)(jcStatement(jcPackage(jcoCopy(pkg)))); + } + whole = listNConcat(JavaCode)(whole, imports); + whole = listNConcat(JavaCode)(whole, listSingleton(JavaCode)(body)); + + file = jcoNew(jc0ClassObj(JCO_CLSS_File), + 3, name, jcoCopy(pkg), jcNLSeq(whole)); + + jcoFree(pkg); + + return file; +} + +void +jcFilePrint(JavaCodePContext ctxt, JavaCode code) +{ + jcoWrite(ctxt, jcoArgv(code)[2]); } +String +jcFileClassName(JavaCode file) +{ + return jcIdName(jcoArgv(file)[0]); +} + +String +jcFilePackageName(JavaCode file) +{ + if (jcoArgv(file)[1] == NULL) { + return ""; + } + else { + return jcIdName(jcoArgv(file)[1]); + } +} /* * :: Generic operations diff --git a/aldor/aldor/src/java/javacode.h b/aldor/aldor/src/java/javacode.h index c59721169..ada937d8a 100644 --- a/aldor/aldor/src/java/javacode.h +++ b/aldor/aldor/src/java/javacode.h @@ -165,6 +165,8 @@ extern JavaCode jcConditional(JavaCode test, JavaCode c1, JavaCode c2); * :: Utility methods */ extern JavaCodeList jcCollectImports(JavaCode clss); +extern String jcFileClassName(JavaCode file); +extern String jcFilePackageName(JavaCode file); extern SExpr jcNodeSExpr(JavaCode code); extern void jcNodePrint(JavaCodePContext ctxt, JavaCode code); diff --git a/aldor/aldor/src/java/main.c b/aldor/aldor/src/java/main.c index f6f9b55c6..e7b4bb8b5 100644 --- a/aldor/aldor/src/java/main.c +++ b/aldor/aldor/src/java/main.c @@ -49,7 +49,7 @@ generate(String name) JavaCodePContext ctxt; lastElt[strlen(lastElt)-3] = '\0'; - jc = genJavaUnit(f, lastElt); + jc = genJavaUnit(f, lastElt)->first; foamFree(f); printf("/*...\n"); diff --git a/aldor/aldor/src/scobind.c b/aldor/aldor/src/scobind.c index 736bec2af..4c54e3934 100644 --- a/aldor/aldor/src/scobind.c +++ b/aldor/aldor/src/scobind.c @@ -2396,11 +2396,18 @@ scobindForeignExport(AbSyn ab) { AbSyn dest = ab->abForeignExport.dest; AbSyn what = ab->abForeignExport.what; + ForeignOrigin forg = forgFrAbSyn(dest->abApply.argv[0]); scoIsInExport = true; - scobindLOF(what, SCO_Sig_Local); + if (forg->protocol == FOAM_Proto_Java) { + scobindValue(what); + } + else { + scobindLOF(what, SCO_Sig_Local); + } + scoIsInExport = false; } diff --git a/aldor/aldor/src/stab.c b/aldor/aldor/src/stab.c index 1f9375c97..3803e9180 100644 --- a/aldor/aldor/src/stab.c +++ b/aldor/aldor/src/stab.c @@ -555,6 +555,7 @@ stabNewLevel(int levno, int lamno, SrcPos spos, Bool isLargeLevel) slev->boundSymes = listNil(Syme); slev->extendSymes = listNil(Syme); + slev->exportedTypes = NULL; return slev; } @@ -1825,6 +1826,42 @@ stabImportRemark(Stab stab, TFormList what, TForm origin) } } +/****************************************************************************** + * + * :: Foreign exports + * + *****************************************************************************/ + +void +stabAddForeignExport(Stab stab, TForm tf, ForeignOrigin forg) +{ + if (car(stab)->exportedTypes == NULL) + car(stab)->exportedTypes = tblNew((TblHashFun) tfHash, (TblEqFun) tfEqual); + tblSetElt(car(stab)->exportedTypes, tf, forg); +} + +ForeignOrigin +stabForeignExportLocation(Stab stab, TForm tf) +{ + while (stab != listNil(StabLevel)) { + if (car(stab)->exportedTypes == NULL) { + stab = cdr(stab); + continue; + } + ForeignOrigin forg = tblElt(car(stab)->exportedTypes, tf, NULL); + if (forg != NULL) + return forg; + stab = cdr(stab); + } + return NULL; +} + +Bool +stabIsForeignExport(Stab stab, TForm tf) +{ + return stabForeignExportLocation(stab, tf) != NULL; +} + /**************************************************************************** * * TForm and TFormUses code. diff --git a/aldor/aldor/src/stab.h b/aldor/aldor/src/stab.h index e43d8acbe..3d3ae5c3e 100644 --- a/aldor/aldor/src/stab.h +++ b/aldor/aldor/src/stab.h @@ -81,6 +81,7 @@ struct stabLevel { TFormList tformsUnused; /* registered but unused */ SymeList boundSymes; /* List of bound symes */ SymeList extendSymes; /* List of extend symes */ + Table exportedTypes; /* types exported to foreign */ }; /****************************************************************************** @@ -226,6 +227,10 @@ extern TForm stabAddTFormQuery (Stab, TForm, TForm); extern TForm stabFindOuterTForm (Stab, AbSyn); extern TFormUses stabFindTFormUses (Stab, AbSyn); +extern void stabAddForeignExport (Stab, TForm, ForeignOrigin); +extern Bool stabIsForeignExport (Stab, TForm); +extern ForeignOrigin stabForeignExportLocation(Stab, TForm); + /* * Labels */ diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c index 1f8f9f2a4..e673dd633 100644 --- a/aldor/aldor/src/syme.c +++ b/aldor/aldor/src/syme.c @@ -793,14 +793,15 @@ symeIsJavaExport(Syme syme) tfFollow(inner); if (errorSetCheck(errors, tfIsMap(inner), "apply must return a map")) { - tfJavaCheckArgs(errors, 0, tfMapArg(inner)); - tfJavaCheckArgs(errors, 0, tfMapRet(inner)); + tfJavaCheckArgs(errors, listNil(StabLevel), 0, tfMapArg(inner)); + tfJavaCheckArgs(errors, listNil(StabLevel), 0, tfMapRet(inner)); } } if (symeId(syme) == ssymTheNew) { - errorSetCheck(errors, tfMapRetc(tf) == 1 && tfIsSelf(tfMapRetN(tf, 0)), + TForm retTf = tfIgnoreExceptions(tfMapRetN(tf, 0)); + errorSetCheck(errors, tfMapRetc(tf) == 1 && tfIsSelf(retTf), "new must return %"); - tfJavaCheckArgs(errors, 0, tfMapArg(tf)); + tfJavaCheckArgs(errors, listNil(StabLevel), 0, tfMapArg(tf)); } return errors; } diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 970b48e81..bfa7b0fd9 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -1440,7 +1440,6 @@ tfmExcept(Stab stab, AbSyn ab, TForm tf) tfMeaning(stab, ab->abExcept.type, tfExceptType(tf)); tfMeaning(stab, ab->abExcept.except, tfExceptExcept(tf)); - tfGetSelf(stab, tf); return tf; } @@ -2653,6 +2652,10 @@ tfGetDomSelf(TForm tf) tf = tfDefineeType(tf); + if (tfHasSelf(tf) && tfIsId(tf) && symeExtension(tfIdSyme(tf))) { + return tfGetDomSelf(tfFrSyme(stabFile(), symeExtensionFull(tfIdSyme(tf)))); + } + if (tfHasSelf(tf)) return tfSelf(tf); @@ -8087,32 +8090,85 @@ tfConditionalStab(TForm tf) * :: Java * *****************************************************************************/ -local void tfJavaCheckArg(ErrorSet errors, TForm self, TForm arg); +local Bool tfCheckJavaImport(ErrorSet errors, TForm tf); +local Bool tfJavaCheckArg(ErrorSet errors, Stab stab, TForm self, TForm arg); +local Bool abCheckJavaImport(ErrorSet errors, AbSyn ab); +local Bool abCheckJavaImportId(ErrorSet errors, AbSyn id); +local Bool abIsJavaImportId(AbSyn id); +local Bool abIsJavaImportId(AbSyn id); Bool tfIsJavaImport(TForm tf) +{ + tfFollow(tf); + + if (tfIsId(tf)) + return abIsJavaImportId(tfExpr(tf)); + else if (tfIsApply(tf) && abIsId(tfExpr(tf)->abApply.op)) { + return abIsJavaImportId(tfExpr(tf)->abApply.op); + } + return false; +} + +local Bool +abIsJavaImportId(AbSyn id) +{ + Syme syme = abSyme(id); + if (syme == NULL) + return false; + return symeIsForeign(syme) && symeForeign(syme)->protocol == FOAM_Proto_Java; +} + +local Bool +tfCheckJavaImport(ErrorSet errors, TForm tf) { Syme syme; tfFollow(tf); if (!tfIsGeneral(tf)) return false; - if (!tfIsId(tf)) - return false; - syme = tfIdSyme(tf); + return abCheckJavaImport(errors, tfExpr(tf)); +} - if (!symeIsForeign(syme)) - return false; +local Bool +abCheckJavaImport(ErrorSet errors, AbSyn ab) +{ + Bool ret = false; - if (symeForeign(syme)->protocol != FOAM_Proto_Java) - return false; + if (abIsId(ab)) { + ret = abCheckJavaImportId(errors, ab); + } + else if (abHasTag(ab, AB_Apply)) { + AbSyn op = ab->abApply.op; + if (abCheckJavaImportId(errors, op)) { + int i; + ret = true; + for (i=0; ret && i ?", - abPretty(tfExpr(arg))); - errorSetPrintf(errors, enc != NULL, "The domain %s must export fromJava: ? -> %%", - abPretty(tfExpr(arg))); +local Bool +tfJavaCheckArg(ErrorSet errors, Stab stab, TForm self, TForm arg) +{ + Syme enc, dec; + Bool flg = true; + + arg = tfIgnoreExceptions(arg); + + if (tfIsSelf(arg)) + return true; + if (tfIsJavaImport(arg)) + return true; + if (self && tfEqual(self, arg)) + return true; + if (stabIsForeignExport(stab, arg)) + return true; + + if (tfHasSelf(arg) && tfIsId(arg) && symeExtension(tfIdSyme(arg))) { + arg = tfFrSyme(stabFile(), symeExtensionFull(tfIdSyme(arg))); + } + + enc = tfGetDomExport(arg, symString(ssymTheToJava), tfIsJavaEncoder); + dec = tfGetDomExport(arg, symString(ssymTheFromJava), tfIsJavaDecoder); + if (!errorSetPrintf(errors, dec != NULL, "The domain %s must export toJava: %% -> ?", + abPretty(tfExpr(arg)))) + flg = false; + if (!errorSetPrintf(errors, enc != NULL, "The domain %s must export fromJava: ? -> %%", + abPretty(tfExpr(arg)))) + flg = false; + return true; } diff --git a/aldor/aldor/src/tform.h b/aldor/aldor/src/tform.h index f0973c619..b3bcdc351 100644 --- a/aldor/aldor/src/tform.h +++ b/aldor/aldor/src/tform.h @@ -922,8 +922,8 @@ extern Syme tfImplicitExport(Stab, SymeList, Syme); ****************************************************************************/ extern Bool tfIsJavaImport(TForm tf); -extern void tfJavaCheckArgs(ErrorSet errors, TForm self, TForm tf); +extern Bool tfJavaCheckArgs(ErrorSet errors, Stab stab, TForm self, TForm tf); extern Bool tfIsJavaEncoder(TForm tf); extern Bool tfIsJavaDecoder(TForm tf); -extern Bool tfJavaCanExport(TForm self, TForm tf); +extern Bool tfJavaCanExport(Stab stab, TForm self, TForm tf); #endif /* !_TFORM_H_ */ diff --git a/aldor/aldor/src/ti_tdn.c b/aldor/aldor/src/ti_tdn.c index 5d83dbd7d..5ab68a31a 100644 --- a/aldor/aldor/src/ti_tdn.c +++ b/aldor/aldor/src/ti_tdn.c @@ -1941,9 +1941,13 @@ local Bool titdnForeignExport(Stab stab, AbSyn absyn, TForm type) { AbSyn what = absyn->abForeignExport.what; + AbSyn dest = absyn->abForeignExport.dest; + ForeignOrigin forg = forgFrAbSyn(dest->abApply.argv[0]); - titdn(stab, absyn->abForeignExport.what, tfUnknown); - + Bool success = titdn(stab, absyn->abForeignExport.what, tfUnknown); + if (success && forg->protocol == FOAM_Proto_Java) { + stabAddForeignExport(stab, tiGetTForm(stab, what), forg); + } abTUnique(absyn) = type; return true; } diff --git a/aldor/aldor/test/JExportTest.java b/aldor/aldor/test/JExportTest.java new file mode 100644 index 000000000..70d766a28 --- /dev/null +++ b/aldor/aldor/test/JExportTest.java @@ -0,0 +1,25 @@ +import org.junit.*; +import aldorcode.jexport; +import aldor.stuff.Foo; +import foamj.FoamContext; +import foamj.FoamHelper; +import foamj.FoamClass; +import foamj.Clos; + +public class JExportTest { + + @Test + public void testJExport() { + FoamContext ctxt = new FoamContext(); + Clos fn = ctxt.createLoadFn("jexport"); + fn.call(); + + FoamHelper.setContext(ctxt); + Foo foo = Foo.wrap(10); + Assert.assertEquals(20, foo.plus(foo).unwrap()); + Assert.assertEquals("hello", Foo.something()); + + Assert.assertEquals(1, Foo.fromBar(Foo.wrap(1).toBar()).unwrap()); + Assert.assertEquals(22, Foo.fromString("hello").unwrap()); + } +} diff --git a/aldor/aldor/test/JThrowTest.java b/aldor/aldor/test/JThrowTest.java new file mode 100644 index 000000000..35a8f157d --- /dev/null +++ b/aldor/aldor/test/JThrowTest.java @@ -0,0 +1,59 @@ +import org.junit.*; +import aldorcode.jthrow; +import aldor.stuff.ExnThrow; +import foamj.*; + +public class JThrowTest { + + @Test + public void testSimpleThrow() { + FoamContext ctxt = new FoamContext(); + Clos fn = ctxt.createLoadFn("jthrow"); + fn.call(); + + FoamHelper.setContext(ctxt); + + try { + ExnThrow.fn(22); + Assert.fail(); + } + catch (FoamUserException e) { + } + } + + @Test + public void testConditional() { + FoamContext ctxt = new FoamContext(); + Clos fn = ctxt.createLoadFn("jthrow"); + fn.call(); + + FoamHelper.setContext(ctxt); + + Assert.assertEquals(1, ExnThrow.fn2(1)); + + try { + ExnThrow.fn2(0); + Assert.fail(); + } + catch (FoamUserException e) { + } + } + + @Test + public void testLoop() { + FoamContext ctxt = new FoamContext(); + Clos fn = ctxt.createLoadFn("jthrow"); + fn.call(); + + FoamHelper.setContext(ctxt); + + Assert.assertEquals(-1, ExnThrow.fn3(-1)); + + try { + int n = ExnThrow.fn3(10); + Assert.fail(); + } + catch (FoamUserException e) { + } + } +} diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index e38369efa..1b235d4fa 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -7,10 +7,12 @@ AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ VPATH = @srcdir@ abs_top_builddir = @abs_top_builddir@ srcdir = @srcdir@ +abs_srcdir = @abs_srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_top_srcdir = @abs_top_srcdir@ subdir = aldor/test +JUNIT_JAR = @JUNIT_JAR@ define am_auto_template AM_V_$(1) = $$(am__v_$(1)_$$(V)) @@ -57,19 +59,34 @@ aptests := exquo fmtests := rectest enumtest clos strtable1 simple apply ctests := rectest enumtest multinever maptuple otests := enumtest -xtests := enumtest -@BUILD_JAVA_TRUE@junittests := -@BUILD_JAVA_TRUE@jruntests := jimport jimp0 -@BUILD_JAVA_TRUE@jtests := simple_j enumtest run_j +xtests := enumtest jimport + +@BUILD_JAVA_TRUE@jtests := simple_j enumtest run_j halt +@HAS_JUNIT_TRUE@junittests := JExportTest JThrowTest +@BUILD_JAVA_TRUE@jruntests := jimport jimport_opt jimp0 jlist jexport jexport1 jexport2 envname jexn jthrow x_extra := rtexns simple_j_AXLFLAGS=-Q2 jimport_opt_AXLFLAGS=-Q9 -Qinline-all -badtests := opt1 +badtests := opt1 jcatch jimport_opts := -Q3 +jthrow_opts := -Q3 +halt_opts := -Q3 +jlist_opts := + +jexport_extjava := aldor.stuff.Foo aldor.stuff.Bar +jthrow_extjava := aldor.stuff.ExnThrow +envname_extjava := aldor.stuff.Env +jlist_extjava := aldor.stuff.Singleton +jexn_srcjava := aldor.test.ExceptionExample +JExportTest_classes := aldorcode.jexport +JThrowTest_classes := aldorcode.jthrow + +jimport_opt.ao: $(srcdir)/jimport.as + # opt1 fails because the optimise decides to inline the recursive call # (it shouldn't, but spotting the call is a bit tricky). @@ -83,11 +100,11 @@ _aptests := $(sort $(aptests)) _ctests := $(sort $(ctests) $(otests)) _jruntests := $(sort $(jruntests)) -_jtests := $(sort $(jtests) $(_jruntests)) _junittests := $(sort $(junittests)) +_jtests := $(sort $(jtests) $(_jruntests)) _xtests := $(sort $(xtests)) _fmtests := $(sort $(fmtests) $(_jtests) $(_ctests)) -_otests := $(sort $(otests) $(x_extra)) +_otests := $(sort $(otests) $(x_extra) $(_xtests)) _ctests := $(sort $(ctests) $(_otests)) _aotests := $(sort $(_fmtests) $(_ctests) $(_xtests)) @@ -101,24 +118,25 @@ $(patsubst %, out/fm/%.fm, $(_fmtests)): out/fm/%.fm: out/ao/%.ao $(patsubst %, out/c/%.c, $(_ctests)): out/c/%.c: out/ao/%.ao $(AM_V_ALDOR_GENC) \ mkdir -p $$(dirname $@); \ - $(aldorexedir)/aldor $(nfile) -Fc=$(builddir)/$@ $< + $(AM_DBG_C) $(aldorexedir)/aldor $(nfile) -Fc=$(builddir)/$@ $< -$(patsubst %, out/java/%.java, $(_jtests)): $(aldorexedir)/javagen -$(patsubst %, out/java/%.java, $(_jtests)): out/java/%.java: out/fm/%.fm +$(patsubst %, out/java/aldorcode/%.java, $(_jtests)): out/java/aldorcode/%.java: out/fm/%.fm $(AM_V_ALDOR_JAVA) \ mkdir -p $$(dirname $@); \ $(AM_DBG_J) $(aldorexedir)/aldor $(nfile) \ $(if $(filter $(_jruntests), $*), -Jmain,) \ - -Fjava=$(builddir)/$@ $< + -Fjava=$(builddir)/out/java/$*.java $< javaopts=-cp $(abs_top_builddir)/aldor/lib/java/src/foamj.jar define java_import_dependency_template -out/java/$1.class: $(patsubst %,out/java/%.java,$(subst .,/,$($(1)_srcjava))) +out/java/aldorcode/$1.class: $(patsubst %,out/java/%.java,$(subst .,/,$($(1)_srcjava))) +$(1)_srcjava: + echo $(1) $($(1)_srcjava) $(patsubst %,out/java/%.java,$(subst .,/,$($(1)_srcjava))) endef define junit_class_dependency_template -out/java/$1.class: $(patsubst %,out/java/%.java,$(subst .,/,$($(1)_classes))) +out/java/aldorcode/$1.class: $(patsubst %,out/java/aldorcode/%.java,$(subst .,/,$($(1)_classes))) endef $(foreach jtest,$(_jtests), $(eval $(call java_import_dependency_template,$(jtest)))) @@ -130,10 +148,10 @@ $(allsrcjava): out/java/%.java: $(srcdir)/%.java $(AM_V_JAVA_CP) \ (mkdir -p $(dir $@); cp $(srcdir)/$*.java $@) -$(patsubst %, out/java/%.class, $(_jtests)): out/java/%.class: out/java/%.java +$(patsubst %, out/java/aldorcode/%.class, $(_jtests)): out/java/aldorcode/%.class: out/java/aldorcode/%.java $(AM_V_JAVAC) \ (cd $(builddir)/out/java; \ - javac $(javaopts) $*.java \ + javac $(javaopts) aldorcode/$*.java \ $(addsuffix .java,$(subst .,/,$($*_extjava) $($*_srcjava))) \ ) @@ -192,10 +210,23 @@ $(patsubst %, %.exe, $(_xtests)): %.exe: %.o rtexns.o # -Fmain=bobthebuilder.c \ -$(patsubst %, %-javatest,$(_jruntests)): %-javatest: out/java/%.class - $(AM_V_ALDOR_JAVATEST) java -cp out/java:$(abs_top_builddir)/aldor/lib/java/src/foamj.jar:$(abs_top_builddir)/aldor/lib/libfoam/al/foam.jar:$(abs_top_builddir)/aldor/lib/libfoamlib/al/foamlib.jar: $* +classpath=$(abs_top_builddir)/aldor/lib/java/src/foamj.jar:$(abs_top_builddir)/aldor/lib/libfoam/al/foam.jar:$(abs_top_builddir)/aldor/lib/libfoamlib/al/foamlib.jar +$(patsubst %, %-javatest,$(_jruntests)): %-javatest: out/java/aldorcode/%.class + $(AM_V_ALDOR_JAVATEST) java -cp out/java:$(classpath) aldorcode.$* + +$(patsubst %,out/java/%.class,$(_junittests)): out/java/%.class: %.java + (cd $(builddir)/out/java; \ + javac -d . -cp $(classpath)/../src/foamj.jar:$(JUNIT_JAR):. \ + $(abs_srcdir)/$*.java) + +.PHONY: $(addsuffix -junittest,$(_junittests)) + +$(addsuffix -junittest,$(_junittests)): %-junittest: out/java/%.class + $(AM_V_JUNIT) \ + java -cp $(classpath):$(JUNIT_JAR):out/java \ + org.junit.runner.JUnitCore $* -check-java: $(patsubst %,%-javatest,$(_jruntests)) +check-java: $(patsubst %,%-javatest,$(_jruntests)) $(patsubst %,%-junittest,$(_junittests)) .PHONY: check-java @@ -206,9 +237,9 @@ really-all: \ $(patsubst %,out/ao/%.cmd,$(_aotests)) \ $(patsubst %,out/fm/%.fm,$(_fmtests)) \ $(patsubst %,out/c/%.c,$(_ctests)) \ - $(patsubst %,out/java/%.java,$(_jtests)) \ - $(patsubst %,out/java/%.class,$(_jtests)) \ - $(patsubst %,out/java/%.class,$(_jruntests)) \ + $(patsubst %,out/java/aldorcode/%.java,$(_jtests)) \ + $(patsubst %,out/java/aldorcode/%.class,$(_jtests)) \ + $(patsubst %,out/java/aldorcode/%.class,$(_jruntests)) \ $(patsubst %,%.o,$(_otests)) \ $(patsubst %,%.exe,$(_xtests)) diff --git a/aldor/aldor/test/aldor/test/ExceptionExample.java b/aldor/aldor/test/aldor/test/ExceptionExample.java new file mode 100644 index 000000000..6d724cefa --- /dev/null +++ b/aldor/aldor/test/aldor/test/ExceptionExample.java @@ -0,0 +1,24 @@ +package aldor.test; + +public class ExceptionExample { + int value; + + public ExceptionExample(int n) { + this.value = n; + } + + public int value() { + return value; + } + + public static ExceptionExample random() { + return new ExceptionExample(22); // 22 is random. officially. + } + + public void decrement() { + this.value--; + } + + static class DubiousException extends Exception { + } +} diff --git a/aldor/aldor/test/envname.as b/aldor/aldor/test/envname.as new file mode 100644 index 000000000..ce62e41ec --- /dev/null +++ b/aldor/aldor/test/envname.as @@ -0,0 +1,12 @@ +#include "foamlib" +import from Machine; +#pile + +export Env to Foreign Java "aldor.stuff" + +Env: with + foo: () -> % +== add + Rep == String + import from String + foo(): % == per "x" diff --git a/aldor/aldor/test/halt.as b/aldor/aldor/test/halt.as new file mode 100644 index 000000000..6095529b8 --- /dev/null +++ b/aldor/aldor/test/halt.as @@ -0,0 +1,8 @@ +#include "foamlib" +#pile + +foo(): MachineInteger == never + +bar(): MachineInteger == + stdout << foo() + foo() << newline + 22 diff --git a/aldor/aldor/test/jcatch.as b/aldor/aldor/test/jcatch.as new file mode 100644 index 000000000..dbae9c1b6 --- /dev/null +++ b/aldor/aldor/test/jcatch.as @@ -0,0 +1,16 @@ +#include "foamlib" +#pile + +define SomeExceptionType:Category == with; +SomeException: SomeExceptionType == add; + +local fn(x: MachineInteger): MachineInteger == throw SomeException + +local check(f: Boolean): () == if not f then never; + +local test(): () == + import from MachineInteger + x := try fn(0) catch E in -1 + stdout << x << newline + check(x = -1) +test() diff --git a/aldor/aldor/test/jexn.as b/aldor/aldor/test/jexn.as new file mode 100644 index 000000000..2c9838753 --- /dev/null +++ b/aldor/aldor/test/jexn.as @@ -0,0 +1,39 @@ +#include "foamlib" +#pile + +APPLY(id, rhs) ==> { apply: (%, 'id') -> rhs; export from 'id' } + +JavaExceptionType: Category == with; + +import + ExceptionExample: with + new: MachineInteger -> % throw JavaExceptionType + APPLY(decrement, () -> () throw JavaExceptionType) + random: () -> % throw JavaExceptionType +#if 0 + new: MachineInteger -> % + APPLY(decrement, () -> ()) + random: () -> % +#endif + APPLY(value, () -> MachineInteger) + from Foreign Java "aldor.test" + +import from ExceptionExample +import from MachineInteger + +testNew(): () == + ee: ExceptionExample := new(2) pretend ExceptionExample + stdout << ee.value() << newline + +testStatic(): () == + r: ExceptionExample := random()$ExceptionExample pretend ExceptionExample + stdout << r.value() << newline + +testMethod(): () == + ee := new(4)$ExceptionExample pretend ExceptionExample + ee.decrement() + stdout << ee.value() << newline + +testNew() +testStatic() +testMethod() diff --git a/aldor/aldor/test/jexport.as b/aldor/aldor/test/jexport.as new file mode 100644 index 000000000..0a048c3fe --- /dev/null +++ b/aldor/aldor/test/jexport.as @@ -0,0 +1,63 @@ +#include "foamlib" +import from Machine; +#pile + +export Foo to Foreign Java "aldor.stuff" +export Bar to Foreign Java "aldor.stuff" + +JString ==> java_.lang_.String; +import JString: with { +} from Foreign Java; +extend String: with { + toJava: % -> JString; + fromJava: JString -> %; +} +== add { + import Foam: with { + javaStringToString: JString -> Pointer; + stringToJavaString: Pointer -> JString; + } from Foreign Java "foamj"; + import from Foam; + toJava(x: %): JString == stringToJavaString(x pretend Pointer); + fromJava(x: JString): % == javaStringToString(x) pretend %; +} + +SimpleToString(T: with): with + toString: T -> String +== add + toString(t: T): String == "nope" + +Foo: with + new: SingleInteger -> % + wrap: SingleInteger -> % + unwrap: % -> SingleInteger + plus: (%, %) -> % + withBar: (%, Bar) -> % + nothing: () -> () + something: () -> String + toBar: % -> Bar + fromBar: Bar -> % + fromString: String -> % +-- export from SimpleToString % +== add + Rep == SingleInteger + import from Rep + new(n: SingleInteger): % == per n + wrap(n: SingleInteger): % == per n + unwrap(n: %): SingleInteger == rep n + plus(x: %, y: %): % == per(rep(x) + rep(y)) + nothing(): () == never + fromString(s: String): % == per 22 + something(): String == "hello" + withBar(x: %, b: Bar): % == x + toBar(x: %): Bar == wrap rep x + fromBar(b: Bar): % == per unwrap b + +Bar: with + wrap: SingleInteger -> % + unwrap: % -> SingleInteger +== add + Rep == SingleInteger + import from Rep + wrap(n: SingleInteger): % == per n + unwrap(n: %): SingleInteger == rep n diff --git a/aldor/aldor/test/jexport1.as b/aldor/aldor/test/jexport1.as new file mode 100644 index 000000000..4f0bf98fc --- /dev/null +++ b/aldor/aldor/test/jexport1.as @@ -0,0 +1,28 @@ +#include "foamlib" +import from Machine; +#pile + +export Foo1 to Foreign Java "aldor.stuff" + +JString ==> java_.lang_.String; +import JString: with { +} from Foreign Java; +extend String: with { + toJava: % -> JString; + fromJava: JString -> %; +} +== add { + import Foam: with { + javaStringToString: JString -> Pointer; + stringToJavaString: Pointer -> JString; + } from Foreign Java "foamj"; + import from Foam; + toJava(x: %): JString == stringToJavaString(x pretend Pointer); + fromJava(x: JString): % == javaStringToString(x) pretend %; +} + + +Foo1: with + something: () -> String +== add + something(): String == "hello" diff --git a/aldor/aldor/test/jexport2.as b/aldor/aldor/test/jexport2.as new file mode 100644 index 000000000..0236e2bf0 --- /dev/null +++ b/aldor/aldor/test/jexport2.as @@ -0,0 +1,8 @@ +#include "foamlib" +import from Machine; +#pile +define PrimitiveType: Category == with + +export Foo to Foreign Java "aldor.foo" + +Foo: PrimitiveType == add diff --git a/aldor/aldor/test/jimport.as b/aldor/aldor/test/jimport.as index ad2be479a..f36721689 100644 --- a/aldor/aldor/test/jimport.as +++ b/aldor/aldor/test/jimport.as @@ -14,13 +14,13 @@ extend String: with { fromJava: JString -> %; } == add { - import { - javaStringToString: JString -> %; - stringToJavaString: % -> JString; - } from Foreign; - - toJava(x: %): JString == stringToJavaString x; - fromJava(x: JString): % == javaStringToString x; + import Foam: with { + javaStringToString: JString -> Pointer; + stringToJavaString: Pointer -> JString; + } from Foreign Java "foamj"; + import from Foam; + toJava(x: %): JString == stringToJavaString(x pretend Pointer); + fromJava(x: JString): % == javaStringToString(x) pretend %; } import BitSet: with { @@ -56,9 +56,9 @@ import Month: with { _of: SingleInteger -> %; } from Foreign Java "java.time"; -check(f: Boolean): () == if not f then never; +local check(f: Boolean): () == if not f then never; -test1(): () == { +local test1(): () == { import from SingleInteger, JMath; b: BitSet := new(5); print << "BitSet: " << b.get(0) << newline; @@ -68,7 +68,7 @@ test1(): () == { check(b.get(0)); } -test2(): () == { +local test2(): () == { import from SingleInteger; -- print << abs(1)$JMath << " " << abs(-1)$JMath << newline; @@ -76,7 +76,7 @@ test2(): () == { -- check(1 = abs(-1)$JMath); } -test3(): () == { +local test3(): () == { import from SingleInteger; b1: BitSet := new(5); @@ -89,7 +89,7 @@ test3(): () == { check(not b1.equals(b2)); } -test4(): () == { +local test4(): () == { import from String; dd: LocalDate := now(); stdout << fromJava(dd.toString()) << newline diff --git a/aldor/aldor/test/jlist.as b/aldor/aldor/test/jlist.as new file mode 100644 index 000000000..bf33e53c5 --- /dev/null +++ b/aldor/aldor/test/jlist.as @@ -0,0 +1,79 @@ +#include "foamlib" +#pile + +JString ==> java_.lang_.String; +JList ==> java_.util_.List; +import JString: with { +} from Foreign Java; +extend String: with { + toJava: % -> JString; + fromJava: JString -> %; +} +== add { + import Foam: with { + javaStringToString: JString -> Pointer; + stringToJavaString: Pointer -> JString; + } from Foreign Java "foamj"; + import from Foam; + toJava(x: %): JString == stringToJavaString(x pretend Pointer); + fromJava(x: JString): % == javaStringToString(x) pretend %; +} + + +APPLY(id, rhs) ==> { apply: (%, 'id') -> rhs; export from 'id' } + +import ArrayList: (T: with) -> with + new: MachineInteger -> % + APPLY(_add, T -> Boolean) + APPLY(iterator, () -> Iterator T) + APPLY(get, MachineInteger -> T) + APPLY(set, (MachineInteger, T) -> T) + APPLY(toString, () -> String) + from Foreign Java "java.util" + +JIterable ==> java_.lang_.Iterable; +import + JIterable: (T: with) -> with + APPLY(iterator, () -> Iterator T); + from Foreign Java + +import + Iterator: (T: with) -> with + APPLY(hasNext, () -> Boolean); + APPLY(next, () -> T); +from Foreign Java "java.util" + +ll(): () == + import from MachineInteger, String + l: ArrayList String := new(2) + l._add("hello") + stdout << l.toString() << newline + stdout << l.get(0) << #(l.get(0)) << newline + +iter(): () == + import from MachineInteger + l: ArrayList String := new(2) + l._add("hello") + l._add("world") + iter: Iterator String := l.iterator() + while iter.hasNext() repeat + stdout << iter.next() << newline + +ll() +iter() + +export Singleton to Foreign Java "aldor.stuff" +Singleton: with + new: () -> % +== add + Rep == MachineInteger + import from Rep + new(): % == per 1 + +l2(): () == + import from MachineInteger, Singleton, ArrayList Singleton + x: ArrayList Singleton := new(2) + x._add(new()) + stdout << x.toString() << newline + +l2() diff --git a/aldor/aldor/test/jthrow.as b/aldor/aldor/test/jthrow.as new file mode 100644 index 000000000..b038d4eb7 --- /dev/null +++ b/aldor/aldor/test/jthrow.as @@ -0,0 +1,20 @@ +#include "foamlib" +#pile + +export ExnThrow to Foreign Java "aldor.stuff" + +define SomeExceptionType:Category == with; +SomeException: SomeExceptionType == add; + +ExnThrow: with + fn: MachineInteger -> MachineInteger + fn2: MachineInteger -> MachineInteger + fn3: MachineInteger -> MachineInteger +== add + fn(x: MachineInteger): MachineInteger == throw SomeException + fn2(x: MachineInteger): MachineInteger == if x = 0 then throw SomeException else x + fn3(x: MachineInteger): MachineInteger == + while x >= 0 repeat + x = 0 => throw SomeException + x := x - 1 + return x diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index 81ee1f02a..3711cd7ed 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -212,30 +212,29 @@ ifneq ($(BUILD_JAVA),) ifneq ($(javalibrary),) _javalibrary = $(filter-out $(java_blacklist), $(javalibrary)) -$(addsuffix .java, $(_javalibrary)): %.java: %.ao +$(patsubst %,aldorcode/%.java, $(_javalibrary)): aldorcode/%.java: %.ao $(AM_V_FOAMJ)$(AM_DBG) \ $(aldorexedir)/aldor $(aldor_common_args) -Fjava $*.ao -$(addsuffix .class, $(_javalibrary)): %.class: $(libraryname).classlib +$(patsubst %,aldorcode/%.class, $(_javalibrary)): aldorcode/%.class: $(libraryname).classlib # FIXME: -g here is ropey -$(libraryname).classlib: $(addsuffix .java, $(_javalibrary)) +$(libraryname).classlib: $(patsubst %,aldorcode/%.java, $(_javalibrary)) $(AM_V_JAVAC)javac -g -cp $(aldorlibdir)/java/src/foamj.jar $^ @touch $@ -$(libraryname).jar: $(addsuffix .class, $(_javalibrary)) $(top_srcdir)/lib/buildlib.mk +$(libraryname).jar: $(patsubst %,aldorcode/%.class, $(_javalibrary)) $(top_srcdir)/lib/buildlib.mk $(AM_V_JAR) \ rm -f $@; \ rm -rf jar; \ mkdir jar; \ - jar cf $@ $(addsuffix *.class, $(_javalibrary)) + jar cf $@ $(patsubst %,aldorcode/%*.class, $(_javalibrary)) for i in $(foreach i, $(SUBDIRS), $i/$(libraryname).jar); do \ (cd jar; jar xf ../$$i); \ jar uf ../$@ -C jar .; done; \ rm -rf jar all: $(libraryname).jar \ - $(addsuffix .java,$(_javalibrary)) \ - $(addsuffix .class,$(_javalibrary)) + $(patsubst %,aldorcode/%.class,$(_javalibrary)) endif endif @@ -300,8 +299,8 @@ $(aldortestjavas): %.aldortest-exec-java: Makefile %.as -Fjava -Ffm -Jmain \ $($*_test_AXLFLAGS) \ $*_jtest.as; \ - javac -g -cp $(aldorlibdir)/java/src/foamj.jar $*_jtest.java; \ - java -cp .:$(aldorlibdir)/java/src/foamj.jar:$(aldorlibdir)/libfoam/al/foam.jar:$(top_builddir)/lib/$(libraryname)/src/$(libraryname).jar:$(top_builddir)/lib/aldor/src/aldor.jar $*_jtest; \ + javac -g -cp $(aldorlibdir)/java/src/foamj.jar aldorcode/$*_jtest.java; \ + java -cp .:$(aldorlibdir)/java/src/foamj.jar:$(aldorlibdir)/libfoam/al/foam.jar:$(top_builddir)/lib/$(libraryname)/src/$(libraryname).jar:$(top_builddir)/lib/aldor/src/aldor.jar aldorcode.$*_jtest; \ $(CHECK_TEST_STATUS) \ fi;) From 537be1e58221bd1a651412d0b093ecbefa559c62 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 25 Apr 2018 21:58:35 +0100 Subject: [PATCH 283/352] src/absyn.c: Add abToSExprElided - to skip the boring bits --- aldor/aldor/src/absyn.c | 25 +++++++++++++++++++++++++ aldor/aldor/src/absyn.h | 1 + 2 files changed, 26 insertions(+) diff --git a/aldor/aldor/src/absyn.c b/aldor/aldor/src/absyn.c index 4276432ce..00df53ce9 100644 --- a/aldor/aldor/src/absyn.c +++ b/aldor/aldor/src/absyn.c @@ -1258,6 +1258,17 @@ abPosSpan(AbSyn ab, SrcPos *pmin, SrcPos *pmax) * :: AbSyn/SExpr conversion * *****************************************************************************/ +static Bool abElideInnerExpressions; + +SExpr +abToSExprElided(AbSyn ab) +{ + SExpr sx; + abElideInnerExpressions = true; + sx = abToSExpr(ab); + abElideInnerExpressions = false; + return sx; +} SExpr abToSExpr(AbSyn ab) @@ -1308,6 +1319,20 @@ abToSExpr(AbSyn ab) sx = sxNReverse(sx); break; } + case AB_Add: + case AB_With: { + if (abElideInnerExpressions) { + sx = sxCons(abInfo(abTag(ab)).sxsym, sxNil); + } + else { + sx = sxCons(abInfo(abTag(ab)).sxsym, sxNil); + for (ai = 0; ai < abArgc(ab); ai++) + sx = sxCons(abToSExpr(abArgv(ab)[ai]), sx); + sx = sxNReverse(sx); + } + break; + } + default: sx = sxCons(abInfo(abTag(ab)).sxsym, sxNil); for (ai = 0; ai < abArgc(ab); ai++) diff --git a/aldor/aldor/src/absyn.h b/aldor/aldor/src/absyn.h index 9ebb55e03..6be9f0208 100644 --- a/aldor/aldor/src/absyn.h +++ b/aldor/aldor/src/absyn.h @@ -977,6 +977,7 @@ extern int abPrintClippedDb (AbSyn, int maxNodes); extern int abOStreamPrint (OStream, AbSyn ab); extern SExpr abToSExpr (AbSyn); +extern SExpr abToSExprElided (AbSyn); extern AbSyn abFrSExpr (SExpr); extern AbSyn abRdSExpr (FILE *, FileName *, int *lno); From 5c3faf58783f4ad5089bab20bfb0f720f5a9bf1a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 25 Apr 2018 22:37:08 +0100 Subject: [PATCH 284/352] syme.c: Use elided absyn sexpressions --- 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 e673dd633..f2882bb04 100644 --- a/aldor/aldor/src/syme.c +++ b/aldor/aldor/src/syme.c @@ -1629,13 +1629,13 @@ symeSExprAList(Syme syme) type = tfMapRet(type); /* 5. Category exports */ - if (!symeIsSelfSelf(syme) && tfSatCat(type)) { + if (!symeIsSelfSelf(syme) && !symeIsParam(syme) && tfSatCat(type)) { sxi = symeListToSExpr(tfGetThdExports(type), false); al = sxiACons("catExports", sxi, al); } /* 6. Domain exports */ - else if (!symeIsSelfSelf(syme) && tfSatDom(type)) { + else if (!symeIsSelfSelf(syme) && !symeIsParam(syme) && tfSatDom(type)) { sxi = symeListToSExpr(tfGetCatExports(type), false); al = sxiACons("domExports", sxi, al); } @@ -1709,7 +1709,7 @@ symeToSExpr(Syme syme) sx = sxCons(sxi, sx); /* Symbol type */ - sxi = abToSExpr(tfExpr(type)); + sxi = abToSExprElided(tfExpr(type)); sx = sxCons(sxi, sx); /* Create an Alist for remaining data */ From 52d9dd388b9bb8a8f6a3fc38674b3a45281faf73 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 4 May 2018 22:27:16 +0100 Subject: [PATCH 285/352] annabs.c: Reduce size of file.. need to do this more. --- aldor/aldor/src/annabs.c | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/annabs.c b/aldor/aldor/src/annabs.c index 3c695708c..ab46daa8b 100644 --- a/aldor/aldor/src/annabs.c +++ b/aldor/aldor/src/annabs.c @@ -22,6 +22,7 @@ * :: Annotated SExpression * ****************************************************************************/ +static Bool abcElideInnerExpressions; SExpr abToAnnotatedSExpr(AbSyn whole); @@ -121,6 +122,18 @@ abcSetSymeSExpr(AbAnnotationBucket bucket, AInt idx, SExpr sx) tblSetElt(bucket->symeSxForIndex, (TblElt) idx, sx); } +local SExpr +abAnnotatedSExprElided(AbSyn ab, AbAnnotationBucket bucket) +{ + SExpr sx; + Bool current = abcElideInnerExpressions; + abcElideInnerExpressions = true; + sx = abAnnotatedSExpr(ab, bucket); + abcElideInnerExpressions = current; + return sx; +} + + local SExpr abcSExpr(AbAnnotationBucket bucket) @@ -198,6 +211,19 @@ abAnnotatedSExpr(AbSyn ab, AbAnnotationBucket bucket) sx = sxNReverse(sx); break; } + case AB_Add: + case AB_With: { + if (abcElideInnerExpressions) { + sx = sxCons(abInfo(abTag(ab)).sxsym, sxNil); + } + else { + sx = sxCons(abInfo(abTag(ab)).sxsym, sxNil); + for (ai = 0; ai < abArgc(ab); ai++) + sx = sxCons(abAnnotatedSExpr(abArgv(ab)[ai], bucket), sx); + sx = sxNReverse(sx); + } + break; + } default: sx = sxCons(abInfo(abTag(ab)).sxsym, sxNil); for (ai = 0; ai < abArgc(ab); ai++) @@ -402,7 +428,7 @@ abAnnotateSefo(Sefo sefo, AbAnnotationBucket bucket) AInt idx = abcGetSefo(bucket, sefo); if (idx == -1) { AInt newIdx = abcAddSefo(bucket, sefo); - SExpr sx = abAnnotatedSExpr(sefo, bucket); + SExpr sx = abAnnotatedSExprElided(sefo, bucket); abcSetSefoSExpr(bucket, newIdx, sx); return sxCons(sxiFrSymbol(symInternConst("ref")), sxiFrInteger(newIdx)); } From 61ebeef78295e5b1cc643a7b31ce0a4d3f0c9a50 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 4 May 2018 22:29:27 +0100 Subject: [PATCH 286/352] buildlib.mk: Also export asy files. --- aldor/lib/buildlib.mk | 3 +++ 1 file changed, 3 insertions(+) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index 3711cd7ed..17f0da585 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -346,6 +346,9 @@ install-data: if test -f $$i.abn; then \ $(INSTALL_DATA) $$i.abn $(DESTDIR)$(datarootdir)/aldor/lib/$(libraryname)/$(libsubdir)/$$i.abn; \ fi; \ + if test -f $$i.asy; then \ + $(INSTALL_DATA) $$i.asy $(DESTDIR)$(datarootdir)/aldor/lib/$(libraryname)/$(libsubdir)/$$i.asy; \ + fi; \ done uninstall: From 6908a5983a356603d7264d474056025461bc2430 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 11 May 2018 22:28:55 +0100 Subject: [PATCH 287/352] ablogic.c: Allow null AbLogic in formatter In case we're passing nulls around --- aldor/aldor/src/ablogic.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/ablogic.c b/aldor/aldor/src/ablogic.c index c69e25d04..918a4c4dc 100644 --- a/aldor/aldor/src/ablogic.c +++ b/aldor/aldor/src/ablogic.c @@ -182,7 +182,10 @@ ablogFormatter(OStream ostream, Pointer p) { int c; - c = ablogWrite(ostream, p); + if (p == NULL) + c = ostreamWrite(ostream, "", -1); + else + c = ablogWrite(ostream, p); return c; } @@ -349,7 +352,6 @@ ablogFrSefo(Sefo sefo) return rr; } - /***************************************************************************** * * :: Boolean arithmetic operations. From 32d10d7b1ceda368009469981af8addf91a0888b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 28 May 2018 12:14:31 +0100 Subject: [PATCH 288/352] tform.c: Always follow before updating conditions in tfPendingFrSyntax --- 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 bfa7b0fd9..4b1cd2cb0 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -2058,7 +2058,7 @@ tfPendingFrSyntax(Stab stab, AbSyn ab, TForm tf) TForm tfp = tfPending(stab, ab); /* This test is probably too weak */ if (!tfIsId(tfp)) - tfSetConditions(tfp, tfConditions(tf)); + tfSetConditions(tfFollowOnly(tfp), tfConditions(tf)); tfForwardFrSyntax(tf, tfFollowOnly(tfp)); } else if (tfIsAnyMap(tf)) { From 1c9f5c06d214f9c45b1926b347e5376821f2cbb4 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 28 May 2018 18:00:07 +0100 Subject: [PATCH 289/352] syme.c: symeCheckCondition should clear the incomplete bit at start Otherwise it'll persist, causing slow compile times. --- aldor/aldor/src/syme.c | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c index f2882bb04..4306df29e 100644 --- a/aldor/aldor/src/syme.c +++ b/aldor/aldor/src/syme.c @@ -1278,11 +1278,16 @@ symeListCheckJoinSymes(Syme syme1, Syme syme2) symeTransferImplInfo(syme1, syme2); } } - +/* + * False => Condition evaluates to false + * True => Condition either pending or true + */ Bool symeCheckCondition(Syme syme) { symeSetCondChecked(syme); + symeClrCheckCondIncomplete(syme); + while (symeCondition(syme)) { Sefo cond = car(symeCondition(syme)); Sefo dom, cat; @@ -1314,14 +1319,13 @@ symeCheckCondition(Syme syme) if (!abIsFullyInstantiated(dom)) { return true; } - if (abTForm(dom) && tfEqual(abTForm(dom), symeExporter(syme))) + if (abTForm(dom) && tfEqual(abTForm(dom), symeExporter(syme))) { return true; + } - symeClrCheckCondIncomplete(syme); return false; } - symeClrCheckCondIncomplete(syme); return true; } From fef47808ba74525f559c1f514ad7f3ddbaee4283 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 28 May 2018 18:05:28 +0100 Subject: [PATCH 290/352] tfsat.c: Always try to match for embedded % in tfSatExport --- aldor/aldor/src/tfsat.c | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/aldor/aldor/src/tfsat.c b/aldor/aldor/src/tfsat.c index 3de724b31..06e2d3330 100644 --- a/aldor/aldor/src/tfsat.c +++ b/aldor/aldor/src/tfsat.c @@ -1692,6 +1692,7 @@ local SatMask tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) { SatMask result = tfSatFalse(mask); + TForm substT; SymeList symes; Bool tryHarder = true; static int serialNo = 0; @@ -1743,9 +1744,6 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) if (!tryHarder) return result; - if (!symeIsSelfSelf(t)) - return result; - if (Sab == NULL) return result; @@ -1758,22 +1756,26 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) sigma = absFrSymes(stabFile(), mods, Sab); tfsExportDEBUG(dbOut, "tfSatExport[%d]:: Incoming S: %pAbSyn\n", serialThis, Sab); + substT = tfSubst(sigma, symeType(t)); for (symes = S; !tfSatSucceed(result) && symes; symes = cdr(symes)) { Syme s = car(symes); TForm substS; Bool weakEq; - if (!symeIsSelfSelf(s)) + if (symeId(s) != symeId(t)) { continue; + } substS = tfSubst(sigma, symeType(s)); - weakEq = abEqualModDeclares(tfExpr(substS), tfExpr(symeType(t))); + weakEq = abEqualModDeclares(tfExpr(substS), tfExpr(substT)); tfsExportDEBUG(dbOut, "tfsatExport[%d]::CompareTF: [%pTForm], [%pTForm] = %d\n", - serialThis, substS, symeType(t), weakEq); + serialThis, substS, substT, weakEq); if (weakEq) { result = tfSatTrue(mask); } + tfFree(substS); } + tfFree(substT); return result; } From 698be675422efaa73f6a6da0a89a3df5bc4e919a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 28 May 2018 18:46:59 +0100 Subject: [PATCH 291/352] tfcond.c: Allow for condition to be a combination of AbLogic and Sefo This is so that we can add conditions on the fly from abCondKnown --- aldor/aldor/src/tfcond.c | 29 ++++++++++++++++++++++++----- aldor/aldor/src/tfcond.h | 4 ++++ aldor/aldor/src/tform.c | 2 ++ 3 files changed, 30 insertions(+), 5 deletions(-) diff --git a/aldor/aldor/src/tfcond.c b/aldor/aldor/src/tfcond.c index 6a89953d0..6f75ec9c3 100644 --- a/aldor/aldor/src/tfcond.c +++ b/aldor/aldor/src/tfcond.c @@ -10,13 +10,16 @@ CREATE_LIST(TfCondElt); extern Bool tfDebug; #define tfCondDEBUG DEBUG_IF(tf) afprintf +local TfCondElt tfCondEltNewFull(Stab stab, AbSynList absynList, AbLogic known); + TfCond tfCondNew() { TfCond tfcond = (TfCond) stoAlloc(OB_Other, sizeof(*tfcond)); - tfcond->conditions = NULL; + tfcond->conditions = listNil(TfCondElt); tfcond->containsEmpty = false; + tfcond->known = ablogFalse(); return tfcond; } @@ -28,17 +31,30 @@ tfCondFree(TfCond cond) } -TfCondElt -tfCondEltNew(Stab stab, AbSynList absynList) +local TfCondElt +tfCondEltNewFull(Stab stab, AbSynList absynList, AbLogic known) { TfCondElt tfcondElt = (TfCondElt) stoAlloc(OB_Other, sizeof(*tfcondElt)); tfcondElt->stab = stab; tfcondElt->list = absynList; + tfcondElt->known = ablogCopy(known); return tfcondElt; } +TfCondElt +tfCondEltNew(Stab stab, AbSynList absynList) +{ + return tfCondEltNewFull(stab, absynList, ablogFalse()); +} + +TfCondElt +tfCondEltNewKnown(Stab stab, AbLogic known) +{ + return tfCondEltNewFull(stab, listNil(AbSyn), known); +} + void tfCondEltFree(TfCondElt condElt) { @@ -115,12 +131,15 @@ tfCondMerge(TfCond c1, Stab stab, TfCondElt condition) if (c1->containsEmpty) { return c1; } - if (condition == NULL) { + if (condition == NULL || ablogIsTrue(condition->known)) { c1->containsEmpty = true; } - else { + else if (condition->list != listNil(AbSyn)) { TfCondElt conditionElt = tfCondEltNew(stab, condition->list); c1->conditions = listCons(TfCondElt)(conditionElt, c1->conditions); } + + c1->known = ablogOr(c1->known, condition->known); + return c1; } diff --git a/aldor/aldor/src/tfcond.h b/aldor/aldor/src/tfcond.h index b8b1c1afc..ca3bdb653 100644 --- a/aldor/aldor/src/tfcond.h +++ b/aldor/aldor/src/tfcond.h @@ -2,10 +2,12 @@ #define _TFCOND_H_ #include "axlobs.h" +#include "ablogic.h" typedef struct tfCondElt { Stab stab; AbSynList list; + AbLogic known; } *TfCondElt; DECLARE_LIST(TfCondElt); @@ -13,10 +15,12 @@ DECLARE_LIST(TfCondElt); typedef struct tfCond { Bool containsEmpty; TfCondEltList conditions; + AbLogic known; } *TfCond; TfCond tfCondNew(void); TfCondElt tfCondEltNew(Stab stab, AbSynList absynList); +TfCondElt tfCondEltNewKnown(Stab stab, AbLogic known); void tfCondSetCondition(TfCond cond, AbSynList list); TfCond tfCondFloat(Stab stab, TfCond tfcond); diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 4b1cd2cb0..3f6895242 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -8062,6 +8062,8 @@ tfConditionalAbSyn(TForm tf) return listNil(AbSyn); if (tfConditions(tf)->containsEmpty) return listNil(AbSyn); + if (tfConditions(tf)->conditions == listNil(TfCondElt)) + return listNil(AbSyn); if (DEBUG(tf)) { TfCondEltList list; From 44fa51c7cdcf96317b3c1e04559331e4647d78e5 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 28 May 2018 18:52:19 +0100 Subject: [PATCH 292/352] src: Keep track of abCondKnown when creating type forms. This fixes cases like if X has Y then qq: Foo(X) where Foo: Y -> whatever --- aldor/aldor/src/ablogic.c | 4 ++-- aldor/aldor/src/syme.c | 9 +++++++-- aldor/aldor/src/tform.c | 4 ++-- aldor/aldor/src/tfsat.c | 2 +- aldor/aldor/src/ti_bup.c | 4 ++-- aldor/aldor/src/ti_top.h | 2 +- aldor/aldor/src/tinfer.c | 22 +++++++++++++--------- aldor/aldor/src/tinfer.h | 2 ++ 8 files changed, 30 insertions(+), 19 deletions(-) diff --git a/aldor/aldor/src/ablogic.c b/aldor/aldor/src/ablogic.c index 918a4c4dc..f48232d4d 100644 --- a/aldor/aldor/src/ablogic.c +++ b/aldor/aldor/src/ablogic.c @@ -633,9 +633,9 @@ ablogTestProperties(Sefo test, Sefo know) know = know->abHas.property; tftest = abTForm(test) ? - abTForm(test) : (tiTopFns()->tiGetTopLevelTForm)(NULL, test); + abTForm(test) : (tiTopFns()->tiGetTopLevelTForm)(ablogTrue(), test); tfknown = abTForm(know) ? - abTForm(know) : (tiTopFns()->tiGetTopLevelTForm)(NULL, know); + abTForm(know) : (tiTopFns()->tiGetTopLevelTForm)(ablogTrue(), know); if (DEBUG(ablog)){ fprintf(dbOut, "Checking: \n"); diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c index 4306df29e..a1170550f 100644 --- a/aldor/aldor/src/syme.c +++ b/aldor/aldor/src/syme.c @@ -1350,6 +1350,11 @@ abIsFullyInstantiated(Sefo ab) return result; } +/* + * 0 => Failed + * 1 => SatPending + * 2 => Success + */ local int symeCheckHas(SymeCContext conditionContext, Sefo dom, Sefo cat) { @@ -1366,7 +1371,7 @@ symeCheckHas(SymeCContext conditionContext, Sefo dom, Sefo cat) if (tiTopFns()->tiCanSefo(cat)) { tiTopFns()->tiSefo(stabFile(), cat); } - tfcat = abTForm(cat) ? abTForm(cat) : tiTopFns()->tiGetTopLevelTForm(NULL, cat); + tfcat = abTForm(cat) ? abTForm(cat) : tiTopFns()->tiGetTopLevelTForm(ablogTrue(), cat); /* D has C iff typeof(D) satisfies C. */ result = tfSat(tfSatBupMask(), tfdom, tfcat); @@ -1548,7 +1553,7 @@ symeCheckIdentifier(AbSyn ab, Syme syme) cat = cond->abHas.property; tfdom = abGetCategory(dom); - tfcat = abTForm(cat) ? abTForm(cat) : tiTopFns()->tiGetTopLevelTForm(NULL, cat); + tfcat = abTForm(cat) ? abTForm(cat) : tiTopFns()->tiGetTopLevelTForm(ablogTrue(), cat); /* D has C iff typeof(D) satisfies C. */ result = tfSat(tfSatTdnInfoMask(), tfdom, tfcat); diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 3f6895242..0ab43426b 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -7736,7 +7736,7 @@ tfFrSymbol(Symbol sym) /* There can only be one ... */ if (symes && !cdr(symes)) - return tiTopFns()->tiGetTopLevelTForm(NULL, abFrSyme(car(symes))); + return tiTopFns()->tiGetTopLevelTForm(ablogTrue(), abFrSyme(car(symes))); else return (TForm)NULL; } @@ -7770,7 +7770,7 @@ tfFrSymbolPair(Symbol functor, Symbol argument) if (!fsymes || !asymes) return tfUnknown; /* Please don't return (TForm)NULL */ else - return tiTopFns()->tiGetTopLevelTForm(NULL, ab); + return tiTopFns()->tiGetTopLevelTForm(ablogTrue(), ab); } /***************************************************************************** diff --git a/aldor/aldor/src/tfsat.c b/aldor/aldor/src/tfsat.c index 06e2d3330..382695b09 100644 --- a/aldor/aldor/src/tfsat.c +++ b/aldor/aldor/src/tfsat.c @@ -1815,7 +1815,7 @@ tfSatConditions(SatMask mask, SymeList mods, Syme s, Syme t) } tfdom = abGetCategory(cond->abHas.expr); cat = cond->abHas.property; - tfcat = abTForm(cat) ? abTForm(cat) : tiTopFns()->tiGetTopLevelTForm(NULL, cat); + tfcat = abTForm(cat) ? abTForm(cat) : tiTopFns()->tiGetTopLevelTForm(ablogTrue(), cat); result = tfSat(mask, tfdom, tfcat); if (tfSatSucceed(result)) diff --git a/aldor/aldor/src/ti_bup.c b/aldor/aldor/src/ti_bup.c index f6cee3ed9..b010b134c 100644 --- a/aldor/aldor/src/ti_bup.c +++ b/aldor/aldor/src/ti_bup.c @@ -3124,8 +3124,8 @@ tibupHas(Stab stab, AbSyn absyn, TForm type) * ensure that tfBoolean has been imported into every * scope that needs it before we get this far. */ - tiGetTForm(stab, expr); - tiGetTForm(stab, prop); + tiGetTFormContext(stab, abCondKnown, expr); + tiGetTFormContext(stab, abCondKnown, prop); if (tfBoolean == tfUnknown) comsgFatal(absyn, ALDOR_F_BugNoBoolean); tibup0Generic(stab, absyn, tfBoolean); diff --git a/aldor/aldor/src/ti_top.h b/aldor/aldor/src/ti_top.h index ebf7e7842..df1c8f68c 100644 --- a/aldor/aldor/src/ti_top.h +++ b/aldor/aldor/src/ti_top.h @@ -9,7 +9,7 @@ typedef struct _tiTopLevel { void (*tiBottomUp) (Stab, AbSyn, TForm); void (*tiTopDown) (Stab, AbSyn, TForm); Bool (*tiCanSefo) (Sefo); - TForm (*tiGetTopLevelTForm) (SymeCContext, AbSyn); + TForm (*tiGetTopLevelTForm) (AbLogic, AbSyn); Bool (*tiUnaryToRaw) (Stab, AbSyn, TForm); Bool (*tiRawToUnary) (Stab, AbSyn, TForm); diff --git a/aldor/aldor/src/tinfer.c b/aldor/aldor/src/tinfer.c index 9372200d7..403a74a9c 100644 --- a/aldor/aldor/src/tinfer.c +++ b/aldor/aldor/src/tinfer.c @@ -202,7 +202,7 @@ local Bool tiTopEqual (TFormUses, TFormUses); ****************************************************************************/ local Bool tqShouldImport (TQual); -local TForm tiGetTopLevelTForm(SymeCContext context, AbSyn type); +local TForm tiGetTopLevelTForm(AbLogic context, AbSyn type); local Bool tiCheckSymeConditionalImplementation(Stab stab, Syme syme, Syme implSyme); void @@ -605,10 +605,8 @@ tiAddSymes(Stab astab, AbSyn capsule, TForm base, TForm context, SymeList *p) return dsymes; } -TForm tiGetTFormContext(Stab stab, SymeCContext context, AbSyn type); - local TForm -tiGetTopLevelTForm(SymeCContext context, AbSyn type) +tiGetTopLevelTForm(AbLogic context, AbSyn type) { TForm tf; @@ -624,11 +622,11 @@ tiGetTopLevelTForm(SymeCContext context, AbSyn type) TForm tiGetTForm(Stab stab, AbSyn type) { - return tiGetTFormContext(stab, NULL, type); + return tiGetTFormContext(stab, ablogTrue(), type); } TForm -tiGetTFormContext(Stab stab, SymeCContext context, AbSyn type) +tiGetTFormContext(Stab stab, AbLogic context, AbSyn type) { TForm tf, ntf; @@ -648,8 +646,9 @@ tiGetTFormContext(Stab stab, SymeCContext context, AbSyn type) abTransferSemantics(type, tfGetExpr(tf)); } - if (!tfIsMeaning(tf)) - tfMergeConditions(tf, stab, tfCondEltNew(stab, context)); + if (!tfIsMeaning(tf)) { + tfMergeConditions(tf, stab, tfCondEltNewKnown(stab, context)); + } ntf = typeInferTForm(stab, tf); tfTransferSemantics(ntf, tf); @@ -1916,9 +1915,11 @@ tiTfBottomUp1(Stab stab, TFormUses tfu, TForm tf) local AbLogic tiTfCondition(Stab stab, TForm tf) { + Scope("tiTfCondition"); AbSynList condition = tfConditionalAbSyn(tf); AbSyn absyn = tfGetExpr(tf); AbLogic rule = ablogTrue(); + AbLogic fluid(abCondKnown); while (condition != listNil(AbSyn)) { Stab cstab = stab;/*tfConditionalStab(tf);*/ @@ -1933,12 +1934,15 @@ tiTfCondition(Stab stab, TForm tf) condition = cdr(condition); continue; } + abCondKnown = rule; tiBottomUp(cstab, ab, tfUnknown); tiTopDown (cstab, ab, tfUnknown); rule = ablogAnd(rule, ablogFrSefo(ab)); condition = cdr(condition); } - return rule; + TfCond conds = tfConditions(tf); + + Return(rule); } /* Audit the bottom-up type analysis phase. */ diff --git a/aldor/aldor/src/tinfer.h b/aldor/aldor/src/tinfer.h index 4c28fe482..7dbd8aa98 100644 --- a/aldor/aldor/src/tinfer.h +++ b/aldor/aldor/src/tinfer.h @@ -73,6 +73,8 @@ extern Bool tiTfDoDefault (Sefo); extern void tiTfImportCascades (Stab stab, TQualList tq); extern SymeList tiAddSymes (Stab, AbSyn, TForm, TForm, SymeList *); extern TForm tiGetTForm (Stab, AbSyn); +extern TForm tiGetTFormContext (Stab, AbLogic, AbSyn); + extern Syme tiGetMeaning (Stab, AbSyn, TForm); extern Syme tiGetExtendee (Stab, AbSyn, TForm); extern Bool tiUnaryToRaw (Stab, AbSyn, TForm); From 8173cca75d40f08138ce30d36beb3c16b3dc2629 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 28 May 2018 18:53:30 +0100 Subject: [PATCH 293/352] test: Add test for condition propagation --- aldor/aldor/test/Makefile.in | 2 +- aldor/aldor/test/nestcond.as | 11 +++++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) create mode 100644 aldor/aldor/test/nestcond.as diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 1b235d4fa..21b1ecb76 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -56,7 +56,7 @@ foamsrcdir = $(abs_top_srcdir)/aldor/lib/libfoam foamdir = $(abs_top_builddir)/aldor/lib/libfoam aptests := exquo -fmtests := rectest enumtest clos strtable1 simple apply +fmtests := rectest enumtest clos strtable1 simple apply nestcond ctests := rectest enumtest multinever maptuple otests := enumtest xtests := enumtest jimport diff --git a/aldor/aldor/test/nestcond.as b/aldor/aldor/test/nestcond.as new file mode 100644 index 000000000..cc6269867 --- /dev/null +++ b/aldor/aldor/test/nestcond.as @@ -0,0 +1,11 @@ +#include "foamlib" +#pile + +SetCategory: Category == with + +Evalable(X: SetCategory): Category == with + +Thing(R: Type): Category == with + if R has SetCategory then + if R has Evalable R then + foo: List % -> % From 596cc4de16b0493eff54bc11642a226ec20db2c9 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 19 Aug 2018 10:18:24 +0100 Subject: [PATCH 294/352] configure: Add CFLAGS to STRICTCFLAGS --- aldor/m4/error-on-warn.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/m4/error-on-warn.m4 b/aldor/m4/error-on-warn.m4 index 86b43f50c..71ec5ab44 100644 --- a/aldor/m4/error-on-warn.m4 +++ b/aldor/m4/error-on-warn.m4 @@ -24,7 +24,7 @@ ALDOR_SBRK_OPTION case "${aldor_error_on_warning}" in *yes) - STRICTCFLAGS=${cfgSTRICTCFLAGS};; + STRICTCFLAGS="${cfgSTRICTCFLAGS} ${CFLAGS}";; *no) STRICTCFLAGS=;; *);; From cf929de3c1af86c8e56d6bfb2a2119773f186b6e Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 19 Aug 2018 11:27:48 +0100 Subject: [PATCH 295/352] ttable.[ch] Add some iteration tests and size() function --- aldor/aldor/src/test/test_tset.c | 26 ++++++++++++++ aldor/aldor/src/ttable.c | 61 ++++++++++++++++++++++---------- aldor/aldor/src/ttable.h | 12 +++++-- 3 files changed, 78 insertions(+), 21 deletions(-) diff --git a/aldor/aldor/src/test/test_tset.c b/aldor/aldor/src/test/test_tset.c index 107dec678..c19082678 100644 --- a/aldor/aldor/src/test/test_tset.c +++ b/aldor/aldor/src/test/test_tset.c @@ -9,12 +9,14 @@ DECLARE_TSET(String); CREATE_TSET(String); local void testTSet(void); +local void testTSetIter(void); void tsetTestSuite() { init(); TEST(testTSet); + TEST(testTSetIter); fini(); } @@ -33,18 +35,42 @@ testTSet() tsetAdd(String)(set, x); testTrue("", tsetMember(String)(set, x)); testFalse("", tsetMember(String)(set, y)); + testIntEqual("", 1, tsetSize(String)(set)); tsetAdd(String)(set, y); testTrue("", tsetMember(String)(set, x)); testTrue("", tsetMember(String)(set, y)); + testIntEqual("", 2, tsetSize(String)(set)); tsetRemove(String)(set, x); testFalse("", tsetMember(String)(set, x)); testTrue("", tsetMember(String)(set, y)); + testIntEqual("", 1, tsetSize(String)(set)); tsetRemove(String)(set, y); testFalse("", tsetMember(String)(set, x)); testFalse("", tsetMember(String)(set, y)); + testIntEqual("", 0, tsetSize(String)(set)); tsetFree(String)(set); } + +local void +testTSetIter() +{ + StringTSet set; + StringTSetIter iter; + String someString; + + set = tsetCreate(String)(); + tsetAdd(String)(set, "x"); + + iter = tsetIter(String)(set); + testTrue("", tsetIterHasNext(String)(iter)); + + someString = tsetIterElt(String)(iter); + testPointerEqual("", someString, "x"); + iter = tsetIterNext(String)(iter); + + testFalse("", tsetIterHasNext(String)(iter)); +} diff --git a/aldor/aldor/src/ttable.c b/aldor/aldor/src/ttable.c index ae2d5482e..c4a4a527c 100644 --- a/aldor/aldor/src/ttable.c +++ b/aldor/aldor/src/ttable.c @@ -5,6 +5,7 @@ local PointerTSet ptrTSetCreate (void); local PointerTSet ptrTSetEmpty (void); local void ptrTSetFree (PointerTSet); +local Length ptrTSetSize (PointerTSet); local void ptrTSetAdd (PointerTSet, Pointer); local void ptrTSetRemove (PointerTSet, Pointer); local Bool ptrTSetMember (PointerTSet, Pointer); @@ -13,12 +14,16 @@ local PointerTSetIter ptrTSetIter(PointerTSet); local PointerTSetIter ptrTSetIterNext(PointerTSetIter); local Pointer ptrTSetIterElt(PointerTSetIter); local Bool ptrTSetIterHasNext(PointerTSetIter); +local void ptrTSetIterDone(PointerTSetIter); local PointerTSet ptrTSetEmptyVal; +CREATE_TSET(Pointer); + const struct TSetOpsStructName(Pointer) ptrTSetOps = { ptrTSetCreate, ptrTSetFree, + ptrTSetSize, ptrTSetAdd, ptrTSetRemove, ptrTSetMember, @@ -28,77 +33,97 @@ const struct TSetOpsStructName(Pointer) ptrTSetOps = { ptrTSetIterNext, ptrTSetIterElt, ptrTSetIterHasNext, + ptrTSetIterDone, }; local PointerTSet ptrTSetCreate() { PointerTSet tset = (PointerTSet) stoAlloc(OB_Other, sizeof(*tset)); - tset->lst = listNil(Pointer); + tset->table = tblNew(ptrHashFn, ptrEqualFn); return tset; } local PointerTSet ptrTSetEmpty() { - if (ptrTSetEmptyVal == NULL) - ptrTSetEmptyVal = ptrTSetCreate(); - return ptrTSetEmptyVal; + return ptrTSetCreate(); } local void ptrTSetFree(PointerTSet tset) { - listFree(Pointer)(tset->lst); + if (tset == NULL) { + return; + } + tblFree(tset->table); stoFree(tset); } +local Length +ptrTSetSize(PointerTSet tset) +{ + return tblSize(tset->table); +} + local Bool ptrTSetIsEmpty(PointerTSet tset) { - return listNil(Pointer) == tset->lst; + return tblSize(tset->table) == 0; } local Bool ptrTSetMember(PointerTSet tset, Pointer ptr) { - return listMemq(Pointer)(tset->lst, ptr); + return tblElt(tset->table, ptr, NULL) != NULL; } local void ptrTSetAdd(PointerTSet tset, Pointer ptr) { - if (listMemq(Pointer)(tset->lst, ptr)) - return; - tset->lst = listCons(Pointer)(ptr, tset->lst); + assert(ptr != NULL); + tblSetElt(tset->table, ptr, ptr); } local void ptrTSetRemove(PointerTSet tset, Pointer ptr) { - tset->lst = listNRemove(Pointer)(tset->lst, ptr, 0); + tblDrop(tset->table, ptr); } local PointerTSetIter ptrTSetIter(PointerTSet tset) { - return tset->lst; + PointerTSetIter tsetIter = (PointerTSetIter) stoAlloc(OB_Other, sizeof(*tsetIter)); + tblITER(tsetIter->iter, tset->table); + + return tsetIter; } local PointerTSetIter -ptrTSetIterNext(PointerTSetIter iter) +ptrTSetIterNext(PointerTSetIter tsetIter) { - return iter->rest; + tblSTEP(tsetIter->iter); + return tsetIter; } local Pointer -ptrTSetIterElt(PointerTSetIter iter) +ptrTSetIterElt(PointerTSetIter tsetIter) { - return iter->first; + return tblKEY(tsetIter->iter);; } local Bool -ptrTSetIterHasNext(PointerTSetIter iter) +ptrTSetIterHasNext(PointerTSetIter tsetIter) +{ + Bool res = tblMORE(tsetIter->iter); + if (!res) + stoFree(tsetIter); + return res; +} + +local void +ptrTSetIterDone(PointerTSetIter tsetIter) { - return iter != listNil(Pointer); + stoFree(tsetIter); } diff --git a/aldor/aldor/src/ttable.h b/aldor/aldor/src/ttable.h index 098444ddb..cbff35ce4 100644 --- a/aldor/aldor/src/ttable.h +++ b/aldor/aldor/src/ttable.h @@ -2,15 +2,17 @@ #define _TTABLE_H_ #include "cport.h" #include "ostream.h" -#include "list.h" +#include "table.h" + +typedef struct tsetIter { TableIterator iter; } *ANY_TSetIter; #define TSet(Type) Type##TSet #define TSetIter(Type) Type##TSetIter #define DECLARE_TSET(Type) \ typedef struct Type##_TSet { \ - Type##List lst; \ + Table table; \ } *TSet(Type); \ - typedef Type##List Type##TSetIter; \ + typedef ANY_TSetIter Type##TSetIter; \ TSetOpsStruct(Type); \ extern struct TSetOpsStructName(Type) \ const *TSetOps(Type) \ @@ -27,6 +29,7 @@ struct TSetOpsStructName(Type) const *TSetOps(Type) = \ #define tsetCreate(Type) (TSetOps(Type)->Create) #define tsetEmpty(Type) (TSetOps(Type)->Create) #define tsetFree(Type) (TSetOps(Type)->Free) +#define tsetSize(Type) (TSetOps(Type)->Size) #define tsetAdd(Type) (TSetOps(Type)->Add) #define tsetRemove(Type) (TSetOps(Type)->Remove) #define tsetMember(Type) (TSetOps(Type)->Member) @@ -35,6 +38,7 @@ struct TSetOpsStructName(Type) const *TSetOps(Type) = \ #define tsetIterNext(Type) (TSetOps(Type)->IterNext) #define tsetIterElt(Type) (TSetOps(Type)->IterElt) #define tsetIterHasNext(Type) (TSetOps(Type)->IterHasNext) +#define tsetIterDone(Type) (TSetOps(Type)->IterDone) #define TSetOps(Type) Type##_tsetPointer #define TSetOpsStructName(Type) Type##_tsetOpsStruct @@ -43,6 +47,7 @@ struct TSetOpsStructName(Type) const *TSetOps(Type) = \ struct TSetOpsStructName(Type) { \ TSet(Type) (*Create) (void); \ void (*Free) (TSet(Type)); \ + Length (*Size) (TSet(Type)); \ void (*Add) (TSet(Type), Type); \ void (*Remove) (TSet(Type), Type); \ Bool (*Member) (TSet(Type), Type); \ @@ -52,6 +57,7 @@ struct TSetOpsStructName(Type) { \ TSetIter(Type) (*IterNext)(TSetIter(Type)); \ Type (*IterElt)(TSetIter(Type)); \ Bool (*IterHasNext)(TSetIter(Type)); \ + void (*IterDone)(TSetIter(Type)); \ } #if 0 ; /* for editor indentation */ From 244d022e52784c83b68085dd595334e148cd39c5 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 19 Aug 2018 11:29:10 +0100 Subject: [PATCH 296/352] formatters.c: Add a simple formatter for tsets. --- aldor/aldor/src/formatters.c | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/aldor/aldor/src/formatters.c b/aldor/aldor/src/formatters.c index b5e2ba572..2cf2b7687 100644 --- a/aldor/aldor/src/formatters.c +++ b/aldor/aldor/src/formatters.c @@ -13,6 +13,7 @@ #include "strops.h" #include "errorset.h" #include "tconst.h" +#include "ttable.h" local int tfFormatter(OStream stream, Pointer p); local int tfListFormatter(OStream stream, Pointer p); @@ -30,6 +31,8 @@ local int symeListListFormatter(OStream stream, Pointer p); local int symeConditionFormatter(OStream stream, Pointer p); local int symeConditionListFormatter(OStream stream, Pointer p); +local int tsetFormatter(OStream stream, Pointer p); + local int ptrFormatter(OStream stream, Pointer p); local int ptrListFormatter(OStream stream, Pointer p); @@ -65,6 +68,8 @@ fmttsInit() fmtRegister("SymeC", symeConditionFormatter); fmtRegister("SymeCList", symeConditionListFormatter); + fmtRegister("TSet", tsetFormatter); + fmtRegister("Ptr", ptrFormatter); fmtRegister("PtrList", ptrListFormatter); @@ -108,6 +113,27 @@ symeConditionFormatter(OStream ostream, Pointer p) return c; } +local int +tsetFormatter(OStream ostream, Pointer p) +{ + PointerTSet tset = (PointerTSet) p; + PointerTSetIter iter; + String sep = ""; + int c = 0; + + c += ostreamWrite(ostream, "{", -1); + for (iter = tsetIter(Pointer)(tset); + tsetIterHasNext(Pointer)(iter); + iter = tsetIterNext(Pointer)(iter)) { + c += ostreamWrite(ostream, sep, -1); + c += ptrFormatter(ostream, tsetIterElt(Pointer)(iter)); + sep = ", "; + } + + c += ostreamWrite(ostream, ")", -1); + return c; +} + local int ptrFormatter(OStream ostream, Pointer p) { From 48662bc0277278e5f569058f242da9d84ff23a0b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 19 Aug 2018 11:42:37 +0100 Subject: [PATCH 297/352] cport.[ch]: Add ptr eq and hash functions --- aldor/aldor/src/cport.c | 22 +++++++++++++++++++++- aldor/aldor/src/cport.h | 7 +++++++ 2 files changed, 28 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/cport.c b/aldor/aldor/src/cport.c index 89343e5d6..b14dec31c 100644 --- a/aldor/aldor/src/cport.c +++ b/aldor/aldor/src/cport.c @@ -14,7 +14,21 @@ * ****************************************************************************/ -# if defined(CC_noncanonical_pointer) && defined(OS_MS_DOS) && \ +Bool +ptrEqualFn(Pointer p1, Pointer p2) +{ + return ptrEqual(p1, p2); +} + +Hash +ptrHashFn(Pointer p) +{ + Hash h = (Hash) p>>2; // Bottom bit is boring. + + return h * 2654435761; +} + +# if defined(CC_noncanonical_pointer) && defined(OS_MS_DOS) && \ (defined(CC_BORLAND) || defined(CC_MICROSOFT)) #include @@ -51,6 +65,12 @@ ptrEqual(Pointer p, Pointer q) return ptrCanon(p) == ptrCanon(q); } +Hash +ptrHash(Pointer p) +{ + return (Hash) p; +} + long ptrDiff(const char *p, const char *q) { diff --git a/aldor/aldor/src/cport.h b/aldor/aldor/src/cport.h index 7ce9b7937..59ad02bd4 100644 --- a/aldor/aldor/src/cport.h +++ b/aldor/aldor/src/cport.h @@ -243,6 +243,9 @@ * Bool ptrEqual (Pointer, Pointer); * Compare two possible non-canonical pointers. * + * Bool ptrHash (Pointer); + * HashCode for a pointer. + * * long ptrDiff (const char *a, const char *b); * Compute the difference between possibly non-canonical pointers. * @@ -513,11 +516,15 @@ typedef double MostAlignedType; * ****************************************************************************/ +extern Bool ptrEqualFn (Pointer, Pointer); +extern Hash ptrHashFn (Pointer p); + #ifdef CC_noncanonical_pointer extern Pointer ptrCanon (Pointer); extern Pointer ptrOff (const char *, long); extern Bool ptrEqual (Pointer, Pointer); +extern Bool ptrHash (Pointer); extern long ptrDiff (const char *, const char *); extern long ptrToLong(Pointer); extern Pointer ptrFrLong(long); From 00adcf094239325dfe69dcff53a00c74771bfa18 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 19 Aug 2018 11:43:07 +0100 Subject: [PATCH 298/352] list.[ch]: Add containsAll function --- aldor/aldor/src/list.c | 15 +++++++++++++++ aldor/aldor/src/list.h | 2 ++ 2 files changed, 17 insertions(+) diff --git a/aldor/aldor/src/list.c b/aldor/aldor/src/list.c index f394641b3..ad1f2ebd5 100644 --- a/aldor/aldor/src/list.c +++ b/aldor/aldor/src/list.c @@ -438,6 +438,20 @@ ptrlistPosq(PointerList l, Pointer x) return -1; } +/* + * Return true if l1 contains every element in l2 + */ +local Bool +ptrlistContainsAllq(PointerList l1, PointerList l2) +{ + while (l2 != listNil(Pointer)) { + if (ptrlistPosq(l1, car(l2)) == -1) + return false; + l2 = cdr(l2); + } + return true; +} + /* * Return the position of e in l using `eq' as the equality test. * If e is not there, -1 is returned. @@ -590,6 +604,7 @@ const struct ListOpsStructName(Pointer) ptrlistOps = { ptrlistNConcat, ptrlistMemq, ptrlistMember, + ptrlistContainsAllq, ptrlistPosq, ptrlistPosition, ptrlistNRemove, diff --git a/aldor/aldor/src/list.h b/aldor/aldor/src/list.h index 84d545027..986ab093d 100644 --- a/aldor/aldor/src/list.h +++ b/aldor/aldor/src/list.h @@ -48,6 +48,7 @@ # define listCons(Type) (ListOps(Type)->Cons) # define listEqual(Type) (ListOps(Type)->Equal) # define listFind(Type) (ListOps(Type)->Find) +# define listContainsAllq(Type) (ListOps(Type)->ContainsAllq) # define listFreeCons(Type) (ListOps(Type)->FreeCons) # define listFree(Type) (ListOps(Type)->Free) # define listFreeTo(Type) (ListOps(Type)->FreeTo) @@ -151,6 +152,7 @@ Statement({ \ Bool (*Memq) (List(Type), Type); \ Bool (*Member) (List(Type), Type, \ Bool(*eq)(Type,Type) ); \ + Bool (*ContainsAllq) (List(Type), List(Type)); \ int (*Posq) (List(Type), Type); \ int (*Position) (List(Type), Type, \ Bool(*eq)(Type,Type) ); \ From b9d4e0926e1de4f904df7b5749c328da68049835 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 19 Aug 2018 12:06:41 +0100 Subject: [PATCH 299/352] stab.c: Check ablogic condition before calling getConditions - Performance improvement --- aldor/aldor/src/stab.c | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/aldor/aldor/src/stab.c b/aldor/aldor/src/stab.c index 3803e9180..dcecbad43 100644 --- a/aldor/aldor/src/stab.c +++ b/aldor/aldor/src/stab.c @@ -395,6 +395,16 @@ stabEntryGetSymes(StabEntry stent, AbLogic abl) Length i; SymeList symes; + if (abl != NULL && ablogEqual(abl, ablogFalse())) { + if (stent->argc == 1) { + return stent->symev[0]; + } + else { + assert(ablogEqual(stent->condv[1], ablogFalse())); + return stent->symev[1]; + } + } + stabEntryCheckConditions(stent); /* Generic entry: no conditional symes, return them all. */ From 1163e7620ffbe695c4bdf01ef32374a7352f403f Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 19 Aug 2018 12:08:21 +0100 Subject: [PATCH 300/352] syme.c: Add showtwins function - Mostly for debugging --- aldor/aldor/src/sefo.c | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/aldor/aldor/src/sefo.c b/aldor/aldor/src/sefo.c index 13daabb34..dddfbf53f 100644 --- a/aldor/aldor/src/sefo.c +++ b/aldor/aldor/src/sefo.c @@ -1391,6 +1391,18 @@ symeMarkTwins(Syme syme) } } +void +symeShowTwins(Syme syme) +{ + SymeList symes = symeTwins(syme); + + afprintf(dbOut, "%p -> %pPtrList\n", syme, symes); + for (; symes; symes = cdr(symes)) { + Syme twin = car(symes); + if (twin != syme) symeShowTwins(twin); + } +} + local Bool symeFindTwins(Syme syme) { From ab0c40f3cfa718e2ca678db6019a9a243388c76e Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 19 Aug 2018 12:17:54 +0100 Subject: [PATCH 301/352] sefo.c: symeListMember - check all members with eq before using supplied function --- aldor/aldor/src/sefo.c | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/aldor/aldor/src/sefo.c b/aldor/aldor/src/sefo.c index dddfbf53f..21784eb20 100644 --- a/aldor/aldor/src/sefo.c +++ b/aldor/aldor/src/sefo.c @@ -3974,13 +3974,19 @@ tqualListClosure0(Lib lib, TQualList tquals) Bool symeListMember(Syme syme, SymeList symes, SymeEqFun eq) { - for (; symes; symes = cdr(symes)) { + SymeList symes0 = symes; + for (; symes0; symes0 = cdr(symes0)) { /* The extra '==' check saves a lot of funcalls on symeEq. */ - if (syme == car(symes)) - return true; - if (eq != symeEq && eq(syme, car(symes))) + if (syme == car(symes0)) return true; } + + if (eq != symeEq) { + for (; symes; symes = cdr(symes)) { + if (eq(syme, car(symes))) + return true; + } + } return false; } From 0df119a776857e0fdc576a441afc67ea330249de Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 19 Aug 2018 12:20:20 +0100 Subject: [PATCH 302/352] tfsat.c: Use tformSubst for more sharing in getCatExportsConditional This whole thing is a bit odd - might be better to use a better equalModX --- aldor/aldor/src/tfsat.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/aldor/aldor/src/tfsat.c b/aldor/aldor/src/tfsat.c index 382695b09..e80d099a3 100644 --- a/aldor/aldor/src/tfsat.c +++ b/aldor/aldor/src/tfsat.c @@ -1756,7 +1756,7 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) sigma = absFrSymes(stabFile(), mods, Sab); tfsExportDEBUG(dbOut, "tfSatExport[%d]:: Incoming S: %pAbSyn\n", serialThis, Sab); - substT = tfSubst(sigma, symeType(t)); + substT = tformSubst(sigma, symeType(t)); for (symes = S; !tfSatSucceed(result) && symes; symes = cdr(symes)) { Syme s = car(symes); TForm substS; @@ -1765,7 +1765,7 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) continue; } - substS = tfSubst(sigma, symeType(s)); + substS = tformSubst(sigma, symeType(s)); weakEq = abEqualModDeclares(tfExpr(substS), tfExpr(substT)); tfsExportDEBUG(dbOut, "tfsatExport[%d]::CompareTF: [%pTForm], [%pTForm] = %d\n", serialThis, substS, substT, weakEq); @@ -1773,9 +1773,7 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) if (weakEq) { result = tfSatTrue(mask); } - tfFree(substS); } - tfFree(substT); return result; } From 89b7ea20fd5acab305306d71a76b059d5f83f26b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 19 Aug 2018 12:22:14 +0100 Subject: [PATCH 303/352] tfsat.c: Fix some debug statements --- aldor/aldor/src/tfsat.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/tfsat.c b/aldor/aldor/src/tfsat.c index e80d099a3..560205f19 100644 --- a/aldor/aldor/src/tfsat.c +++ b/aldor/aldor/src/tfsat.c @@ -1943,13 +1943,13 @@ tfSatParents(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, SymeList T) newS = tfGetCatParents(symeType(oldSyme), true); queue = cdr(queue); - tfsParentDEBUG(dbOut, " ->tfpSyme: %*s%d= into: %pSymeList", + tfsParentDEBUG(dbOut, " ->tfpSyme: %*s%d= into: %pSymeList\n", tfsDepthNo, "", serialThis, newS); } else newS = listNil(Syme); } - tfsParentDEBUG(dbOut, " ->tfpSyme: %*s= Left: %pSymeList)", + tfsParentDEBUG(dbOut, " ->tfpSyme: %*s= Left: %pSymeList)\n", tfsDepthNo, "", T); if (T == listNil(Syme)) return tfSatTrue(mask); From 7d106ecdc5e46f26c66400f503b5c414ca8e7991 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 20 Aug 2018 20:36:56 +0100 Subject: [PATCH 304/352] stab.c: Use return value of check condition - if false, drop --- aldor/aldor/src/stab.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/stab.c b/aldor/aldor/src/stab.c index dcecbad43..6a9c52715 100644 --- a/aldor/aldor/src/stab.c +++ b/aldor/aldor/src/stab.c @@ -439,7 +439,11 @@ stabEntryCheckConditions(StabEntry stent) npsymes = listNil(Syme); while (psymes != listNil(Syme)) { Syme psyme = car(psymes); - symeCheckCondition(psyme); + psymes = cdr(psymes); + + if (!symeCheckCondition(psyme)) { + continue; + } stabDEBUG(dbOut, "Checked: %pSyme - complete: %d condition: %pAbSynList\n", psyme, symeIsCheckCondIncomplete(psyme), @@ -451,7 +455,6 @@ stabEntryCheckConditions(StabEntry stent) if (symeIsCheckCondIncomplete(psyme)) { npsymes = listCons(Syme)(psyme, npsymes); } - psymes = cdr(psymes); } listFree(Syme)(stent->pending); stent->pending = npsymes; From 2a4cccd25e5a59efb12a013b1dc81a24cbd84b0c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 20 Aug 2018 20:37:12 +0100 Subject: [PATCH 305/352] tform.c: Pre check condition --- aldor/aldor/src/tform.c | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index 0ab43426b..6ee791db4 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -4038,11 +4038,18 @@ tfGetCatExportsCond(SymeList symes0, SefoList conds0, Bool pos) * For example S has Ring and X has Algebra S */ for (symes = symes0; symes; symes = cdr(symes)) { - Syme nsyme = symeCopy(car(symes)); - for (conds = reversedConds0; conds; conds = cdr(conds)) { - symeAddCondition(nsyme, car(conds), pos); + Syme syme = car(symes); + Syme nsyme; + if (listContainsAllq(Sefo)(symeCondition(syme), conds0)) { + nsymes = listCons(Syme)(syme, nsymes); + } + else { + nsyme = symeCopy(syme); + for (conds = reversedConds0; conds; conds = cdr(conds)) { + symeAddCondition(nsyme, car(conds), pos); + } + nsymes = listCons(Syme)(nsyme, nsymes); } - nsymes = listCons(Syme)(nsyme, nsymes); } listFree(Sefo)(reversedConds0); From edf3e2e093c11adec88e22a59ea0191a4fe513f7 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 28 Sep 2018 19:46:23 +0100 Subject: [PATCH 306/352] Revert "tfsat.c: Use tformSubst for more sharing in getCatExportsConditional" This reverts commit 0df119a776857e0fdc576a441afc67ea330249de. Caused segfaults when compiling libaxiom --- aldor/aldor/src/tfsat.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/tfsat.c b/aldor/aldor/src/tfsat.c index 560205f19..510edcf31 100644 --- a/aldor/aldor/src/tfsat.c +++ b/aldor/aldor/src/tfsat.c @@ -1756,7 +1756,7 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) sigma = absFrSymes(stabFile(), mods, Sab); tfsExportDEBUG(dbOut, "tfSatExport[%d]:: Incoming S: %pAbSyn\n", serialThis, Sab); - substT = tformSubst(sigma, symeType(t)); + substT = tfSubst(sigma, symeType(t)); for (symes = S; !tfSatSucceed(result) && symes; symes = cdr(symes)) { Syme s = car(symes); TForm substS; @@ -1765,7 +1765,7 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) continue; } - substS = tformSubst(sigma, symeType(s)); + substS = tfSubst(sigma, symeType(s)); weakEq = abEqualModDeclares(tfExpr(substS), tfExpr(substT)); tfsExportDEBUG(dbOut, "tfsatExport[%d]::CompareTF: [%pTForm], [%pTForm] = %d\n", serialThis, substS, substT, weakEq); @@ -1773,7 +1773,9 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) if (weakEq) { result = tfSatTrue(mask); } + tfFree(substS); } + tfFree(substT); return result; } From e66b9dbc5c9a5f8cc1d5ae77d07fde2317c74863 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 13 Dec 2018 23:17:36 +0000 Subject: [PATCH 307/352] fint.c: Remove untrue assertion --- aldor/aldor/src/fint.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/aldor/aldor/src/fint.c b/aldor/aldor/src/fint.c index 0b3dc6227..3047bb15f 100644 --- a/aldor/aldor/src/fint.c +++ b/aldor/aldor/src/fint.c @@ -4300,8 +4300,6 @@ fintEval_(DataObj retDataObj) fintGetInt(fmt, n); - hardAssert(fintUnitLexsCount(unit, n)); - retDataObj->fiRec = (FiRec) fintAlloc(union dataObj, fintUnitLexsCount(unit,n)); From 37f702b9226a1c9416ccbafad223e927b17dce90 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 13 Dec 2018 23:18:44 +0000 Subject: [PATCH 308/352] ti_bup.c: Allow type aliases and crosses to mix Allows Rep == Cross(...) --- aldor/aldor/src/ti_bup.c | 2 +- aldor/aldor/test/Makefile.in | 2 +- aldor/aldor/test/cross.as | 26 ++++++++++++++++++++++++++ 3 files changed, 28 insertions(+), 2 deletions(-) create mode 100644 aldor/aldor/test/cross.as diff --git a/aldor/aldor/src/ti_bup.c b/aldor/aldor/src/ti_bup.c index b010b134c..d7a77f6cf 100644 --- a/aldor/aldor/src/ti_bup.c +++ b/aldor/aldor/src/ti_bup.c @@ -1356,7 +1356,7 @@ tibup0InferLhs(Stab stab, AbSyn absyn, AbSyn lhs, AbSyn rhs, TPoss tprhs) trhsv= &trhs; } else if (abTag(lhs) == AB_Comma) { - trhs = tfDefineeType(trhs); + trhs = tfDefineeBaseType(trhs); rhs = NULL; if (tfIsCross(trhs) && tfCrossArgc(trhs) == lhsc) trhsv = tfCrossArgv(trhs); diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 21b1ecb76..28e5b07f9 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -59,7 +59,7 @@ aptests := exquo fmtests := rectest enumtest clos strtable1 simple apply nestcond ctests := rectest enumtest multinever maptuple otests := enumtest -xtests := enumtest jimport +xtests := enumtest jimport cross @BUILD_JAVA_TRUE@jtests := simple_j enumtest run_j halt @HAS_JUNIT_TRUE@junittests := JExportTest JThrowTest diff --git a/aldor/aldor/test/cross.as b/aldor/aldor/test/cross.as new file mode 100644 index 000000000..d0654de45 --- /dev/null +++ b/aldor/aldor/test/cross.as @@ -0,0 +1,26 @@ +#include "foamlib" +#pile + +Foo: with + new: String -> % + foo: % -> String + bar: % -> String +== add + Rep == Cross(String, String) + new(n: String): % == (n, n)@Rep pretend % + foo(c: %): String == + (a, b) := rep c + a + + bar(c: %): String == bar(rep c) + + bar(c: Rep): String == + (a, b) := c + a + +test(): () == + import from Foo, String + print << foo(new("xx")) << newline + print << bar(new "xx") << newline + +test() \ No newline at end of file From e4deebdd7d851b4614b540ac720760850e69a65f Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Thu, 13 Dec 2018 23:19:08 +0000 Subject: [PATCH 309/352] sal_fname.as: Remove output --- aldor/lib/aldor/src/util/sal_fname.as | 1 - 1 file changed, 1 deletion(-) diff --git a/aldor/lib/aldor/src/util/sal_fname.as b/aldor/lib/aldor/src/util/sal_fname.as index 8eba6b0eb..d66222588 100644 --- a/aldor/lib/aldor/src/util/sal_fname.as +++ b/aldor/lib/aldor/src/util/sal_fname.as @@ -67,7 +67,6 @@ FileName : FileNameCategory == add coerce(s : String) : % == (flg1, lastSlash, c) := linearReverseSearch(char "/", s) (flg2, lastDot, c) := linearReverseSearch(char ".", s) - stdout << "coerce " << s << " " << flg1 << flg2 << newline if flg1 and flg2 and lastDot > lastSlash then filename(substring(s, 0, lastSlash), substring(s, lastSlash+1, lastDot - lastSlash - 1), From ffcc78a5c95c9d243ed40b5429cdca06018111f6 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 21:20:47 +0000 Subject: [PATCH 310/352] int.c: Add AIntPtr type Just a pointer that looks like an integer. Keeps the function pointer police at bay --- aldor/aldor/src/int.c | 12 ++++++++++++ aldor/aldor/src/int.h | 8 ++++++++ 2 files changed, 20 insertions(+) diff --git a/aldor/aldor/src/int.c b/aldor/aldor/src/int.c index f14cf2d8b..dcb6a1ff2 100644 --- a/aldor/aldor/src/int.c +++ b/aldor/aldor/src/int.c @@ -22,12 +22,24 @@ aintEqual(AInt i1, AInt i2) return i1 == i2; } +Bool +aintPtrEqual(AIntPtr i1, AIntPtr i2) +{ + return i1 == i2; +} + Hash aintHash(AInt n) { return n; } +Hash +aintPtrHash(AIntPtr n) +{ + return ptr2aint(n); +} + AInt aintAbsorbingSum(AInt max, AInt i1, AInt i2) { diff --git a/aldor/aldor/src/int.h b/aldor/aldor/src/int.h index 3b3f1cc0a..f6007d16b 100644 --- a/aldor/aldor/src/int.h +++ b/aldor/aldor/src/int.h @@ -1,10 +1,18 @@ #ifndef _INT_H_ #include "cport.h" +typedef void *AIntPtr; +#define aint2ptr(n) ((AIntPtr) n) +#define ptr2aint(p) ((AInt) p) + extern Bool longIsInt32(long n); extern Bool aintEqual(AInt i1, AInt i2); extern Hash aintHash(AInt i1); + +extern Bool aintPtrEqual(AIntPtr i1, AIntPtr i2); +extern Hash aintPtrHash(AIntPtr i1); + extern AInt aintAbsorbingSum(AInt, AInt, AInt); #ifdef CC_long_not_int32 From 90677caa4a77cfceeaa32cdea3bfaba9570cd940 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 21:21:38 +0000 Subject: [PATCH 311/352] Phase.h: Correct the type of PhPrFun - it returns an int. --- aldor/aldor/src/phase.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/phase.h b/aldor/aldor/src/phase.h index d9011f9ce..bf8f77e4f 100644 --- a/aldor/aldor/src/phase.h +++ b/aldor/aldor/src/phase.h @@ -47,7 +47,7 @@ struct phInfo { }; typedef Enum(phTag) PhTag; -typedef void (*PhPrFun)(FILE *, Pointer); +typedef int (*PhPrFun)(FILE *, Pointer); extern int phTraceOption(String flags); /* From c6a1e7f53fb499fa469bab500cf7115cbcf5e113 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 21:22:13 +0000 Subject: [PATCH 312/352] gf_imps.c: Type fix for gen0BuiltinTable --- aldor/aldor/src/gf_imps.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/gf_imps.c b/aldor/aldor/src/gf_imps.c index 86eb593e2..969f30b64 100644 --- a/aldor/aldor/src/gf_imps.c +++ b/aldor/aldor/src/gf_imps.c @@ -1314,8 +1314,8 @@ static Table gen0BuiltinTable; void gen0InitBuiltinTable() { - gen0BuiltinTable = tblNew((TblHashFun) aintHash, - (TblEqFun) aintEqual); + gen0BuiltinTable = tblNew((TblHashFun) aintPtrHash, + (TblEqFun) aintPtrEqual); } void From 945945e0accacd7668e5d828252a532b135b1bd7 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 21:22:49 +0000 Subject: [PATCH 313/352] foam_c.c: Fix expected return of fiClos --- aldor/aldor/src/foam_c.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/foam_c.c b/aldor/aldor/src/foam_c.c index 412e0a8fe..a40315691 100644 --- a/aldor/aldor/src/foam_c.c +++ b/aldor/aldor/src/foam_c.c @@ -156,7 +156,7 @@ fiEnvEnsureFun(FiEnv e) { FiWord tmp = (e)->info; if ((FiClos) tmp != NULL) - fiCCall0(FiWord, ((FiClos) tmp)); + fiCCall0(Ptr, ((FiClos) tmp)); } /***************************************************************************** From b926f1296326d9b33c9e25fe897cec699ae3c2ff Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 21:23:12 +0000 Subject: [PATCH 314/352] annabs.c: Use aintPtr functions in hashtable --- aldor/aldor/src/annabs.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/annabs.c b/aldor/aldor/src/annabs.c index ab46daa8b..0575145a4 100644 --- a/aldor/aldor/src/annabs.c +++ b/aldor/aldor/src/annabs.c @@ -62,9 +62,9 @@ abcNew(void) { AbAnnotationBucket bucket = (AbAnnotationBucket) stoAlloc((int) OB_Other, sizeof(*bucket)); bucket->indexForSefo = tblNew((TblHashFun) abHashSefo, (TblEqFun) sefoEqual); - bucket->sxForIndex = tblNew((TblHashFun) aintHash, (TblEqFun) aintEqual); + bucket->sxForIndex = tblNew((TblHashFun) aintPtrHash, (TblEqFun) aintPtrEqual); bucket->indexForSyme = tblNew((TblHashFun) symeHashFn, (TblEqFun) symeEqualWithAnnotation); - bucket->symeSxForIndex = tblNew((TblHashFun) aintHash, (TblEqFun) aintEqual); + bucket->symeSxForIndex = tblNew((TblHashFun) aintPtrHash, (TblEqFun) aintPtrEqual); bucket->nextIndex = 0; bucket->nextSymeIndex = 0; return bucket; From 9796b902e7e6b1f5b769d1590f3f3b26ad0acd12 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 21:23:50 +0000 Subject: [PATCH 315/352] fint.c: Use correct form of fallthrough comment --- aldor/aldor/src/fint.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/fint.c b/aldor/aldor/src/fint.c index 3047bb15f..05424718d 100644 --- a/aldor/aldor/src/fint.c +++ b/aldor/aldor/src/fint.c @@ -4039,7 +4039,7 @@ fintEval_(DataObj retDataObj) retDataObj->fiDFlo = fiUnBoxDFlo(expr.fiSInt); goto castDone; } - /* NO BREAK !*/ + /* fall through !*/ case FOAM_Word: switch ((int)toType) { case FOAM_SInt: @@ -4052,7 +4052,7 @@ fintEval_(DataObj retDataObj) retDataObj->fiDFlo = fiUnBoxDFlo(expr.fiSInt); goto castDone; } - /* NO BREAK !*/ + /* fall through !*/ default:{ int frSize = 0, toSize = 0; From eacc8fa15b78127c494b931c9edfcf86e75ec499 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 22:47:07 +0000 Subject: [PATCH 316/352] test_stab.c: Additional init() removed --- aldor/aldor/src/test/test_stab.c | 1 - 1 file changed, 1 deletion(-) diff --git a/aldor/aldor/src/test/test_stab.c b/aldor/aldor/src/test/test_stab.c index 8064948b8..a9a646214 100644 --- a/aldor/aldor/src/test/test_stab.c +++ b/aldor/aldor/src/test/test_stab.c @@ -85,7 +85,6 @@ testTFormCascadedImport() absynList = listCons(AbSyn)(stdtypes(), abqParseLines(lines)); absyn = abNewSequenceL(sposNone, absynList); - initFile(); stabImportDebug = 1; tipBupDebug = 1; From 179d3436f195672d087aee22b5eb06d94ab94c09 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 22:46:35 +0000 Subject: [PATCH 317/352] FIXUP: test_java.c: extra fini() --- aldor/aldor/src/test/test_java.c | 1 + 1 file changed, 1 insertion(+) diff --git a/aldor/aldor/src/test/test_java.c b/aldor/aldor/src/test/test_java.c index 07c8fec09..6fdad51ea 100644 --- a/aldor/aldor/src/test/test_java.c +++ b/aldor/aldor/src/test/test_java.c @@ -73,4 +73,5 @@ testValidation() testFalse("NotSefo", abIsSefo(imp->abImport.what)); + finiFile(); } From d8ef53674b72945ed937e7b4db669c350a4119b3 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 22:47:33 +0000 Subject: [PATCH 318/352] fix - test tform.c: Need a finiFile --- aldor/aldor/src/test/test_tform.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/aldor/src/test/test_tform.c b/aldor/aldor/src/test/test_tform.c index 48fd19f82..3b25e6f77 100644 --- a/aldor/aldor/src/test/test_tform.c +++ b/aldor/aldor/src/test/test_tform.c @@ -158,4 +158,6 @@ testMachineInt() tfqTypeInfer(stabFile(), "MachineInteger: with == add; default x: MachineInteger"); testTrue("xx", tfMachineInteger != tfUnknown); + + finiFile(); } From 4a25a84b5b6b3da932b0cf478e34510633b17ab5 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 22:50:35 +0000 Subject: [PATCH 319/352] test_ablogic.c: Add finiFile where needed --- aldor/aldor/src/test/test_ablogic.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/aldor/src/test/test_ablogic.c b/aldor/aldor/src/test/test_ablogic.c index 1a60854b7..1742276cf 100644 --- a/aldor/aldor/src/test/test_ablogic.c +++ b/aldor/aldor/src/test/test_ablogic.c @@ -90,6 +90,7 @@ testAblog() testTrue("10", ablogImplies(cond1, cond0)); testFalse("01",ablogImplies(cond0, cond1)); testTrue("11", ablogImplies(cond1, cond1)); + finiFile(); } local void testAbLogEqual(String text, Stab stab, Sefo sefo1, Sefo sefo2); @@ -142,6 +143,7 @@ testAblogSefo() 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)); + finiFile(); } local void From 7447c807c7c0a0251235f2445d37c6566e82f54b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 22:51:06 +0000 Subject: [PATCH 320/352] test_genfoam.c: Add finiFile where needed --- aldor/aldor/src/test/test_genfoam.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/aldor/aldor/src/test/test_genfoam.c b/aldor/aldor/src/test/test_genfoam.c index 60f1fb68c..b60d4119c 100644 --- a/aldor/aldor/src/test/test_genfoam.c +++ b/aldor/aldor/src/test/test_genfoam.c @@ -49,6 +49,8 @@ testForeign() testIntEqual("Error Count", 0, comsgErrorCount()); foam = generateFoam(stab, absyn, "test"); + + finiFile(); /* 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 @@ -58,4 +60,5 @@ testForeign() foam); testAIntEqual(FOAM_Rec, foamExprType(foam, pcall->first->foamPCall.argv[0])) #endif + } From f22d5b94f71a2dfccaf13ae0cade5338bc6f5db3 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 22:51:20 +0000 Subject: [PATCH 321/352] test_tibup.c: Add finiFile where needed --- aldor/aldor/src/test/test_tibup.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/aldor/aldor/src/test/test_tibup.c b/aldor/aldor/src/test/test_tibup.c index f40d3fc16..73fd67010 100644 --- a/aldor/aldor/src/test/test_tibup.c +++ b/aldor/aldor/src/test/test_tibup.c @@ -215,6 +215,8 @@ testTiBupApplyMixed() tiTopDown(stab, case1, tfNone()); testIntEqual("Unique", AB_State_HasUnique, abState(case1)); + + finiFile(); } @@ -251,6 +253,7 @@ testTiBupApplyImplicit() tiTopDown(stab, case1, tfNone()); testIntEqual("Unique", AB_State_HasUnique, abState(case1)); + finiFile(); } From c100ac8fccc2c5e681a8d8fe583114aea96ffd2d Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 22:51:49 +0000 Subject: [PATCH 322/352] test_tinfer.c: Add finiFile where needed --- aldor/aldor/src/test/test_tinfer.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/aldor/src/test/test_tinfer.c b/aldor/aldor/src/test/test_tinfer.c index 94603de44..020b15c7a 100644 --- a/aldor/aldor/src/test/test_tinfer.c +++ b/aldor/aldor/src/test/test_tinfer.c @@ -376,7 +376,7 @@ testConditionalTInfer4() testTrue("Declare is sefo", abIsSefo(absyn)); testIntEqual("Error Count", 0, comsgErrorCount()); - + finiFile(); } void From 9e3f9df3b932416b125ce4d8e393c26785b8285f Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 1 Feb 2019 22:52:46 +0000 Subject: [PATCH 323/352] testlib.c: Add assertions around file state --- aldor/aldor/src/test/testlib.c | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/aldor/aldor/src/test/testlib.c b/aldor/aldor/src/test/testlib.c index 70658c8a2..c037d00cb 100644 --- a/aldor/aldor/src/test/testlib.c +++ b/aldor/aldor/src/test/testlib.c @@ -157,24 +157,35 @@ testAllPassed() return failed == 0; } +static Bool inFile = false; + void initFile() { + if (inFile) { + testFail("", "missing 'finiFile()'"); + } macexInitFile(); comsgInit(); scobindInitFile(); stabInitFile(); + inFile = true; } void finiFile() { + if (!inFile) { + testFail("", "missing 'initFile()'"); + } + scobindFiniFile(); stabFiniFile(); comsgFini(); macexFiniFile(); cmdDebugReset(); + inFile = false; } void @@ -202,5 +213,8 @@ fini() { saveAndEmptyAllPhaseSymbolData(); + if (inFile) + testFail("", "Missing fini"); + dbFini(); } From 5c72cc57022db8970d93a07e4d16d908f4bccec6 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 29 Jul 2019 21:46:33 +0100 Subject: [PATCH 324/352] stab.c, editlevels.h: Remove EDIT_1_0_n2_06 --- aldor/aldor/src/editlevels.h | 1 - aldor/aldor/src/stab.c | 11 ++--------- 2 files changed, 2 insertions(+), 10 deletions(-) diff --git a/aldor/aldor/src/editlevels.h b/aldor/aldor/src/editlevels.h index 296c1a447..a1f34d723 100644 --- a/aldor/aldor/src/editlevels.h +++ b/aldor/aldor/src/editlevels.h @@ -27,7 +27,6 @@ /* ===================================================================== */ /* ============================ Aldor Edits ============================ */ /* ===================================================================== */ -#define EDIT_1_0_n2_06 1 /* fix bug 4 - disabled type cache in stab */ /* * These next three (probably just edit 6) break AXIOM 2.3. Unfortunately diff --git a/aldor/aldor/src/stab.c b/aldor/aldor/src/stab.c index 6a9c52715..e2797bf59 100644 --- a/aldor/aldor/src/stab.c +++ b/aldor/aldor/src/stab.c @@ -492,12 +492,6 @@ stabEntryGetTypes(StabEntry stent, AbLogic abl) TPoss tposs; stabEntryCheckConditions(stent); -/*LDR*/ -#if EDIT_1_0_n2_06 != 1 - /* Generic entry: no conditional symes, return all types. */ - if (stent->argc == 1) - return stabEntryCacheTypes(stent, int0); -#endif /* Generic query: return the unconditional types. */ if (abl == NULL || ablogIsTrue(abl)) @@ -661,13 +655,12 @@ stabGetEntry(Stab stab0, Symbol id, Bool recurse) stabDEBUG(dbOut, " ... copying"); } -/*LDR*/ -#if 1 && EDIT_1_0_n2_06 + if (DEBUG(stab)) { fnewline(dbOut); } stabEntryGetTypes(stent, ablogFalse()); -#endif + if (DEBUG(stab)) { SymeList sl = stabEntryAllSymes(stent); TPoss tp = stabEntryAllTypes(stent); From e5b2f3f5610766b0131a3c3d06f823a0904681c1 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 29 Jul 2019 22:12:54 +0100 Subject: [PATCH 325/352] tests: Add test for empty cross (I know it's not very useful, but good to be able to map () to a cross) --- aldor/aldor/test/Makefile.in | 2 +- aldor/aldor/test/silly.as | 11 +++++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) create mode 100644 aldor/aldor/test/silly.as diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 28e5b07f9..983e1d705 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -56,7 +56,7 @@ foamsrcdir = $(abs_top_srcdir)/aldor/lib/libfoam foamdir = $(abs_top_builddir)/aldor/lib/libfoam aptests := exquo -fmtests := rectest enumtest clos strtable1 simple apply nestcond +fmtests := rectest enumtest clos strtable1 simple apply nestcond silly ctests := rectest enumtest multinever maptuple otests := enumtest xtests := enumtest jimport cross diff --git a/aldor/aldor/test/silly.as b/aldor/aldor/test/silly.as new file mode 100644 index 000000000..e97d4c2ba --- /dev/null +++ b/aldor/aldor/test/silly.as @@ -0,0 +1,11 @@ +#include "foamlib" +#pile + +Pair(X: with, x: X): with + value: () -> X + obj: % +== add + Rep == Cross() + value(): X == x + obj: % == per( ()@Cross()) + From 01b781f75fe09641aeda8d3f59f1d91f5a8570ea Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 15 Jul 2019 22:28:59 +0100 Subject: [PATCH 326/352] lib.c: libfricas.al is an alternate name for libaxiom.al --- aldor/aldor/src/lib.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/src/lib.c b/aldor/aldor/src/lib.c index e94a3d113..77b78d9a2 100644 --- a/aldor/aldor/src/lib.c +++ b/aldor/aldor/src/lib.c @@ -539,7 +539,8 @@ libLibrarySyme(Lib lib) { String id; - if (strEqual(libGetFileId(lib), "axiom")) + if (strEqual(libGetFileId(lib), "axiom") + || strEqual(libGetFileId(lib), "fricas")) id = libToStringShort(lib); else id = libGetFileId(lib); From 449821564376ecf2397d272dbd60c25b1d7d4281 Mon Sep 17 00:00:00 2001 From: LdBeth Date: Tue, 3 Mar 2020 03:41:21 -0800 Subject: [PATCH 327/352] Fix #134 Bring back macOS/OSX platform support. --- aldor/aldor/src/os_macosx_vm.c | 7 +++++-- aldor/aldor/src/time.h0 | 2 +- aldor/m4/strict_compile.m4 | 3 ++- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/aldor/aldor/src/os_macosx_vm.c b/aldor/aldor/src/os_macosx_vm.c index 496713ba1..1ba94c9dc 100644 --- a/aldor/aldor/src/os_macosx_vm.c +++ b/aldor/aldor/src/os_macosx_vm.c @@ -21,9 +21,12 @@ #include #include #include +#include #include #include +#include "util.h" + #define OS_PAGE_SIZE 4096 /* from mach/machine/vm_param.h */ Pointer @@ -271,8 +274,8 @@ next_os_vm_region(os_vm_region_t region) { vm_region_basic_info_data_t data ; vm_map_t this_task = mach_task_self() ; - vm_address_t address = ptrToLong(region->hi) ; - vm_size_t size ; + mach_vm_address_t address = ptrToLong(region->hi) ; + mach_vm_size_t size ; vm_region_flavor_t flavour = VM_REGION_BASIC_INFO ; unsigned int info_count = sizeof(data)/sizeof(int) ; mach_port_t object_name ; diff --git a/aldor/aldor/src/time.h0 b/aldor/aldor/src/time.h0 index 05ff2008f..6491c0d58 100644 --- a/aldor/aldor/src/time.h0 +++ b/aldor/aldor/src/time.h0 @@ -22,7 +22,7 @@ typedef unsigned long time_t; #endif /* !CC_no_time_h */ #ifndef CLK_TCK -# define CLK_TCK CLOCK_PER_SECOND +# define CLK_TCK CLOCKS_PER_SEC #endif #endif /* !_TIME_H0_ */ diff --git a/aldor/m4/strict_compile.m4 b/aldor/m4/strict_compile.m4 index 0227f0d86..05904ef35 100644 --- a/aldor/m4/strict_compile.m4 +++ b/aldor/m4/strict_compile.m4 @@ -22,7 +22,8 @@ AC_DEFUN([ALDOR_STRICT_COMPILE], ;; clang*) cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -fcolor-diagnostics -Wno-error=enum-conversion \ - -Wno-error=tautological-compare -Wno-parentheses-equality" + -Wno-error=tautological-compare -Wno-parentheses-equality \ + -Wno-error=return-type" ;; *) AC_MSG_WARN(Unknown C compiler ${CC}) From 60136d9baada53a6bcc3bcb40acb23d07fb1dadf Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 6 Mar 2020 21:00:43 +0000 Subject: [PATCH 328/352] travis.yml: Add macos target --- .travis.yml | 27 ++++++++++++++++++++++----- build-macos.sh | 13 +++++++++++++ 2 files changed, 35 insertions(+), 5 deletions(-) create mode 100644 build-macos.sh diff --git a/.travis.yml b/.travis.yml index 500a86c46..e962b1903 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,13 +1,30 @@ language: c -script: dpkg-buildpackage -b -us -uc -install: - - sudo apt-get install libgmp-dev - - sudo apt-get install fakeroot - - sudo apt-get install debhelper +jobs: + include: + - os: macos + script: sh ./build-macos.sh + compiler: clang + + - os: linux + script: dpkg-buildpackage -b -us -uc + compiler: gcc + install: + - sudo apt-get install libgmp-dev + - sudo apt-get install fakeroot + - sudo apt-get install debhelper + +# - os: linux +# compiler: clang +# script: dpkg-buildpackage -b -us -uc +# install: +# - sudo apt-get install libgmp-dev +# - sudo apt-get install fakeroot +# - sudo apt-get install debhelper # whitelist branches: only: - master - /.*\/staging/ + - /.*\/travis/ diff --git a/build-macos.sh b/build-macos.sh new file mode 100644 index 000000000..e042e49ed --- /dev/null +++ b/build-macos.sh @@ -0,0 +1,13 @@ +#!/bin/sh + +echo "current directory is: " $(pwd) +echo files: +ls +root=`pwd` +mkdir build +cd aldor +./autogen.sh + +cd ../build +../aldor/configure --prefix=$root/opt +make From eb67f996cf8e379c7391f5f0f37c60a955f35138 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Mar 2020 00:31:49 +0000 Subject: [PATCH 329/352] macos: No sbrk required --- aldor/configure.ac | 1 + aldor/m4/error-on-warn.m4 | 7 ++++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/aldor/configure.ac b/aldor/configure.ac index 1166e747f..245db01a6 100644 --- a/aldor/configure.ac +++ b/aldor/configure.ac @@ -6,6 +6,7 @@ AC_INIT([aldor],[1.2],[aldor@xinutec.org]) AC_CONFIG_MACRO_DIR([m4]) AC_CONFIG_SRCDIR([aldor/src/main.c]) AC_CONFIG_AUX_DIR([amaux]) +AC_CANONICAL_HOST # Automake AM_INIT_AUTOMAKE([foreign silent-rules parallel-tests color-tests subdir-objects]) diff --git a/aldor/m4/error-on-warn.m4 b/aldor/m4/error-on-warn.m4 index 71ec5ab44..b746288f8 100644 --- a/aldor/m4/error-on-warn.m4 +++ b/aldor/m4/error-on-warn.m4 @@ -1,7 +1,12 @@ AC_DEFUN([ALDOR_ERROR_ON_WARN], ALDOR_STRICT_COMPILE -ALDOR_SBRK_OPTION +[echo HOST OS ${host_os}; + case "${host_os}" in + macos) ;; + *) ALDOR_SBRK_OPTION;; + esac] + [AC_MSG_CHECKING(what extra warning flags to pass to the C compiler) warnFLAGS= STRICTCFLAGS="${CFLAGS}" From ce3f2046a8099b6e60179d9699fda5b5ac847dca Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Mar 2020 00:39:23 +0000 Subject: [PATCH 330/352] travis: Fix osname --- aldor/m4/error-on-warn.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aldor/m4/error-on-warn.m4 b/aldor/m4/error-on-warn.m4 index b746288f8..b76db97af 100644 --- a/aldor/m4/error-on-warn.m4 +++ b/aldor/m4/error-on-warn.m4 @@ -3,7 +3,7 @@ AC_DEFUN([ALDOR_ERROR_ON_WARN], ALDOR_STRICT_COMPILE [echo HOST OS ${host_os}; case "${host_os}" in - macos) ;; + darwin*) ;; *) ALDOR_SBRK_OPTION;; esac] From e50e96de01acf5e9796849f640fbc4e5cfb04830 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Mar 2020 00:44:42 +0000 Subject: [PATCH 331/352] macos: Guard sbrk --- aldor/aldor/src/opsys_port.h.in | 2 ++ 1 file changed, 2 insertions(+) diff --git a/aldor/aldor/src/opsys_port.h.in b/aldor/aldor/src/opsys_port.h.in index 621f7a09f..7ddc87d90 100644 --- a/aldor/aldor/src/opsys_port.h.in +++ b/aldor/aldor/src/opsys_port.h.in @@ -7,6 +7,8 @@ #define _ALL_SOURCE 1 /* For RS/6000 - should come before cport.h include. */ #define _POSIX_SOURCE 1 /* For Linux/BSD. */ +#if "@SBRK_OPT@" != "" #define @SBRK_OPT@ +#endif #endif From 50b4c08bf6bf64eb887bd864aa3b5cdb0a0fe81a Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Mar 2020 00:52:10 +0000 Subject: [PATCH 332/352] macos: try again.. --- aldor/aldor/src/opsys_port.h.in | 2 -- aldor/m4/error-on-warn.m4 | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/aldor/aldor/src/opsys_port.h.in b/aldor/aldor/src/opsys_port.h.in index 7ddc87d90..621f7a09f 100644 --- a/aldor/aldor/src/opsys_port.h.in +++ b/aldor/aldor/src/opsys_port.h.in @@ -7,8 +7,6 @@ #define _ALL_SOURCE 1 /* For RS/6000 - should come before cport.h include. */ #define _POSIX_SOURCE 1 /* For Linux/BSD. */ -#if "@SBRK_OPT@" != "" #define @SBRK_OPT@ -#endif #endif diff --git a/aldor/m4/error-on-warn.m4 b/aldor/m4/error-on-warn.m4 index b76db97af..a421ef0cc 100644 --- a/aldor/m4/error-on-warn.m4 +++ b/aldor/m4/error-on-warn.m4 @@ -3,7 +3,7 @@ AC_DEFUN([ALDOR_ERROR_ON_WARN], ALDOR_STRICT_COMPILE [echo HOST OS ${host_os}; case "${host_os}" in - darwin*) ;; + darwin*) sbrk_opt = SBRK_NOT_NEEDED;; *) ALDOR_SBRK_OPTION;; esac] From 061db8ef55f46b3715c9ca429f81f6e9bfa4a5f9 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Mar 2020 01:03:34 +0000 Subject: [PATCH 333/352] macos: define sbrk thing.. --- aldor/m4/error-on-warn.m4 | 6 +----- aldor/m4/sbrk.m4 | 29 ++++++++++++++++------------- 2 files changed, 17 insertions(+), 18 deletions(-) diff --git a/aldor/m4/error-on-warn.m4 b/aldor/m4/error-on-warn.m4 index a421ef0cc..4e20601ee 100644 --- a/aldor/m4/error-on-warn.m4 +++ b/aldor/m4/error-on-warn.m4 @@ -1,11 +1,7 @@ AC_DEFUN([ALDOR_ERROR_ON_WARN], ALDOR_STRICT_COMPILE -[echo HOST OS ${host_os}; - case "${host_os}" in - darwin*) sbrk_opt = SBRK_NOT_NEEDED;; - *) ALDOR_SBRK_OPTION;; - esac] +ALDOR_SBRK_OPTION [AC_MSG_CHECKING(what extra warning flags to pass to the C compiler) warnFLAGS= diff --git a/aldor/m4/sbrk.m4 b/aldor/m4/sbrk.m4 index 58b61ffff..7d2bf5776 100644 --- a/aldor/m4/sbrk.m4 +++ b/aldor/m4/sbrk.m4 @@ -5,19 +5,22 @@ cat > conftest_sbrk.c << EOF #include int main() { sbrk(3); } EOF - -if ${CC} ${CFLAGS} ${cfgSTRICTCFLAGS} conftest_sbrk.c >&AS_MESSAGE_LOG_FD 2>&1; -then - sbrk_opt=_ALDOR_ANY_SBRK -elif ${CC} ${CFLAGS} ${cfgSTRICTCFLAGS} -D_BSD_SOURCE conftest_sbrk.c >&AS_MESSAGE_LOG_FD 2>&1; -then - sbrk_opt=_BSD_SOURCE -elif ${CC} ${CFLAGS} ${cfgSTRICTCFLAGS} -D_DEFAULT_SOURCE conftest_sbrk.c >&AS_MESSAGE_LOG_FD 2>&1; -then - sbrk_opt=_DEFAULT_SOURCE -else - AC_MSG_FAILURE([No way to get sbrk()]) -fi +case ${host_os} in + darwin*) sbrk_opt=_SBRK_NOT_NEEDED + *) + if ${CC} ${CFLAGS} ${cfgSTRICTCFLAGS} conftest_sbrk.c >&AS_MESSAGE_LOG_FD 2>&1; + then + sbrk_opt=_ALDOR_ANY_SBRK + elif ${CC} ${CFLAGS} ${cfgSTRICTCFLAGS} -D_BSD_SOURCE conftest_sbrk.c >&AS_MESSAGE_LOG_FD 2>&1; + then + sbrk_opt=_BSD_SOURCE + elif ${CC} ${CFLAGS} ${cfgSTRICTCFLAGS} -D_DEFAULT_SOURCE conftest_sbrk.c >&AS_MESSAGE_LOG_FD 2>&1; + then + sbrk_opt=_DEFAULT_SOURCE + else + AC_MSG_FAILURE([No way to get sbrk()]) + fi +esac SBRK_OPT=$sbrk_opt AC_SUBST(SBRK_OPT) AC_MSG_RESULT($sbrk_opt) From 7c9b11d363aaca926d90c27e707687127ef2c99f Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Mar 2020 01:13:38 +0000 Subject: [PATCH 334/352] macos: syntax --- aldor/m4/sbrk.m4 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/m4/sbrk.m4 b/aldor/m4/sbrk.m4 index 7d2bf5776..8c3ff2835 100644 --- a/aldor/m4/sbrk.m4 +++ b/aldor/m4/sbrk.m4 @@ -6,7 +6,7 @@ cat > conftest_sbrk.c << EOF int main() { sbrk(3); } EOF case ${host_os} in - darwin*) sbrk_opt=_SBRK_NOT_NEEDED + darwin*) sbrk_opt=_SBRK_NOT_NEEDED;; *) if ${CC} ${CFLAGS} ${cfgSTRICTCFLAGS} conftest_sbrk.c >&AS_MESSAGE_LOG_FD 2>&1; then @@ -19,7 +19,7 @@ case ${host_os} in sbrk_opt=_DEFAULT_SOURCE else AC_MSG_FAILURE([No way to get sbrk()]) - fi + fi;; esac SBRK_OPT=$sbrk_opt AC_SUBST(SBRK_OPT) From 03058c499277c1e0d10daa372e953a19331a8e22 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Mar 2020 09:16:40 +0000 Subject: [PATCH 335/352] util.c: Explicit return for hashCombinePair --- aldor/aldor/src/util.c | 1 + 1 file changed, 1 insertion(+) diff --git a/aldor/aldor/src/util.c b/aldor/aldor/src/util.c index 1a47bc0e5..ce0641d5f 100644 --- a/aldor/aldor/src/util.c +++ b/aldor/aldor/src/util.c @@ -503,6 +503,7 @@ hashCombinePair(int i1, int i2) else { assert(0);/* Need a new hash function */ } + NotReached(return 0;); } /* Used this for digging out random numbers: */ From 86b555a2def3b6153cac42b1998e5e62c98e1757 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Mar 2020 09:28:44 +0000 Subject: [PATCH 336/352] More experiments --- aldor/m4/strict_compile.m4 | 3 +-- build-macos.sh | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/aldor/m4/strict_compile.m4 b/aldor/m4/strict_compile.m4 index 05904ef35..0227f0d86 100644 --- a/aldor/m4/strict_compile.m4 +++ b/aldor/m4/strict_compile.m4 @@ -22,8 +22,7 @@ AC_DEFUN([ALDOR_STRICT_COMPILE], ;; clang*) cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -fcolor-diagnostics -Wno-error=enum-conversion \ - -Wno-error=tautological-compare -Wno-parentheses-equality \ - -Wno-error=return-type" + -Wno-error=tautological-compare -Wno-parentheses-equality" ;; *) AC_MSG_WARN(Unknown C compiler ${CC}) diff --git a/build-macos.sh b/build-macos.sh index e042e49ed..979a4d822 100644 --- a/build-macos.sh +++ b/build-macos.sh @@ -10,4 +10,4 @@ cd aldor cd ../build ../aldor/configure --prefix=$root/opt -make +make V=1 From e05ecc9447b9461b1e96034cd5a91a86fea12145 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Mar 2020 10:29:49 +0000 Subject: [PATCH 337/352] mac --- aldor/aldor/subcmd/unitools/Makefile.am | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/subcmd/unitools/Makefile.am b/aldor/aldor/subcmd/unitools/Makefile.am index 2471582b4..af2742402 100644 --- a/aldor/aldor/subcmd/unitools/Makefile.am +++ b/aldor/aldor/subcmd/unitools/Makefile.am @@ -9,9 +9,9 @@ libport_a_SOURCES = \ bigint.c \ btree.c \ buffer.c \ - cfgfile.c \ compopt.c \ debug.c \ + cfgfile.c \ dword.c \ file.c \ fluid.c \ @@ -46,3 +46,8 @@ noinst_PROGRAMS = platform platform_CFLAGS = -I $s -I $l $(AM_CFLAGS) CLEANFILES=$(libport_a_SOURCES) + +nm-thing: + nm libport.a + +all: nm-thing From e8476945446768af6ca520f1baac04e717e5f8bb Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 8 Mar 2020 19:36:10 +0000 Subject: [PATCH 338/352] more macos --- build-macos.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build-macos.sh b/build-macos.sh index 979a4d822..4c57e10f1 100644 --- a/build-macos.sh +++ b/build-macos.sh @@ -10,4 +10,4 @@ cd aldor cd ../build ../aldor/configure --prefix=$root/opt -make V=1 +make -k V=1 From 13afc223a13e3e0766568a37810707143d61a7fe Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 11 Mar 2020 00:08:32 +0000 Subject: [PATCH 339/352] mac port.. just a test --- aldor/aldor/src/Makefile.am | 4 ++-- aldor/aldor/subcmd/unitools/Makefile.am | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index 6b818c530..6ea8d8e62 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -58,7 +58,7 @@ aldor_CFLAGS = -g $(STRICTCFLAGS) #aldortest_CFLAGS = -DTEST_STAND_ALONE -DTEST_ALL -save-temps $(STRICTCFLAGS) aldortest_CFLAGS = -DTEST_STAND_ALONE -DTEST_ALL -save-temps $(STRICTCFLAGS) aldortest_SOURCES = test.c -aldortest_LDADD = libtest.a libstruct.a libgen.a libport.a -lm +aldortest_LDADD = libtest.a libstruct.a libgen.a libport.a libport.a -lm aldortest_LDFLAGS = libport_a_SOURCES = \ @@ -195,7 +195,7 @@ libstruct_a_SOURCES = \ version.c #libstruct_a_LIBADD = libgen.a libport.a structtest_SOURCES = structtest.c -structtest_LDADD = libstruct.a libgen.a libport.a -lm +structtest_LDADD = libstruct.a libstruct.a libgen.a libport.a -lm structtest_LDFLAGS = libphase_a_SOURCES = \ diff --git a/aldor/aldor/subcmd/unitools/Makefile.am b/aldor/aldor/subcmd/unitools/Makefile.am index af2742402..02e66c9e3 100644 --- a/aldor/aldor/subcmd/unitools/Makefile.am +++ b/aldor/aldor/subcmd/unitools/Makefile.am @@ -10,8 +10,8 @@ libport_a_SOURCES = \ btree.c \ buffer.c \ compopt.c \ - debug.c \ cfgfile.c \ + debug.c \ dword.c \ file.c \ fluid.c \ @@ -36,7 +36,7 @@ $(libport_a_SOURCES): %.c: $s/%.c bin_PROGRAMS = unicl unicl_SOURCES = unicl.c -unicl_LDADD = libport.a -lm +unicl_LDADD = libport.a libport.a -lm unicl_CFLAGS = -I $s -I $l $(AM_CFLAGS) From 4805c5621d0cfa22cc0e3dc88688d62b44318d0d Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 11 Mar 2020 00:24:29 +0000 Subject: [PATCH 340/352] tt --- aldor/aldor/src/debug.c | 2 +- aldor/aldor/subcmd/unitools/Makefile.am | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/aldor/aldor/src/debug.c b/aldor/aldor/src/debug.c index b1ba47103..7eaf68669 100644 --- a/aldor/aldor/src/debug.c +++ b/aldor/aldor/src/debug.c @@ -11,7 +11,7 @@ Bool phaseDebug = false; -FILE *dbOut; +FILE *dbOut = NULL; void dbInit(void) diff --git a/aldor/aldor/subcmd/unitools/Makefile.am b/aldor/aldor/subcmd/unitools/Makefile.am index 02e66c9e3..9383920bd 100644 --- a/aldor/aldor/subcmd/unitools/Makefile.am +++ b/aldor/aldor/subcmd/unitools/Makefile.am @@ -36,7 +36,7 @@ $(libport_a_SOURCES): %.c: $s/%.c bin_PROGRAMS = unicl unicl_SOURCES = unicl.c -unicl_LDADD = libport.a libport.a -lm +unicl_LDADD = libport.a -lm unicl_CFLAGS = -I $s -I $l $(AM_CFLAGS) From 4557592e51c636306c3be85659428c8452a93b34 Mon Sep 17 00:00:00 2001 From: LdBeth Date: Mon, 9 Mar 2020 05:00:40 -0700 Subject: [PATCH 341/352] Solve link failure on macOS This is a workaround for that libtool cannot find certian symbols on macOS. --- aldor/aldor/src/Makefile.am | 4 ++-- aldor/aldor/subcmd/unitools/Makefile.am | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index 6ea8d8e62..9a830e99b 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -58,7 +58,7 @@ aldor_CFLAGS = -g $(STRICTCFLAGS) #aldortest_CFLAGS = -DTEST_STAND_ALONE -DTEST_ALL -save-temps $(STRICTCFLAGS) aldortest_CFLAGS = -DTEST_STAND_ALONE -DTEST_ALL -save-temps $(STRICTCFLAGS) aldortest_SOURCES = test.c -aldortest_LDADD = libtest.a libstruct.a libgen.a libport.a libport.a -lm +aldortest_LDADD = libtest.a libstruct.a libgen.a libport.a debug.o -lm aldortest_LDFLAGS = libport_a_SOURCES = \ @@ -195,7 +195,7 @@ libstruct_a_SOURCES = \ version.c #libstruct_a_LIBADD = libgen.a libport.a structtest_SOURCES = structtest.c -structtest_LDADD = libstruct.a libstruct.a libgen.a libport.a -lm +structtest_LDADD = libstruct.a libgen.a libport.a spesym.o -lm structtest_LDFLAGS = libphase_a_SOURCES = \ diff --git a/aldor/aldor/subcmd/unitools/Makefile.am b/aldor/aldor/subcmd/unitools/Makefile.am index 9383920bd..802a84b8d 100644 --- a/aldor/aldor/subcmd/unitools/Makefile.am +++ b/aldor/aldor/subcmd/unitools/Makefile.am @@ -36,7 +36,7 @@ $(libport_a_SOURCES): %.c: $s/%.c bin_PROGRAMS = unicl unicl_SOURCES = unicl.c -unicl_LDADD = libport.a -lm +unicl_LDADD = libport.a libport_a-debug.o -lm unicl_CFLAGS = -I $s -I $l $(AM_CFLAGS) From 41f825b9bc6117acfdff379ab2893fc9774329b5 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Fri, 13 Mar 2020 22:09:48 +0000 Subject: [PATCH 342/352] macos: add build-id check --- aldor/configure.ac | 1 + aldor/m4/build_id.m4 | 17 +++++++++++++++++ aldor/m4/git.m4 | 11 +++++++++-- 3 files changed, 27 insertions(+), 2 deletions(-) create mode 100644 aldor/m4/build_id.m4 diff --git a/aldor/configure.ac b/aldor/configure.ac index 245db01a6..8f827f39f 100644 --- a/aldor/configure.ac +++ b/aldor/configure.ac @@ -65,6 +65,7 @@ ALDOR_ERROR_ON_WARN ALDOR_JAVA_TESTS +ALDOR_LD_BUILD_ID_CHECK ALDOR_GIT_BUILD_ID # Generate Makefiles diff --git a/aldor/m4/build_id.m4 b/aldor/m4/build_id.m4 new file mode 100644 index 000000000..d7c954e1f --- /dev/null +++ b/aldor/m4/build_id.m4 @@ -0,0 +1,17 @@ +# Check that ld supports build id +AC_DEFUN([ALDOR_LD_BUILD_ID_CHECK], +[AC_MSG_CHECKING([if the linker accepts -Wl,--build-id=none]) +safe_CFLAGS=$CFLAGS +AC_LANG([C]) +CFLAGS="-Wl,--build-id=none -Werror" +AC_LINK_IFELSE( +[AC_LANG_PROGRAM([ ], [return 0;])], +[ + ld_has_build_id=yes + AC_MSG_RESULT([yes]) +], [ + ld_has_build_id=no + AC_MSG_RESULT([no]) +]) +CFLAGS=$safe_CFLAGS +]) diff --git a/aldor/m4/git.m4 b/aldor/m4/git.m4 index cd080bf0f..7113d32bd 100644 --- a/aldor/m4/git.m4 +++ b/aldor/m4/git.m4 @@ -2,6 +2,10 @@ AC_DEFUN([ALDOR_GIT_BUILD_ID], [git_build_id="" +if test "$ld_has_build_id" = ""; +then + AC_MSG_FAILURE([Need to set ld_has_build_id]) +fi AC_ARG_ENABLE([git-build-id], [AS_HELP_STRING([--enable-git-build-id], [Force git sha1 hash as build id])], @@ -15,10 +19,13 @@ AC_ARG_ENABLE([git-build-id], # Git SHA1 hash as ld build-id. AC_MSG_CHECKING([build id]) -if test 1 = "$git_build_id"; then +if test yes = "$ld_has_build_id" && test 1 = "$git_build_id"; then VCSVERSION=`cd $srcdir; git rev-parse HEAD` build_id="-Wl,--build-id=0x$VCSVERSION" - AC_MSG_RESULT([git: $VCSVERSION]) + AC_MSG_RESULT([git: $VCSVERSION ld: yes]) +elif test 1 = "$git_build_id"; then + VCSVERSION=`cd $srcdir; git rev-parse HEAD` + AC_MSG_RESULT([git: $VCSVERSION ld: no]) else VCSVERSION=`date +%Y%m%d` AC_MSG_RESULT([date: $VCSVERSION]) From 23697e3738cf4317526b4d9444706ec858ecad9c Mon Sep 17 00:00:00 2001 From: rocky Date: Wed, 24 Jun 2020 12:55:23 -0400 Subject: [PATCH 343/352] Error if all flavors of YACC and Lex are missing Another possibility would be to include copies of processed files. However as things stand before this patch. configure will complete but you'll get a somewhat cryptic message when trying to build. Fixes #139 --- aldor/configure.ac | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/aldor/configure.ac b/aldor/configure.ac index 8f827f39f..2f04d7d20 100644 --- a/aldor/configure.ac +++ b/aldor/configure.ac @@ -15,7 +15,18 @@ AM_MAINTAINER_MODE([enable]) # Checks for programs AC_PROG_LEX +if test "x$LEX" = x:; then + AC_MSG_ERROR([[lex/flex not found. + Please install lex.]]) +fi AC_PROG_YACC +if test x"$YACC" = "xyacc"; then + AC_CHECK_PROG([YACC_EXISTS], [yacc], [yes], [no]) + if test x"$YACC_EXISTS" != xyes; then + AC_MSG_ERROR([[bison/byacc/yacc not found. + Please install bison.]]) + fi +fi GC=aldor # Check for GMP From c75a0232fa1ba4ddb0f18a687da42e2343523f77 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 25 Mar 2020 08:43:50 +0000 Subject: [PATCH 344/352] subcmd/unitools: macos: remove nm command Added for debugging.. Resolved by including libraries twice where needed. Not nice, but works. --- aldor/aldor/subcmd/unitools/Makefile.am | 4 ---- 1 file changed, 4 deletions(-) diff --git a/aldor/aldor/subcmd/unitools/Makefile.am b/aldor/aldor/subcmd/unitools/Makefile.am index 802a84b8d..48b529009 100644 --- a/aldor/aldor/subcmd/unitools/Makefile.am +++ b/aldor/aldor/subcmd/unitools/Makefile.am @@ -47,7 +47,3 @@ platform_CFLAGS = -I $s -I $l $(AM_CFLAGS) CLEANFILES=$(libport_a_SOURCES) -nm-thing: - nm libport.a - -all: nm-thing From ac99bfa7d31640c34fa0fcb6f879498c0465346b Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Wed, 25 Mar 2020 08:44:23 +0000 Subject: [PATCH 345/352] macos: Stop on first error again --- build-macos.sh | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/build-macos.sh b/build-macos.sh index 4c57e10f1..18da2e9b3 100644 --- a/build-macos.sh +++ b/build-macos.sh @@ -1,8 +1,5 @@ #!/bin/sh -echo "current directory is: " $(pwd) -echo files: -ls root=`pwd` mkdir build cd aldor @@ -10,4 +7,4 @@ cd aldor cd ../build ../aldor/configure --prefix=$root/opt -make -k V=1 +make V=1 From 04e725d54216e1c3d2b9f0336b218c998d2aa5a8 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 1 Nov 2020 22:27:52 +0000 Subject: [PATCH 346/352] configure.ac: Add macros for documentation Not used at the moment, we'll add in a subsequent commit --- aldor/configure.ac | 10 ++++++++++ aldor/lib/config.mk.in | 1 + aldor/m4/documentation-tests.m4 | 19 +++++++++++++++++++ 3 files changed, 30 insertions(+) create mode 100644 aldor/m4/documentation-tests.m4 diff --git a/aldor/configure.ac b/aldor/configure.ac index 2f04d7d20..a924de3c4 100644 --- a/aldor/configure.ac +++ b/aldor/configure.ac @@ -61,6 +61,11 @@ AC_ARG_WITH([boehm-gc], GC=boehm LIBS="$LIBS -lgc"]) +AC_ARG_ENABLE([documentation], + [AS_HELP_STRING([--enable-documentation], [Generate documentation - requires latex])], + [], + [enable_documentation=if_exists]) + AC_SUBST([GC]) AM_CONDITIONAL(HAVE_ALDOR_GC, test $GC = aldor) AM_CONDITIONAL(HAVE_BOEHM_GC, test $GC = boehm) @@ -75,6 +80,7 @@ AC_SUBST([LIBTOOL_DEPS]) ALDOR_ERROR_ON_WARN ALDOR_JAVA_TESTS +ALDOR_DOCUMENTATION_TESTS ALDOR_LD_BUILD_ID_CHECK ALDOR_GIT_BUILD_ID @@ -107,6 +113,8 @@ AC_CONFIG_FILES( dnl Aldor base library. lib/config.mk lib/aldor/Makefile + lib/aldor/doc/Makefile + lib/aldor/doc/tex/Makefile lib/aldor/include/Makefile lib/aldor/src/Makefile lib/aldor/src/lang/Makefile @@ -121,6 +129,8 @@ AC_CONFIG_FILES( dnl Mathematical library. lib/algebra/Makefile + lib/algebra/doc/Makefile + lib/algebra/doc/tex/Makefile lib/algebra/include/Makefile lib/algebra/src/Makefile lib/algebra/src/util/Makefile diff --git a/aldor/lib/config.mk.in b/aldor/lib/config.mk.in index a5049b06f..3319bfc61 100644 --- a/aldor/lib/config.mk.in +++ b/aldor/lib/config.mk.in @@ -6,3 +6,4 @@ datarootdir := @datarootdir@ MKDIR_P := @MKDIR_P@ INSTALL := @INSTALL@ INSTALL_DATA := @INSTALL_DATA@ +DOCS := @DOCS@ diff --git a/aldor/m4/documentation-tests.m4 b/aldor/m4/documentation-tests.m4 new file mode 100644 index 000000000..cc9180c2b --- /dev/null +++ b/aldor/m4/documentation-tests.m4 @@ -0,0 +1,19 @@ +AC_DEFUN([ALDOR_DOCUMENTATION_TESTS], +[AC_CHECK_PROG([LATEX],[latex], [ok]) + AC_CHECK_PROG([PDFLATEX],[pdflatex], [ok]) + AC_CHECK_PROG([MAKEINDEX],[makeindex], [ok]) + AC_CHECK_PROG([FIG2EPS],[fig2eps],[ok]) + if test -z "$LATEX" -o -z "PDFLATEX" -o -z "$MAKEINDEX" -o -z "$FIG2EPS"; then docs_ok=no; fi; + if test "$enable_documentation" = "if_exists" -a "$docs_ok" = "no"; then + AC_MSG_NOTICE([Documentation disabled as prerequisite programs not found]) + DOCS= + elif test "$enable_documentation" = "if_exists"; then + AC_MSG_NOTICE([documentation enabled]) + DOCS=true + elif test "$enable_documentation" = "yes" -a "$docs_ok" = "no"; then + AC_MSG_ERROR([missing documentation prerequisites]) + elif test "$enable_documentation" = yes; then + DOCS=true + fi] + [AC_SUBST([DOCS])] + [AM_CONDITIONAL(BUILD_DOCS,test "$DOCS" = true)]) From 503439f6b21f96d14412abf93b5dd9868f560c87 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 1 Nov 2020 23:53:44 +0000 Subject: [PATCH 347/352] tools/unix: enable extract & aldoc2html --- aldor/aldor/tools/unix/Makefile.am | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/aldor/aldor/tools/unix/Makefile.am b/aldor/aldor/tools/unix/Makefile.am index 7d3b9dd88..51a124cfb 100644 --- a/aldor/aldor/tools/unix/Makefile.am +++ b/aldor/aldor/tools/unix/Makefile.am @@ -6,7 +6,7 @@ bin_SCRIPTS = aldor gdb-aldor #tool_SCRIPTS=doaldor doas doaxiomxl docc dog++ dolatex domkmk \ # dopdflatex doranlib buildarg -noinst_PROGRAMS = zacc msgcat atinlay +noinst_PROGRAMS = zacc msgcat atinlay extract aldoc2html msgcat_SOURCES = msgcat.c @@ -20,6 +20,15 @@ zacc_SOURCES = \ atinlay_SOURCES = atinlay.c +extract_SOURCES = \ + extract.c \ + flags.c + +aldoc2html_SOURCES = \ + aldoc2html.c \ + flags.c + + # Forces a dependency on the zaccgram.h header file zacc.o: zaccgram.c zaccscan.o: zaccgram.c From f7b00d8e02097cd2d9c35fcafe77e6e5abfb4978 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Sun, 1 Nov 2020 23:55:24 +0000 Subject: [PATCH 348/352] sal_table.as: Fix documentation to be correct latex --- aldor/lib/aldor/src/datastruc/sal_table.as | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/aldor/lib/aldor/src/datastruc/sal_table.as b/aldor/lib/aldor/src/datastruc/sal_table.as index 32a0afd5f..375d393b2 100644 --- a/aldor/lib/aldor/src/datastruc/sal_table.as +++ b/aldor/lib/aldor/src/datastruc/sal_table.as @@ -179,7 +179,8 @@ That space grows when needed as elements are inserted in the table.} \alpage{bracket} \Usage{\name()\\ \name~n} \Signature{\altype{Generator} \altype{Cross}(K, V)}{\%} -\Params{{\em g} & \% & a generator of key-value pairs\\} +\Params{ +{\em g} & \% & a generator of key-value pairs\\ } \Retval{Returns a new table containing the specified pairs} \alseealso{\alexp{[]}} From 7d44ae79780242f2988268848958a0f50b0e5f2c Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 2 Nov 2020 00:33:39 +0000 Subject: [PATCH 349/352] Add build mechanism for docs --- aldor/doc/tex/Makefile.in | 77 ++++++++++++++++++++ aldor/lib/aldor/Makefile.am | 2 +- aldor/lib/aldor/doc/.gitignore | 1 + aldor/lib/aldor/doc/Makefile.am | 4 + aldor/lib/aldor/doc/tex/Makefile.in | 28 +++++++ aldor/lib/aldor/src/common.mk | 1 + aldor/lib/aldor/src/datastruc/Makefile.in | 1 + aldor/lib/algebra/Makefile.am | 2 +- aldor/lib/algebra/doc/.gitignore | 1 + aldor/lib/algebra/doc/Makefile.am | 4 + aldor/lib/algebra/doc/tex/Makefile.in | 34 +++++++++ aldor/lib/algebra/src/categories/Makefile.in | 2 + aldor/lib/algebra/src/common.mk | 1 + aldor/lib/algebra/src/extree/Makefile.in | 2 + aldor/lib/builddoc.mk | 75 +++++++++++++++++++ aldor/lib/buildlib.mk | 14 ++++ 16 files changed, 247 insertions(+), 2 deletions(-) create mode 100644 aldor/doc/tex/Makefile.in create mode 100644 aldor/lib/aldor/doc/.gitignore create mode 100644 aldor/lib/aldor/doc/Makefile.am create mode 100644 aldor/lib/aldor/doc/tex/Makefile.in create mode 100644 aldor/lib/algebra/doc/.gitignore create mode 100644 aldor/lib/algebra/doc/Makefile.am create mode 100644 aldor/lib/algebra/doc/tex/Makefile.in create mode 100644 aldor/lib/builddoc.mk diff --git a/aldor/doc/tex/Makefile.in b/aldor/doc/tex/Makefile.in new file mode 100644 index 000000000..17a5646f0 --- /dev/null +++ b/aldor/doc/tex/Makefile.in @@ -0,0 +1,77 @@ +@SET_MAKE@ +VPATH = @srcdir@ + +all: dvi + +dvi: ../algebra.dvi +ps: ../algebra.ps +pdf: ../algebra.pdf +html: ../html/html.html + +../algebra.ps: ../algebra.dvi algbcat.eps algpolcat.eps + rm -f ../algebra.ps + dvips -f ../algebra.dvi | psnup -2 > ../algebra.ps + +links: + echo ln -sf $(ALDORLIBROOT)/doc/tex/alltypes.tex libaldor.tex + echo ln -sf $(ALDORLIBROOT)/doc/tex/rtexns.tex + ln -sf $(ALDORLIBROOT)/lib/aldor/doc/tex/*.tex . + ln -sf $(ALDORLIBROOT)/lib/algebra/doc/tex/*.tex . + +prepare: cleanlinks links + (cd $(ALGEBRAROOT)/src ; make doc) + +../algebra.dvi: prepare alltypes.tex title.tex algebra.tex intro.tex \ + guide.tex refer.tex algbcat.eps algpolcat.eps + rm -f *.aux *.ind *.idx *.toc *.ilg + latex algebra | grep -v Underfull | grep -v vbox + latex algebra | grep -v Underfull | grep -v vbox + makeindex algebra + latex algebra | grep -v Underfull | grep -v vbox + mv algebra.dvi .. + +algbcat.eps: algbcat.fig + fig2dev -Leps algbcat.fig algbcat.eps + +algpolcat.eps: algpolcat.fig + fig2dev -Leps algpolcat.fig algpolcat.eps + +algbcat.pdf: algbcat.fig + fig2dev -Lpdf algbcat.fig algbcat.pdf + +algpolcat.pdf: algpolcat.fig + fig2dev -Lpdf algpolcat.fig algpolcat.pdf + +../algebra.pdf: prepare alltypes.tex title.tex algebra.tex intro.tex \ + guide.tex refer.tex algbcat.pdf algpolcat.pdf + rm -f *.aux *.ind *.idx *.toc *.ilg + pdflatex algebra | grep -v Underfull | grep -v vbox + pdflatex algebra | grep -v Underfull | grep -v vbox + makeindex algebra + pdflatex algebra | grep -v Underfull | grep -v vbox + mv algebra.pdf .. + +html.tex: prepare alltypes.tex title.tex algebra.tex intro.tex guide.tex refer.tex + aldoc2html -o html.tex algebra + +html.aux: html.tex + latex html + latex html + +../html/html.html : html.aux + rm -fr ../html + latex2html html + mv html .. + rm -f html.* + +.PHONY: cleanlinks +cleanlinks: + -rm sal_*.tex ald_*.tex rtexns.tex libaldor.tex + +.PHONY: clean +clean: cleanlinks + -rm -f *.dvi *.aux *.log *.idx *.ilg *.ind *.toc sit_*.tex sm_*.tex + -rm -f alg_*.tex stamp-* *.out html.tex ../*.dvi ../*.ps ../*.pdf + -rm -f *.pdf *.eps + rm -fr ../html + diff --git a/aldor/lib/aldor/Makefile.am b/aldor/lib/aldor/Makefile.am index 033692a5f..74fc63b9e 100644 --- a/aldor/lib/aldor/Makefile.am +++ b/aldor/lib/aldor/Makefile.am @@ -1 +1 @@ -SUBDIRS = include src test +SUBDIRS = include src test doc diff --git a/aldor/lib/aldor/doc/.gitignore b/aldor/lib/aldor/doc/.gitignore new file mode 100644 index 000000000..10a7e8d6c --- /dev/null +++ b/aldor/lib/aldor/doc/.gitignore @@ -0,0 +1 @@ +/Makefile.in diff --git a/aldor/lib/aldor/doc/Makefile.am b/aldor/lib/aldor/doc/Makefile.am new file mode 100644 index 000000000..a64f5f235 --- /dev/null +++ b/aldor/lib/aldor/doc/Makefile.am @@ -0,0 +1,4 @@ +SUBDIRS = +if BUILD_DOCS +SUBDIRS+=tex +endif diff --git a/aldor/lib/aldor/doc/tex/Makefile.in b/aldor/lib/aldor/doc/tex/Makefile.in new file mode 100644 index 000000000..d1571f6ac --- /dev/null +++ b/aldor/lib/aldor/doc/tex/Makefile.in @@ -0,0 +1,28 @@ +@SET_MAKE@ + +default: pdf + +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ + +abs_builddir := @abs_builddir@ +top_builddir := @top_builddir@ +abs_top_builddir:= @abs_top_builddir@ +srcdir := @srcdir@ +top_srcdir := @top_srcdir@ +abs_top_srcdir := @abs_top_srcdir@ +subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) + +librarydocdir := $(top_builddir)/lib/$(libraryname)/doc + +top_builddir := @top_builddir@ +abs_top_builddir:= @abs_top_builddir@ + +doc = libaldor +sources = libaldor.tex alltypes.tex title.tex intro.tex guide.tex refer.tex macros.tex \ + aldoc.cls ttyverb.sty +figs = sallicat.fig sallidata.fig +other = + +include $(abs_top_srcdir)/lib/builddoc.mk + + diff --git a/aldor/lib/aldor/src/common.mk b/aldor/lib/aldor/src/common.mk index 963ebcc0e..84ba389cf 100644 --- a/aldor/lib/aldor/src/common.mk +++ b/aldor/lib/aldor/src/common.mk @@ -4,6 +4,7 @@ abs_libdir := $(abs_top_builddir)/lib/aldor/src libraryname := aldor librarydeps := +withdocs = yes #AXLCDB := -W check -Csmax=0 -Zdb -Qno-cc AXLFLAGS := -Q3 $(AXLCDB) diff --git a/aldor/lib/aldor/src/datastruc/Makefile.in b/aldor/lib/aldor/src/datastruc/Makefile.in index ec512f575..998098574 100644 --- a/aldor/lib/aldor/src/datastruc/Makefile.in +++ b/aldor/lib/aldor/src/datastruc/Makefile.in @@ -21,6 +21,7 @@ library = ald_symbol ald_symtab sal_array sal_barray sal_bdata \ sal_set sal_slist sal_sortas sal_sset sal_stream sal_string \ sal_table sal_fold ald_flags sal_langx sal_union sal_map \ sal_hashset +documentation = sal_ckarray sal_ckmembk sal_cklist ald_queue @BUILD_JAVA_TRUE@javalibrary := $(library) diff --git a/aldor/lib/algebra/Makefile.am b/aldor/lib/algebra/Makefile.am index 033692a5f..74fc63b9e 100644 --- a/aldor/lib/algebra/Makefile.am +++ b/aldor/lib/algebra/Makefile.am @@ -1 +1 @@ -SUBDIRS = include src test +SUBDIRS = include src test doc diff --git a/aldor/lib/algebra/doc/.gitignore b/aldor/lib/algebra/doc/.gitignore new file mode 100644 index 000000000..10a7e8d6c --- /dev/null +++ b/aldor/lib/algebra/doc/.gitignore @@ -0,0 +1 @@ +/Makefile.in diff --git a/aldor/lib/algebra/doc/Makefile.am b/aldor/lib/algebra/doc/Makefile.am new file mode 100644 index 000000000..a64f5f235 --- /dev/null +++ b/aldor/lib/algebra/doc/Makefile.am @@ -0,0 +1,4 @@ +SUBDIRS = +if BUILD_DOCS +SUBDIRS+=tex +endif diff --git a/aldor/lib/algebra/doc/tex/Makefile.in b/aldor/lib/algebra/doc/tex/Makefile.in new file mode 100644 index 000000000..bf82addba --- /dev/null +++ b/aldor/lib/algebra/doc/tex/Makefile.in @@ -0,0 +1,34 @@ +@SET_MAKE@ + +default: pdf + +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ + +abs_builddir := @abs_builddir@ +top_builddir := @top_builddir@ +abs_top_builddir:= @abs_top_builddir@ +srcdir := @srcdir@ +top_srcdir := @top_srcdir@ +abs_top_srcdir := @abs_top_srcdir@ +subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) + +librarydocdir := $(top_builddir)/lib/$(libraryname)/doc + +top_builddir := @top_builddir@ +abs_top_builddir:= @abs_top_builddir@ + +doc = algebra +sources = \ + algebra.tex alltypes.tex guide.tex intro.tex macros.tex \ + referAldor.tex refer.tex title.tex \ + aldoc.cls \ + algbcat.fig algpolcat.fig \ + ttyverb.sty + +figs = algbcat.fig algpolcat.fig +other = libaldor.tex + +libaldor.tex: $(srcdir)/alltypes.tex + ln -sf $(srcdir)/alltypes.tex libaldor.tex + +include $(abs_top_srcdir)/lib/builddoc.mk diff --git a/aldor/lib/algebra/src/categories/Makefile.in b/aldor/lib/algebra/src/categories/Makefile.in index 3a562955b..1645d026e 100644 --- a/aldor/lib/algebra/src/categories/Makefile.in +++ b/aldor/lib/algebra/src/categories/Makefile.in @@ -17,6 +17,8 @@ subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) # Build starts here library = alg_cansimp alg_ffield alg_frering alg_idxfrng alg_modcmp alg_primsrc alg_rescls alg_rring sit_abgroup sit_abmon sit_algebra sit_automor sit_basic sit_char0 sit_charp sit_chrem sit_comring sit_dcmprng sit_deriv sit_diffext sit_difring sit_euclid sit_field sit_freealg sit_freelar sit_freelc sit_freemod sit_fset sit_gcd sit_gexpcat sit_group sit_idxfalg sit_idxflar sit_idxflc sit_idxfmod sit_intdom sit_integer sit_intgmp sit_linarit sit_module sit_monoid sit_ncid sit_pable sit_prfcat0 sit_ptools sit_qring sit_ring sit_spf0 sit_spfcat0 sit_spzble +documentation = sit_power + java_blacklist = sit_intgmp include $(abs_top_srcdir)/lib/algebra/src/common.mk diff --git a/aldor/lib/algebra/src/common.mk b/aldor/lib/algebra/src/common.mk index 37c9f004a..f89d670bd 100644 --- a/aldor/lib/algebra/src/common.mk +++ b/aldor/lib/algebra/src/common.mk @@ -10,4 +10,5 @@ AXLFLAGS := -Z db $(AXLCDB) AXLFLAGS += -Y $(aldorlibdir) -I $(aldorincdir) -laldor -Q3 javalibrary := $(library) +withdocs := true include $(top_srcdir)/lib/buildlib.mk diff --git a/aldor/lib/algebra/src/extree/Makefile.in b/aldor/lib/algebra/src/extree/Makefile.in index 71bbcde71..2dfada14b 100644 --- a/aldor/lib/algebra/src/extree/Makefile.in +++ b/aldor/lib/algebra/src/extree/Makefile.in @@ -16,6 +16,8 @@ subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) # Build starts here library := sit_extree sit_optools +documentation := alg_leaf alg_op + otherfiles := alg_leaf alg_op include $(abs_top_srcdir)/lib/algebra/src/common.mk diff --git a/aldor/lib/builddoc.mk b/aldor/lib/builddoc.mk new file mode 100644 index 000000000..1c2f97b2f --- /dev/null +++ b/aldor/lib/builddoc.mk @@ -0,0 +1,75 @@ + +tooldir= $(abs_top_builddir)/aldor/tools/unix + +all: pdf dvi + +dvi: $(doc).dvi +pdf: $(doc).pdf +html: html/html/index.html +.PHONY: dvi ps pdf html + +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ '; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ ;; \ + esac; + +generated = $(patsubst %.fig,%.eps,$(figs)) $(other) +all_deps = $(patsubst %,$(srcdir)/%,$(sources)) $(generated) + +$(patsubst %.fig, %.eps,$(figs)): $(top_srcdir)/lib/builddoc.mk +$(patsubst %.fig, %.eps,$(figs)): %.eps: $(srcdir)/%.fig + if [ ! -f $*.fig ]; then cp $(srcdir)/$*.fig .; fi + fig2eps --viewer=true $*.fig + +$(doc).dvi: $(top_srcdir)/lib/builddoc.mk +$(doc).dvi: $(all_deps) + set -e; \ + rm -rf ./dvi; mkdir dvi; cd dvi; \ + ln -sf $(patsubst %,../%,$(all_deps)) . ; \ + ln -sf ../gen/* .; \ + latex $(doc) < /dev/null | grep -v Underfull | grep -v vbox ; \ + latex $(doc) < /dev/null | grep -v Underfull | grep -v vbox ; \ + makeindex $(doc) ; \ + latex $(doc) < /dev/null | grep -v Underfull | grep -v vbox; \ + mv $(doc).dvi .. + +$(doc).pdf: $(top_srcdir)/lib/builddoc.mk +$(doc).pdf: $(all_deps) + set -e; \ + rm -rf pdf; mkdir pdf; cd pdf; \ + ln -sf $(patsubst %,../%,$(all_deps)) . ; \ + ln -sf ../gen/* .; \ + pdflatex $(doc) < /dev/null | grep -v Underfull | grep -v vbox; \ + pdflatex $(doc) < /dev/null | grep -v Underfull | grep -v vbox; \ + makeindex $(doc); \ + pdflatex $(doc) < /dev/null | grep -v Underfull | grep -v vbox; \ + mv $(doc).pdf .. + +# This kind of works, but the aldoc.cls is not correctly processed, leading +# to a mess. Looking at the documentation, latex2html reads a .perl file +# instead of the .cls. There may well be other issues here, but not yet +# investigated. + +#html/html/index.html: $(all_deps) +# set -e; set -x; \ +# rm -rf html_work; \ +# mkdir html_work; \ +# cd html_work; \ +# ln -sf $(patsubst %,../%,$(all_deps)) . ; \ +# ln -sf ../gen/* .; \ +# $(tooldir)/aldoc2html -o html.tex $(doc).tex; \ +# latex html < /dev/null; \ +# latex html < /dev/null; \ +# TEXINPUTS=. latex2html html; \ +# mv html_work/html html + +clean: + rm -rf pdf + rm -rf dvi + rm -rf html + rm -f $(patsubst %.fig,%.eps,$(figs)) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index 17f0da585..f71cf0b4f 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -8,12 +8,14 @@ aldorlibdir := $(top_builddir)/aldor/lib libraryincdir := $(top_srcdir)/lib/$(libraryname)/include librarylibdir := $(top_builddir)/lib/$(libraryname)/src +librarydocdir := $(top_builddir)/lib/$(libraryname)/doc UNIQ := perl $(top_srcdir)/aldor/tools/unix/uniq asdomains := $(internal) $(library) $(tests) axdomains := $(axlibrary) alldomains := $(asdomains) $(axdomains) +docdomains := $(asdomains) $(documentation) libsubdir := $(subst $(abs_libdir)/,,$(abs_builddir)/.) @@ -56,6 +58,10 @@ AM_V_JAR = $(am__v_JAR_$(V)) am__v_JAR_ = $(am__v_JAR_$(AM_DEFAULT_VERBOSITY)) am__v_JAR = @echo " JAR " $@; +AM_V_AS2TEX = $(am__v_AS2TEX_$(V)) +am__v_AS2TEX_ = $(am__v_AS2TEX_$(AM_DEFAULT_VERBOSITY)) +am__v_AS2TEX_0 = @echo " AS2TEX " $@; + # ALDORTEST - don't echo anything as the build rule will show the test name AM_V_ALDORTEST = $(am__v_ALDORTEST_$(V)) am__v_ALDORTEST_ = $(am__v_ALDORTEST_$(AM_DEFAULT_VERBOSITY)) @@ -77,6 +83,8 @@ Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ ;; \ esac; +_withdocs = $(if $(DOCS),$(withdocs),) + aldor_common_args := \ -Nfile=$(aldorsrcdir)/aldor.conf \ -Mno-ALDOR_W_WillObsolete \ @@ -144,6 +152,11 @@ $(addsuffix .fm,$(alldomains)): %.fm: %.ao $(aldor_common_args) \ -Ffm=$@ $< +$(if $(_withdocs),$(patsubst %,$(librarydocdir)/tex/gen/%.tex,$(docdomains)),): $(librarydocdir)/tex/gen/%.tex: %.as + $(AM_V_AS2TEX)set -x; \ + mkdir -p $(librarydocdir)/tex/gen; \ + $(tooldir)/extract -mALDOC -o $@ $(srcdir)/$*.as + .PHONY: $(addsuffix .gloop, $(alldomains)) $(addsuffix .gloop, $(alldomains)): %.gloop: $(AM_V_ALDOR)set -e; \ @@ -204,6 +217,7 @@ $(SUBLIB).al: all: Makefile $(SUBLIB).al all: $(addsuffix .fm,$(library)) +all: $(if $(_withdocs),$(patsubst %,$(librarydocdir)/tex/gen/%.tex,$(docdomains)),) ifeq ($(bytecode_only),) all: $(addsuffix .c,$(library)) endif From 1eb797027b08ac037f3b3037a8803cdafdc8d869 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 2 Nov 2020 08:18:19 +0000 Subject: [PATCH 350/352] Build fix --- aldor/lib/buildlib.mk | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index f71cf0b4f..04c50a133 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -155,7 +155,7 @@ $(addsuffix .fm,$(alldomains)): %.fm: %.ao $(if $(_withdocs),$(patsubst %,$(librarydocdir)/tex/gen/%.tex,$(docdomains)),): $(librarydocdir)/tex/gen/%.tex: %.as $(AM_V_AS2TEX)set -x; \ mkdir -p $(librarydocdir)/tex/gen; \ - $(tooldir)/extract -mALDOC -o $@ $(srcdir)/$*.as + $(unixtooldir)/extract -mALDOC -o $@ $(srcdir)/$*.as .PHONY: $(addsuffix .gloop, $(alldomains)) $(addsuffix .gloop, $(alldomains)): %.gloop: @@ -280,6 +280,7 @@ CHECK_TEST_STATUS = \ aldortestexecs := $(patsubst %,%.aldortest.exe,$(library)) aldortooldir = $(abs_top_builddir)/aldor/subcmd/unitools +unixtooldir = $(abs_top_builddir)/aldor/tools/unix foamdir = $(abs_top_builddir)/aldor/lib/libfoam foamlibdir = $(abs_top_builddir)/aldor/lib/libfoamlib @@ -345,10 +346,12 @@ mostlyclean: clean: mostlyclean rm -f $(SUBLIB).al + rm -f $(patsubst %,$(librarydocdir)/tex/gen/%.tex,$(docdomains)) distclean: clean rm -f $(addsuffix .dep,$(alldomains)) rm Makefile + maintainer-clean: distclean install-data: From 9fa08a1d97319a7b6464408df5dab29d7e18caa8 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 2 Nov 2020 08:52:17 +0000 Subject: [PATCH 351/352] builddoc.mk: Add install, tidy up clean --- aldor/lib/builddoc.mk | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/aldor/lib/builddoc.mk b/aldor/lib/builddoc.mk index 1c2f97b2f..2e4f8a05c 100644 --- a/aldor/lib/builddoc.mk +++ b/aldor/lib/builddoc.mk @@ -1,6 +1,8 @@ tooldir= $(abs_top_builddir)/aldor/tools/unix +include $(top_builddir)/lib/config.mk + all: pdf dvi dvi: $(doc).dvi @@ -68,8 +70,27 @@ $(doc).pdf: $(all_deps) # TEXINPUTS=. latex2html html; \ # mv html_work/html html +install: install-pdf install-dvi + +install-pdf: $(doc).pdf + $(MKDIR_P) $(DESTDIR)/$(datarootdir)/doc + $(INSTALL_DATA) $(doc).pdf $(DESTDIR)/$(datarootdir)/doc/$(doc).pdf + +install-dvi: $(doc).dvi + $(MKDIR_P) $(DESTDIR)/$(datarootdir)/doc + $(INSTALL_DATA) $(doc).dvi $(DESTDIR)/$(datarootdir)/doc/$(doc).dvi + clean: - rm -rf pdf - rm -rf dvi - rm -rf html + rm -rf pdf $(doc).pdf + rm -rf dvi $(doc).dvi + rm -rf html_work html rm -f $(patsubst %.fig,%.eps,$(figs)) + +EMPTY_AUTOMAKE_TARGETS = ps info html tags ctags +EMPTY_AUTOMAKE_TARGETS += install-exec uninstall +EMPTY_AUTOMAKE_TARGETS += install-dvi install-html install-info install-ps install-pdf +EMPTY_AUTOMAKE_TARGETS += installdirs +EMPTY_AUTOMAKE_TARGETS += check installcheck + +.PHONY: $(EMPTY_AUTOMAKE_TARGETS) +$(EMPTY_AUTOMAKE_TARGETS): From 03783f685eb3764a6480966349b8c2f59b54c801 Mon Sep 17 00:00:00 2001 From: Peter Broadbery Date: Mon, 2 Nov 2020 08:53:21 +0000 Subject: [PATCH 352/352] travis.yaml: Add latex dependencies for documentation - experimental, as it'll add time to the build --- .travis.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.travis.yml b/.travis.yml index e962b1903..2ba25dbca 100644 --- a/.travis.yml +++ b/.travis.yml @@ -13,6 +13,9 @@ jobs: - sudo apt-get install libgmp-dev - sudo apt-get install fakeroot - sudo apt-get install debhelper + - sudo apt-get install texlive-binaries + - sudo apt-get install texlive-latex-base + - sudo apt-get install fig2ps # - os: linux # compiler: clang