diff --git a/.gitignore b/.gitignore index 17453710b..69d435e83 100644 --- a/.gitignore +++ b/.gitignore @@ -5,3 +5,4 @@ /build /run_j /build-2 +/.idea diff --git a/aldor/.gitignore b/aldor/.gitignore index 57952b30a..393d407b5 100644 --- a/aldor/.gitignore +++ b/aldor/.gitignore @@ -7,9 +7,17 @@ /.metadata /workspace +/.idea +*.iml +/out + Makefile a.out +/.idea +*.iml +/out/ + .#* \#* diff --git a/aldor/Makefile.in b/aldor/Makefile.in index 7cf4101e3..5a12e1a81 100644 --- a/aldor/Makefile.in +++ b/aldor/Makefile.in @@ -256,7 +256,8 @@ am__DIST_COMMON = $(srcdir)/Makefile.in \ $(top_srcdir)/lib/axldem/src/al/Makefile.in \ $(top_srcdir)/lib/axllib/src/al/Makefile.in AUTHORS \ amaux/compile amaux/config.guess amaux/config.sub \ - amaux/install-sh amaux/ltmain.sh amaux/missing amaux/ylwrap + amaux/depcomp amaux/install-sh amaux/ltmain.sh amaux/missing \ + amaux/ylwrap DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) distdir = $(PACKAGE)-$(VERSION) top_distdir = $(distdir) diff --git a/aldor/aldor/lib/java/Makefile.am b/aldor/aldor/lib/java/Makefile.am index ed6a11069..fcc9ea9ca 100644 --- a/aldor/aldor/lib/java/Makefile.am +++ b/aldor/aldor/lib/java/Makefile.am @@ -1,6 +1,6 @@ SUBDIRS=src test -@BUILD_JAVA_TRUE@JAVA_TARGET = src/foamj.jar +@BUILD_JAVA_TRUE@JAVA_TARGET = src/foamj.jar src/foamj-sources.jar datalibdir = $(datadir)/lib datalib_DATA = $(JAVA_TARGET) diff --git a/aldor/aldor/lib/java/Makefile.in b/aldor/aldor/lib/java/Makefile.in index 311a0e748..9394884dc 100644 --- a/aldor/aldor/lib/java/Makefile.in +++ b/aldor/aldor/lib/java/Makefile.in @@ -357,7 +357,7 @@ top_build_prefix = @top_build_prefix@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ SUBDIRS = src test -@BUILD_JAVA_TRUE@JAVA_TARGET = src/foamj.jar +@BUILD_JAVA_TRUE@JAVA_TARGET = src/foamj.jar src/foamj-sources.jar datalibdir = $(datadir)/lib datalib_DATA = $(JAVA_TARGET) all: all-recursive diff --git a/aldor/aldor/lib/java/src/Makefile.in b/aldor/aldor/lib/java/src/Makefile.in index ee8029590..b0409d427 100644 --- a/aldor/aldor/lib/java/src/Makefile.in +++ b/aldor/aldor/lib/java/src/Makefile.in @@ -1,15 +1,22 @@ # ..From autoconf @SET_MAKE@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ VPATH = @srcdir@ abs_top_builddir = @abs_top_builddir@ srcdir = @srcdir@ +top_srcdir = @top_srcdir@ top_builddir = @top_builddir@ builddir = @builddir@ abs_builddir = @abs_builddir@ abs_top_srcdir = @abs_top_srcdir@ subdir = aldor/lib/java/src +include $(top_srcdir)/mk/step.mk +$(call am_define_steps, JAVAC JAVAJAR JAVASRC) + +defaultTarget: all + .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ @@ -23,16 +30,20 @@ Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status buildfiles := $(shell cd $(srcdir); find foamj -name \*.java) outdir := $(abs_builddir)/classes -jarfile := $(abs_builddir)/foamj.jar +jarfile := foamj.jar +sourcejarfile := foamj-sources.jar # Build directly to a .jar file (easier than tracking .class files) $(jarfile): $(buildfiles) - mkdir -p $(outdir) - (cd $(srcdir); javac -g -d $(outdir) $(buildfiles)) - (wd=$$(pwd); cd $(outdir); jar cf $@ .) + @mkdir -p $(outdir) + $(AM_V_JAVAC) (cd $(srcdir); javac -g -d $(outdir) $(buildfiles)) + $(AM_V_JAVAJAR) (wd=$$(pwd); cd $(outdir); jar cf $(abs_builddir)/$@ .) + +$(sourcejarfile): $(buildfiles) + $(AM_V_JAVASRC) \ + cd $(srcdir); jar cf $(abs_builddir)/$@ $(shell cd $(srcdir); find . -type f) -all: $(jarfile) - echo $< +all: $(jarfile) $(sourcejarfile) # # :: Automake requires this little lot @@ -40,6 +51,7 @@ all: $(jarfile) mostlyclean: rm -rf $(outdir) rm -f $(jarfile) + rm -f $(sourcejarfile) clean: mostlyclean diff --git a/aldor/aldor/lib/java/src/foamj/Clos.java b/aldor/aldor/lib/java/src/foamj/Clos.java index 512a7c6a3..7fb95e3fb 100644 --- a/aldor/aldor/lib/java/src/foamj/Clos.java +++ b/aldor/aldor/lib/java/src/foamj/Clos.java @@ -58,6 +58,10 @@ public Word asWord() { return this; } + public Object toPtr() { + return this; + } + @Override public Value toValue() { return this; diff --git a/aldor/aldor/lib/java/src/foamj/Fn.java b/aldor/aldor/lib/java/src/foamj/Fn.java index f408aab71..a71978fcf 100644 --- a/aldor/aldor/lib/java/src/foamj/Fn.java +++ b/aldor/aldor/lib/java/src/foamj/Fn.java @@ -31,4 +31,4 @@ public String getName() { 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 95f97f0fc..cd291523e 100644 --- a/aldor/aldor/lib/java/src/foamj/Foam.java +++ b/aldor/aldor/lib/java/src/foamj/Foam.java @@ -357,18 +357,18 @@ public static Word osMemMap(Word w1) { } public static void fiRaiseException(Word w) { - throw new RuntimeException(w.toString()); + throw new RuntimeException(stringToJavaString(w)); } public static float arrToSFlo(Object o) { char[] arr = (char[]) o; - return new Float(arrToString(arr)); + return Float.parseFloat(arrToString(arr)); } public static double arrToDFlo(Object o) { char[] arr = (char[]) o; - return new Double(arrToString(arr)); + return Double.parseDouble(arrToString(arr)); } public static int arrToSInt(Object o) { @@ -542,9 +542,11 @@ public static Word javaStringToString(String s) { 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/src/foamj/FoamHelper.java b/aldor/aldor/lib/java/src/foamj/FoamHelper.java index 1bbaee7a7..93918b04e 100644 --- a/aldor/aldor/lib/java/src/foamj/FoamHelper.java +++ b/aldor/aldor/lib/java/src/foamj/FoamHelper.java @@ -8,6 +8,6 @@ static public void setContext(FoamContext context) { } static public T instanceForClass(Class clss) { - return contextForThread.get().instanceForClass(clss); + return contextForThread.get().instanceForClass(clss); } } diff --git a/aldor/aldor/lib/java/src/foamj/FoamJ.java b/aldor/aldor/lib/java/src/foamj/FoamJ.java index 53042481e..1da19042a 100644 --- a/aldor/aldor/lib/java/src/foamj/FoamJ.java +++ b/aldor/aldor/lib/java/src/foamj/FoamJ.java @@ -27,6 +27,10 @@ public Word asWord() { return this; } + public Object toPtr() { + return arr; + } + public String toString() { return "A" + arr.toString() + "]"; } @@ -60,6 +64,9 @@ public String toString() { return obj.toString(); } + public Object toPtr() { + return obj; + } } /** @@ -194,7 +201,9 @@ public Value toValue() { } static public class Bool extends AbstractValue implements Value, Word { - private boolean value; + public final static Bool TRUE = new Bool(true); + public final static Bool FALSE = new Bool(false); + private final boolean value; public Bool(boolean b) { this.value = b; diff --git a/aldor/aldor/lib/java/src/foamj/Record.java b/aldor/aldor/lib/java/src/foamj/Record.java index f49b4c5d8..7d9412bb5 100644 --- a/aldor/aldor/lib/java/src/foamj/Record.java +++ b/aldor/aldor/lib/java/src/foamj/Record.java @@ -44,4 +44,8 @@ public Word asWord() { public String toString() { return "[R: " + id + "]"; } + + public Object toPtr() { + return this; + } } diff --git a/aldor/aldor/lib/java/src/foamj/Word.java b/aldor/aldor/lib/java/src/foamj/Word.java index 2ef1ade71..fb0623174 100644 --- a/aldor/aldor/lib/java/src/foamj/Word.java +++ b/aldor/aldor/lib/java/src/foamj/Word.java @@ -33,6 +33,7 @@ public interface Word { byte toByte(); + Object toPtr(); public class U { static public Object toArray(Word word) { @@ -42,6 +43,13 @@ static public Object toArray(Word word) { return word.toArray(); } + static public Object toPtr(Word word) { + if (word == null) + return null; + else + return word.toPtr(); + } + static public T toJavaObj(Word word) { if (word == null) return null; @@ -70,7 +78,7 @@ public static Word fromJavaObj(T t) { } public static Word fromBool(boolean b) { - return new Bool(b); + return b ? Bool.TRUE : Bool.FALSE; } public static Word fromChar(char c) { diff --git a/aldor/aldor/lib/java/test/Makefile.in b/aldor/aldor/lib/java/test/Makefile.in index a24153648..c9af526cd 100644 --- a/aldor/aldor/lib/java/test/Makefile.in +++ b/aldor/aldor/lib/java/test/Makefile.in @@ -46,7 +46,6 @@ $(jarfile): $(buildfiles) (cd $(outdir); jar cf $@ .) all: - echo $< # # :: Automake requires this little lot diff --git a/aldor/aldor/lib/libfoam/Makefile.am b/aldor/aldor/lib/libfoam/Makefile.am index fd663a897..aa8fb3c94 100644 --- a/aldor/aldor/lib/libfoam/Makefile.am +++ b/aldor/aldor/lib/libfoam/Makefile.am @@ -1,6 +1,6 @@ SUBDIRS = al -@BUILD_JAVA_TRUE@JAVA_TARGET = al/foam.jar +@BUILD_JAVA_TRUE@JAVA_TARGET = al/foam.jar al/foam-sources.jar aldorsrcdir = $(top_srcdir)/aldor/src diff --git a/aldor/aldor/lib/libfoam/Makefile.in b/aldor/aldor/lib/libfoam/Makefile.in index 1a63fd6ba..0a010522c 100644 --- a/aldor/aldor/lib/libfoam/Makefile.in +++ b/aldor/aldor/lib/libfoam/Makefile.in @@ -421,7 +421,7 @@ top_build_prefix = @top_build_prefix@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ SUBDIRS = al -@BUILD_JAVA_TRUE@JAVA_TARGET = al/foam.jar +@BUILD_JAVA_TRUE@JAVA_TARGET = al/foam.jar al/foam-sources.jar aldorsrcdir = $(top_srcdir)/aldor/src runtime_CFLAGS = -I $(aldorsrcdir) -I ../../src runtime_ALDOR = al/runtime.c diff --git a/aldor/aldor/lib/libfoamlib/al/Makefile.in b/aldor/aldor/lib/libfoamlib/al/Makefile.in index b95e416bb..24f7c94ff 100644 --- a/aldor/aldor/lib/libfoamlib/al/Makefile.in +++ b/aldor/aldor/lib/libfoamlib/al/Makefile.in @@ -50,7 +50,7 @@ libraryname := foamlib exec_test_blacklist = $(library) #AXLCDB := -W check -Csmax=0 -Fc -Zdb -Qno-cc -AXLFLAGS := -Z db -Q8 $(AXLCDB) +AXLFLAGS := -Q8 $(AXLCDB) include $(top_srcdir)/lib/buildlib.mk libraryincdir := $(top_srcdir)/aldor/lib/libfoamlib/al diff --git a/aldor/aldor/src/Makefile.am b/aldor/aldor/src/Makefile.am index 43add6fda..d9ca7511d 100644 --- a/aldor/aldor/src/Makefile.am +++ b/aldor/aldor/src/Makefile.am @@ -159,6 +159,7 @@ libstruct_a_SOURCES = \ compcfg.c \ comsg.c \ comsgdb.c \ + csig.c \ depdag.c \ dflow.c \ doc.c \ @@ -291,6 +292,8 @@ testsuite = \ test/test_jcode.c \ test/test_int.c \ test/test_list.c \ + test/test_of_cprop.c \ + test/test_of_peep.c \ test/test_ostream.c \ test/test_printf.c \ test/test_retyp.c \ diff --git a/aldor/aldor/src/Makefile.in b/aldor/aldor/src/Makefile.in index 9fb0a7911..e4c7cd197 100644 --- a/aldor/aldor/src/Makefile.in +++ b/aldor/aldor/src/Makefile.in @@ -115,7 +115,7 @@ am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ DIST_COMMON = $(srcdir)/Makefile.am $(include_HEADERS) \ $(am__DIST_COMMON) mkinstalldirs = $(install_sh) -d -CONFIG_CLEAN_FILES = opsys_port.h +CONFIG_CLEAN_FILES = opsys_port.h version.c CONFIG_CLEAN_VPATH_FILES = am__installdirs = "$(DESTDIR)$(bindir)" "$(DESTDIR)$(libexecdir)" \ "$(DESTDIR)$(dataincludedir)" "$(DESTDIR)$(datalibdir)" \ @@ -179,12 +179,12 @@ libstruct_a_LIBADD = am_libstruct_a_OBJECTS = ablogic.$(OBJEXT) abpretty.$(OBJEXT) \ absub.$(OBJEXT) absyn.$(OBJEXT) annabs.$(OBJEXT) \ archive.$(OBJEXT) axlobs.$(OBJEXT) compcfg.$(OBJEXT) \ - comsg.$(OBJEXT) comsgdb.$(OBJEXT) depdag.$(OBJEXT) \ - dflow.$(OBJEXT) doc.$(OBJEXT) fbox.$(OBJEXT) fint.$(OBJEXT) \ - flog.$(OBJEXT) foam.$(OBJEXT) foamsig.$(OBJEXT) forg.$(OBJEXT) \ - freevar.$(OBJEXT) formatters.$(OBJEXT) ftype.$(OBJEXT) \ - gf_syme.$(OBJEXT) javasig.$(OBJEXT) lib.$(OBJEXT) \ - loops.$(OBJEXT) output.$(OBJEXT) sefo.$(OBJEXT) \ + comsg.$(OBJEXT) comsgdb.$(OBJEXT) csig.$(OBJEXT) \ + depdag.$(OBJEXT) dflow.$(OBJEXT) doc.$(OBJEXT) fbox.$(OBJEXT) \ + fint.$(OBJEXT) flog.$(OBJEXT) foam.$(OBJEXT) foamsig.$(OBJEXT) \ + forg.$(OBJEXT) freevar.$(OBJEXT) formatters.$(OBJEXT) \ + ftype.$(OBJEXT) gf_syme.$(OBJEXT) javasig.$(OBJEXT) \ + lib.$(OBJEXT) loops.$(OBJEXT) output.$(OBJEXT) sefo.$(OBJEXT) \ simpl.$(OBJEXT) spesym.$(OBJEXT) srcline.$(OBJEXT) \ stab.$(OBJEXT) syme.$(OBJEXT) symeset.$(OBJEXT) \ symcoinfo.$(OBJEXT) tconst.$(OBJEXT) tfcond.$(OBJEXT) \ @@ -272,6 +272,8 @@ am__objects_1 = test/testall-test_abcheck.$(OBJEXT) \ test/testall-test_jcode.$(OBJEXT) \ test/testall-test_int.$(OBJEXT) \ test/testall-test_list.$(OBJEXT) \ + test/testall-test_of_cprop.$(OBJEXT) \ + test/testall-test_of_peep.$(OBJEXT) \ test/testall-test_ostream.$(OBJEXT) \ test/testall-test_printf.$(OBJEXT) \ test/testall-test_retyp.$(OBJEXT) \ @@ -322,7 +324,7 @@ am__depfiles_remade = ./$(DEPDIR)/abcheck.Po ./$(DEPDIR)/ablogic.Po \ ./$(DEPDIR)/ccomp.Po ./$(DEPDIR)/cfgfile.Po \ ./$(DEPDIR)/compcfg.Po ./$(DEPDIR)/compopt.Po \ ./$(DEPDIR)/comsg.Po ./$(DEPDIR)/comsgdb.Po \ - ./$(DEPDIR)/cport.Po ./$(DEPDIR)/debug.Po \ + ./$(DEPDIR)/cport.Po ./$(DEPDIR)/csig.Po ./$(DEPDIR)/debug.Po \ ./$(DEPDIR)/depdag.Po ./$(DEPDIR)/dflow.Po ./$(DEPDIR)/dnf.Po \ ./$(DEPDIR)/doc.Po ./$(DEPDIR)/dword.Po ./$(DEPDIR)/emit.Po \ ./$(DEPDIR)/errorset.Po ./$(DEPDIR)/fbox.Po \ @@ -435,6 +437,8 @@ am__depfiles_remade = ./$(DEPDIR)/abcheck.Po ./$(DEPDIR)/ablogic.Po \ test/$(DEPDIR)/testall-test_jcode.Po \ test/$(DEPDIR)/testall-test_jflow.Po \ test/$(DEPDIR)/testall-test_list.Po \ + test/$(DEPDIR)/testall-test_of_cprop.Po \ + test/$(DEPDIR)/testall-test_of_peep.Po \ test/$(DEPDIR)/testall-test_ostream.Po \ test/$(DEPDIR)/testall-test_printf.Po \ test/$(DEPDIR)/testall-test_retyp.Po \ @@ -710,8 +714,8 @@ TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/amaux/test-driver TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \ $(TEST_LOG_FLAGS) am__DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/opsys_port.h.in \ - $(top_srcdir)/amaux/depcomp $(top_srcdir)/amaux/test-driver \ - ChangeLog + $(srcdir)/version.c.in $(top_srcdir)/amaux/depcomp \ + $(top_srcdir)/amaux/test-driver ChangeLog DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ @@ -1004,6 +1008,7 @@ libstruct_a_SOURCES = \ compcfg.c \ comsg.c \ comsgdb.c \ + csig.c \ depdag.c \ dflow.c \ doc.c \ @@ -1129,6 +1134,8 @@ testsuite = \ test/test_jcode.c \ test/test_int.c \ test/test_list.c \ + test/test_of_cprop.c \ + test/test_of_peep.c \ test/test_ostream.c \ test/test_printf.c \ test/test_retyp.c \ @@ -1197,6 +1204,8 @@ $(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) $(am__aclocal_m4_deps): opsys_port.h: $(top_builddir)/config.status $(srcdir)/opsys_port.h.in cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ +version.c: $(top_builddir)/config.status $(srcdir)/version.c.in + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ install-binPROGRAMS: $(bin_PROGRAMS) @$(NORMAL_INSTALL) @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ @@ -1433,6 +1442,10 @@ test/testall-test_int.$(OBJEXT): test/$(am__dirstamp) \ test/$(DEPDIR)/$(am__dirstamp) test/testall-test_list.$(OBJEXT): test/$(am__dirstamp) \ test/$(DEPDIR)/$(am__dirstamp) +test/testall-test_of_cprop.$(OBJEXT): test/$(am__dirstamp) \ + test/$(DEPDIR)/$(am__dirstamp) +test/testall-test_of_peep.$(OBJEXT): test/$(am__dirstamp) \ + test/$(DEPDIR)/$(am__dirstamp) test/testall-test_ostream.$(OBJEXT): test/$(am__dirstamp) \ test/$(DEPDIR)/$(am__dirstamp) test/testall-test_printf.$(OBJEXT): test/$(am__dirstamp) \ @@ -1509,6 +1522,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/comsg.Po@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/comsgdb.Po@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cport.Po@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/csig.Po@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/debug.Po@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/depdag.Po@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dflow.Po@am__quote@ # am--include-marker @@ -1697,6 +1711,8 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@test/$(DEPDIR)/testall-test_jcode.Po@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@test/$(DEPDIR)/testall-test_jflow.Po@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@test/$(DEPDIR)/testall-test_list.Po@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@test/$(DEPDIR)/testall-test_of_cprop.Po@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@test/$(DEPDIR)/testall-test_of_peep.Po@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@test/$(DEPDIR)/testall-test_ostream.Po@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@test/$(DEPDIR)/testall-test_printf.Po@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@test/$(DEPDIR)/testall-test_retyp.Po@am__quote@ # am--include-marker @@ -2556,6 +2572,34 @@ test/testall-test_list.obj: test/test_list.c @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(testall_CFLAGS) $(CFLAGS) -c -o test/testall-test_list.obj `if test -f 'test/test_list.c'; then $(CYGPATH_W) 'test/test_list.c'; else $(CYGPATH_W) '$(srcdir)/test/test_list.c'; fi` +test/testall-test_of_cprop.o: test/test_of_cprop.c +@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(testall_CFLAGS) $(CFLAGS) -MT test/testall-test_of_cprop.o -MD -MP -MF test/$(DEPDIR)/testall-test_of_cprop.Tpo -c -o test/testall-test_of_cprop.o `test -f 'test/test_of_cprop.c' || echo '$(srcdir)/'`test/test_of_cprop.c +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) test/$(DEPDIR)/testall-test_of_cprop.Tpo test/$(DEPDIR)/testall-test_of_cprop.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='test/test_of_cprop.c' object='test/testall-test_of_cprop.o' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(testall_CFLAGS) $(CFLAGS) -c -o test/testall-test_of_cprop.o `test -f 'test/test_of_cprop.c' || echo '$(srcdir)/'`test/test_of_cprop.c + +test/testall-test_of_cprop.obj: test/test_of_cprop.c +@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(testall_CFLAGS) $(CFLAGS) -MT test/testall-test_of_cprop.obj -MD -MP -MF test/$(DEPDIR)/testall-test_of_cprop.Tpo -c -o test/testall-test_of_cprop.obj `if test -f 'test/test_of_cprop.c'; then $(CYGPATH_W) 'test/test_of_cprop.c'; else $(CYGPATH_W) '$(srcdir)/test/test_of_cprop.c'; fi` +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) test/$(DEPDIR)/testall-test_of_cprop.Tpo test/$(DEPDIR)/testall-test_of_cprop.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='test/test_of_cprop.c' object='test/testall-test_of_cprop.obj' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(testall_CFLAGS) $(CFLAGS) -c -o test/testall-test_of_cprop.obj `if test -f 'test/test_of_cprop.c'; then $(CYGPATH_W) 'test/test_of_cprop.c'; else $(CYGPATH_W) '$(srcdir)/test/test_of_cprop.c'; fi` + +test/testall-test_of_peep.o: test/test_of_peep.c +@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(testall_CFLAGS) $(CFLAGS) -MT test/testall-test_of_peep.o -MD -MP -MF test/$(DEPDIR)/testall-test_of_peep.Tpo -c -o test/testall-test_of_peep.o `test -f 'test/test_of_peep.c' || echo '$(srcdir)/'`test/test_of_peep.c +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) test/$(DEPDIR)/testall-test_of_peep.Tpo test/$(DEPDIR)/testall-test_of_peep.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='test/test_of_peep.c' object='test/testall-test_of_peep.o' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(testall_CFLAGS) $(CFLAGS) -c -o test/testall-test_of_peep.o `test -f 'test/test_of_peep.c' || echo '$(srcdir)/'`test/test_of_peep.c + +test/testall-test_of_peep.obj: test/test_of_peep.c +@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(testall_CFLAGS) $(CFLAGS) -MT test/testall-test_of_peep.obj -MD -MP -MF test/$(DEPDIR)/testall-test_of_peep.Tpo -c -o test/testall-test_of_peep.obj `if test -f 'test/test_of_peep.c'; then $(CYGPATH_W) 'test/test_of_peep.c'; else $(CYGPATH_W) '$(srcdir)/test/test_of_peep.c'; fi` +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) test/$(DEPDIR)/testall-test_of_peep.Tpo test/$(DEPDIR)/testall-test_of_peep.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='test/test_of_peep.c' object='test/testall-test_of_peep.obj' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(testall_CFLAGS) $(CFLAGS) -c -o test/testall-test_of_peep.obj `if test -f 'test/test_of_peep.c'; then $(CYGPATH_W) 'test/test_of_peep.c'; else $(CYGPATH_W) '$(srcdir)/test/test_of_peep.c'; fi` + test/testall-test_ostream.o: test/test_ostream.c @am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(testall_CFLAGS) $(CFLAGS) -MT test/testall-test_ostream.o -MD -MP -MF test/$(DEPDIR)/testall-test_ostream.Tpo -c -o test/testall-test_ostream.o `test -f 'test/test_ostream.c' || echo '$(srcdir)/'`test/test_ostream.c @am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) test/$(DEPDIR)/testall-test_ostream.Tpo test/$(DEPDIR)/testall-test_ostream.Po @@ -3225,6 +3269,7 @@ distclean: distclean-am -rm -f ./$(DEPDIR)/comsg.Po -rm -f ./$(DEPDIR)/comsgdb.Po -rm -f ./$(DEPDIR)/cport.Po + -rm -f ./$(DEPDIR)/csig.Po -rm -f ./$(DEPDIR)/debug.Po -rm -f ./$(DEPDIR)/depdag.Po -rm -f ./$(DEPDIR)/dflow.Po @@ -3413,6 +3458,8 @@ distclean: distclean-am -rm -f test/$(DEPDIR)/testall-test_jcode.Po -rm -f test/$(DEPDIR)/testall-test_jflow.Po -rm -f test/$(DEPDIR)/testall-test_list.Po + -rm -f test/$(DEPDIR)/testall-test_of_cprop.Po + -rm -f test/$(DEPDIR)/testall-test_of_peep.Po -rm -f test/$(DEPDIR)/testall-test_ostream.Po -rm -f test/$(DEPDIR)/testall-test_printf.Po -rm -f test/$(DEPDIR)/testall-test_retyp.Po @@ -3504,6 +3551,7 @@ maintainer-clean: maintainer-clean-am -rm -f ./$(DEPDIR)/comsg.Po -rm -f ./$(DEPDIR)/comsgdb.Po -rm -f ./$(DEPDIR)/cport.Po + -rm -f ./$(DEPDIR)/csig.Po -rm -f ./$(DEPDIR)/debug.Po -rm -f ./$(DEPDIR)/depdag.Po -rm -f ./$(DEPDIR)/dflow.Po @@ -3692,6 +3740,8 @@ maintainer-clean: maintainer-clean-am -rm -f test/$(DEPDIR)/testall-test_jcode.Po -rm -f test/$(DEPDIR)/testall-test_jflow.Po -rm -f test/$(DEPDIR)/testall-test_list.Po + -rm -f test/$(DEPDIR)/testall-test_of_cprop.Po + -rm -f test/$(DEPDIR)/testall-test_of_peep.Po -rm -f test/$(DEPDIR)/testall-test_ostream.Po -rm -f test/$(DEPDIR)/testall-test_printf.Po -rm -f test/$(DEPDIR)/testall-test_retyp.Po diff --git a/aldor/aldor/src/abpretty.c b/aldor/aldor/src/abpretty.c index f03a458c8..2b121f0b9 100644 --- a/aldor/aldor/src/abpretty.c +++ b/aldor/aldor/src/abpretty.c @@ -6,16 +6,15 @@ * ****************************************************************************/ +#include "abpretty.h" #include "axlobs.h" +#include "comsg.h" +#include "doc.h" +#include "lib.h" #include "spesym.h" +#include "strops.h" #include "syme.h" -#include "lib.h" #include "tform.h" -#include "abpretty.h" -#include "doc.h" -#include "comsg.h" -#include "strops.h" - #define CONTINUED "..." #define NCONTINUED (sizeof("...") - 1) diff --git a/aldor/aldor/src/absub.c b/aldor/aldor/src/absub.c index c807b506d..71807dafc 100644 --- a/aldor/aldor/src/absub.c +++ b/aldor/aldor/src/absub.c @@ -119,6 +119,28 @@ absPrint(FILE *fout, AbSub sigma) return listPrint(AbBind)(fout, sigma->l, absPrintBinding); } +int +absOStreamWrite(OStream os, AbSub sigma) +{ + int c = 0; + if (sigma == absFail()) { + return ostreamPrintf(os, "{ FAIL }"); + } + + c += ostreamPrintf(os, "{(%d) ", sigma->serialNo); + c += listFormat(AbBind)(os, "AbBind", sigma->l); + c += ostreamPrintf(os, "}"); + return c; +} + +int +abbOStreamWrite(OStream os, AbBind bind) +{ + int c = 0; + c += ostreamPrintf(os, "%pSyme -> %pAbSyn", bind->key, bind->val); + return c; +} + int absPrintDb(AbSub sigma) { @@ -208,11 +230,15 @@ absLookup(Syme syme, Sefo fail, AbSub sigma) { AbBindList l0; - for (l0 = sigma->l; l0; l0 = cdr(l0)) - /** if (syme == car(l0)->key) **/ /** commented by C.O. for ALMA usage**/ - if (symeEqual(syme, car(l0)->key)) /** code introduced by C.O. for ALMA usage**/ + for (l0 = sigma->l; l0; l0 = cdr(l0)) { + if (syme == car(l0)->key) { return car(l0)->val; - + } + } + for (l0 = sigma->l; l0; l0 = cdr(l0)) { + if (symeEqual(syme, car(l0)->key)) + return car(l0)->val; + } return fail; } diff --git a/aldor/aldor/src/absub.h b/aldor/aldor/src/absub.h index 6127d5c58..08b8d7616 100644 --- a/aldor/aldor/src/absub.h +++ b/aldor/aldor/src/absub.h @@ -57,6 +57,8 @@ struct abSub { extern AbSub absNew (Stab); extern AbSub absFail (void); +extern int absOStreamWrite (OStream, AbSub); +extern int abbOStreamWrite (OStream, AbBind); extern int absPrint (FILE *, AbSub); extern int absPrintDb (AbSub); extern AbSub absRefer (AbSub); diff --git a/aldor/aldor/src/absyn.c b/aldor/aldor/src/absyn.c index 00df53ce9..78d6c2a7a 100644 --- a/aldor/aldor/src/absyn.c +++ b/aldor/aldor/src/absyn.c @@ -704,12 +704,54 @@ abEqualModDeclares0(AbSyn ab1, AbSyn ab2, Bool decls) } } +local Bool +abCompareModDeclares0(AbEqualFn eq, void *ctxt, AbSyn ab1, AbSyn ab2, Bool decls) +{ + if (ab1 == ab2) + return true; + + ab1 = abEqualDeclMods(ab1, decls); + ab2 = abEqualDeclMods(ab2, decls); + + AbEqualValue val = eq(ctxt, ab1, ab2); + if (val != AbEqual_Struct) { + return val == AbEqual_True ? true : false; + } + if (abTag(ab1) != abTag(ab2) || abArgc(ab1) != abArgc(ab2)) + return false; + + else if (abIsLeaf(ab1)) + return abEqual(ab1, ab2); + + else if (abHasTag(ab1, AB_Define)) + return abCompareModDeclares0(eq, ctxt, ab1->abDefine.lhs, + ab2->abDefine.lhs, decls) && + abCompareModDeclares0(eq, ctxt, ab1->abDefine.rhs, + ab2->abDefine.rhs, false); + + else { + Length i; + decls &= abHasTag(ab1, AB_Comma) || abIsAnyMap(ab1); + for (i = 0; i < abArgc(ab1); i += 1) + if (!abCompareModDeclares0(eq, ctxt, abArgv(ab1)[i], + abArgv(ab2)[i], decls)) + return false; + return true; + } +} + Bool abEqualModDeclares(AbSyn ab1, AbSyn ab2) { return abEqualModDeclares0(ab1, ab2, true); } +Bool +abCompareModDeclares(AbEqualFn eq, void *ctxt, AbSyn ab1, AbSyn ab2) +{ + return abCompareModDeclares0(eq, ctxt, ab1, ab2, true); +} + /* * Hash code. */ @@ -1985,8 +2027,10 @@ abDefineeIdOrElse(AbSyn ab, AbSyn failed) case AB_Comma: if (abArgc(ab) < 1) return failed; - if (abArgc(ab) > 1) + if (abArgc(ab) > 1) { + afprintf(dbOut, "%pAbSyn\n", ab); bugWarning("abDefineeId comma bug"); + } ab = abArgv(ab)[0]; break; case AB_Id: diff --git a/aldor/aldor/src/absyn.h b/aldor/aldor/src/absyn.h index 6be9f0208..d4f292c88 100644 --- a/aldor/aldor/src/absyn.h +++ b/aldor/aldor/src/absyn.h @@ -941,6 +941,10 @@ extern struct ab_info abInfoTable[]; abIsTheId((op), ssymRecord) || \ abIsTheId((op), ssymRawRecord) \ ) +enum abEqualValue { AbEqual_True, AbEqual_False, AbEqual_Struct }; +typedef Enum(abEqualValue) AbEqualValue; + +typedef AbEqualValue (*AbEqualFn)(void *, AbSyn, AbSyn); /* * :: General operations @@ -963,6 +967,7 @@ extern AbSyn abMarkAsMacroExpanded (AbSyn); extern Bool abContains (AbSyn, AbSyn); extern Bool abEqual (AbSyn, AbSyn); extern Bool abEqualModDeclares (AbSyn, AbSyn); +extern Bool abCompareModDeclares (AbEqualFn, void *, AbSyn, AbSyn); extern Hash abHash (AbSyn); extern Hash abHashSefo (AbSyn); extern Hash abHashList (AbSynList); diff --git a/aldor/aldor/src/axlcomp.c b/aldor/aldor/src/axlcomp.c index 90a8c9f5d..90c94aaac 100644 --- a/aldor/aldor/src/axlcomp.c +++ b/aldor/aldor/src/axlcomp.c @@ -90,11 +90,9 @@ compCmd(int argc, char **argv) /* Display the version string in all its glory */ if (cmdHasVerboseOption(argc, argv)) { - fprintf(osStdout, "%s version %d.%d.%d", + fprintf(osStdout, "%s version %s", verName, - verMajorVersion, - verMinorVersion, - verMinorFreeze); + verVersionId); if (*verPatchLevel) fprintf(osStdout, "(%s)", verPatchLevel); fprintf(osStdout, " for %s %s\n", CONFIG, DEBUG_CONFIG); @@ -425,12 +423,10 @@ compGLoopInit(int argc, char **argv, FILE *fout, FileName *pfn, /* Helpful start-up banner ... */ fprintf(osStdout,"%s\n",comsgString(ALDOR_M_GloopBanner)); if (comsgOkRelease()) { - fprintf(osStdout, "%s: %s(%s) version %d.%d.%d", + fprintf(osStdout, "%s: %s(%s) version %s", "Release", verName, "C", /* C-language version */ - verMajorVersion, - verMinorVersion, - verMinorFreeze); + verVersionId); if (*verPatchLevel) fprintf(osStdout, "(%s)", verPatchLevel); fprintf(osStdout, " for %s %s\n", CONFIG, DEBUG_CONFIG); diff --git a/aldor/aldor/src/axlgen.h b/aldor/aldor/src/axlgen.h index 6d440f095..1accfc761 100644 --- a/aldor/aldor/src/axlgen.h +++ b/aldor/aldor/src/axlgen.h @@ -16,6 +16,8 @@ #include "axlgen0.h" #include "list.h" +#include "table.h" +#include "ttable.h" #define OB_Other 0 #define OB_Bogus 1 @@ -42,7 +44,6 @@ typedef ULong SrcPos; typedef struct sposCell * SrcPosCell; typedef union sposStack SrcPosStack; typedef union SExprUnion * SExpr; -typedef struct table * Table; typedef struct bint * BInt; typedef union ccode * CCode; diff --git a/aldor/aldor/src/axlobs.c b/aldor/aldor/src/axlobs.c index e86bd30b4..e3f1f8105 100644 --- a/aldor/aldor/src/axlobs.c +++ b/aldor/aldor/src/axlobs.c @@ -51,6 +51,7 @@ CREATE_LIST(DepDag); CREATE_LIST(SymeList); +CREATE_TSET(Syme); /* diff --git a/aldor/aldor/src/axlobs.h b/aldor/aldor/src/axlobs.h index aff99934e..947191926 100644 --- a/aldor/aldor/src/axlobs.h +++ b/aldor/aldor/src/axlobs.h @@ -95,6 +95,12 @@ DECLARE_LIST(DepDag); DECLARE_LIST(SymeList); +/* + * Declare necessary sets + */ + +DECLARE_TSET(Syme); + /* * Include files which give meaning to the above declarations. */ diff --git a/aldor/aldor/src/csig.c b/aldor/aldor/src/csig.c new file mode 100644 index 000000000..1b25a8bc1 --- /dev/null +++ b/aldor/aldor/src/csig.c @@ -0,0 +1,59 @@ +#include "csig.h" +#include "strops.h" +#include "util.h" + +Foam +csigNew(FoamList args, FoamList rets) +{ + Foam ddecl; + Length i, argc, retc; + + argc = listLength(Foam)(args); + retc = listLength(Foam)(rets); + + ddecl = foamNewDDecl(FOAM_DDecl, 1 + argc + 1 + retc); + ddecl->foamDDecl.usage = FOAM_DDecl_CSig; + + listIter(Foam, argDecl, args, { + ddecl->foamDDecl.argv[i++] = argDecl; + }); + // * Add a marker to separate args and return + ddecl->foamDDecl.argv[i++] = foamNewDDecl(FOAM_Nil, strCopy(""), emptyFormatSlot); + + listIter(Foam, retDecl, rets, { + ddecl->foamDDecl.argv[i++] = retDecl; + }); + return ddecl; +} + +AInt +csigArgc(Foam foam) +{ + int i; + for (i=0; ifoamDDecl.argv[i]->foamDecl.type == FOAM_Nil) { + return i; + } + } + bug("no gap in csig"); +} + +Foam +csigArgN(Foam foam, Length n) +{ + return foam->foamDDecl.argv[n]; +} + +AInt +csigRetc(Foam foam) +{ + int argc = csigArgc(foam); + return foamDDeclArgc(foam) - argc - 1; +} + +Foam +csigRetN(Foam foam, Length n) +{ + int pos = csigArgc(foam); + return foam->foamDDecl.argv[pos + 1 + n]; +} diff --git a/aldor/aldor/src/csig.h b/aldor/aldor/src/csig.h new file mode 100644 index 000000000..533097190 --- /dev/null +++ b/aldor/aldor/src/csig.h @@ -0,0 +1,14 @@ +#ifndef _CSIG_H_ +#define _CSIG_H_ +#include "foam.h" + +Foam csigNew(FoamList args, FoamList rets); + +AInt csigArgc(Foam foam); +Foam csigArgN(Foam foam, Length n); + +AInt csigRetc(Foam foam); +Foam csigRetN(Foam foam, Length n); + + +#endif diff --git a/aldor/aldor/src/fint.c b/aldor/aldor/src/fint.c index 05424718d..305225309 100644 --- a/aldor/aldor/src/fint.c +++ b/aldor/aldor/src/fint.c @@ -1433,7 +1433,7 @@ readDef(FintUnit unit) progInfoLabels(p) = (FiProgPos *) NULL; fintGetByte(progInfoRetType(p)); /* return type */ - fintGetInt(fmt, progInfoMValFmt(p)); + fintGetSInt(progInfoMValFmt(p)); fintGetSInt(progInfoBMask(p)); /* bit mask */ fintGetSInt(n); /* skip size */ diff --git a/aldor/aldor/src/flog.c b/aldor/aldor/src/flog.c index 9e4a2444f..a2a0f966d 100644 --- a/aldor/aldor/src/flog.c +++ b/aldor/aldor/src/flog.c @@ -521,8 +521,6 @@ flogToSeq(FlowGraph flog, int * nLabels) newSeq = flogToSeq0(flog, &lab); if (nLabels) *nLabels = lab + 1; - stoFree(flog); - return newSeq; } @@ -926,7 +924,7 @@ bbPrint(FILE *fout, BBlock bb, Bool extended) cc += fprintf(fout, " %d", bbEntry(bb,i)->label); cc += fprintf(fout, "\n"); - if (extended) cc += foamPrint(fout, bb->code); + if (extended) cc += afprintf(fout, "%pFoam\n", bb->code); if (extended) cc += dflowPrintBlockInfo(fout, bb); return cc; diff --git a/aldor/aldor/src/foam.c b/aldor/aldor/src/foam.c index af7be91ac..2bb9ccc44 100644 --- a/aldor/aldor/src/foam.c +++ b/aldor/aldor/src/foam.c @@ -1075,6 +1075,10 @@ foamAuditDecl(Foam decl) if (fmt >= faNumFormats) foamAuditBadDecl(decl); break; + case FOAM_CObj: + if (fmt >= faNumFormats) + foamAuditBadDecl(decl); + break; case FOAM_Rec: /* TODO: Fix implicit exports so that they don't @@ -1758,8 +1762,6 @@ foamToSExpr0(Foam foam) Bool isDecl; long li; - assert (foam); - if (!foam) return sxiFrString("Bad-Foam-0"); /* @@ -2157,11 +2159,13 @@ foamGDeclIsExportOf(AInt tag, Foam foam) #define FOAM_PUT_INT(format, buf, i) { \ switch (format) { \ case 0: bufPutSInt(buf, i); break; \ - case 1: bufPutByte(buf, i); break; \ + case 1: FOAM_CHK_INT(i); bufPutByte(buf, i); break; \ default: break; /* Included in tag. */ \ } \ } +#define FOAM_CHK_INT(i) {if (i > MAX_BYTE) bug("oops - int too large");} + #define FOAM_GET_INT(format, buf, i) { \ switch (format) { \ case 0: (i) = bufGetSInt(buf); break; \ @@ -3525,8 +3529,8 @@ foamFindFirst(FoamTestFn testFn, Foam foam) { if (testFn(foam)) return foam; - - foamIter(foam, arg, { + + foamIter(foam, arg, { Foam f = foamFindFirst(testFn, *arg); if (f != 0) return f; @@ -3534,6 +3538,34 @@ foamFindFirst(FoamTestFn testFn, Foam foam) return 0; } +Foam +foamFindFirstEnv(FoamTestEnvFn testFn, Foam foam, AInt env) +{ + if (testFn(foam, env)) + return foam; + + foamIter(foam, arg, { + Foam f = foamFindFirstEnv(testFn, *arg, env); + if (f != 0) + return f; + }); + return 0; +} + +Foam +foamFindFirstTag(FoamTag tag, Foam foam) +{ + if (foamTag(foam) == tag) + return foam; + + foamIter(foam, arg, { + Foam f = foamFindFirstTag(tag, *arg); + if (f != 0) + return f; + }); + return 0; +} + Foam foamCastIfNeeded(FoamTag wanted, FoamTag actual, Foam foam) { @@ -3631,6 +3663,7 @@ struct foam_info foamInfoTable[] = { {FOAM_MFmt, 0,"MFmt", 2, "iC", 0}, {FOAM_RRFmt, 0,"RRFmt", 1, "C", 0}, {FOAM_JavaObj, 0,"JavaObj", 0, "", 0}, + {FOAM_CObj, 0,"CObj", 0, "", 0}, /* ========> FFO_ORIGIN (start of multi-format instructions) <======== */ @@ -3676,9 +3709,9 @@ struct foam_info foamInfoTable[] = { {FOAM_Seq, 0,"Seq", FOAM_NARY, "C*", 0}, {FOAM_Values, 0,"Values", FOAM_NARY, "C*", 0}, #ifdef NEW_FORMATS - {FOAM_Prog, 0,"Prog", FOAM_NARY, "XFtiwwwwC*", 0} + {FOAM_Prog, 0,"Prog", FOAM_NARY, "XFtwwwwwC*", 0} #else - {FOAM_Prog, 0,"Prog", FOAM_NARY, "XFtiwwwwC*", 0} + {FOAM_Prog, 0,"Prog", FOAM_NARY, "XFtwwwwwC*", 0} #endif }; @@ -3721,6 +3754,7 @@ struct foamDDecl_info foamDDeclInfoTable[] = { { FOAM_DDecl_Global, 0, "Globals" }, { FOAM_DDecl_FortranSig, 0, "FortranSig" }, { FOAM_DDecl_CSig, 0, "CSig" }, + { FOAM_DDecl_CType, 0, "CType" }, { 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 6b217b4c6..c1a3efbd6 100644 --- a/aldor/aldor/src/foam.h +++ b/aldor/aldor/src/foam.h @@ -75,6 +75,7 @@ enum foamTag { FOAM_MFmt, /* Indicate multiple values */ FOAM_RRFmt, /* Raw record (dynamic) format */ FOAM_JavaObj, /* Java things */ + FOAM_CObj, /* C things */ FOAM_CONTROL_LIMIT, @@ -467,6 +468,7 @@ enum foamDDeclTag { FOAM_DDecl_Global, FOAM_DDecl_FortranSig, FOAM_DDecl_CSig, + FOAM_DDecl_CType, FOAM_DDecl_JavaSig, FOAM_DDecl_JavaClass, FOAM_DDECL_LIMIT @@ -681,10 +683,9 @@ struct foamClos { Foam prog; }; -#define foamNewGDecl(ty,id,f,pr,dir) foamNew(FOAM_GDecl,6,(AInt)(ty),id, \ - (AInt)FOAM_Nil,f, \ +#define foamNewGDecl(ty,id,rt,f,pr,dir) foamNew(FOAM_GDecl,6,(AInt)(ty),id, \ + rt,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); @@ -1622,6 +1623,11 @@ extern Bool foamIsControlFlow (Foam); typedef Bool (*FoamTestFn)(Foam f); extern Foam foamFindFirst(FoamTestFn testFn, Foam foam); +typedef Bool (*FoamTestEnvFn)(Foam f, AInt env); +extern Foam foamFindFirstEnv(FoamTestEnvFn testFn, Foam foam, AInt env); + +extern Foam foamFindFirstTag(FoamTag tag, Foam foam); + Foam foamCastIfNeeded(FoamTag wanted, FoamTag actual, Foam foam); diff --git a/aldor/aldor/src/foam_c.h b/aldor/aldor/src/foam_c.h index e8c9507b8..67ce092aa 100644 --- a/aldor/aldor/src/foam_c.h +++ b/aldor/aldor/src/foam_c.h @@ -17,6 +17,7 @@ #include "cconfig.h" typedef char *Ptr; +typedef long *LPtr; typedef Ptr FiNil; typedef unsigned long int FiWord; diff --git a/aldor/aldor/src/format.c b/aldor/aldor/src/format.c index 54fa1c079..2e4743649 100644 --- a/aldor/aldor/src/format.c +++ b/aldor/aldor/src/format.c @@ -15,13 +15,14 @@ #include "list.h" #include "store.h" #include "strops.h" +#include "util.h" /* * fnewline(fout) prints a newline and indents next line by amount findent. */ int findent = 0; -local int fmtPPrint(Format format, OStream stream, Pointer ptr); -local int fmtIPrint(Format format, OStream stream, int n); +local int fmtPPrint(Format format, int width, char *fmt, OStream stream, Pointer ptr); +local int fmtIPrint(Format format, int width, char *fmt, OStream stream, int n); int fnewline(FILE *fout) @@ -292,7 +293,7 @@ ostreamVPrintf(OStream ostream, const char *fmt, va_list argp) cc += ostreamWrite(ostream, arg_buf, -1); } else { - cc += fmtIPrint(format, ostream, va_arg(argp, int)); + cc += fmtIPrint(format, fb.width, fb.fmt, ostream, va_arg(argp, int)); fmt += strlen(format->name); } continue; @@ -306,7 +307,7 @@ ostreamVPrintf(OStream ostream, const char *fmt, va_list argp) cc += ostreamWrite(ostream, arg_buf, -1); } else { - cc += fmtPPrint(format, ostream, va_arg(argp, Pointer)); + cc += fmtPPrint(format, fb.width, fb.fmt, ostream, va_arg(argp, Pointer)); fmt += strlen(format->name); } continue; @@ -367,7 +368,10 @@ fmtRegisterFull(const char *name, PFormatFn fn, Bool nullOk) assert(name[0] != '\0'); format->name = strCopy(name); format->pfn = fn; + format->ifn = NULL; format->nullOk = nullOk; + format->apfn = NULL; + format->aifn = NULL; fmtRegisteredFormats = listCons(Format)(format, fmtRegisteredFormats); } @@ -378,9 +382,20 @@ void fmtRegisterI(const char *name, IFormatFn ifn) format->name = strCopy(name); format->ifn = ifn; format->nullOk = false; + format->apfn = NULL; + format->aifn = NULL; fmtRegisteredFormats = listCons(Format)(format, fmtRegisteredFormats); } +void fmtRegisterAlt(const char *name, AltPFormatFn fn) +{ + Format f = fmtMatch(name); + if (f == NULL) + bug("Missing format"); + + f->apfn = fn; +} + Format fmtMatch(const char *fmtTxt) @@ -407,17 +422,29 @@ fmtMatch(const char *fmtTxt) } static int -fmtPPrint(Format format, OStream stream, Pointer ptr) +fmtPPrint(Format format, int width, char *fmt, OStream stream, Pointer ptr) { + int outlvl = 0; + int c; assert(format != NULL); + if (!format->nullOk && ptr == NULL) { return ostreamPrintf(stream, "(nil)"); } - return format->pfn(stream, ptr); + while (*fmt != '\0') { + if (*fmt == '#') outlvl++; + fmt++; + } + if (outlvl == 0 || format->apfn == NULL) + c = format->pfn(stream, ptr); + else + c = format->apfn(stream, outlvl, ptr); + + return c; } static int -fmtIPrint(Format format, OStream stream, int n) +fmtIPrint(Format format, int width, char *fmt, OStream stream, int n) { assert(format != NULL); return format->ifn(stream, n); diff --git a/aldor/aldor/src/format.h b/aldor/aldor/src/format.h index 21f866e21..6568a8eec 100644 --- a/aldor/aldor/src/format.h +++ b/aldor/aldor/src/format.h @@ -45,17 +45,23 @@ extern int ostreamVPrintf(OStream ostream, const char *fmt, va_list argp); typedef int (*PFormatFn)(OStream stream, Pointer p); typedef int (*IFormatFn)(OStream stream, int np); +typedef int (*AltPFormatFn)(OStream stream, int alt, Pointer p); +typedef int (*AltIFormatFn)(OStream stream, int alt, int np); typedef struct format { const char *name; PFormatFn pfn; + AltPFormatFn apfn; IFormatFn ifn; + AltIFormatFn aifn; Bool nullOk; } *Format; extern void fmtRegister(const char *name, PFormatFn fn); +extern void fmtRegisterAlt(const char *name, AltPFormatFn fn); extern void fmtRegisterI(const char *name, IFormatFn fn); +extern void fmtRegisterIAlt(const char *name, AltIFormatFn fn); extern void fmtRegisterFull(const char *name, PFormatFn fn, Bool nullOk); extern Format fmtMatch(const char *fmtTxt); extern void fmtUnregister(Format format); diff --git a/aldor/aldor/src/formatters.c b/aldor/aldor/src/formatters.c index 2cf2b7687..0b147436f 100644 --- a/aldor/aldor/src/formatters.c +++ b/aldor/aldor/src/formatters.c @@ -1,25 +1,29 @@ - -#include "formatters.h" +#include "absub.h" #include "axlobs.h" -#include "syme.h" -#include "symeset.h" -#include "freevar.h" #include "bigint.h" +#include "errorset.h" +#include "format.h" +#include "formatters.h" +#include "freevar.h" #include "java/javacode.h" #include "ostream.h" -#include "format.h" #include "sefo.h" -#include "tposs.h" #include "strops.h" -#include "errorset.h" +#include "syme.h" +#include "symeset.h" #include "tconst.h" +#include "tfsat.h" +#include "tposs.h" #include "ttable.h" local int tfFormatter(OStream stream, Pointer p); +local int tfFormatterAlt(OStream stream, int lvl, Pointer p); local int tfListFormatter(OStream stream, Pointer p); local int tpossFormatter(OStream stream, Pointer p); local int fvFormatter(OStream stream, Pointer p); +local int absFormatter(OStream stream, Pointer p); +local int abbFormatter(OStream stream, Pointer p); local int tconstFormatter(OStream stream, Pointer p); @@ -49,14 +53,21 @@ local int errorSetFormatter(OStream stream, Pointer p); local int javaCodeFormatter(OStream stream, Pointer p); +local int boolFormatter(OStream ostream, int p); + void fmttsInit() { + fmtRegisterI("Bool", boolFormatter); + fmtRegister("TForm", tfFormatter); + fmtRegisterAlt("TForm", tfFormatterAlt); fmtRegister("TFormList", tfListFormatter); fmtRegister("FreeVar", fvFormatter); fmtRegister("TPoss", tpossFormatter); + fmtRegister("AbSub", absFormatter); + fmtRegister("AbBind", abbFormatter); fmtRegister("TConst", tconstFormatter); @@ -192,7 +203,17 @@ tfFormatter(OStream ostream, Pointer p) { int c; - c = tformOStreamWrite(ostream, p); + c = tformOStreamWrite(ostream, false, p); + + return c; +} + +local int +tfFormatterAlt(OStream ostream, int lvl, Pointer p) +{ + int c; + + c = tformOStreamWrite(ostream, true, p); return c; } @@ -219,6 +240,29 @@ tpossFormatter(OStream ostream, Pointer p) return c; } +local int +absFormatter(OStream ostream, Pointer p) +{ + AbSub tp = (AbSub) p; + int c; + + c = absOStreamWrite(ostream, tp); + + return c; +} + + +local int +abbFormatter(OStream ostream, Pointer p) +{ + AbBind tp = (AbBind) p; + int c; + + c = abbOStreamWrite(ostream, tp); + + return c; +} + local int errorSetFormatter(OStream ostream, Pointer p) { @@ -246,7 +290,7 @@ tconstFormatter(OStream ostream, Pointer p) TConst tc = (TConst) p; int i; - i = ostreamPrintf(ostream, "[TC: %pTForm %pTForm]", tc->argv[0], tc->argv[1]); + i = ostreamPrintf(ostream, "[TC: %d %pTForm %pTForm]", tc->serial, tc->argv[0], tc->argv[1]); return i; } @@ -306,3 +350,16 @@ stringListFormatter(OStream ostream, Pointer p) StringList list = (StringList) p; return listFormat(String)(ostream, "String", list); } + +local int +boolFormatter(OStream ostream, int p) +{ + Bool flg = p; + + if (flg < 0 || flg > 1) { + return ostreamPrintf(ostream, "Bool[%d]", flg); + } + else { + return ostreamPrintf(ostream, "%s", flg ? "true": "false"); + } +} diff --git a/aldor/aldor/src/genc.c b/aldor/aldor/src/genc.c index 29bea3af3..182bb7b41 100644 --- a/aldor/aldor/src/genc.c +++ b/aldor/aldor/src/genc.c @@ -6,7 +6,10 @@ * ****************************************************************************/ +#include "bigint.h" +#include "comsg.h" #include "compcfg.h" +#include "csig.h" #include "debug.h" #include "fluid.h" #include "fortran.h" @@ -16,11 +19,8 @@ #include "of_rrfmt.h" #include "optfoam.h" #include "store.h" -#include "util.h" #include "syme.h" -#include "comsg.h" -#include "bigint.h" - +#include "util.h" /* * The following naming conventions are used in this file: @@ -262,8 +262,11 @@ local Bool gc0NeedBothCasts(FoamTag, FoamTag); local CCode gc0TryCast (FoamTag, Foam); local CCode gc0Cast (FoamTag, Foam); local CCode gc0TypeId (AInt, AInt); +local String gc0CTypeId (AInt fmt); + local CCode gc0IdDecl (Foam, FoamTag, Foam, int, int); local CCode gc0IdCDecl (Foam, CCode); +local CCode gc0IdCRetDecl (Foam); local void gc0IdFortranDecl(Foam, CCode *, CCode *); local CCode gc0GloIdDecl (Foam, int); local CCode gc0FluidSet (Foam, Foam); @@ -638,6 +641,7 @@ gc0ExternDecls(String name) case FOAM_DDecl_FortranSig: /*FALLTHROUGH*/ case FOAM_DDecl_CSig: /*FALLTHROUGH*/ case FOAM_DDecl_JavaClass: /*FALLTHROUGH*/ + case FOAM_DDecl_CType: /*FALLTHROUGH*/ break; default: gc0LFmtDef(i); @@ -655,6 +659,7 @@ gc0ExternDecls(String name) /* Some formats must not have a typedef */ case FOAM_DDecl_FortranSig: /*FALLTHROUGH*/ case FOAM_DDecl_CSig: /*FALLTHROUGH*/ + case FOAM_DDecl_CType: /*FALLTHROUGH*/ case FOAM_DDecl_JavaClass: /*FALLTHROUGH*/ case FOAM_DDecl_JavaSig: /*FALLTHROUGH*/ break; @@ -808,7 +813,8 @@ gc0AddExtraModules() { Foam decl; CCode cco; - decl = foamNewGDecl(FOAM_Clos, "rtexns", + decl = foamNewGDecl(FOAM_Clos, strCopy("rtexns"), + FOAM_Nil, emptyFormatSlot, FOAM_GDecl_Import, FOAM_Proto_Init); @@ -5434,6 +5440,8 @@ gc0FunOCall0(Foam foam, int returnKind) return ccoFCall(gccProgId(foam->foamOCall.op), ccArgs); } +local CCode gc0PCallCArgument(Foam op, int idx, Foam farg); + local CCode gc0FunPCall0(Foam foam, int returnKind) { @@ -5459,6 +5467,13 @@ gc0FunPCall0(Foam foam, int returnKind) } return ccPCall; } + else if (foam->foamPCall.protocol == FOAM_Proto_C) { + for (i = 0; i < argc; i++) { + Foam farg = foam->foamPCall.argv[i]; + gc0AddLine(code, gc0PCallCArgument(foam->foamPCall.op, i, farg)); + } + code = listNReverse(CCode)(code); + } else { for (i = 0; i < argc; i++) { Foam farg = foam->foamPCall.argv[i]; @@ -5471,6 +5486,31 @@ gc0FunPCall0(Foam foam, int returnKind) return ccoFCall(gccPCallId(foam), ccArgs); } +local CCode +gc0PCallCArgument(Foam op, int idx, Foam farg) +{ + Foam gdecl = gcvGlo->foamDDecl.argv[op->foamGlo.index]; + Foam sig, arg; + AInt argTypeIdx; + + if (gdecl->foamGDecl.protocol != FOAM_Proto_C) { + return gccExpr(farg); + } + if (gdecl->foamGDecl.format == emptyFormatSlot) { + return gccExpr(farg); + } + sig = gcvFmt->foamDFmt.argv[gdecl->foamGDecl.format]; + argTypeIdx = sig->foamDDecl.argv[idx]->foamDecl.format; + arg = gcvFmt->foamDFmt.argv[argTypeIdx]; + if (arg->foamDDecl.usage == FOAM_DDecl_CType) { + String name = arg->foamDDecl.argv[0]->foamDecl.id; + return ccoCast(ccoIdOf(name), gccExpr(farg)); + } + else { + return gccExpr(farg); + } +} + /* This is a bit of a hack, since it assumes that the declaration * foo(FiWord, FiWord, etc); @@ -5824,7 +5864,7 @@ gc0GloIdDecl(Foam decl, int idx) ccType = gc0TypeId(t, fmt); else if (imported && (p == FOAM_Proto_C)) { ccName = gc0IdCDecl(decl, ccName); - ccType = gc0TypeId(decl->foamGDecl.rtype, emptyFormatSlot); + ccType = gc0IdCRetDecl(decl); } else { /* @@ -5877,29 +5917,43 @@ gc0GloIdDecl(Foam decl, int idx) } +local CCode +gc0IdCRetDecl(Foam decl) +{ + AInt fmt = decl->foamGDecl.format; + Foam fndecl = gcvFmt->foamDFmt.argv[fmt]; + int retc = csigRetc(fndecl); + + if (retc == 1) { + Foam ret = csigRetN(fndecl, 0); + return gc0TypeId(ret->foamDecl.type, ret->foamDecl.format); + } + else { + return ccoVoid(); + } +} + local CCode gc0IdCDecl(Foam decl, CCode ccName) { - AInt i, argc; + AInt i, argc, nargs, nrets; Foam fndecl; CCode ccArgs; AInt fmt = decl->foamGDecl.format; - /* Ignore things with no format */ if (fmt == emptyFormatSlot) return ccoFCall(ccoCopy(ccName), int0); /* Get the true declaration */ fndecl = gcvFmt->foamDFmt.argv[fmt]; - argc = foamArgc(fndecl) - 1; /* skip CSig */ - ccArgs = ccoNewNode(CCO_Many, argc); + nargs = csigArgc(fndecl); + ccArgs = ccoNewNode(CCO_Many, nargs); - - /* Process each argument (includes arguments for return values) */ - for (i = 0; i < argc; i++) + /* Process each argument */ + for (i = 0; i < nargs; i++) { - Foam arg = fndecl->foamDDecl.argv[i]; + Foam arg = csigArgN(fndecl, i); FoamTag type = arg->foamDecl.type; AInt fmt = arg->foamDecl.format; String str = arg->foamDecl.id; @@ -6175,6 +6229,9 @@ gc0TypeId(AInt t, AInt fmt) case FOAM_Arb: cc = ccoTypeIdOf(gcFiArb); break; + case FOAM_CObj: + cc = ccoTypedefId(gc0CTypeId(fmt)); + break; case FOAM_JavaObj: cc = ccoTypeIdOf(gcFiWord); break; @@ -6185,6 +6242,13 @@ gc0TypeId(AInt t, AInt fmt) return cc; } +local String +gc0CTypeId(AInt fmt) +{ + return strPrintf("QQ-%d", fmt); +} + + local CCode gc0SIntMod(Foam foam, CCodeTag ctag) { diff --git a/aldor/aldor/src/genfoam.c b/aldor/aldor/src/genfoam.c index d1fa15a64..5abd6362b 100644 --- a/aldor/aldor/src/genfoam.c +++ b/aldor/aldor/src/genfoam.c @@ -394,11 +394,13 @@ generateFoam(Stab stab0, AbSyn absyn, String initName) /* Declare the globals for the top-level prog. */ /* Once called, never again */ - decl = foamNewGDecl(FOAM_Clos, strCopy(gen0ProgName), emptyFormatSlot, + decl = foamNewGDecl(FOAM_Clos, strCopy(gen0ProgName), FOAM_Nil, + emptyFormatSlot, FOAM_GDecl_Export, FOAM_Proto_Init); gloInitIdx = gen0AddGlobal(decl); - decl = foamNewGDecl(FOAM_Clos, strCopy("noOperation"), emptyFormatSlot, + decl = foamNewGDecl(FOAM_Clos, strCopy("noOperation"), FOAM_Nil, + emptyFormatSlot, FOAM_GDecl_Import,FOAM_Proto_Foam); gloNOpIdx = gen0AddGlobal(decl); @@ -422,6 +424,7 @@ generateFoam(Stab stab0, AbSyn absyn, String initName) if (!genIsRuntime()) { decl = foamNewGDecl(FOAM_Clos, gen0InitialiserName("runtime"), + FOAM_Nil, emptyFormatSlot, FOAM_GDecl_Import, FOAM_Proto_Init); @@ -1011,10 +1014,10 @@ gen0ExportToBuiltin(AbSyn absyn) rtype = tfIsMap(tf) ? gen0Type(tfMapRet(tf), NULL) : FOAM_Nil; decl = foamNewGDecl(gen0Type(tf, NULL), strCopy(symeString(syme)), + rtype, emptyFormatSlot, FOAM_GDecl_Export, FOAM_Proto_Foam); - foamGDeclSetRType(decl, rtype); index = gen0AddGlobal(decl); @@ -1065,8 +1068,8 @@ gen0ExportToC(AbSyn absyn) /*!! Assumes export to C is exporting a function! */ decl = foamNewGDecl(FOAM_Clos, strCopy(symeString(syme)), - init, FOAM_GDecl_Export, FOAM_Proto_C); - foamGDeclSetRType(decl, rtype); + rtype, init, FOAM_GDecl_Export, + FOAM_Proto_C); index = gen0AddGlobal(decl); gen0BuiltinExports = listCons(AInt)(index, gen0BuiltinExports); @@ -1108,9 +1111,9 @@ genForeignImport(AbSyn absyn) return (Foam) NULL; /* Global declaration */ - decl = foamNewGDecl(FOAM_Word, strCopy(forg->file), emptyFormatSlot, + decl = foamNewGDecl(FOAM_Word, strCopy(forg->file), + FOAM_Nil, emptyFormatSlot, FOAM_GDecl_Import, FOAM_Proto_Include); - foamGDeclSetRType(decl, FOAM_Nil); gen0AddGlobal(decl); return (Foam)NULL; @@ -1454,6 +1457,9 @@ genImplicit(AbSyn absyn, AbSyn val, FoamTag type) return gen0ApplyReturn(absyn, syme, gen0AbType(absyn), foam); } +local FoamTag gen0CSigType(TForm tf, AInt *fmt); +local FoamTag gen0CSigTypeTypedef(Syme syme, AInt *fmt); + local Foam genApply(AbSyn absyn) { @@ -1779,8 +1785,6 @@ gen0ApplySyme(FoamTag type, Syme syme, SImpl impl, listIsSingleton(gen0State->envFormatStack)) foam = gen0OCall(mtype, syme, argc, &args); else - /* BDS -- syme->id->str gives the name of the function being - called. */ foam = gen0CCall(mtype, syme, argc, &args); if (type != mtype) @@ -1843,16 +1847,24 @@ local Foam gen0ApplyForeign(FoamTag type, Syme syme, Length argc, Foam **pargv) { Foam foam; + FoamTag objTag = type; + if (symeForeign(syme)->protocol == FOAM_Proto_C) { + AInt fmt; + objTag = gen0CSigType(tfMapRet(symeType(syme)), &fmt); + } /* printf("BDS: Inside gen0ApplyForeign\n"); */ foam = foamNewEmpty(FOAM_PCall, TypeSlot + OpSlot + ProtoSlot + argc); - foam->foamPCall.type = type; + foam->foamPCall.type = objTag; foam->foamPCall.op = gen0ForeignValue(syme); foam->foamPCall.protocol = symeForeign(syme)->protocol; *pargv = foam->foamPCall.argv; + if (objTag != type) { + foam = foamNewCast(type, foam); + } return foam; } @@ -1936,6 +1948,7 @@ gen0ApplyImplicitSyme(FoamTag type, Syme syme, Length argc, } /* Gross! */ tf = symeType(syme); + tfFollow(tf); assert(tfIsAnyMap(tf)); tfargc = tfMapArgc(tf); @@ -3057,8 +3070,8 @@ gen0TrailingNew(Syme syme, TForm key, Length argc, AbSyn *argv, Foam *vals) whole = gen0Temp0(FOAM_TR, format); sz = foamNewCast(FOAM_SInt, arg0); - hdr = gen0CrossToMulti(arg1, tfMapArgN(tf, 1)); - proto = gen0CrossToMulti(arg2, tfMapArgN(tf, 2)); + hdr = gen0CrossToMulti(arg1, tfDefineeMaybeType(tfMapArgN(tf, 1))); + proto = gen0CrossToMulti(arg2, tfDefineeMaybeType(tfMapArgN(tf, 2))); /* Idea is to generate: * tr := TRNew(fmt, sz) @@ -3313,11 +3326,9 @@ gen0CSigFormatNumber(TForm tf) /* Generate the format. */ retc = tfMapRetc(tf); - if (retc == 1) retc = 0; /* Only want retc for multi-valued imports */ - ddecl = foamNewEmpty(FOAM_DDecl, 1 + argc + retc); + ddecl = foamNewEmpty(FOAM_DDecl, 1 + argc + 1 + retc); ddecl->foamDDecl.usage = FOAM_DDecl_CSig; - /* Process the arguments */ for (i = 0; i < argc; i++) { AInt fmt; @@ -3328,30 +3339,59 @@ gen0CSigFormatNumber(TForm tf) /* Skip any declaration */ if (tfIsDeclare(tfi)) tfi = tfDeclareType(tfi); - /* Get the foam type */ - type = gen0Type(tfi, &fmt); - + type = gen0CSigType(tfi, &fmt); /* Create a suitable declaration */ - (void)sprintf(buffer, "P%d", (int) i); - str = strCopy(buffer); + str = aStrPrintf("P%d", (int) i); ddecl->foamDDecl.argv[i] = foamNewDecl(type, str, fmt); } /* Process any multiple return values */ + ddecl->foamDDecl.argv[argc + 0] = foamNewDecl(FOAM_Nil, strCopy(""), emptyFormatSlot); + for (i = 0; i < retc; i++) { + TForm tfi = tfMapRetN(tf, i); + AInt fmt; + FoamTag type; char *str; - FoamTag rtype = FOAM_Ptr; /* Always a pointer */ - AInt fmt = emptyFormatSlot; - (void)sprintf(buffer, "R%d", (int) i); - str = strCopy(buffer); - ddecl->foamDDecl.argv[argc + i] = foamNewDecl(rtype, str, fmt); + + if (tfIsDeclare(tfi)) tfi = tfDeclareType(tfi); + + type = gen0CSigType(tfi, &fmt); + str = aStrPrintf("R%d", (int) i); + ddecl->foamDDecl.argv[argc + 1 + i] = foamNewDecl(type, str, fmt); } return gen0AddRealFormat(ddecl); } +local FoamTag +gen0CSigType(TForm tf, AInt *fmt) +{ + if (!tfIsId(tf)) { + return gen0Type(tf, fmt); + } + Syme syme = tfIdSyme(tf); + if (syme == NULL) { + return gen0Type(tf, fmt); + } + if (symeIsForeign(syme) && + symeForeign(syme)->protocol == FOAM_Proto_C) { + return gen0CSigTypeTypedef(syme, fmt); + } + return gen0Type(tf, fmt); +} + +local FoamTag +gen0CSigTypeTypedef(Syme syme, AInt *fmt) +{ + Foam decl = foamNewDecl(FOAM_CObj, strCopy(symeString(syme)), emptyFormatSlot); + AInt typeDDeclId = gen0AddRealFormat(foamNewDDecl(FOAM_DDecl_CType, decl, NULL)); + *fmt = typeDDeclId; + return FOAM_CObj; +} + /* * Return the format number of a C arguments format. * @@ -3365,15 +3405,14 @@ gen0CPackedSigFormatNumber(TForm tf) { Foam ddecl; Length i, argc, retc; - char buffer[120]; assert (tfIsPackedMap(tf)); argc = tfMapArgc(tf); /* Generate the format. */ retc = tfMapRetc(tf); - if (retc == 1) retc = 0; /* Only want retc for multi-valued imports */ - ddecl = foamNewEmpty(FOAM_DDecl, 1 + argc + retc); + + ddecl = foamNewEmpty(FOAM_DDecl, 1 + argc + 1 + retc); ddecl->foamDDecl.usage = FOAM_DDecl_CSig; @@ -3395,19 +3434,18 @@ gen0CPackedSigFormatNumber(TForm tf) /* Create a suitable declaration */ - (void)sprintf(buffer, "P%d", (int) i); - str = strCopy(buffer); + str = aStrPrintf("P%d", (int) i); ddecl->foamDDecl.argv[i] = foamNewDecl(type, str, fmt); } + ddecl->foamDDecl.argv[argc + 0] = foamNewDecl(FOAM_Nil, strCopy(""), emptyFormatSlot); /* Process any multiple return values */ for (i = 0; i < retc; i++) { char *str; FoamTag rtype = FOAM_Ptr; /* Always a pointer */ AInt fmt = emptyFormatSlot; - (void)sprintf(buffer, "R%d", (int) i); - str = strCopy(buffer); - ddecl->foamDDecl.argv[argc + i] = foamNewDecl(rtype, str, fmt); + str = aStrPrintf("R%d", (int) i); + ddecl->foamDDecl.argv[argc + 1 + i] = foamNewDecl(rtype, str, fmt); } return gen0AddRealFormat(ddecl); @@ -5703,7 +5741,7 @@ gen0VarsLex(Syme syme, Stab stab) if (fintMode == FINT_LOOP && gen0State->tag == GF_File && stabLevelNo(stab) == 1) { - decl = foamNewGDecl(type, name, fmtSlot, + decl = foamNewGDecl(type, name, FOAM_Nil, fmtSlot, FOAM_GDecl_Export, FOAM_Proto_Foam); decl->foamDecl.id = gen0GlobalName(gen0FileName, syme); isGlobal = true; @@ -5818,7 +5856,7 @@ gen0VarsExport(Syme syme, Stab stab) fmtSlot = gen0RecordFormatNumber(symeType(syme)); if (gen0State->tag == GF_File && stabLevelNo(stab) == 1) { - decl = foamNewGDecl(type, NULL, fmtSlot, + decl = foamNewGDecl(type, NULL, FOAM_Nil, fmtSlot, FOAM_GDecl_Export, FOAM_Proto_Foam); decl->foamGDecl.id = gen0GlobalName(gen0FileName, syme); index = gen0AddGlobal(decl); @@ -5895,9 +5933,8 @@ gen0VarsForeign(Syme syme) else fmtSlot = emptyFormatSlot; - decl = foamNewGDecl(type, name, fmtSlot, + decl = foamNewGDecl(type, name, rtype, fmtSlot, FOAM_GDecl_Import, forg->protocol); - foamGDeclSetRType(decl, rtype); index = gen0AddGlobal(decl); @@ -6291,7 +6328,8 @@ gen0ForIter(AbSyn absyn, FoamList *forl, FoamList *itl) call = foamNewEmpty(FOAM_CCall, 2); call->foamCCall.type = FOAM_Word; call->foamCCall.op = foamCopy(valueFun); - call = gen0CrossToMulti(foamNewCast(FOAM_Rec, call), tfGeneratorArg(gen0AbContextType(absyn))); + call = gen0CrossToMulti(foamNewCast(FOAM_Rec, call), + tfDefineeMaybeType(tfGeneratorArg(gen0AbContextType(absyn)))); gen0MultiAssign(FOAM_Set, absyn->abFor.lhs, call); } else { @@ -7463,9 +7501,10 @@ gen0CrossToMulti(Foam val, TForm tf) { Foam values; Foam t; - int i, size = tfCrossArgc(tf); + int i, size; AInt cfmt, ftype; + size = tfCrossArgc(tf); ftype = gen0Type(tf, &cfmt); cfmt = gen0CrossFormatNumber(tf); t = gen0TempLocal0(FOAM_Rec, cfmt); @@ -7793,7 +7832,8 @@ gen0BuiltinImport(String fun, String lib) for(i=0, l = gen0GlobalList; l; i++, l = cdr(l)) if (strEqual(fun, car(l)->foamGDecl.id)) return (AInt) (gen0NumGlobals - i - 1); - decl = foamNewGDecl(FOAM_Clos, strCopy(fun), emptyFormatSlot, + decl = foamNewGDecl(FOAM_Clos, strCopy(fun), FOAM_Nil, + emptyFormatSlot, FOAM_GDecl_Import, FOAM_Proto_Foam); assert(gen0GetRuntimeCallInfo(decl)); return (AInt) gen0AddGlobal(decl); @@ -8167,6 +8207,8 @@ gen0CompareFormats(Foam dd1, Foam dd2) * foreign Fortran interface. */ if (t1 == FOAM_Clos + || usage == FOAM_DDecl_CSig + || usage == FOAM_DDecl_CType || usage == FOAM_DDecl_JavaClass || usage == FOAM_DDecl_JavaSig) { /* Can't merge if different signatures ... */ diff --git a/aldor/aldor/src/gf_add.c b/aldor/aldor/src/gf_add.c index 0e3bdebb6..70eb9f413 100644 --- a/aldor/aldor/src/gf_add.c +++ b/aldor/aldor/src/gf_add.c @@ -29,6 +29,7 @@ #include "comsg.h" #include "strops.h" #include "table.h" +#include "ti_top.h" local Foam gen0AddBody1 (AbSyn, Stab, AbSyn); local void gen0AddImportedDomain (TForm, Foam, AInt); @@ -2150,6 +2151,7 @@ gen0RtSefoHash(Sefo sf, Sefo osf) sf = gen0EqualMods(sf); osf = gen0EqualMods(osf); + tiTopFns()->tiSefo(stabFile(), sf); tf = gen0AbType(sf); if (tf && !tfSatDom(tf) && !tfSatCat(tf)) diff --git a/aldor/aldor/src/gf_fortran.c b/aldor/aldor/src/gf_fortran.c index 420510f12..55ec26956 100644 --- a/aldor/aldor/src/gf_fortran.c +++ b/aldor/aldor/src/gf_fortran.c @@ -1447,9 +1447,8 @@ gen0ExportToFortran(AbSyn absyn) fmtslot = gen0FortranSigExportNumber(tf); str = strCopy(symeString(syme)); wrapper = gen0FortranExportFn(tf, rtype, gen0Syme(syme), str, absyn); - decl = foamNewGDecl(FOAM_Clos, str, fmtslot, + decl = foamNewGDecl(FOAM_Clos, str, rtype, fmtslot, FOAM_GDecl_Export, FOAM_Proto_Fortran); - foamGDeclSetRType(decl, rtype); index = gen0AddGlobal(decl); glo = foamNewGlo(index); gen0AddStmt(foamNewSet(glo, wrapper), absyn); diff --git a/aldor/aldor/src/gf_imps.c b/aldor/aldor/src/gf_imps.c index 969f30b64..bcd1a13c0 100644 --- a/aldor/aldor/src/gf_imps.c +++ b/aldor/aldor/src/gf_imps.c @@ -811,6 +811,7 @@ gen0StdLazyRef(FoamSig sig) decl = foamNewGDecl(FOAM_Clos, gen0StdLazyName(sig->inArgs, sig->retType, sig->nRets), + FOAM_Nil, emptyFormatSlot, FOAM_GDecl_Import, FOAM_Proto_Foam); return foamNewGlo(gen0AddGlobal(decl)); @@ -887,6 +888,7 @@ gen0StdGetsCreate1(AIntList args, FoamTag retType, int nRets) foam = foamNewClos(foamNewEnv(int0), foamCopy(sig->ref)); name = gen0StdLazyName(args, retType, nRets); decl = foamNewGDecl(FOAM_Clos, name, emptyFormatSlot, + FOAM_Nil, FOAM_GDecl_Export, FOAM_Proto_Foam); idx = gen0AddGlobal(decl); gen0AddStmt(foamNewSet(foamNewGlo(idx), foam), NULL); @@ -1149,7 +1151,7 @@ gen0GVectIssueFn(String libName, AIntList globs) /* Make a call to the initialiser */ decl = foamNewGDecl(FOAM_Clos, gen0InitialiserName(libName), - emptyFormatSlot, + FOAM_Nil, emptyFormatSlot, FOAM_GDecl_Import, FOAM_Proto_Init); ini = foamNewEmpty(FOAM_CCall, 2); ini->foamCCall.type = FOAM_NOp; @@ -1196,6 +1198,7 @@ gen0GlobalRef(Lib lib, Syme syme) decl = foamNewGDecl(gen0Type(symeType(syme), NULL), gen0GlobalName(libGetFileId(lib), syme), + FOAM_Nil, emptyFormatSlot, FOAM_GDecl_Import, FOAM_Proto_Foam); globNo = gen0AddGlobal(decl); diff --git a/aldor/aldor/src/gf_java.c b/aldor/aldor/src/gf_java.c index f2eb27f84..8ce90df21 100644 --- a/aldor/aldor/src/gf_java.c +++ b/aldor/aldor/src/gf_java.c @@ -142,7 +142,7 @@ gfjImportApplyInner(Syme syme, AInt fmtNum) globName = gfjDeclMethodNameForType(exporter, symeJavaApplyName(syme)); - gdecl = foamNewGDecl(FOAM_Clos, globName, + gdecl = foamNewGDecl(FOAM_Clos, globName, FOAM_Nil, gfjPCallDeclImport(innerTf, tfMapArgN(symeType(syme), 0)), FOAM_GDecl_Import, FOAM_Proto_JavaMethod); gnum = gen0AddGlobal(gdecl); @@ -200,7 +200,8 @@ gfjImportConstructor(Syme syme) constNum = gen0NumProgs; - gdecl = foamNewGDecl(FOAM_Clos, globName, gfjPCallDeclImport(symeType(syme), NULL), + gdecl = foamNewGDecl(FOAM_Clos, globName, FOAM_Nil, + gfjPCallDeclImport(symeType(syme), NULL), FOAM_GDecl_Import, FOAM_Proto_JavaConstructor); gnum = gen0AddGlobal(gdecl); @@ -246,7 +247,9 @@ gfjImportStaticCall(Syme syme) constNum = gen0NumProgs; - gdecl = foamNewGDecl(FOAM_Clos, globName, gfjPCallDeclImport(symeType(syme), NULL), + gdecl = foamNewGDecl(FOAM_Clos, globName, + FOAM_Nil, + gfjPCallDeclImport(symeType(syme), NULL), FOAM_GDecl_Import, FOAM_Proto_Java); gnum = gen0AddGlobal(gdecl); @@ -737,11 +740,9 @@ gfjExportToJavaSyme(TForm exporter, Syme syme, Foam clos) String foamName = gfjDeclMethodName(symeString(tfIdSyme(exporter)), forg, methodName); strFree(methodName); - decl = foamNewGDecl(FOAM_Clos, foamName, + decl = foamNewGDecl(FOAM_Clos, foamName, rtype, declFmt, FOAM_GDecl_Export, protocol); - foamGDeclSetRType(decl, rtype); - index = gen0AddGlobal(decl); gen0BuiltinExports = listCons(AInt)(index, gen0BuiltinExports); gen0BuiltinExports = listCons(AInt)(int0, gen0BuiltinExports); @@ -963,13 +964,13 @@ gfjExportDecoder(TForm tf) // This will be .rep() String globName = gfjDeclMethodName(symeString(tfIdSyme(tf)), stabForeignExportLocation(gen0State->stab, tf), - "rep");; + "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, + gdecl = foamNewGDecl(FOAM_Clos, globName, FOAM_Nil, sigIdx, FOAM_GDecl_Import, FOAM_Proto_JavaMethod); AInt idx = gen0AddGlobal(gdecl); @@ -998,7 +999,7 @@ gfjExportEncoder(TForm tf) listSingleton(Foam)(foamNewDecl(FOAM_Word, strCopy(""), emptyFormatSlot))); AInt sigIdx = gen0AddRealFormat(ddecl); - gdecl = foamNewGDecl(FOAM_Clos, globName, sigIdx, + gdecl = foamNewGDecl(FOAM_Clos, globName, FOAM_Nil, sigIdx, FOAM_GDecl_Import, FOAM_Proto_JavaMethod); AInt idx = gen0AddGlobal(gdecl); diff --git a/aldor/aldor/src/java/genjava.c b/aldor/aldor/src/java/genjava.c index 39eaf6eb1..6ea2579d6 100644 --- a/aldor/aldor/src/java/genjava.c +++ b/aldor/aldor/src/java/genjava.c @@ -314,7 +314,7 @@ genJavaUnit(Foam foam, String name) body = listNConcat(JavaCode)(body, stubs); interfaces = listSingleton(JavaCode)(gj0Id(GJ_FoamClass)); - clss = jcClass(JCO_MOD_Public, comment, + clss = jcClass(JCO_MOD_Public, comment, listNil(JavaCode), jcId(gj0ClassName(foam, name)), NULL, interfaces, body); imps = gj0CollectImports(clss); @@ -490,6 +490,7 @@ gj0ExportClassCreate(JavaCode classId, AIntList ids) clss = jcClass(JCO_MOD_Public|JCO_MOD_Final, strCopy(".. ++ docco goes here"), + listNil(JavaCode), jcoCopy(className), gj0Id(GJ_AldorObject), listNil(JavaCode), body); @@ -3802,7 +3803,37 @@ gj0CastObjToWord(JavaCode val, FoamTag type, AInt fmt) local JavaCode gj0CastObjToPtr(JavaCode val, FoamTag type, AInt fmt) { - return val; + switch (type) { + // self + case FOAM_Ptr: + return val; + // allocated once (I think) + case FOAM_Arr: + case FOAM_Rec: + case FOAM_JavaObj: + case FOAM_Clos: + return val; + // wrapped by runtime + case FOAM_Word: + return jcApplyMethod(jcMemRef(gj0Id(GJ_FoamWord), + jcId(strCopy("U"))), + jcId(strCopy("toPtr")), + listSingleton(JavaCode)(val)); + // throw an error + case FOAM_DFlo: + case FOAM_SFlo: + case FOAM_Byte: + case FOAM_Char: + case FOAM_SInt: + case FOAM_Bool: + case FOAM_HInt: + case FOAM_BInt: + return val; + case FOAM_Nil: + return val; + default: + return val; + } } /* diff --git a/aldor/aldor/src/java/javacode.c b/aldor/aldor/src/java/javacode.c index c8978232f..1f1368d8c 100644 --- a/aldor/aldor/src/java/javacode.c +++ b/aldor/aldor/src/java/javacode.c @@ -6,34 +6,35 @@ enum jc_clss_enum { JCO_CLSS_START, JCO_CLSS_String = JCO_CLSS_START, - JCO_CLSS_Character, - JCO_CLSS_Integer, - JCO_CLSS_Float, - JCO_CLSS_Double, - JCO_CLSS_Keyword, - JCO_CLSS_Id, - JCO_CLSS_CommaSeq, - JCO_CLSS_SpaceSeq, - JCO_CLSS_NLSeq, - JCO_CLSS_Seq, - JCO_CLSS_Parens, - JCO_CLSS_Braces, + JCO_CLSS_Character, + JCO_CLSS_Integer, + JCO_CLSS_Float, + JCO_CLSS_Double, + JCO_CLSS_Keyword, + JCO_CLSS_Id, + JCO_CLSS_CommaSeq, + JCO_CLSS_SpaceSeq, + JCO_CLSS_NLSeq, + JCO_CLSS_Seq, + JCO_CLSS_Parens, + JCO_CLSS_Braces, JCO_CLSS_SqBrackets, - JCO_CLSS_ABrackets, - JCO_CLSS_ImportedId, - JCO_CLSS_ImportedStatic, - JCO_CLSS_Class, - JCO_CLSS_JavaDoc, - JCO_CLSS_Comment, - JCO_CLSS_Method, - JCO_CLSS_Declaration, - JCO_CLSS_Statement, + JCO_CLSS_ABrackets, + JCO_CLSS_ImportedId, + JCO_CLSS_ImportedStatic, + JCO_CLSS_Annotation, + JCO_CLSS_Class, + JCO_CLSS_JavaDoc, + JCO_CLSS_Comment, + JCO_CLSS_Method, + JCO_CLSS_Declaration, + JCO_CLSS_Statement, JCO_CLSS_File, - - JCO_CLSS_If, - JCO_CLSS_While, - JCO_CLSS_Switch, - JCO_CLSS_Case, + + JCO_CLSS_If, + JCO_CLSS_While, + JCO_CLSS_Switch, + JCO_CLSS_Case, JCO_CLSS_Block, JCO_CLSS_Try, JCO_CLSS_Catch, @@ -48,10 +49,10 @@ enum jc_clss_enum { JCO_CLSS_Not, JCO_CLSS_LogAnd, - JCO_CLSS_LogOr, + JCO_CLSS_LogOr, JCO_CLSS_And, - JCO_CLSS_Or, - JCO_CLSS_XOr, + JCO_CLSS_Or, + JCO_CLSS_XOr, JCO_CLSS_Equals, JCO_CLSS_NEquals, JCO_CLSS_Assign, @@ -192,15 +193,16 @@ struct javaKeyword jkKeywords[] = { }; typedef Enum(jc_clss_enum) JcClassId; - + +local JWriteFn jcAnnotationPrint; local JWriteFn jcApplyPrint; local JWriteFn jcARefPrint; -local JWriteFn jcBinOpPrint; -local JWriteFn jcBlockHdrPrint; +local JWriteFn jcBinOpPrint; +local JWriteFn jcBlockHdrPrint; local JWriteFn jcBlockKeywordPrint; local JWriteFn jcBlockPrint; -local JWriteFn jcCasePrint; -local JWriteFn jcCastPrint; +local JWriteFn jcCasePrint; +local JWriteFn jcCastPrint; local JWriteFn jcClassPrint; local JWriteFn jcCommentPrint; local JWriteFn jcCondPrint; @@ -217,7 +219,7 @@ local JWriteFn jcSequencePrint; local JWriteFn jcStatementPrint; local JWriteFn jcFilePrint; local JWriteFn jcStringPrint; -local JWriteFn jcUnaryOpPrint; +local JWriteFn jcUnaryOpPrint; local JSExprFn jcCommentSExpr; local JSExprFn jcIdSExpr; @@ -246,7 +248,7 @@ Operator Description Associativity 10. << >> Bitwise shift left, Bitwise shift right left-to-right 9. < <= Relational less than/less than or equal to left-to-right > >= Relational greater than/greater than or equal to - instanceof Type comparison + instanceof Type comparison 8 == != Relational is equal to/is not equal to left-to-right 7 & Bitwise AND left-to-right 6 ^ Bitwise exclusive OR left-to-right @@ -255,11 +257,11 @@ Operator Description Associativity 3. || Logical OR left-to-right 2. ?: Ternary conditional right-to-left 1. = Assignment right-to-left - += -= Addition/subtraction assignment - *= /= Multiplication/division assignment - %= &= Modulus/bitwise AND assignment + += -= Addition/subtraction assignment + *= /= Multiplication/division assignment + %= &= Modulus/bitwise AND assignment ^= |= Bitwise exclusive/inclusive OR assignment - <<= >>= Bitwise shift left/right assignment + <<= >>= Bitwise shift left/right assignment */ static struct jclss jcClss[] = { @@ -282,6 +284,7 @@ static struct jclss jcClss[] = { { JCO_CLSS_ImportedId, jcImportPrint, jcImportSExpr,"importid", 0}, { JCO_CLSS_ImportedStatic, jcImportPrint, jcImportSExpr, "static-importid", 0}, + { JCO_CLSS_Annotation, jcAnnotationPrint, jcNodeSExpr, "annotation", 0}, { JCO_CLSS_Class, jcClassPrint, jcNodeSExpr, "class", 0}, { JCO_CLSS_JavaDoc, jcJavaDocPrint, jcCommentSExpr, "javadoc", 0}, { JCO_CLSS_Comment, jcCommentPrint, jcCommentSExpr, "comment", 0}, @@ -345,34 +348,39 @@ jcInit() local JavaCodeClass jc0ClassObj(JcClassId); -JavaCode -jcClass(int modifiers, String comment, - JavaCode id, JavaCode superclass, - JavaCodeList extendList, JavaCodeList body) +JavaCode +jcClass(int modifiers, String comment, + JavaCodeList annotations, + JavaCode id, JavaCode superclass, + JavaCodeList extendList, JavaCodeList body) { JavaCodeList jcmods = jc0CreateModifiers(modifiers); - + JavaCode clss = jcoNew(jc0ClassObj(JCO_CLSS_Class), - 5, + 6, + jcNLSeq(annotations), jcSpaceSeq(jcmods), - id, superclass, + id, superclass, extendList == listNil(JavaCode) ? NULL : jcCommaSeq(extendList), jcNLSeq(body)); - if (comment == NULL) + if (comment == NULL) return clss; return jcDocumented(comment, clss); } -void +void jcClassPrint(JavaCodePContext ctxt, JavaCode clss) { - JavaCode modifiers = jcoArgv(clss)[0]; - JavaCode id = jcoArgv(clss)[1]; - JavaCode superclass = jcoArgv(clss)[2]; - JavaCode implList = jcoArgv(clss)[3]; - JavaCode body = jcoArgv(clss)[4]; + JavaCode annotations = jcoArgv(clss)[0]; + JavaCode modifiers = jcoArgv(clss)[1]; + JavaCode id = jcoArgv(clss)[2]; + JavaCode superclass = jcoArgv(clss)[3]; + JavaCode implList = jcoArgv(clss)[4]; + JavaCode body = jcoArgv(clss)[5]; + jcoWrite(ctxt, annotations); + jcoPContextWrite(ctxt, "\n"); if (modifiers != NULL && jcoArgc(modifiers) > 0) { jcoWrite(ctxt, modifiers); jcoPContextWrite(ctxt, " "); @@ -397,8 +405,8 @@ jcClassPrint(JavaCodePContext ctxt, JavaCode clss) /* * :: Methods (actually, could be 'member' instead) */ -JavaCode -jcMethod(int modifiers, String comment, +JavaCode +jcMethod(int modifiers, String comment, JavaCode retnType, JavaCode id, JavaCodeList genArgs, JavaCodeList args, @@ -406,34 +414,34 @@ jcMethod(int modifiers, String comment, { JavaCode meth = jcoNew(jc0ClassObj(JCO_CLSS_Method), 2, - jcDeclaration(modifiers, retnType, - id, listNil(JavaCode), + jcDeclaration(modifiers, retnType, + id, listNil(JavaCode), jcParens(jcCommaSeq(args)), exns), body); return meth; } -JavaCode -jcConstructor(int modifiers, String comment, +JavaCode +jcConstructor(int modifiers, String comment, JavaCode id, JavaCodeList genArgs, JavaCodeList args, JavaCodeList exns, JavaCode body) { JavaCode meth = jcoNew(jc0ClassObj(JCO_CLSS_Method), 2, - jcDeclaration(modifiers, jcSpaceSeqV(0), - id, listNil(JavaCode), + jcDeclaration(modifiers, jcSpaceSeqV(0), + id, listNil(JavaCode), jcParens(jcCommaSeq(args)), exns), body); return meth; } -local void +local void jcMethodPrint(JavaCodePContext ctxt, JavaCode code) { JavaCode decl = jcoArgv(code)[0]; JavaCode body = jcoArgv(code)[1]; - + jcoWrite(ctxt, decl); jcoPContextWrite(ctxt, " {"); jcoPContextNewlineIndent(ctxt); @@ -448,8 +456,8 @@ jcMethodPrint(JavaCodePContext ctxt, JavaCode code) * :: Declarations */ -JavaCode -jcDeclaration(int modifiers, +JavaCode +jcDeclaration(int modifiers, JavaCode retnType, JavaCode id, JavaCodeList genArgs, JavaCode args, @@ -494,13 +502,13 @@ jcInitialisation(int modifiers, JavaCode type, JavaCode id, JavaCode value) } -local void +local void jcDeclarationPrint(JavaCodePContext ctxt, JavaCode code) { JavaCode mods = jcoArgv(code)[0]; JavaCode retn = jcoArgv(code)[1]; JavaCode name = jcoArgv(code)[2]; - + if (!jcoIsEmpty(mods)) { jcoWrite(ctxt, mods); jcoPContextWrite(ctxt, " "); @@ -523,17 +531,37 @@ jcDeclarationPrint(JavaCodePContext ctxt, JavaCode code) } +/* + * :: Annotations + */ + +JavaCode +jcAnnotation(JavaCode annotationClass, JavaCodeList arguments) +{ + return jcoNew(jc0ClassObj(JCO_CLSS_Annotation), + 2, annotationClass, + jcParens(jcCommaSeq(arguments))); +} + +local void +jcAnnotationPrint(JavaCodePContext ctxt, JavaCode code) +{ + jcoPContextWrite(ctxt, "@"); + jcoWrite(ctxt, jcoArgv(code)[0]); + jcoWrite(ctxt, jcoArgv(code)[1]); +} + /* * :: Function application */ -JavaCode +JavaCode jcApply(JavaCode c, JavaCodeList args) { return jcoNew(jc0ClassObj(JCO_CLSS_Apply), 2, c, jcParens(jcCommaSeq(args))); } -JavaCode +JavaCode jcApplyV(JavaCode c, int n, ...) { va_list argp; @@ -547,17 +575,17 @@ jcApplyV(JavaCode c, int n, ...) JavaCode jcApplyP(JavaCode c, int n, va_list argp) { - return jcoNew(jc0ClassObj(JCO_CLSS_Apply), + return jcoNew(jc0ClassObj(JCO_CLSS_Apply), 2, c, jcParens(jcCommaSeqP(n, argp))); } -JavaCode +JavaCode jcApplyMethod(JavaCode c, JavaCode id, JavaCodeList args) { return jcApply(jcMemRef(c, id), args); } -JavaCode +JavaCode jcApplyMethodV(JavaCode c, JavaCode id, int n, ...) { va_list argp; @@ -599,34 +627,34 @@ jcGenericMethodNameV(JavaCode methodName, int n, ...) * :: Parens */ JavaCode -jcParens(JavaCode args) +jcParens(JavaCode args) { JavaCode jco = jcoNew(jc0ClassObj(JCO_CLSS_Parens), 1, args); return jco; } JavaCode -jcBraces(JavaCode args) +jcBraces(JavaCode args) { JavaCode jco = jcoNew(jc0ClassObj(JCO_CLSS_Braces), 1, args); return jco; } JavaCode -jcSqBrackets(JavaCode args) +jcSqBrackets(JavaCode args) { JavaCode jco = jcoNew(jc0ClassObj(JCO_CLSS_SqBrackets), 1, args); return jco; } JavaCode -jcABrackets(JavaCode args) +jcABrackets(JavaCode args) { JavaCode jco = jcoNew(jc0ClassObj(JCO_CLSS_ABrackets), 1, args); return jco; } -local void +local void jcParenPrint(JavaCodePContext ctxt, JavaCode code) { char s[2] = " "; @@ -643,14 +671,14 @@ jcParenPrint(JavaCodePContext ctxt, JavaCode code) * :: Comments */ JavaCode -jcDocumented(String comment, JavaCode code) +jcDocumented(String comment, JavaCode code) { JavaCode doc = jcoNewLiteral(jc0ClassObj(JCO_CLSS_JavaDoc), comment); return jcNLSeqV(2, doc, code); } JavaCode -jcComment(String comment) +jcComment(String comment) { JavaCode jc = jcoNewLiteral(jc0ClassObj(JCO_CLSS_Comment), comment); return jc; @@ -677,7 +705,7 @@ jcCommentPrint(JavaCodePContext ctxt, JavaCode code) strFree(s); } -local SExpr +local SExpr jcCommentSExpr(JavaCode code) { SExpr h = sxiFrSymbol(symIntern(jcoClass(code)->name)); @@ -766,7 +794,7 @@ jcImportedStaticIdName(JavaCode importedId) return jcImportedIdName(importedId); } -local void +local void jcImportPrint(JavaCodePContext ctxt, JavaCode code) { if (jcoImportIsImported(code)) @@ -780,14 +808,14 @@ jcImportPrint(JavaCodePContext ctxt, JavaCode code) } } -local SExpr +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, + return sxiList(3, sym, sxiFrString(jcoImportPkg(code)), sxiFrString(jcoImportId(code))); } @@ -798,10 +826,10 @@ jcImportSExpr(JavaCode code) */ -JavaCode +JavaCode jcLiteralString(String s) { - return jcoNewLiteral(jc0ClassObj(JCO_CLSS_String), + return jcoNewLiteral(jc0ClassObj(JCO_CLSS_String), jc0EscapeString(s, false)); } @@ -812,11 +840,11 @@ jcLiteralStringWithTerminalChar(String s) jc0EscapeString(s, true)); } -JavaCode +JavaCode jcLiteralChar(String s) { String t; - if (s[0] == '\0') + if (s[0] == '\0') t = strCopy("\\0"); else if (s[0] == '\'') t = strCopy("\\'"); @@ -826,6 +854,8 @@ jcLiteralChar(String s) t = strCopy("\\n"); else if (s[0] == '\t') t = strCopy("\\t"); + else if (s[0] == '\\') + t = strCopy("\\\\"); else if (s[0] == -1) t = strCopy("\\1"); else @@ -843,7 +873,7 @@ jcStringPrint(JavaCodePContext ctxt, JavaCode code) jcoPContextWrite(ctxt, thisClss->txt); } -local SExpr +local SExpr jcStringSExpr(JavaCode code) { String s = jcoLiteral(code); @@ -859,20 +889,20 @@ jcStringSExpr(JavaCode code) */ -JavaCode +JavaCode jcLiteralInteger(AInt i) { String s = strPrintf("%d", i); return jcoNewLiteral(jc0ClassObj(JCO_CLSS_Integer), s); } -JavaCode +JavaCode jcLiteralIntegerFrString(String s) { return jcoNewLiteral(jc0ClassObj(JCO_CLSS_Integer), s); } -JavaCode +JavaCode jcLiteralFloatFrString(String s) { return jcoNewLiteral(jc0ClassObj(JCO_CLSS_Float), s); @@ -884,7 +914,7 @@ jcIntegerPrint(JavaCodePContext ctxt, JavaCode code) jcoPContextWrite(ctxt, jcoLiteral(code)); } -local SExpr +local SExpr jcIntegerSExpr(JavaCode code) { int i = atoi(jcoLiteral(code)); @@ -896,48 +926,48 @@ jcIntegerSExpr(JavaCode code) */ -JavaCode -jcKeyword(Symbol sym) +JavaCode +jcKeyword(Symbol sym) { return jcoNewToken(jc0ClassObj(JCO_CLSS_Keyword), sym); } -JavaCode -jcReturn(JavaCode c) +JavaCode +jcReturn(JavaCode c) { return jcSpaceSeqV(2, jcKeyword(symInternConst("return")), c); } -JavaCode -jcReturnVoid() +JavaCode +jcReturnVoid() { return jcKeyword(symInternConst("return")); } -JavaCode -jcNull(String name) +JavaCode +jcNull(String name) { return jcKeyword(symIntern("null")); } -JavaCode -jcTrue(String name) +JavaCode +jcTrue(String name) { return jcKeyword(symIntern("true")); } -JavaCode -jcFalse(String name) +JavaCode +jcFalse(String name) { return jcKeyword(symIntern("false")); } -JavaCode -jcThis(String name) +JavaCode +jcThis(String name) { return jcKeyword(symIntern("this")); } -local SExpr +local SExpr jcKeywordSExpr(JavaCode code) { return sxiFrSymbol(jcoToken(code)); @@ -953,8 +983,8 @@ jcKeywordPrint(JavaCodePContext ctxt, JavaCode code) * :: Ids */ -JavaCode -jcId(String name) +JavaCode +jcId(String name) { return jcoNewLiteral(jc0ClassObj(JCO_CLSS_Id), name); } @@ -965,14 +995,14 @@ jcIdName(JavaCode id) return jcoLiteral(id); } -local SExpr +local SExpr jcIdSExpr(JavaCode code) { return sxiFrString(jcoLiteral(code)); } -void -jcIdPrint(JavaCodePContext ctxt, JavaCode code) +void +jcIdPrint(JavaCodePContext ctxt, JavaCode code) { String name = jcoLiteral(code); jcoPContextWrite(ctxt, name); @@ -1049,7 +1079,7 @@ jcArrayOf(JavaCode type) JavaCode jcNAry(JavaCode type) { - return jcSpaceSeqV(2, type, + return jcSpaceSeqV(2, type, jcKeyword(symInternConst("..."))); } @@ -1142,7 +1172,7 @@ struct jcOpInfo JcOpInfoTable[] = { { JCO_OP_ShiftDn, 0, JCO_CLSS_ShiftDn}, }; -JavaCode +JavaCode jcOp(JcOperation op, JavaCodeList args) { JcOpInfo inf = jc0OpInfo(op); @@ -1164,13 +1194,13 @@ jcBinOp(JcOperation op, JavaCode e1, JavaCode e2) } -local JavaCode +local JavaCode jcOpNot(JavaCodeList l) { return jcNot(car(l)); } -local JavaCode +local JavaCode jcOpNegate(JavaCodeList l) { return jcNegate(car(l)); @@ -1183,13 +1213,13 @@ jcOpTimesPlus(JavaCodeList args) JavaCode a2 = car(cdr(args)); JavaCode a3 = car(cdr(cdr(args))); - return jcBinaryOp(jc0ClassObj(JCO_CLSS_Plus), + return jcBinaryOp(jc0ClassObj(JCO_CLSS_Plus), jcBinaryOp(jc0ClassObj(JCO_CLSS_Times), a1, a2), a3); } -local JcOpInfo +local JcOpInfo jc0OpInfo(JcOperation op) { JcOpInfo inf = &JcOpInfoTable[op]; @@ -1202,7 +1232,7 @@ jc0OpInfo(JcOperation op) * :: Binary operations */ -JavaCode +JavaCode jcBinaryOp(JavaCodeClass c, JavaCode lhs, JavaCode rhs) { JavaCode r = jcoNew(c, 2, lhs, rhs); @@ -1210,7 +1240,7 @@ jcBinaryOp(JavaCodeClass c, JavaCode lhs, JavaCode rhs) } local void -jcBinOpPrint(JavaCodePContext ctxt, JavaCode code) +jcBinOpPrint(JavaCodePContext ctxt, JavaCode code) { JavaCodeClass thisClss = jcoClass(code); JavaCode lhs = jcoArgv(code)[0]; @@ -1236,7 +1266,7 @@ jc0PrintWithParens(JavaCodePContext ctxt, JavaCodeClass oClss, JavaCode arg) } local Bool -jc0NeedsParens(JavaCodeClass c1, JavaCodeClass c2) +jc0NeedsParens(JavaCodeClass c1, JavaCodeClass c2) { if (c2->prec == 0) return false; @@ -1247,13 +1277,13 @@ jc0NeedsParens(JavaCodeClass c1, JavaCodeClass c2) * :: Unary operations */ -JavaCode +JavaCode jcNot(JavaCode arg) { return jcoNew(jc0ClassObj(JCO_CLSS_Not), 1, arg); } -JavaCode +JavaCode jcNegate(JavaCode arg) { return jcoNew(jc0ClassObj(JCO_CLSS_Negate), 1, arg); @@ -1295,7 +1325,7 @@ jcCastPrint(JavaCodePContext ctxt, JavaCode code) * Well, there's only ?:. */ -JavaCode +JavaCode jcConditional(JavaCode test, JavaCode truePart, JavaCode falsePart) { return jcoNew(jc0ClassObj(JCO_CLSS_Conditional), 3, test, truePart, falsePart); @@ -1321,7 +1351,7 @@ jcCondPrint(JavaCodePContext ctxt, JavaCode code) * :: Statements */ JavaCode -jcStatement(JavaCode stmt) +jcStatement(JavaCode stmt) { return jcoNew(jc0ClassObj(JCO_CLSS_Statement), 1, stmt); } @@ -1338,13 +1368,13 @@ jcStatementPrint(JavaCodePContext ctxt, JavaCode code) */ JavaCode -jcCommaSeq(JavaCodeList lst) +jcCommaSeq(JavaCodeList lst) { return jcoNewFrList(jc0ClassObj(JCO_CLSS_CommaSeq), lst); } JavaCode -jcCommaSeqP(int n, va_list argp) +jcCommaSeqP(int n, va_list argp) { return jcoNewP(jc0ClassObj(JCO_CLSS_CommaSeq), n, argp); } @@ -1367,19 +1397,19 @@ jcSeqV(int n, ...) } JavaCode -jcNLSeq(JavaCodeList lst) +jcNLSeq(JavaCodeList lst) { return jcoNewFrList(jc0ClassObj(JCO_CLSS_NLSeq), lst); } JavaCode -jcSpaceSeq(JavaCodeList lst) +jcSpaceSeq(JavaCodeList lst) { return jcoNewFrList(jc0ClassObj(JCO_CLSS_SpaceSeq), lst); } JavaCode -jcSpaceSeqV(int n, ...) +jcSpaceSeqV(int n, ...) { va_list argp; JavaCode jc; @@ -1390,7 +1420,7 @@ jcSpaceSeqV(int n, ...) } JavaCode -jcNLSeqV(int n, ...) +jcNLSeqV(int n, ...) { va_list argp; JavaCode jc; @@ -1400,7 +1430,7 @@ jcNLSeqV(int n, ...) return jc; } -local void +local void jcSequencePrint(JavaCodePContext ctxt, JavaCode code) { char *theSep = jcoClass(code)->txt; @@ -1414,19 +1444,19 @@ jcSequencePrint(JavaCodePContext ctxt, JavaCode code) } } -JavaCode +JavaCode jcBlockNoNL(JavaCode body) { return jcoNew(jc0ClassObj(JCO_CLSS_Braces), 1, body); } -JavaCode +JavaCode jcBlock(JavaCode body) { return jcoNew(jc0ClassObj(JCO_CLSS_Block), 1, body); } -local void +local void jcBlockPrint(JavaCodePContext ctxt, JavaCode code) { jcoPContextWrite(ctxt, "{"); @@ -1434,7 +1464,7 @@ jcBlockPrint(JavaCodePContext ctxt, JavaCode code) jcoWrite(ctxt, jcoArgv(code)[0]); jcoPContextNewlineUnindent(ctxt); jcoPContextWrite(ctxt, "}"); - + } JavaCode @@ -1461,7 +1491,7 @@ jcCaseLabel(JavaCode label) return jcoNew(jc0ClassObj(JCO_CLSS_Case), 1, label); } -local void +local void jcCasePrint(JavaCodePContext ctxt, JavaCode code) { jcoPContextWrite(ctxt, "case "); @@ -1515,7 +1545,7 @@ jcPackage(JavaCode arg) * :: Throw, catch */ -JavaCode +JavaCode jcThrow(JavaCode arg) { return jcSpaceSeqV(2, jcKeyword(symInternConst("throw")), arg); @@ -1525,20 +1555,20 @@ jcThrow(JavaCode arg) * :: If, Switch, While */ -JavaCode +JavaCode jcIf(JavaCode test, JavaCode stmt) { return jcoNew(jc0ClassObj(JCO_CLSS_If), 2, test, stmt); } -JavaCode +JavaCode jcSwitch(JavaCode test, JavaCodeList bodyList) { JavaCode block = jcBraces(jcNLSeq(bodyList)); return jcoNew(jc0ClassObj(JCO_CLSS_Switch), 2, test, block); } -JavaCode +JavaCode jcWhile(JavaCode test, JavaCode stmt) { return jcoNew(jc0ClassObj(JCO_CLSS_While), 2, test, stmt); @@ -1553,7 +1583,7 @@ jcBlockHdrPrint(JavaCodePContext ctxt, JavaCode code) jcoPContextWrite(ctxt, " ("); jcoWrite(ctxt, jcoArgv(code)[0]); jcoPContextWrite(ctxt, ") "); - + needsIndent = jcBlockHdrIndent(jcoArgv(code)[1]); if (needsIndent) jcoPContextNewlineIndent(ctxt); @@ -1638,8 +1668,8 @@ jcFilePackageName(JavaCode file) /* * :: Generic operations */ -SExpr -jcNodeSExpr(JavaCode code) +SExpr +jcNodeSExpr(JavaCode code) { Symbol sym = symIntern(jcoClass(code)->name); SExpr whole = sxiList(1, sxiFrSymbol(sym)); @@ -1653,15 +1683,15 @@ jcNodeSExpr(JavaCode code) return sxNReverse(whole); } -extern void +extern void jcNodePrint(JavaCodePContext ctxt, JavaCode code) { jcoPContextWrite(ctxt, "<>"); } -void -jcListPrint(JavaCodePContext ctxt, JavaCode code) +void +jcListPrint(JavaCodePContext ctxt, JavaCode code) { char *theSep = (char *) jcoClass(code)->txt; char *sep = ""; @@ -1679,7 +1709,7 @@ jcListPrint(JavaCodePContext ctxt, JavaCode code) */ local Symbol jc0ModifierSymbol(int idx); -local JavaCodeClass +local JavaCodeClass jc0ClassObj(JcClassId id) { JavaCodeClass clss = &jcClss[id]; @@ -1704,13 +1734,13 @@ static struct jcModifierInfo jcModifierList[] = { { JCO_MOD_Volatile, "volatile"}, }; -local JavaCodeList +local JavaCodeList jc0CreateModifiers(int modifiers) { JavaCodeList l = listNil(JavaCode); int i=0, m; for (m=1; m< JCO_MOD_MAX; m=m<<1) { - if (modifiers & m) + if (modifiers & m) l = listCons(JavaCode)(jcoNewToken(jc0ClassObj(JCO_CLSS_Keyword), jc0ModifierSymbol(i)), l); i++; @@ -1719,7 +1749,7 @@ jc0CreateModifiers(int modifiers) } local Symbol -jc0ModifierSymbol(int idx) +jc0ModifierSymbol(int idx) { struct jcModifierInfo *inf = &jcModifierList[idx]; if (inf->sym == NULL) @@ -1731,7 +1761,7 @@ jc0ModifierSymbol(int idx) local Bool jc0ImportEq(JavaCode c1, JavaCode c2); local void jc0CollectImports(Table tbl, Table nameTbl, JavaCode code); -JavaCodeList +JavaCodeList jcCollectImports(JavaCode code) { Table tbl = tblNew((TblHashFun) jcoHash, (TblEqFun) jc0ImportEq); @@ -1768,17 +1798,17 @@ local Bool jc0ImportEq(JavaCode c1, JavaCode c2) { assert(jcoIsImport(c1) && jcoIsImport(c2)); - + if (strcmp(jcoImportPkg(c1), jcoImportPkg(c2)) != 0) return false; if (strcmp(jcoImportId(c1), jcoImportId(c2)) != 0) return false; - + return true; } -local void +local void jc0CollectImports(Table tbl, Table nameTbl, JavaCode code) { if (code == 0) @@ -1806,7 +1836,7 @@ jc0CollectImports(Table tbl, Table nameTbl, JavaCode code) /* * Returns a newly allocated string with properly escaped characters. */ -local String +local String jc0EscapeString(String s, Bool addTerminalChar) { Buffer buf; diff --git a/aldor/aldor/src/java/javacode.h b/aldor/aldor/src/java/javacode.h index ada937d8a..153234253 100644 --- a/aldor/aldor/src/java/javacode.h +++ b/aldor/aldor/src/java/javacode.h @@ -58,9 +58,10 @@ 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); +extern JavaCode jcClass(int modifiers, String comment, + JavaCodeList annotations, + JavaCode id, JavaCode superclass, + JavaCodeList implList, JavaCodeList body); extern JavaCode jcMethod(int modifiers, String comment, JavaCode retnType, @@ -87,6 +88,7 @@ extern JavaCode jcInitialisation(int modifiers, JavaCode type, extern JavaCode jcFile(JavaCode pkg, JavaCode name, JavaCodeList imports, JavaCode body); extern JavaCodeList jcCollectImports(JavaCode code); extern JavaCode jcDocumented(String comment, JavaCode code); +extern JavaCode jcAnnotation(JavaCode annotationClass, JavaCodeList arguments); extern JavaCode jcComment(String comment); extern JavaCode jcImportedId(String pkg, String name); extern JavaCode jcImportedStaticId(String pkg, String clss, String name); diff --git a/aldor/aldor/src/list.c b/aldor/aldor/src/list.c index ad1f2ebd5..edcee021c 100644 --- a/aldor/aldor/src/list.c +++ b/aldor/aldor/src/list.c @@ -17,6 +17,9 @@ typedef Pointer (*PointerListEltFun) (Pointer); typedef Bool (*PointerListEltEqFun) (Pointer, Pointer); typedef int (*PointerListEltPrFun) (FILE *, Pointer); typedef Bool (*PointerListEltSatFun) (Pointer); +typedef Bool (*PointerListPredicate) (Pointer, void *); + +local Bool ptrlistMember(PointerList l, Pointer x, PointerListEltEqFun eq); local Bool ptrEqEqual(PointerListEltEqFun eq, Pointer a, Pointer b) @@ -137,6 +140,34 @@ ptrlistFind(PointerList l, Pointer x, PointerListEltEqFun eq, int *pos) return 0; } +/* Return the first element matching the supplied predicate */ +local Pointer +ptrlistMatch(PointerList l, void *p, PointerListPredicate pred, int *posn) +{ + int i; + for (i = 0; l; l = l->rest, i++) { + if ((*pred)(l->first, p)) { + *posn = i; + return l->first; + } + } + return 0; +} + +/* Returns the elements matching the supplied predicate */ +local PointerList +ptrlistMatchAll(PointerList l, void *p, PointerListPredicate pred) +{ + PointerList res = listNil(Pointer); + int i; + for (i = 0; l; l = l->rest, i++) + if ((*pred)(l->first, p)) { + res = listCons(Pointer)(l->first, res); + } + + return listNReverse(Pointer)(res); +} + /* * Free just the first cons cell, return the former tail. */ @@ -452,6 +483,49 @@ ptrlistContainsAllq(PointerList l1, PointerList l2) return true; } +/* + * Return true if l1 contains any element in l2 + */ +local Bool +ptrlistContainsAnyq(PointerList l1, PointerList l2) +{ + while (l2 != listNil(Pointer)) { + if (ptrlistPosq(l1, car(l2)) != -1) + return true; + l2 = cdr(l2); + } + return false; +} + + +/* + * Return true if l1 contains every element in l2 (equal test) + */ +local Bool +ptrlistContainsAll(PointerList l1, PointerList l2, Bool (*eq)(Pointer, Pointer)) +{ + while (l2 != listNil(Pointer)) { + if (!ptrlistMember(l1, car(l2), eq)) + return false; + l2 = cdr(l2); + } + return true; +} + +/* + * Return true if l1 contains any element in l2 (equal test) + */ +local Bool +ptrlistContainsAny(PointerList l1, PointerList l2, Bool (*eq)(Pointer, Pointer)) +{ + while (l2 != listNil(Pointer)) { + if (ptrlistMember(l1, car(l2), eq)) + return true; + l2 = cdr(l2); + } + return false; +} + /* * Return the position of e in l using `eq' as the equality test. * If e is not there, -1 is returned. @@ -579,6 +653,8 @@ const struct ListOpsStructName(Pointer) ptrlistOps = { ptrlistListNull, ptrlistEqual, ptrlistFind, + ptrlistMatch, + ptrlistMatchAll, ptrlistFreeCons, ptrlistFree, ptrlistFreeTo, @@ -605,6 +681,9 @@ const struct ListOpsStructName(Pointer) ptrlistOps = { ptrlistMemq, ptrlistMember, ptrlistContainsAllq, + ptrlistContainsAnyq, + ptrlistContainsAll, + ptrlistContainsAny, ptrlistPosq, ptrlistPosition, ptrlistNRemove, diff --git a/aldor/aldor/src/list.h b/aldor/aldor/src/list.h index 986ab093d..bca8d7984 100644 --- a/aldor/aldor/src/list.h +++ b/aldor/aldor/src/list.h @@ -48,7 +48,12 @@ # define listCons(Type) (ListOps(Type)->Cons) # define listEqual(Type) (ListOps(Type)->Equal) # define listFind(Type) (ListOps(Type)->Find) +# define listMatch(Type) (ListOps(Type)->Match) +# define listMatchAll(Type) (ListOps(Type)->MatchAll) # define listContainsAllq(Type) (ListOps(Type)->ContainsAllq) +# define listContainsAll(Type) (ListOps(Type)->ContainsAll) +# define listContainsAnyq(Type) (ListOps(Type)->ContainsAnyq) +# define listContainsAny(Type) (ListOps(Type)->ContainsAny) # define listFreeCons(Type) (ListOps(Type)->FreeCons) # define listFree(Type) (ListOps(Type)->Free) # define listFreeTo(Type) (ListOps(Type)->FreeTo) @@ -123,6 +128,11 @@ Statement({ \ Bool (*f) (Type, Type)); \ Type (*Find) (List(Type), Type, \ Bool(*eq)(Type,Type) , int *); \ + Type (*Match) (List(Type), void *, \ + Bool(*match)(Type, void *), \ + int *); \ + List(Type) (*MatchAll) (List(Type), void *, \ + Bool(*match)(Type, void *)); \ List(Type) (*FreeCons) (List(Type)); \ void (*Free) (List(Type)); \ List(Type) (*FreeTo) (List(Type), List(Type)); \ @@ -152,7 +162,12 @@ Statement({ \ Bool (*Memq) (List(Type), Type); \ Bool (*Member) (List(Type), Type, \ Bool(*eq)(Type,Type) ); \ - Bool (*ContainsAllq) (List(Type), List(Type)); \ + Bool (*ContainsAllq) (List(Type), List(Type)); \ + Bool (*ContainsAnyq) (List(Type), List(Type)); \ + Bool (*ContainsAll) (List(Type), List(Type), \ + Bool (*eq)(Type, Type)); \ + Bool (*ContainsAny) (List(Type), List(Type), \ + Bool (*eq)(Type, Type)); \ int (*Posq) (List(Type), Type); \ int (*Position) (List(Type), Type, \ Bool(*eq)(Type,Type) ); \ diff --git a/aldor/aldor/src/of_deadv.c b/aldor/aldor/src/of_deadv.c index a289024b4..32d154741 100644 --- a/aldor/aldor/src/of_deadv.c +++ b/aldor/aldor/src/of_deadv.c @@ -309,7 +309,7 @@ local void dvMarkType(Foam decl) { int j; - if (decl->foamDecl.type == FOAM_JavaObj) { + if (decl->foamDecl.type == FOAM_JavaObj || decl->foamDecl.type == FOAM_CObj) { dvMarkWholeFormat(decl->foamDecl.format); } } @@ -675,13 +675,20 @@ dvMarkWholeFormat(int format) int i; ddecl = dvFormats[format]; - /* FOAM_DDecl_CSig has no references to other formats (yet) */ - if (ddecl->foamDDecl.usage == FOAM_DDecl_FortranSig) { + + if (ddecl->foamDDecl.usage == FOAM_DDecl_CSig) { + for (i=0; i < foamDDeclArgc(ddecl); i++) { + dvMarkWholeFormat(ddecl->foamDDecl.argv[i]->foamDecl.format); + } + } + + else if (ddecl->foamDDecl.usage == FOAM_DDecl_FortranSig) { for (i=0; i < foamDDeclArgc(ddecl); i++) { if (ddecl->foamDDecl.argv[i]->foamDecl.type == FOAM_Clos) dvMarkWholeFormat(ddecl->foamDDecl.argv[i]->foamDecl.format); } - } + } + for(i=0; ifoamDDecl.argv[i]; if (decl->foamDecl.type == FOAM_Rec || decl->foamDecl.type == FOAM_TR + || decl->foamDecl.type == FOAM_CObj || decl->foamDecl.type == FOAM_JavaObj) decl->foamDecl.format = inlGetFormat(decl->foamDecl.format); @@ -3872,14 +3873,14 @@ inlSubstitutedSyme(Syme syme) return syme; if (symeIsExport(syme)) { - syme = inlSymeSubstSelf(syme, symeExporter(isyme)); + syme = inlSymeSubstSelf(syme, tfFollowFn(symeExporter(isyme))); if (!syme) return NULL; } if (inlInlinee->sigma == NULL) inlInlinee->sigma = - tfSatSubList(tfGetExpr(symeExporter(isyme))); + tfSatSubList(tfGetExpr(tfFollowFn(symeExporter(isyme)))); if (inlInlinee->sigma == absFail()) return NULL; diff --git a/aldor/aldor/src/of_peep.c b/aldor/aldor/src/of_peep.c index a0517e859..ae1c71c44 100644 --- a/aldor/aldor/src/of_peep.c +++ b/aldor/aldor/src/of_peep.c @@ -28,6 +28,7 @@ Bool peepDebug = false; local Foam peepExpr (Foam, Bool *); local void peepAux (Foam *); +local Foam peepAElt (Foam); local Foam peepBCall (Foam); local Foam peepCast (Foam); local Foam peepIf (Foam); @@ -123,6 +124,9 @@ peepExpr(Foam expr, Bool *changed) case FOAM_CCall: newExpr = peepCCall(expr); break; + case FOAM_AElt: + newExpr = peepAElt(expr); + break; case FOAM_EEnsure: newExpr = peepEEnsure(expr); break; @@ -173,6 +177,22 @@ peepAux(Foam *arg) expr->foamBInt.BIntData == val) #define peepIsTheSFlo(val, expr) (peepHasTag(FOAM_SFlo, expr) && \ expr->foamSFlo.SFloData == val) +local Foam +peepAElt(Foam foam) +{ + AInt baseType = foam->foamAElt.baseType; + Foam index = foam->foamAElt.index; + Foam expr = foam->foamAElt.expr; + + if (peepHasTag(FOAM_SInt, index) && peepHasTag(FOAM_Arr, expr)) { + AInt idx = index->foamSInt.SIntData; + return foamNew(expr->foamArr.baseType, 1, expr->foamArr.eltv[index->foamSInt.SIntData]); + } + + return foam; +} + + local Foam peepBCall(Foam bcall) { diff --git a/aldor/aldor/src/of_util.c b/aldor/aldor/src/of_util.c index ef881e6c0..79fa8e8ea 100644 --- a/aldor/aldor/src/of_util.c +++ b/aldor/aldor/src/of_util.c @@ -394,6 +394,7 @@ fpClearFormats(Foam ddecl) } else if (decl->foamDecl.type != FOAM_Rec && decl->foamDecl.type != FOAM_JavaObj + && decl->foamDecl.type != FOAM_CObj && decl->foamDecl.type != FOAM_Arr && decl->foamDecl.type != FOAM_TR && decl->foamDecl.type != FOAM_NOp) diff --git a/aldor/aldor/src/sefo.c b/aldor/aldor/src/sefo.c index 21784eb20..0b5fa3224 100644 --- a/aldor/aldor/src/sefo.c +++ b/aldor/aldor/src/sefo.c @@ -114,6 +114,7 @@ local Bool symeOriginEqual0 (SymeList, Syme, Syme); local Bool tformEqualCheckSymes (TForm); local Sefo sefoEqualMods (Sefo); +local AbEqualValue sefoIdEqual (void *, Sefo, Sefo); local void sfvInitTable (void); local void sfvFiniTable (void); @@ -1132,9 +1133,9 @@ symePrintDb2(Syme syme) } int -tformOStreamWrite(OStream ostream, TForm tf) +tformOStreamWrite(OStream ostream, Bool deep, TForm tf) { - int n = tformOStreamPrint0(ostream, false, tf); + int n = tformOStreamPrint0(ostream, deep, tf); return n; } @@ -1199,7 +1200,6 @@ tformListPrintDb(TFormList tforms) * Local functions. */ -/* The deep argument is currently unused. */ local int sefoOStreamPrint0(OStream ostream, Bool deep, Sefo sefo) { @@ -1289,6 +1289,11 @@ tformOStreamPrint0(OStream ostream, Bool deep, TForm tf) cc += ostreamPrintf(ostream, " "); cc += sefoOStreamPrint0(ostream, deep, tfGetExpr(tf)); } + else if (tfIsSubst(tf) && deep) { + cc += ostreamPrintf(ostream, "%pAbSub", tf->sigma); + cc += ostreamPrintf(ostream, " "); + cc += tformOStreamPrint0(ostream, deep, tfSubstArg(tf)); + } else if (tfIsNode(tf)) { Length i; for (i = 0; i < tfArgc(tf); i += 1) { @@ -1689,6 +1694,39 @@ sefoEqual0(SymeList mods, Sefo sefo1, Sefo sefo2) return result; } +local AbEqualValue +sefoIdEqual(void *ctxt, Sefo sefo1, Sefo sefo2) +{ + int serial; + Bool result; + sstSerialDebug += 1; + serial = sstSerialDebug; + // This is for %% type comparison.. We can't use tfEqual as + // that works via the parent exports.. Instead, compare ids + // only if they are lexical variables + + if (abTag(sefo1) != abTag(sefo2)) { + return AbEqual_Struct; + } + else if (abTag(sefo1) != AB_Id) { + return AbEqual_Struct; + } + else { + sefoEqualDEBUG(dbOut, "(weak[%d]: %pAbSyn %pAbSyn\n", + (int) serial, sefo1, sefo2); + if (symeIsSelf(abSyme(sefo1)) && symeIsSelf(abSyme(sefo2))) { + result = symeEqual0((SymeList) ctxt, abSyme(sefo1), abSyme(sefo2)); + } + else { + result = abEqual(sefo1, sefo2); + } + + sefoEqualDEBUG(dbOut, " weak[%d]: %pAbSyn %pAbSyn --> %d)\n", + (int) serial, sefo1, sefo2, result); + } + return result ? AbEqual_True: AbEqual_False; +} + local Bool symeEqual0(SymeList mods, Syme syme1, Syme syme2) { @@ -1751,9 +1789,11 @@ symeEqual0(SymeList mods, Syme syme1, Syme syme2) tfFollow(tf2); assert (tfIsGeneral(tf1) && tfIsGeneral(tf2)); + sefoEqualDEBUG(dbOut, " symeEqual[%d] - selfSelf case %pTForm %pTForm\n", + (int) serial, tf1, tf2); result = (sefoListEqual0(mods, symeCondition(syme1), symeCondition(syme2)) && - abEqualModDeclares(tfGetExpr(tf1), tfGetExpr(tf2))); + abCompareModDeclares(sefoIdEqual, mods, tfGetExpr(tf1), tfGetExpr(tf2))); } } @@ -2988,6 +3028,19 @@ sefoSubst(AbSub sigma, Sefo sefo) return sefoSubst0(sigma, sefo); } +SefoList +sefoListSubst(AbSub sigma, SefoList sefoList) +{ + SefoList result = listNil(Sefo); + if (absIsEmpty(sigma)) return sefoList; + listIter(Sefo, sefo, sefoList, sefoFreeVars(sefo)); + abSubFreeVars(sigma); + + listIter(Sefo, sefo, sefoList, result = listCons(Sefo)(sefoSubst0(sigma, sefo), result)); + + return listNReverse(Sefo)(result); +} + Syme symeSubst(AbSub sigma, Syme syme) { @@ -4746,3 +4799,29 @@ tqualListFrBuffer0(Buffer buf) for (i = 0; i < tqualc; i += 1) tqualFrBuffer0(buf); } + +/* + * :: General stuff + */ + +SymeList +sefoSymes(Sefo sefo) +{ + SymeList sl = listNil(Syme); + + if (abIsId(sefo) && abSyme(sefo)) { + sl = listSingleton(Syme)(abSyme(sefo)); + } + else if (abIsId(sefo)) { + // skip + } + else if (abIsLeaf(sefo)) { + // skip + } + else { + for (int i=0; ival); +} diff --git a/aldor/aldor/src/symcoinfo.h b/aldor/aldor/src/symcoinfo.h index 291f08983..7492eca3b 100644 --- a/aldor/aldor/src/symcoinfo.h +++ b/aldor/aldor/src/symcoinfo.h @@ -7,22 +7,24 @@ /* * Symbol information for fast S-Expression IO of compiler types. */ -union symCoInfoU { - struct { - union { - Pointer generic; - AbSyn macro; - } phaseVal; /* phase varying info */ +typedef struct { + union { + Pointer generic; + AbSyn macro; + } phaseVal; /* phase varying info */ + AbSynTag abTagVal; + FoamTag foamTagVal; +} symCoInfoV, *SymCoInfoVal; - AbSynTag abTagVal; - FoamTag foamTagVal; - } val; - MostAlignedType align; /* Force alignment. */ +union symCoInfoU { + symCoInfoV val; + MostAlignedType align; /* Force alignment. */ }; extern union symCoInfoU * symCoInfoNew (void); -#define symCoInfo(sym) (&(((union symCoInfoU *) symInfo(sym))->val)) +extern SymCoInfoVal symCoInfo(Symbol sym); + #define symCoInfoInit(sym) (symInfo(sym) = &(symCoInfoNew()->align)) #endif diff --git a/aldor/aldor/src/syme.c b/aldor/aldor/src/syme.c index 84c87de17..823d9bdc7 100644 --- a/aldor/aldor/src/syme.c +++ b/aldor/aldor/src/syme.c @@ -1288,6 +1288,7 @@ symeListCheckJoinSymes(Syme syme1, Syme syme2) Bool symeCheckCondition(Syme syme) { + static int count; symeSetCondChecked(syme); symeClrCheckCondIncomplete(syme); @@ -1295,7 +1296,7 @@ symeCheckCondition(Syme syme) Sefo cond = car(symeCondition(syme)); Sefo dom, cat; int result; - + int serialThis = count++; /* If the condition can be checked now, check it. * Otherwise just leave it alone and accept the syme. */ @@ -1304,9 +1305,9 @@ symeCheckCondition(Syme syme) dom = cond->abHas.expr; cat = cond->abHas.property; - symeHasDEBUG(dbOut, "(symeCheckCondition: %pSymeC...", syme); + symeHasDEBUG(dbOut, "(symeCheckCondition: %d %pSymeC...\n", serialThis, syme); result = symeCheckHas(symeConditionContext(syme), dom, cat); - symeHasDEBUG(dbOut, " ... %d)\n", result); + symeHasDEBUG(dbOut, " ... %d %d)\n", result, serialThis); if (result == 1) { symeSetCheckCondIncomplete(syme); @@ -1924,3 +1925,16 @@ struct symeFieldInfo symeFieldInfo[] = { { SYFI_DefinitionConditions,"definedConditions",(AInt) listNil(AbSyn) }, { SYFI_SrcPos,"srcpos",(SrcPos) listNil(AbSyn) }, }; + +SymeList +symeListFindNamed(SymeList symes, String name) +{ + Symbol sym = symIntern(name); + SymeList result = listNil(Syme); + while (symes) { + if (symeId(car(symes)) == sym) + result = listCons(Syme)(car(symes), result); + symes = cdr(symes); + } + return result; +} diff --git a/aldor/aldor/src/symeset.c b/aldor/aldor/src/symeset.c index ab4b34df8..2a290b82f 100644 --- a/aldor/aldor/src/symeset.c +++ b/aldor/aldor/src/symeset.c @@ -51,6 +51,14 @@ symeSetIsEmpty(SymeSet symeSet) return listNil(Syme) == symeSet->symes; } +SymeSet +symeSetSingleton(Syme syme) +{ + SymeList sl = listSingleton(Syme)(syme); + SymeSet ss = symeSetFrSymes(sl); + return ss; +} + Bool symeSetMember(SymeSet symeSet, Syme syme) { diff --git a/aldor/aldor/src/symeset.h b/aldor/aldor/src/symeset.h index 8ce3e47f1..8287b92a4 100644 --- a/aldor/aldor/src/symeset.h +++ b/aldor/aldor/src/symeset.h @@ -1,8 +1,9 @@ #ifndef _SYMESET_H_ #define _SYMESET_H_ -#include "ttable.h" + #include "symbol.h" #include "syme.h" +#include "ttable.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 @@ -14,6 +15,7 @@ typedef struct SymeSet { SymeList symes; } *SymeSet; +extern SymeSet symeSetSingleton(Syme syme); extern SymeSet symeSetFrSymes (SymeList symes); extern SymeSet symeSetEmpty (void); extern void symeSetFree (SymeSet symeSet); diff --git a/aldor/aldor/src/table.h b/aldor/aldor/src/table.h index 915c26ee7..b5b03c06c 100644 --- a/aldor/aldor/src/table.h +++ b/aldor/aldor/src/table.h @@ -9,7 +9,10 @@ #ifndef _TABLE_H_ #define _TABLE_H_ -#include "axlgen.h" +#include "cport.h" +#include "ostream.h" + +typedef struct table * Table; typedef Pointer TblKey; typedef Pointer TblElt; diff --git a/aldor/aldor/src/tconst.c b/aldor/aldor/src/tconst.c index 944556ac6..d173ef720 100644 --- a/aldor/aldor/src/tconst.c +++ b/aldor/aldor/src/tconst.c @@ -146,7 +146,7 @@ tcFree(TConst tc) listPop(TConst, tc, tcList, tcEq); assert(l0 - 1 == listLength(TConst)(tcList)); } - + tcDEBUG(dbOut, "tcFree: %d %pTForm\n", tc->serial, tcOwner(tc)); tcCount -= 1; stoFree((Pointer) tc); } @@ -162,6 +162,7 @@ tcPush(TConst tc) tcFree(tc); return; } + tcDEBUG(dbOut, "tcPush: %pTForm owns %pTConst\n", owner, tc); listPush(TConst, tc, tfConsts(owner)); } @@ -237,6 +238,7 @@ tcNew(TConstTag tag, TForm owner, AbLogic known, AbSyn id, AbSyn ab0, Length arg assert(owner != tc->owner); tc->owner = owner; } + tcDEBUG(dbOut, "tcNewSat: %pTForm owns %pTConst\n", tcOwner(tc), tc); tcPush(tc); } @@ -259,8 +261,11 @@ tcMove(TForm ntf, TForm otf) tfFollow(ntf); - for (tcl = tfConsts(otf); tcl; tcl = cdr(tcl)) + for (tcl = tfConsts(otf); tcl; tcl = cdr(tcl)) { + tcDEBUG(dbOut, "tcMove: Moving %d from %pTForm to %pTForm\n", + tcSerial(car(tcl)), otf, ntf); tcOwner(car(tcl)) = ntf; + } tfConsts(ntf) = listNConcat(TConst)(tfConsts(ntf), tfConsts(otf)); tfConsts(otf) = listNil(TConst); @@ -308,7 +313,7 @@ tcCheck(TConst tc) } listPop(TConst, tc, tcStack, tcEq); - + tcDEBUG(dbOut, "tcCheck: %pTForm %pTConst %oBool\n", tcOwner(tc), tc, result); if (!result) { if (DEBUG(tc)) { tcPrint(dbOut, tc); diff --git a/aldor/aldor/src/terror.c b/aldor/aldor/src/terror.c index c9b094c36..dfbc69a24 100644 --- a/aldor/aldor/src/terror.c +++ b/aldor/aldor/src/terror.c @@ -6,25 +6,25 @@ * ***************************************************************************/ +#include "ablogic.h" +#include "abpretty.h" +#include "absub.h" +#include "comsg.h" #include "debug.h" #include "format.h" +#include "freevar.h" +#include "lib.h" +#include "sefo.h" #include "spesym.h" #include "stab.h" #include "store.h" -#include "terror.h" -#include "util.h" -#include "sefo.h" -#include "lib.h" -#include "tconst.h" -#include "tposs.h" -#include "tfsat.h" -#include "freevar.h" -#include "absub.h" -#include "ablogic.h" -#include "abpretty.h" -#include "comsg.h" #include "strops.h" #include "table.h" +#include "tconst.h" +#include "tfsat.h" +#include "terror.h" +#include "tposs.h" +#include "util.h" extern void tiBottomUp (Stab, AbSyn, TForm); extern void tiTopDown (Stab, AbSyn, TForm); @@ -67,7 +67,7 @@ typedef struct trejectInfo * TRejectInfo; local TReject trAlloc (Syme, TForm); local void trFree (TReject); -local void trInfoFrSymes (TRejectInfo, SymeList); +local void trInfoFrStab (TRejectInfo, Stab, AbLogic, Symbol); local void trInfoFrTPoss (TRejectInfo, TPoss); local void trInfoFrTUnique (TRejectInfo, TForm); @@ -102,13 +102,15 @@ trFree(TReject tr) } local void -trInfoFrSymes(TRejectInfo trInfo, SymeList symes) +trInfoFrStab(TRejectInfo trInfo, Stab stab, AbLogic cond, Symbol sym) { + SymeList symes; TReject * trArr; - Length nsymes = listLength(Syme)(symes); + Length nsymes; Length i = 0; - + symes = stabGetMeanings(stab, cond, sym); + nsymes = listLength(Syme)(symes); trArr = (TReject *) stoAlloc((unsigned) OB_Other, sizeof(TReject) * nsymes); @@ -968,7 +970,6 @@ terrorCoerceTo(Buffer obuf, AbSyn ab, TForm type) { String fmt; - assert(abState(ab->abCoerceTo.expr) == AB_State_HasPoss); fmt = comsgString(ALDOR_E_TinNoGoodOp); bufPrintf(obuf, fmt, "coerce"); @@ -1193,7 +1194,7 @@ terrorImplicitSetBang(Stab stab, AbSyn ab, Length argc, AbSynGetter argf, * Here we assume this. * !!! FIXME (ablogFalse) */ - trInfoFrSymes(&trInfoStruct, stabGetMeanings(stab, ablogFalse(), ssymSetBang)); + trInfoFrStab(&trInfoStruct, stab, ablogFalse(), ssymSetBang); fillTRejectInfo(&trInfoStruct, type, ab, stab, argc, argf); sortSetBangTRejectInfo(&trInfoStruct); @@ -1736,8 +1737,8 @@ noMeaningsForOperator(Buffer obuf, TForm type, AbSyn ab, AbSyn op, Stab stab, } if (abTag(op) == AB_Id) - trInfoFrSymes(&trInfoStruct, /* vvv FIXME */ - stabGetMeanings(stab, ablogFalse(), op->abId.sym)); + trInfoFrStab(&trInfoStruct, /* vvv FIXME */ + stab, ablogFalse(), op->abId.sym); else if (abState(op) == AB_State_HasPoss || abState(op) == AB_State_Error) trInfoFrTPoss(&trInfoStruct, abGoodTPoss(op)); diff --git a/aldor/aldor/src/test/abquick.c b/aldor/aldor/src/test/abquick.c index 2f553e661..53c9a0d95 100644 --- a/aldor/aldor/src/test/abquick.c +++ b/aldor/aldor/src/test/abquick.c @@ -7,6 +7,7 @@ #include "linear.h" #include "macex.h" #include "parseby.h" +#include "phase.h" #include "scan.h" #include "scobind.h" #include "sefo.h" @@ -214,6 +215,7 @@ tfqTypeInfer(Stab stab, String str) testTrue("Declare is sefo", abIsSefo(absyn)); testIntEqual("Error Count", nErrors, comsgErrorCount()); + saveAndEmptyAllPhaseSymbolData(); return (Sefo) absyn; } diff --git a/aldor/aldor/src/test/test_abcheck.c b/aldor/aldor/src/test/test_abcheck.c index cecf73a37..1eace89b1 100644 --- a/aldor/aldor/src/test/test_abcheck.c +++ b/aldor/aldor/src/test/test_abcheck.c @@ -1,10 +1,10 @@ -#include "axlobs.h" +#include "abcheck.h" #include "abquick.h" +#include "axlobs.h" +#include "comsg.h" #include "format.h" -#include "testlib.h" #include "strops.h" -#include "abcheck.h" -#include "comsg.h" +#include "testlib.h" local void testWithDeclarations(void); diff --git a/aldor/aldor/src/test/test_format.c b/aldor/aldor/src/test/test_format.c index 0070fc1c8..8f0428647 100644 --- a/aldor/aldor/src/test/test_format.c +++ b/aldor/aldor/src/test/test_format.c @@ -1,7 +1,11 @@ +#include "absub.h" +#include "abquick.h" #include "axlobs.h" #include "format.h" -#include "testlib.h" +#include "formatters.h" +#include "stab.h" #include "strops.h" +#include "testlib.h" local void testFormat1(); local void testFormat2(); @@ -9,16 +13,24 @@ local void testFormat3(); local void testFormat4(); local void testFormat5(); local void testFormat6(); +local void testFormatBool(); +local void testFormatAbSub(); void formatTest() { + init(); + TEST(testFormat1); TEST(testFormat2); TEST(testFormat3); TEST(testFormat4); TEST(testFormat5); TEST(testFormat6); + TEST(testFormatBool); + TEST(testFormatAbSub); + + fini(); } int @@ -98,3 +110,27 @@ testFormat6() testStringEqual("test2", "Hello: [-1]", s); } +local void +testFormatBool() +{ + char *s; + fmttsInit(); + + testStringEqual("", "[true]", strPrintf("[%oBool]", true)); + testStringEqual("", "[false]", strPrintf("[%oBool]", false)); + testStringEqual("", "[Bool[123]]", strPrintf("[%oBool]", 123)); +} + +local void +testFormatAbSub() +{ + initFile(); + stdscope(stabFile()); + AbSub sigma = absNew(stabFile()); + Syme syme = symeNewLexVar(symInternConst("X"), tfType, car(stabFile())); + absExtend(syme, tfqTypeInfer(stabFile(), "Cross()"), sigma); + testIsNotNull("test", strPrintf("[%pAbSub]", sigma)); + finiFile(); +} + + diff --git a/aldor/aldor/src/test/test_jcode.c b/aldor/aldor/src/test/test_jcode.c index 977150242..5622894d9 100644 --- a/aldor/aldor/src/test/test_jcode.c +++ b/aldor/aldor/src/test/test_jcode.c @@ -9,6 +9,7 @@ #include "testlib.h" local void testTry(); +local void testStr(); #define ID(name) jcId(strCopy(name)) void @@ -19,6 +20,7 @@ jcodeTest() fmttsInit(); sxiInit(); TEST(testTry); + TEST(testStr); dbFini(); } @@ -42,3 +44,10 @@ testTry() testStringEqual("", "try {\n r = obj.foo();\n}\ncatch (Exn e) {\n return;\n}", txt); } + +void +testStr() +{ + JavaCode c = jcLiteralChar("\\"); + testStringEqual("eq", "\\\\", c->literal.txt); +} diff --git a/aldor/aldor/src/test/test_of_cprop.c b/aldor/aldor/src/test/test_of_cprop.c new file mode 100644 index 000000000..d305b2b9c --- /dev/null +++ b/aldor/aldor/src/test/test_of_cprop.c @@ -0,0 +1,91 @@ +#include "axlobs.h" +#include "fbox.h" +#include "flog.h" +#include "of_cprop.h" +#include "testlib.h" +#include "syme.h" + +local void testCPropSimple(void); +local void testCPropLex(void); + +void ofCPropTest() +{ + init(); + TEST(testCPropSimple); + //TEST(testCPropLex); +} + +extern Bool cpDebug, cpDfDebug; + +local void +testCPropSimple() +{ + FoamList params; + FoamList locals; + FoamBox body; + Foam prog; + + params = listList(Foam)(1, foamNewDecl(FOAM_SInt, strCopy(""), int0)); + locals = listList(Foam)(1, foamNewDecl(FOAM_SInt, strCopy(""), int0)); + + body = fboxNewEmpty(FOAM_Seq); + + fboxAdd(body, foamNewSet(foamNewLoc(int0), foamNewPar(int0))); + fboxAdd(body, foamNewReturn(foamNewLoc(int0))); + + prog = foamNewProgEmpty(); + prog->foamProg.params = foamNewDDecl(FOAM_DDecl_Param, params); + prog->foamProg.locals = foamNewDDecl(FOAM_DDecl_Local, locals); + prog->foamProg.body = fboxMake(body); + + FlowGraph flog = flogFrProg(prog, FLOG_UniqueExit); + + Bool result = cpFlog(flog); + testTrue("cprop", result); + + int nLabels; + Foam seq = flogToSeq(flog, &nLabels); + + Foam ret = foamFindFirstTag(FOAM_Return, seq); + testIsNotNull("found", ret); + testTrue("eq", foamEqual(foamNewPar(int0), ret->foamReturn.value)); +} + + +local void +testCPropLex() +{ + FoamList params; + FoamList locals; + FoamBox body; + Foam prog; + + params = listList(Foam)(1, foamNewDecl(FOAM_SInt, strCopy(""), int0)); + locals = listList(Foam)(0); + + body = fboxNewEmpty(FOAM_Seq); + + fboxAdd(body, foamNewSet(foamNewPar(int0), foamNewLex(1, 1))); + fboxAdd(body, foamNewReturn(foamNewLex(1, 1))); + + prog = foamNewProgEmpty(); + prog->foamProg.params = foamNewDDecl(FOAM_DDecl_Param, params); + prog->foamProg.locals = foamNewDDecl(FOAM_DDecl_Local, locals); + prog->foamProg.body = fboxMake(body); + + FlowGraph flog = flogFrProg(prog, FLOG_UniqueExit); + + cpDebug = 1; + cpDfDebug = 1; + + Bool result = cpFlog(flog); + testTrue("cprop", result); + + int nLabels; + Foam seq = flogToSeq(flog, &nLabels); + + Foam ret = foamFindFirstTag(FOAM_Return, seq); + testIsNotNull("found", ret); + testTrue("eq", foamEqual(foamNewPar(int0), ret->foamReturn.value)); +} + diff --git a/aldor/aldor/src/test/test_of_peep.c b/aldor/aldor/src/test/test_of_peep.c new file mode 100644 index 000000000..726652635 --- /dev/null +++ b/aldor/aldor/src/test/test_of_peep.c @@ -0,0 +1,42 @@ +#include "axlobs.h" +#include "cmdline.h" +#include "flog.h" +#include "foam.h" +#include "of_inlin.h" +#include "of_peep.h" +#include "optfoam.h" +#include "strops.h" +#include "syme.h" +#include "testlib.h" + +local void testAElt(); + +void ofPeepTest() +{ + TEST(testAElt); +} + +void testAElt() +{ + Foam expr, body, prog, locals; + + expr = foamNewDef(foamNewLoc(0), + foamNewAElt(FOAM_Char, foamNewSInt(0), foamNew(FOAM_Arr, 2, FOAM_Char, 46))); + body = foamNewSeq(expr, NULL); + + prog = foamNewProgEmpty(); + locals = foamNewDDecl(FOAM_DDecl_Local, + foamNewDecl(FOAM_Char, strCopy("0"), emptyFormatSlot), NULL); + + prog->foamProg.locals = locals; + prog->foamProg.body = body; + prog->foamProg.params = foamNewEmptyDDecl(int0); + prog->foamProg.fluids = foamNewEmptyDDecl(int0); + prog->foamProg.nLabels = 2; + prog->foamProg.levels = foamNewEmptyDEnv(); + foamOptInfo(prog) = inlInfoNew(NULL, prog, NULL, false); + + peepProg(prog, false); + + testTrue("eq", foamEqual(foamNewDef(foamNewLoc(int0), foamNewChar(46)), prog->foamProg.body->foamSeq.argv[0])); +} diff --git a/aldor/aldor/src/test/testall.c b/aldor/aldor/src/test/testall.c index b1e984513..2623ba1bc 100644 --- a/aldor/aldor/src/test/testall.c +++ b/aldor/aldor/src/test/testall.c @@ -67,6 +67,8 @@ main(int argc, char *argv[]) if (testShouldRun("retype")) retypeTest(); if (testShouldRun("genfoam")) genfoamTestSuite(); if (testShouldRun("tposs")) tpossTest(); + if (testShouldRun("of_peep")) ofPeepTest(); + if (testShouldRun("of_cprop")) ofCPropTest(); testIntEqual("fluidlevel", 0, fluidLevel); diff --git a/aldor/aldor/src/test/testall.h b/aldor/aldor/src/test/testall.h index 19d28ac70..ed3a7918f 100644 --- a/aldor/aldor/src/test/testall.h +++ b/aldor/aldor/src/test/testall.h @@ -24,6 +24,8 @@ void jcodeTest(void); void jflowTest(void); void listTestSuite(void); void ostreamTest(void); +void ofPeepTest(void); +void ofCPropTest(void); void printfTest(void); void retypeTest(void); void scobindTest(void); diff --git a/aldor/aldor/src/test/testlib.c b/aldor/aldor/src/test/testlib.c index c037d00cb..f8756a3b3 100644 --- a/aldor/aldor/src/test/testlib.c +++ b/aldor/aldor/src/test/testlib.c @@ -96,7 +96,7 @@ testTrue(String testName, Bool flg) if (flg) { return; } - testFail(testName, "failed; expected true, got %d", flg); + testFail(testName, "failed; expected true, got %oBool", flg); } void @@ -106,7 +106,7 @@ testFalse(String testName, Bool flg) if (!flg) { return; } - testFail(testName, "failed; expected false, got %d", flg); + testFail(testName, "failed; expected false, got %oBool", flg); } void @@ -179,6 +179,8 @@ finiFile() testFail("", "missing 'initFile()'"); } + saveAndEmptyAllPhaseSymbolData(); + scobindFiniFile(); stabFiniFile(); comsgFini(); @@ -188,14 +190,21 @@ finiFile() inFile = false; } + +static Bool initted = false; void init() { + osInit(); + dbInit(); + + if (initted) + return; + osInit(); sxiInit(); keyInit(); ssymInit(); - dbInit(); stabInitGlobal(); tfInit(); fmttsInit(); @@ -206,6 +215,7 @@ init() sposInit(); ablogInit(); comsgInit(); + initted = true; } void diff --git a/aldor/aldor/src/tform.c b/aldor/aldor/src/tform.c index e9b759829..c68865699 100644 --- a/aldor/aldor/src/tform.c +++ b/aldor/aldor/src/tform.c @@ -24,33 +24,35 @@ * ****************************************************************************/ +#include "ablogic.h" +#include "abpretty.h" +#include "absub.h" +#include "archive.h" #include "axlobs.h" +#include "bigint.h" +#include "comsg.h" #include "debug.h" #include "fint.h" #include "format.h" +#include "freevar.h" +#include "lib.h" +#include "sefo.h" #include "spesym.h" #include "stab.h" #include "store.h" +#include "strops.h" +#include "symbol.h" +#include "symeset.h" +#include "tconst.h" #include "tfcond.h" +#include "tfsat.h" #include "ti_sef.h" #include "ti_top.h" #include "tinfer.h" -#include "util.h" -#include "sefo.h" -#include "archive.h" -#include "lib.h" -#include "tqual.h" -#include "tconst.h" #include "tposs.h" -#include "tfsat.h" -#include "freevar.h" -#include "absub.h" -#include "ablogic.h" -#include "abpretty.h" -#include "comsg.h" -#include "strops.h" -#include "bigint.h" -#include "symeset.h" +#include "tqual.h" +#include "ttable.h" +#include "util.h" Bool tfDebug = false; Bool tfExprDebug = false; @@ -180,7 +182,7 @@ local SymeList tfAddHasExports (TForm, TForm); local SymeList tfGetCatExportsFrParents(SymeList); local SymeList tfGetCatExportsCond (SymeList, SefoList, Bool); -local SymeList tfGetCatExportsFilter (SymeList, SymeList); +local SymeList tfGetCatExportsFilterTable(SymeTSet, SymeList); local SymeList tfGetCatExportsFrWith (TForm); local SymeList tfGetCatExportsFrIf (TForm); @@ -3598,20 +3600,29 @@ tfJoinExportToList(SymeList mods, SymeList symes, Syme syme2, Sefo cond) SymeList tfJoinExportLists(SymeList mods, SymeList symes1, SymeList symes2, Sefo cond) { - SymeList result = symes1, next; + SymeList result = symes1, next, lst; + Table symesByName = tblNew((TblHashFun) symHashFn, (TblEqFun) symEqual); + + for (lst = symes1; lst; lst = cdr(lst)) { + Syme syme = car(lst); + SymeList sl = (SymeList) tblElt(symesByName, symeId(syme), listNil(Syme)); + tblSetElt(symesByName, symeId(syme), listCons(Syme)(syme, sl)); + } for (; symes2; symes2 = cdr(symes2)) { Syme syme2 = car(symes2); + SymeList namedSymes = tblElt(symesByName, symeId(syme2), listNil(Syme)); - if (!tfJoinExportToList(mods, result, syme2, cond)) { + if (!tfJoinExportToList(mods, namedSymes, syme2, cond)) { Syme syme1 = symeCopy(syme2); if (cond) symeAddCondition(syme1, cond, true); next = listCons(Syme)(syme1, listNil(Syme)); result = listNConcat(Syme)(result, next); symeAddTwin(syme1, syme2); + tblSetElt(symesByName, symeId(syme2), listCons(Syme)(syme1, namedSymes)); } } - + tblFreeDeeply(symesByName, NULL, (TblFreeEltFun) listFree(Syme)); return result; } @@ -3903,6 +3914,8 @@ tfGetDomExports(TForm tf) SymeList tfGetCatExports(TForm cat) { + static int count = 0; + int serialThis = count++; tfFollow(cat); if (tfIsDefineOfType(cat)) return tfGetDomExports(tfDefineVal(cat)); @@ -3919,8 +3932,7 @@ tfGetCatExports(TForm cat) } if (DEBUG(tfCat)) { - fprintf(dbOut, "(tfGetCatExports: from "); - tfPrint(dbOut, cat); + afprintf(dbOut, "(tfGetCatExports:%d: from %pTForm\n", serialThis, cat); } tfGetCatSelf(cat); @@ -3947,20 +3959,24 @@ tfGetCatExports(TForm cat) if (DEBUG(tfCat)) { SymeList symes = tfCatExports(cat); if (symes) { + int n = 0; afprintf(dbOut, " Exports for %pTForm: [\n", cat); while (symes != listNil(Syme)) { Syme syme = car(symes); symes = cdr(symes); afprintf(dbOut, - " %s Def: %s %pAbSynList\n", symeString(syme), symeHasDefault(syme) ? "DEF" : "", + "%d %s %s %pAbSynList\n", n, symeString(syme), symeHasDefault(syme) ? "DEF" : "NO", symeCondition(syme)); + afprintf(dbOut, + "%d %s: %pTForm\n", n, symeString(syme), symeType(syme)); + n++; } afprintf(dbOut, " ]\n", cat); } } - tfCatDEBUG(dbOut, ")\n"); + tfCatDEBUG(dbOut, " %d)\n", serialThis); tfAuditExportList(tfCatExports(cat)); return tfCatExports(cat); @@ -4016,12 +4032,15 @@ tfGetThdExports(TForm thd) local SymeList tfGetCatExportsFrParents(SymeList symes) { - SymeList nsymes, osymes = listCopy(Syme)(symes); + static int count = 0; + SymeTSet oldTbl = tsetCreateCustom(Syme)(symeHashFn, symeEqual); + SymeList nsymes; SymeList queue = listCopy(Syme)(symes); SymeList xsymes = listNil(Syme); SefoList cond; while (queue) { + int serialThis = count++; Syme syme = car(queue); SymeList cell = queue; queue = cdr(queue); @@ -4033,7 +4052,8 @@ tfGetCatExportsFrParents(SymeList symes) if (!symeIsSelfSelf(syme)) continue; if (DEBUG(tfParent)) { - afprintf(dbOut, "(tfCatExports: expanding %pTForm %pAbSynList\n", + afprintf(dbOut, "(tfCatExports:%d: expanding %pTForm %pAbSynList\n", + serialThis, symeType(syme), symeCondition(syme)); } @@ -4042,14 +4062,14 @@ tfGetCatExportsFrParents(SymeList symes) if (cond) nsymes = tfGetCatExportsCond(nsymes, cond, true); if (DEBUG(tfParent)) { - afprintf(dbOut, "tfCatExports: into %pSymeList)\n", nsymes); + afprintf(dbOut, "tfCatExports:%d: into %pSymeList)\n", serialThis, nsymes); } - nsymes = tfGetCatExportsFilter(osymes, nsymes); - osymes = listNConcat(Syme)(osymes, nsymes); + nsymes = tfGetCatExportsFilterTable(oldTbl, nsymes); + tsetAddAll(Syme)(oldTbl, nsymes); queue = listNConcat(Syme)(listCopy(Syme)(nsymes), queue); } - listFree(Syme)(osymes); + tsetFree(Syme)(oldTbl); return listNReverse(Syme)(xsymes); } @@ -4084,14 +4104,14 @@ tfGetCatExportsCond(SymeList symes0, SefoList conds0, Bool pos) } local SymeList -tfGetCatExportsFilter(SymeList osymes, SymeList nsymes) +tfGetCatExportsFilterTable(SymeTSet oldTbl, SymeList nsymes) { SymeList symes, rsymes = listNil(Syme); /* Remove symes for %% which have been seen before. */ for (symes = nsymes; symes; symes = cdr(symes)) if (!(symeIsSelfSelf(car(symes)) && - symeListMember(car(symes), osymes, symeEqual))) + tsetMember(Syme)(oldTbl, car(symes)))) rsymes = listCons(Syme)(car(symes), rsymes); listFree(Syme)(nsymes); @@ -4345,14 +4365,13 @@ tfStabGetDomImportSet(Stab stab, TForm tf) local SymeSet tfStabCreateDomImportSet(Stab stab, TForm tf) { - + static int count = 0; + int serialThis = count++; SymeSet symeSet; SymeList xsymes, symes; if (DEBUG(tfImport)) { - fprintf(dbOut, "(tfStabGetDomImports: from "); - tfPrint(dbOut, tf); - fnewline(dbOut); + afprintf(dbOut, "(tfStabGetDomImports:%d: from %pTForm\n", serialThis, tf); } xsymes = tfGetDomExports(tf); @@ -4364,8 +4383,8 @@ tfStabCreateDomImportSet(Stab stab, TForm tf) while (sl != listNil(Syme)) { Syme syme = car(sl); TForm symeTf = symeType(syme); - tfDEBUG(dbOut, "Setting imported condition %s %pTForm\n", - symeString(syme), symeTf); + tfDEBUG(dbOut, "%d: Setting imported condition %s %pTForm\n", + serialThis, symeString(syme), symeTf); tfSetConditions(symeTf, tfConditions(tf)); symeSetConditionContext(syme, tfConditionalAbSyn(tf)); sl = cdr(sl); @@ -4384,7 +4403,7 @@ tfStabCreateDomImportSet(Stab stab, TForm tf) if (DEBUG(tfImport)) { symeListPrintDb(symes); - fprintf(dbOut, ")\n"); + fprintf(dbOut, " %d)\n", serialThis); tfPrint(dbOut, tf); fnewline(dbOut); } @@ -6435,6 +6454,26 @@ tfMapArgN(TForm tf, Length n) return tfAsMultiArgN(tfMapArg(tf), tfMapArgc(tf), n); } +SymeList +tfMapArgSymes(TForm tf) +{ + SymeList sl = listNil(Syme); + int i; + + tfFollow(tf); + assert(tfIsMap(tf)); + + for (i=0; itiUnaryToRaw(absStab(sigma), abi, tfi)) { - result = tfSatResult(mask, TFS_BadArgType); - result = tfSatParNFail(result, pi); + result = tfSatParNFail(mask, TFS_BadArgType, pi); break; } /* @@ -700,8 +732,7 @@ tfSatAsMulti(SatMask mask, AbSub sigma, TForm S, TForm TScope, sigma = absExtend(syme, abi, sigma); } else { - result = tfSatResult(mask, TFS_BadArgType); - result = tfSatParNFail(result, pi); + result = tfSatParNFail(mask, TFS_BadArgType, pi); break; } } @@ -723,8 +754,7 @@ tfSatAsMulti(SatMask mask, AbSub sigma, TForm S, TForm TScope, sigma = absExtend(syme, abc, sigma); } else { - result = tfSatResult(mask, TFS_BadArgType); - result = tfSatParNFail(result, 1); + result = tfSatParNFail(mask, TFS_BadArgType, 1); } } } @@ -790,8 +820,10 @@ tfSatArgPoss(SatMask mask, AbSyn Sab, TForm T) return result; } - for (l = S->possl; l; l = cdr(l)) { - result = tfSat1(mask, Sab, car(l), T); + TPossIterator ip; + for (tpossITER(ip, S); tpossMORE(ip); tpossSTEP(ip)) { + TForm s = tpossELT(ip); + result = tfSat1(mask, Sab, s, T); if (tfSatSucceed(result)) return result; } @@ -829,9 +861,14 @@ tfSat1(SatMask mask, AbSyn Sab, TForm S, TForm T) S = tfFollowOnly(S); T = tfFollowOnly(T); + tfsSerialNo += 1; + serialThis = tfsSerialNo; + /* If we can determine satisfaction w/o using tfFollow, do so. */ if (tfIsSubst(S)) { + tfsDEBUG(dbOut, "(%d - skip subst\n", serialThis); result = tfSat(mask & ~TFS_Pending, tfSubstArg(S), T); + tfsDEBUG(dbOut, " %d - skip subst - %oBool)\n", serialThis, tfSatSucceed(result)); if (tfSatSucceed(result)) return result; } @@ -841,9 +878,7 @@ tfSat1(SatMask mask, AbSyn Sab, TForm S, TForm T) if (tfSatAllow(mask, TFS_Sefo)) return tfSatResult(mask, TFS_Sefo); - tfsSerialNo += 1; tfsDepthNo += 1; - serialThis = tfsSerialNo; if (DEBUG(tfs)) { fprintf(dbOut, "->Tfs: %*s%d= ", tfsDepthNo, "", serialThis); @@ -1033,6 +1068,8 @@ tfSat1(SatMask mask, AbSyn Sab, TForm S, TForm T) serialThis, boolToString(tfSatSucceed(result))); if (tfSatEmbed(result)) fprintf(dbOut, " (after embedding)"); + if (tfSatPending(result)) + afprintf(dbOut, " (pending) - %pTForm", tfSatGetPendingFail()); fnewline(dbOut); } tfsDepthNo -= 1; @@ -1618,7 +1655,8 @@ tfSatThdExports(SatMask mask, TForm S, TForm T) assert(tfHasThdExports(S) && tfHasThdExports(T)); mods = listConcat(Syme)(tfGetThdSelf(S), tfGetThdSelf(T)); - result = tfSatExports(mask, mods, tfGetThdExports(S), + result = tfSatExports(mask, mods, + tfGetThdExports(S), tfGetThdExports(T)); } else if (tfSatAllow(mask, TFS_Pending)) { @@ -1653,6 +1691,7 @@ local SymeList tfSatExportsMissing(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, SymeList T) { SymeList symes, missing; + AbSub lazySelfSubst; if (DEBUG(tfsExport)) { fprintf(dbOut, "(->tfSatExportMissing: %*s= source list: ", @@ -1662,14 +1701,14 @@ tfSatExportsMissing(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, SymeList } missing = listNil(Syme); - + lazySelfSubst = NULL; for (symes = T; symes; symes = cdr(symes)) { Syme syme = car(symes); - tfsExportDEBUG(dbOut, "->tfSatExportMissing: %*s= looking for: %pSyme\n", - tfsDepthNo, "", syme); + tfsExportDEBUG(dbOut, "->tfSatExportMissing: %*s= looking for: %pSyme %pTForm\n", + tfsDepthNo, "", syme, symeType(syme)); - if (tfSatSucceed(tfSatExport(mask, mods, Sab, S, syme))) + if (tfSatSucceed(tfSatExport(mask, mods, Sab, S, syme, &lazySelfSubst))) continue; missing = listCons(Syme)(syme, missing); @@ -1685,11 +1724,67 @@ tfSatExportsMissing(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, SymeList return missing; } +typedef struct satModAbSyn { + SymeList mods; + AbSyn ab; +} *SatModAbSyn; + +local SatModAbSyn +satModAbSynNew(SymeList mods, AbSyn ab) +{ + SatModAbSyn satModAbSyn; + + satModAbSyn = (SatModAbSyn) stoAlloc(OB_Other, sizeof(*satModAbSyn)); + satModAbSyn->mods = mods; + satModAbSyn->ab = ab; + return satModAbSyn; +} + +local void +satModAbSynFree(SatModAbSyn satModAbSyn) +{ + stoFree(satModAbSyn); +} + +local AbEqualValue +tfSatAbCompareModAbSyn(void *ctxt, AbSyn ab1, AbSyn ab2) +{ + SatModAbSyn satModAbSyn = (SatModAbSyn) ctxt; + // For ids, make sure % in ab1, if present at all + if (!abIsTheId(ab1, ssymSelf) && abIsTheId(ab2, ssymSelf)) { + return tfSatAbCompareModAbSyn(ctxt, ab2, ab1); + } + if (abTag(ab1) != AB_Id && abTag(ab2) == AB_Id) { + return tfSatAbCompareModAbSyn(ctxt, ab2, ab1); + } + + if (abTag(ab1) != AB_Id) { + return AbEqual_Struct; + } + else if (abIsTheId(ab1, ssymSelf)) { + Bool eqAbSyn = abEqualModDeclares(satModAbSyn->ab, ab2); + if (eqAbSyn) + return AbEqual_True; + else { + // NB: This is a bit too lax, but we can wait for a counterexample + if (abIsTheId(ab2, ssymSelf)) { + return AbEqual_True; + } + Bool eq = sefoEqualMod(satModAbSyn->mods, ab1, ab2); + return eq ? AbEqual_True : AbEqual_False; + } + } + else { + Bool eq = sefoEqualMod(satModAbSyn->mods, ab1, ab2); + return eq ? AbEqual_True : AbEqual_False; + } +} + /* * Succeed if t can be found in S. */ local SatMask -tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) +tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t, AbSub *lazySelfSubst) { SatMask result = tfSatFalse(mask); TForm substT; @@ -1697,7 +1792,6 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) Bool tryHarder = true; static int serialNo = 0; 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, @@ -1717,15 +1811,20 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) } tfsExportDEBUG(dbOut, "tfSatExport[%d]:: Start S: %pAbSyn\n", serialThis, Sab); + tfsExportDEBUG(dbOut, "tfSatExport[%d]:: Target %pSyme %pTForm\n", serialThis, t, symeType(t)); if (symeHasDefault(t) && !symeIsSelfSelf(t)) return tfSatTrue(mask); /* First round.. try "normally" */ + int iterCount = 0; for (symes = S; !tfSatSucceed(result) && symes; symes = cdr(symes)) { SatMask satConditions; Syme s = car(symes); + int iterThis = iterCount++; + tfsExportDEBUG(dbOut, "tfSatExport[%d.%d]:: Test %pSyme %pTForm %pAbSynList\n", + serialThis, iterThis, s, symeType(s), symeCondition(s)); if (!symeEqualModConditions(mods, s, t)) continue; satConditions = tfSatConditions(mask, mods, s, t); @@ -1753,33 +1852,55 @@ tfSatExport(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, Syme t) * various local values for '%', and swapping them with the value used locally * should let us match 'Foo %' with 'Foo X'. */ - sigma = absFrSymes(stabFile(), mods, Sab); - tfsExportDEBUG(dbOut, "tfSatExport[%d]:: Incoming S: %pAbSyn\n", serialThis, Sab); - substT = tfSubst(sigma, symeType(t)); + tfsExportDEBUG(dbOut, "(tfSatExportExtra[%d]:: Incoming S: %pAbSyn %pTForm\n", + serialThis, Sab, symeType(t)); + + SatModAbSyn satModAbSyn = satModAbSynNew(mods, Sab); for (symes = S; !tfSatSucceed(result) && symes; symes = cdr(symes)) { Syme s = car(symes); - TForm substS; Bool weakEq; + if (symeId(s) != symeId(t)) { continue; } - substS = tfSubst(sigma, symeType(s)); - weakEq = abEqualModDeclares(tfExpr(substS), tfExpr(substT)); - tfsExportDEBUG(dbOut, "tfsatExport[%d]::CompareTF: [%pTForm], [%pTForm] = %d\n", - serialThis, substS, substT, weakEq); + if (!abHasSymbol(tfExpr(symeType(s)), ssymSelf)) + continue; + + //substS = tfSubst(sigma, symeType(s)); + //weakEq = abEqualModDeclares(tfExpr(substS), tfExpr(substT)); + weakEq = abCompareModDeclares(tfSatAbCompareModAbSyn, satModAbSyn, tfExpr(symeType(s)), tfExpr(symeType(t))); if (weakEq) { - result = tfSatTrue(mask); + if (symeCondition(s) != listNil(Sefo)) { + result = tfSatConditions(mask, mods, s, t); + } + else { + result = tfSatTrue(mask); + } } - tfFree(substS); } - tfFree(substT); + satModAbSynFree(satModAbSyn); + + tfsExportDEBUG(dbOut, " tfSatExportExtra[%d]:: --> %d)\n", + serialThis, tfSatSucceed(result)); return result; } +AbSub +tfSatExportLazySelfSubst(SymeList mods, Sefo Sab, AbSub *lazySelfSubst) +{ + AbSub sigma = *lazySelfSubst; + if (sigma == NULL) { + sigma = absFrSymes(stabFile(), mods, Sab); + *lazySelfSubst = sigma; + } + return sigma;; +} + + extern TForm tiGetTForm (Stab, AbSyn); static SatMask tfSatConditionOnSelf(SatMask mask, SymeList mods, Syme s, Sefo property); @@ -1790,6 +1911,8 @@ tfSatConditions(SatMask mask, SymeList mods, Syme s, Syme t) SefoList Sconds = symeCondition(s); SefoList Tconds = symeCondition(t); SatMask result = tfSatTrue(mask); + static int count = 0; + int serial = count++; for (; Sconds; Sconds = cdr(Sconds)) { Sefo cond = car(Sconds); @@ -1806,24 +1929,34 @@ tfSatConditions(SatMask mask, SymeList mods, Syme s, Syme t) */ if (abTag(cond) == AB_Has) { TForm tfdom, tfcat; - AbSyn cat; + AbSyn dom, 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); + tfsExportDEBUG(dbOut, "(%d Check condition %pSyme %pTForm %pAbSyn\n", serial, s, symeType(s), cond); + dom = cond->abHas.expr; + tfdom = abGetCategory(dom); if (tfTestSeen(tfdom, cond->abHas.property)) { return tfSatFalse(mask); } - + if (tfSatUseConditions(mask) && abCondKnown != NULL) { + TForm tfdomNew = ablogImpliedType(abCondKnown, dom, tfdom); + if (tfdomNew != NULL) { + tfsExportDEBUG(dbOut, "Domain switch: %pTForm --> %pTForm\n", tfdom, tfdomNew); + tfdom = tfdomNew; + } + } cat = cond->abHas.property; tfcat = abTForm(cat) ? abTForm(cat) : tiTopFns()->tiGetTopLevelTForm(ablogTrue(), cat); tfTestPush(tfdom, cond->abHas.property); - result = tfSat(mask, tfdom, tfcat); + result = tfSat1(mask, dom, tfdom, tfcat); tfTestPop(tfdom, cond->abHas.property); + tfsExportDEBUG(dbOut, " %d Check condition %pSyme %oBool)\n", serial, s, tfSatSucceed(result)); if (tfSatSucceed(result)) continue; else if (tfSatPending(result)) { @@ -1839,12 +1972,10 @@ tfSatConditions(SatMask mask, SymeList mods, Syme s, Syme t) 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); + tfsExportDEBUG(dbOut, "tfsExport: Check self condition %pSyme %pTForm %pAbSyn\n", s, symeType(s), property); + // Might as well say true as this is an export list.. need to retain + // in case it becomes true on import + return tfSatTrue(mask); } @@ -1921,66 +2052,110 @@ tfSatParents(SatMask mask, SymeList mods, AbSyn Sab, SymeList S, SymeList T) { SymeList newS = S, oldS = listNil(Syme); SymeList queue = listNil(Syme); + SymeTSet oldTbl = tsetCreateCustom(Syme)(symeHashFn, symeEqual); + int serialThis; + int iterThis; + + tfsSerialNo += 1; + serialThis = tfsSerialNo; /* Collect all of the missing exports. */ mask |= TFS_Missing; - tfsParentDEBUG(dbOut, "(->tfpSyme: %*s= source list: %pSymeList\n", - tfsDepthNo, "", S); + tfsParentDEBUG(dbOut, "(->tfpSyme: %*s%d = source list: %pSymeList\n", + tfsDepthNo, "", serialThis, S); while (newS || queue) { - T = tfSatExportsMissing(mask, mods, Sab, newS, T); + iterThis++; + SymeList currentS = newS; + T = tfSatExportsMissing(mask, mods, Sab, currentS, T); if (T == listNil(Syme)) { - tfsParentDEBUG(dbOut, " ->tfpSyme: %*s= No parents)\n", tfsDepthNo, ""); + tfsParentDEBUG(dbOut, " ->tfpSyme: %*s%d = No parents)\n", tfsDepthNo, "", serialThis); return tfSatTrue(mask); } - newS = tfSatParentsFilter(oldS, newS); - oldS = listNConcat(Syme)(oldS, newS); + newS = tfSatParentsFilterTable(oldTbl, currentS); queue = listNConcat(Syme)(queue, listCopy(Syme)(newS)); + tsetAddAll(Syme)(oldTbl, newS); if (queue) { Syme oldSyme = car(queue); - int serialThis; - tfsSerialNo += 1; - serialThis = tfsSerialNo; - - tfsParentDEBUG(dbOut, " ->tfpSyme: %*s%d= expanding: %pSyme\n", - tfsDepthNo, "", serialThis, oldSyme); + tfsParentDEBUG(dbOut, " ->tfpSyme: %*s%d.%d= expanding: %pSyme %pTForm %pAbSynList\n", + tfsDepthNo, "", serialThis, iterThis, oldSyme, + symeType(oldSyme), symeCondition(oldSyme)); newS = tfGetCatParents(symeType(oldSyme), true); + /* + if (symeCondition(oldSyme) != listNil(Sefo)) { + newS = symeListAddCondition(newS, abNewOfList(AB_And, sposNone, + (AbSynList) symeCondition(oldSyme)), true); + } + */ queue = cdr(queue); - tfsParentDEBUG(dbOut, " ->tfpSyme: %*s%d= into: %pSymeList\n", - tfsDepthNo, "", serialThis, newS); + tfsParentDEBUG(dbOut, " ->tfpSyme: %*s%d.%d= into: %pSymeList\n", + tfsDepthNo, "", serialThis, iterThis, newS); } else newS = listNil(Syme); } - tfsParentDEBUG(dbOut, " ->tfpSyme: %*s= Left: %pSymeList)\n", - tfsDepthNo, "", T); + tfsParentDEBUG(dbOut, " ->tfpSyme: %*s%d= Left: %pSymeList)\n", + tfsDepthNo, "", serialThis, T); if (T == listNil(Syme)) return tfSatTrue(mask); + tsetFree(Syme)(oldTbl); + while (T && tfsParentDebug) { + tfsParentDEBUG(dbOut, "%d Missing %pAbSyn %pSyme: %pTForm %pAbSynList\n", serialThis, Sab, car(T), + symeType(car(T)), + symeCondition(car(T))); + T = cdr(T); + } return tfSatResult(mask, TFS_ExportsMissing); } local SymeList -tfSatParentsFilter(SymeList osymes, SymeList nsymes) +tfSatParentsFilterTable(SymeTSet tbl, SymeList nsymes) { - SymeList symes, rsymes = listNil(Syme); - + SymeList symes, rsymes = listNil(Syme); /* Collect symes for %% which have not been seen before. */ for (symes = nsymes; symes; symes = cdr(symes)) if (symeIsSelfSelf(car(symes)) && - !symeListMember(car(symes), osymes, symeEqual)) + !tsetMember(Syme)(tbl, car(symes))) rsymes = listCons(Syme)(car(symes), rsymes); listFree(Syme)(nsymes); return listNReverse(Syme)(rsymes); + } + +local String +tfSatMaskToString(SatMask mask) +{ + String sep=""; + if (mask == TFS_Succeed) { + return "Success"; + } + else { + Buffer b = bufNew(); + OStream os = ostreamNewFrBuffer(b); + int i = 0; + + while (tfSatMaskInfo[i].name != 0) { + if (mask & (1<abExit.test; AbSyn value = absyn->abExit.value; AbLogic saveCond; - + Bool pushCond; titdn(stab, test, tfUnknown); - if (!tuniTdnSelectObj) { + pushCond = !tuniTdnSelectObj && abIsSefo(test); + if (pushCond) { /* See tibupExit for comments */ AbSyn nTest = abExpandDefs(stab, test); ablogAndPush(&abCondKnown, &saveCond, nTest, true); @@ -1378,7 +1381,7 @@ titdnExit(Stab stab, AbSyn absyn, TForm type) titdn0FarValue(stab, absyn, type, value, &tuniExitTForm, &abExitsList); - if (!tuniTdnSelectObj) + if (pushCond) ablogAndPop (&abCondKnown, &saveCond); return titdn0NoValue(stab, absyn, type, ALDOR_E_TinContextExit); diff --git a/aldor/aldor/src/tinfer.c b/aldor/aldor/src/tinfer.c index 403a74a9c..098b5d761 100644 --- a/aldor/aldor/src/tinfer.c +++ b/aldor/aldor/src/tinfer.c @@ -6,32 +6,34 @@ * ***************************************************************************/ +#include "ablogic.h" +#include "abpretty.h" +#include "comsg.h" #include "debug.h" #include "fluid.h" #include "format.h" +#include "lib.h" + #include "opsys.h" +#include "sefo.h" #include "spesym.h" #include "stab.h" #include "store.h" +#include "strops.h" +#include "syme.h" +#include "table.h" +#include "tconst.h" #include "terror.h" #include "tfcond.h" +#include "tfsat.h" #include "ti_bup.h" #include "ti_sef.h" #include "ti_tdn.h" #include "ti_top.h" #include "tinfer.h" -#include "syme.h" -#include "sefo.h" -#include "lib.h" -#include "tqual.h" -#include "tconst.h" #include "tposs.h" -#include "tfsat.h" -#include "ablogic.h" -#include "abpretty.h" -#include "comsg.h" -#include "strops.h" -#include "table.h" +#include "tqual.h" + /***************************************************************************** * diff --git a/aldor/aldor/src/tposs.c b/aldor/aldor/src/tposs.c index 4de21d0d1..3e10bf9bc 100644 --- a/aldor/aldor/src/tposs.c +++ b/aldor/aldor/src/tposs.c @@ -13,16 +13,16 @@ */ #include "axlobs.h" +#include "ablogic.h" #include "debug.h" #include "format.h" #include "spesym.h" #include "store.h" -#include "terror.h" #include "syme.h" #include "tconst.h" -#include "tposs.h" +#include "terror.h" #include "tfsat.h" -#include "ablogic.h" +#include "tposs.h" /* * Each node is given a set of possible meanings. @@ -88,14 +88,8 @@ tpossFrSymes(SymeList symes) TPoss tp = tpossEmpty(); for (; symes; symes = cdr(symes)) { -/* - if (car(symes)->type != NULL) - { -*/ - tpossAdd1(tp, symeType(car(symes))); -/* - } -*/ + Syme syme = car(symes); + tpossAdd1(tp, symeType(syme)); } return tp; } @@ -538,3 +532,8 @@ tpossIsHaving(TPoss tp, TFormPredicate pred) return false; } +TForm +tpossELT_(TPossIterator *ip) +{ + return car(ip->possl); +} diff --git a/aldor/aldor/src/tposs.h b/aldor/aldor/src/tposs.h index 9583d2a1e..3d636ea07 100644 --- a/aldor/aldor/src/tposs.h +++ b/aldor/aldor/src/tposs.h @@ -26,6 +26,7 @@ extern TPoss tpossFrSymes (SymeList); extern TPoss tpossDeclare (Syme, TPoss); extern TPoss tpossMulti (Length, Pointer, TPossGetter); extern TPoss tpossAdd1 (TPoss, TForm); +extern TPoss tpossFrTheList (TFormList); extern TPoss tpossRefer (TPoss); extern TPoss tpossCopy (TPoss); @@ -104,9 +105,11 @@ typedef struct { TFormList possl; } TPossIterator; +extern TForm tpossELT_(TPossIterator *ip); + #define tpossITER(ip,p) ((ip).possl = (p ? (p)->possl : NULL)) #define tpossMORE(ip) ((ip).possl) #define tpossSTEP(ip) ((ip).possl = cdr((ip).possl)) -#define tpossELT(ip) car((ip).possl) +#define tpossELT(ip) tpossELT_(&ip) #endif /* !_TPOSS_H_ */ diff --git a/aldor/aldor/src/tqual.c b/aldor/aldor/src/tqual.c index a7d82ffb5..5772a2665 100644 --- a/aldor/aldor/src/tqual.c +++ b/aldor/aldor/src/tqual.c @@ -6,18 +6,20 @@ * ****************************************************************************/ +#include "abpretty.h" #include "axlobs.h" +#include "comsg.h" +#include "debug.h" #include "format.h" +#include "lib.h" +#include "sefo.h" #include "spesym.h" #include "stab.h" #include "store.h" -#include "sefo.h" -#include "lib.h" -#include "tqual.h" -#include "abpretty.h" -#include "comsg.h" #include "strops.h" #include "symcoinfo.h" +#include "tqual.h" + Bool tqDebug = false; @@ -140,6 +142,14 @@ tqFree(TQual tq) stoFree(tq); } +int +tqPrintDb(TQual tq) +{ + int rc = tqPrint(dbOut, tq); + fnewline(dbOut); + return rc; +} + int tqPrint(FILE *fout, TQual tq) { diff --git a/aldor/aldor/src/tqual.h b/aldor/aldor/src/tqual.h index 6793009d5..e7e666156 100644 --- a/aldor/aldor/src/tqual.h +++ b/aldor/aldor/src/tqual.h @@ -68,6 +68,7 @@ extern TQual tqSetUnqualified (TQual); extern TQual tqAddQual (TQual, TForm); extern void tqFree (TQual); extern int tqPrint (FILE *, TQual); +extern int tqPrintDb (TQual); extern TQualStatus tqSetStatus (TQual, TQualStatus); extern SymeList tqGetQualImports (TQual); diff --git a/aldor/aldor/src/ttable.c b/aldor/aldor/src/ttable.c index c4a4a527c..2e6507b3d 100644 --- a/aldor/aldor/src/ttable.c +++ b/aldor/aldor/src/ttable.c @@ -3,10 +3,12 @@ #include "ttable.h" local PointerTSet ptrTSetCreate (void); +local PointerTSet ptrTSetCreateCustom(TblHashFun, TblEqFun); local PointerTSet ptrTSetEmpty (void); local void ptrTSetFree (PointerTSet); local Length ptrTSetSize (PointerTSet); local void ptrTSetAdd (PointerTSet, Pointer); +local void ptrTSetAddAll (PointerTSet, PointerList); local void ptrTSetRemove (PointerTSet, Pointer); local Bool ptrTSetMember (PointerTSet, Pointer); local Bool ptrTSetIsEmpty(PointerTSet); @@ -22,9 +24,11 @@ CREATE_TSET(Pointer); const struct TSetOpsStructName(Pointer) ptrTSetOps = { ptrTSetCreate, + ptrTSetCreateCustom, ptrTSetFree, ptrTSetSize, ptrTSetAdd, + ptrTSetAddAll, ptrTSetRemove, ptrTSetMember, ptrTSetIsEmpty, @@ -44,6 +48,14 @@ ptrTSetCreate() return tset; } +local PointerTSet +ptrTSetCreateCustom(TblHashFun hashfn, TblEqFun eqfn) +{ + PointerTSet tset = (PointerTSet) stoAlloc(OB_Other, sizeof(*tset)); + tset->table = tblNew(hashfn, eqfn); + return tset; +} + local PointerTSet ptrTSetEmpty() { @@ -85,6 +97,15 @@ ptrTSetAdd(PointerTSet tset, Pointer ptr) tblSetElt(tset->table, ptr, ptr); } +local void +ptrTSetAddAll(PointerTSet tset, PointerList ptrlist) +{ + while (ptrlist != listNil(Pointer)) { + tblSetElt(tset->table, car(ptrlist), car(ptrlist)); + ptrlist = cdr(ptrlist); + } +} + local void ptrTSetRemove(PointerTSet tset, Pointer ptr) { diff --git a/aldor/aldor/src/ttable.h b/aldor/aldor/src/ttable.h index cbff35ce4..5d3d2ac5d 100644 --- a/aldor/aldor/src/ttable.h +++ b/aldor/aldor/src/ttable.h @@ -1,6 +1,7 @@ #ifndef _TTABLE_H_ #define _TTABLE_H_ #include "cport.h" +#include "list.h" #include "ostream.h" #include "table.h" @@ -13,6 +14,8 @@ typedef struct tsetIter { TableIterator iter; } *ANY_TSetIter; Table table; \ } *TSet(Type); \ typedef ANY_TSetIter Type##TSetIter; \ + typedef Hash (*Type##TSetHashFn)(Type); \ + typedef Bool (*Type##TSetEqFn)(Type, Type); \ TSetOpsStruct(Type); \ extern struct TSetOpsStructName(Type) \ const *TSetOps(Type) \ @@ -27,10 +30,12 @@ struct TSetOpsStructName(Type) const *TSetOps(Type) = \ #endif #define tsetCreate(Type) (TSetOps(Type)->Create) +#define tsetCreateCustom(Type) (TSetOps(Type)->CreateCustom) #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 tsetAddAll(Type) (TSetOps(Type)->AddAll) #define tsetRemove(Type) (TSetOps(Type)->Remove) #define tsetMember(Type) (TSetOps(Type)->Member) #define tsetIsEmpty(Type) (TSetOps(Type)->IsEmpty) @@ -46,9 +51,11 @@ struct TSetOpsStructName(Type) const *TSetOps(Type) = \ #define TSetOpsStruct(Type) \ struct TSetOpsStructName(Type) { \ TSet(Type) (*Create) (void); \ + TSet(Type) (*CreateCustom) (Type##TSetHashFn, Type##TSetEqFn); \ void (*Free) (TSet(Type)); \ Length (*Size) (TSet(Type)); \ void (*Add) (TSet(Type), Type); \ + void (*AddAll) (TSet(Type), List(Type)); \ void (*Remove) (TSet(Type), Type); \ Bool (*Member) (TSet(Type), Type); \ Bool (*IsEmpty)(TSet(Type)); \ diff --git a/aldor/aldor/src/version.c b/aldor/aldor/src/version.c.in similarity index 87% rename from aldor/aldor/src/version.c rename to aldor/aldor/src/version.c.in index ac1f989b7..272a60943 100644 --- a/aldor/aldor/src/version.c +++ b/aldor/aldor/src/version.c.in @@ -22,7 +22,5 @@ CString verName = "Aldor"; -int verMajorVersion = 1; -int verMinorVersion = 3; -int verMinorFreeze = 0; +CString verVersionId = "@VERSION@"; CString verPatchLevel = VCSVERSION; diff --git a/aldor/aldor/src/version.h b/aldor/aldor/src/version.h index 0fee07080..2a826899c 100644 --- a/aldor/aldor/src/version.h +++ b/aldor/aldor/src/version.h @@ -14,9 +14,7 @@ * is used for the patch level. */ extern CString verName; -extern int verMajorVersion; -extern int verMinorVersion; -extern int verMinorFreeze; +extern CString verVersionId; extern CString verPatchLevel; #endif /* !_VERSION_H_ */ diff --git a/aldor/aldor/test/Makefile.in b/aldor/aldor/test/Makefile.in index 857c57faf..687333920 100644 --- a/aldor/aldor/test/Makefile.in +++ b/aldor/aldor/test/Makefile.in @@ -46,17 +46,25 @@ foamsrcdir = $(abs_top_srcdir)/aldor/lib/libfoam foamdir = $(abs_top_builddir)/aldor/lib/libfoam aptests := exquo -fmtests := rectest enumtest clos strtable1 simple apply nestcond silly cexp lself0 selfcond -ctests := rectest enumtest multinever maptuple +fmtests := rectest enumtest clos strtable1 simple apply \ + nestcond silly cexp lself0 selfcond lself \ + lself2 catdef2 args1a args1 args2a args2 +ctests := rectest enumtest multinever maptuple cimp1 otests := enumtest -xtests := enumtest jimport cross +xtests := enumtest jimport cross seq small + +out/ao/lself.ao: out/ao/lself0.ao +out/ao/lself2.ao: out/ao/lself0.ao +out/ao/args1.ao: out/ao/args1a.ao +out/ao/args2.ao: out/ao/args2a.ao @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 +@BUILD_JAVA_TRUE@jruntests := small jimport jimport_opt jimp0 jimp1 jlist jexport jexport1 jexport2 envname jexn jthrow x_extra := rtexns +cimp1_AXLFLAGS=-Q3 simple_j_AXLFLAGS=-Q2 jimport_opt_AXLFLAGS=-Q9 -Qinline-all @@ -66,6 +74,10 @@ jimport_opts := -Q3 jthrow_opts := -Q3 halt_opts := -Q3 jlist_opts := +lself_opts = -Y out/ao +lself2_opts = -Y out/ao +args1_opts = -Y out/ao +args2_opts = -Y out/ao jexport_extjava := aldor.stuff.Foo aldor.stuff.Bar jthrow_extjava := aldor.stuff.ExnThrow @@ -89,6 +101,8 @@ strtable1_AXLFLAGS=-Y$(foamdir)/al -I $(foamsrcdir)/al -lRuntimeLib=foam -Q9 clos_AXLFLAGS := -Q2 simple_AXLFLAGS=-O multinever_AXLFLAGS = -Q9 +args1_AXLFLAGS = +args2_AXLFLAGS = _aptests := $(sort $(aptests)) _ctests := $(sort $(ctests) $(otests)) @@ -175,11 +189,15 @@ define aldor_args -Fao=out/ao/$*.ao $(srcdir)/$*.as endef +.PHONY: all-ap +all-ap: $(patsubst %, out/ao/%.ap, $(_aotests)) $(patsubst %, out/ap/%.ap, $(_aotests)): out/ap/%.ap: %.as $(AM_V_ALDOR_AP) \ mkdir -p $$(dirname $@); \ $(aldorexedir)/aldor $(nfile) -Fap=$@ $(srcdir)/$*.as +.PHONY: all-ao +all-ao: $(patsubst %, out/ao/%.ao, $(_aotests)) $(patsubst %, out/ao/%.ao, $(_aotests)): $(aldorexedir)/aldor $(patsubst %, out/ao/%.ao, $(_aotests)): out/ao/%.ao: %.as $(AM_V_ALDOR) \ @@ -191,6 +209,8 @@ $(patsubst %, out/ao/%.cmd, $(_aotests)): out/ao/%.cmd: %.as mkdir -p $$(dirname $@); \ echo run '$(aldor_args)' > $@ +.PHONY: all-exe +all-exe: $(patsubst %, %.exe, $(_xtests)) $(patsubst %, %.exe, $(_xtests)): %.exe: %.o rtexns.o $(AM_V_ALDOR_EXE) \ rm -f $@; \ @@ -199,7 +219,7 @@ $(patsubst %, %.exe, $(_xtests)): %.exe: %.o rtexns.o -Y$(foamdir) \ -Y$(foamlibdir) \ -Lfoamlib \ - -Cargs="-Wconfig=$(aldorsrcdir)/aldor.conf -I$(aldorsrcdir) -Wv=2 $(UNICLFLAGS)" \ + -Cargs="-Wconfig=$(aldorsrcdir)/aldor.conf -I$(aldorsrcdir) $(UNICLFLAGS)" \ -Fx=$@ out/ao/$*.ao rtexns.o # -Fmain=bobthebuilder.c \ @@ -237,7 +257,6 @@ really-all: \ $(patsubst %,%.o,$(_otests)) \ $(patsubst %,%.exe,$(_xtests)) - .PHONY: all # @@ -245,7 +264,7 @@ really-all: \ # mostlyclean: rm -rf $(builddir)/out - rm -f $(patsubst %,%.o,$(otests)) + rm -f $(patsubst %,%.o,$(_otests)) clean: mostlyclean distclean: clean diff --git a/aldor/aldor/test/args1.as b/aldor/aldor/test/args1.as new file mode 100644 index 000000000..786941805 --- /dev/null +++ b/aldor/aldor/test/args1.as @@ -0,0 +1,12 @@ +#include "foamlib" +#pile +#library A1 "args1a.ao" +import from A1 + +ExprSpace: Category == with ExprSpace2P(Ker %) + +--ExprSpaceO: Category == with ExprSpace2P KerP + + +--f(K1: KerCat %): Integer == never + diff --git a/aldor/aldor/test/args1a.as b/aldor/aldor/test/args1a.as new file mode 100644 index 000000000..f10673daa --- /dev/null +++ b/aldor/aldor/test/args1a.as @@ -0,0 +1,13 @@ +#include "foamlib" +#pile + +KerCat(S: with): Category == with +KerCat1(S1: with): Category == with KerCat S1 + +Ker(T: with): KerCat1 T == add + +KerP: KerCat % with == Ker % add + +-- ExpressionSpace2(K : KernelCategory(%)) : Category == with +ExprSpace2K(K: with KerCat(K)): Category == with +ExprSpace2P(K: with KerCat(%)): Category == with diff --git a/aldor/aldor/test/args2.as b/aldor/aldor/test/args2.as new file mode 100644 index 000000000..2774efeab --- /dev/null +++ b/aldor/aldor/test/args2.as @@ -0,0 +1,9 @@ +#include "foamlib" +#pile +#library A1 "args2a.ao" +import from A1 + +ExprSpace: Category == with + ExprSpace2(Ker %) + Compble + diff --git a/aldor/aldor/test/args2a.as b/aldor/aldor/test/args2a.as new file mode 100644 index 000000000..83c9f0929 --- /dev/null +++ b/aldor/aldor/test/args2a.as @@ -0,0 +1,19 @@ +#include "foamlib" +#pile + +Compble: Category == with + >: (%, %) -> Boolean +OSet(A: with): Category == with + contains?: (%, A) -> Boolean + +-- KernelCategory(S : Comparable) : Category == Join(OrderedSet, Patternable S) +KerCat(S: Compble): Category == with + OSet S + +Ker(S: Compble): KerCat S with Compble == add + contains?(a: %, s: S): Boolean == never + (>)(a: %, b: %): Boolean == never + +-- ExpressionSpace2(K : KernelCategory(%)) : Category == with Comparable +KC ==> with Join(KerCat %, Compble) +ExprSpace2(K: KC): Category == with Compble diff --git a/aldor/aldor/test/catdef2.as b/aldor/aldor/test/catdef2.as new file mode 100644 index 000000000..077027491 --- /dev/null +++ b/aldor/aldor/test/catdef2.as @@ -0,0 +1,50 @@ +#include "foamlib" +#pile + +CommutativeStar: Category == with +noZeroDivisors: Category == with +Magma: Category == with + +LeftModule(L: SemiRng): Category == with +RightModule(L: SemiRng): Category == with + +BiModule(L: SemiRng, R: SemiRng): Category == with + LeftModule L + RightModule R + +AbelianSemiGroup: Category == with + NonAssociativeSemiRng + AbelianMonoid + +NonAssociativeSemiRing: Category == with + +NonAssociativeSemiRng: Category == with + +XMonoid: Category == with +SemiGroup: Category == with + +SemiRng: Category == with + NonAssociativeSemiRng + BiModule(%, %) + SemiGroup + +#if 0 +SemiRing: Category == Join(NonAssociativeSemiRing, SemiRng, XMonoid) with + +Algebra(R: CommutativeRing): Category == Ring with + +CommutativeRing: Category == with + Ring + Algebra % + CommutativeStar + +EntireRing: Category == with + Ring + noZeroDivisors + +IntegralDomain: Category == with + CommutativeRing + EntireRing + +Integer: IntegralDomain == never +#endif diff --git a/aldor/aldor/test/cimp1.as b/aldor/aldor/test/cimp1.as new file mode 100644 index 000000000..4517e8057 --- /dev/null +++ b/aldor/aldor/test/cimp1.as @@ -0,0 +1,20 @@ +#include "foamlib" +#pile + +import { Value: with } from Foreign C("valtest.h") + +import from Machine +import + valueNew: BSInt -> Value + valueFree: Value -> () + valueIncrement: (Value, Value) -> () + valueAsInt: Value -> BSInt + valueSet: (lhs: Value, rhs: Value) -> () +from Foreign C("valtest.h") + +test(): () == + import from MachineInteger + v1: Value := valueNew(coerce 22) + v2: Value := valueNew(coerce 1) + valueIncrement(v1, v2) + stdout << coerce valueAsInt v1 << newline diff --git a/aldor/aldor/test/jimp1.as b/aldor/aldor/test/jimp1.as new file mode 100644 index 000000000..942a0543d --- /dev/null +++ b/aldor/aldor/test/jimp1.as @@ -0,0 +1,16 @@ +#include "foamlib" +#pile + +import from Machine; + +APPLY(id, rhs) ==> { apply: (%, 'id') -> rhs; export from 'id' } + +import + System: with + currentTimeMillis: () -> Long + Long: with +from Foreign Java "java.lang" + +foo(): () == + import from System + l := currentTimeMillis() diff --git a/aldor/aldor/test/lself.as b/aldor/aldor/test/lself.as new file mode 100644 index 000000000..d52fd9717 --- /dev/null +++ b/aldor/aldor/test/lself.as @@ -0,0 +1,16 @@ +#include "foamlib" +#pile + +#library LSELF0 "lself0.ao" +import from LSELF0 + +Foo: XGroup with + foo: SUP % -> % +== add + 1: % == never + (a: %) * (b: %): % == never + foo(x: SUP %): % == + c: % := 1 + c * x + never + diff --git a/aldor/aldor/test/lself2.as b/aldor/aldor/test/lself2.as new file mode 100644 index 000000000..6d2a3b984 --- /dev/null +++ b/aldor/aldor/test/lself2.as @@ -0,0 +1,15 @@ +#include "foamlib" +#pile + +#library LSELF0 "lself0.ao" +import from LSELF0 + +SomeProperty: Category == with + +XRing: Category == with + if % has XBiModule(%) then SomeProperty + +XThing: with + XLeftModule(%) +== add + (a: %) * (b: %): % == never diff --git a/aldor/aldor/test/selfcond.as b/aldor/aldor/test/selfcond.as index 73a364a9e..7ecfcf6bb 100644 --- a/aldor/aldor/test/selfcond.as +++ b/aldor/aldor/test/selfcond.as @@ -17,7 +17,20 @@ SUP1(R: XGroup): SUPC R with (a: R) * (b: %): % == never (a: %) * (b: R): % == never + local Test1: with bar: SUP1 % -> % == add bar(x: SUP1 %): % == never + +local Test3: XGroup with + bar: % -> % + baz: SUP1 % -> % +== add + baz(x: SUP1 %): % == never + bar(x: %): % == + x: SUP1 % := never + never + + (a: %) * (b: %): % == never + 1: % == never diff --git a/aldor/aldor/test/seq.as b/aldor/aldor/test/seq.as new file mode 100644 index 000000000..edb055381 --- /dev/null +++ b/aldor/aldor/test/seq.as @@ -0,0 +1,16 @@ +#include "foamlib" +#pile + +zz: MachineInteger := 0 +foo(): () == + free zz + 1 = 1 => + stdout << "Set zz" << zzz() << newline + zz:= 1 + +zzz(): MachineInteger == zz + +foo() +stdout << "zz" << zz << newline + +if zz = 0 then never diff --git a/aldor/aldor/test/small.as b/aldor/aldor/test/small.as new file mode 100644 index 000000000..7306c3b51 --- /dev/null +++ b/aldor/aldor/test/small.as @@ -0,0 +1,17 @@ +#include "foamlib" +#pile + +Foo == Cross(T: Order, T) + +maximum(T: Order, tl: List T): T == + m: T := first tl + for x in tl repeat + if x > m then m := x + return m + +import from Boolean +import from SingleInteger +import from List Boolean, List SingleInteger + +stdout << maximum(Boolean, [true, false]) << newline +stdout << maximum(SingleInteger, [-1, -2, -3]) << newline diff --git a/aldor/configure b/aldor/configure index af0251f89..e91539273 100755 --- a/aldor/configure +++ b/aldor/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.71 for aldor 1.4. +# Generated by GNU Autoconf 2.71 for aldor 1.4.0. # # Report bugs to . # @@ -621,8 +621,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='aldor' PACKAGE_TARNAME='aldor' -PACKAGE_VERSION='1.4' -PACKAGE_STRING='aldor 1.4' +PACKAGE_VERSION='1.4.0' +PACKAGE_STRING='aldor 1.4.0' PACKAGE_BUGREPORT='aldor@xinutec.org' PACKAGE_URL='' @@ -1401,7 +1401,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures aldor 1.4 to adapt to many kinds of systems. +\`configure' configures aldor 1.4.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1472,7 +1472,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of aldor 1.4:";; + short | recursive ) echo "Configuration of aldor 1.4.0:";; esac cat <<\_ACEOF @@ -1600,7 +1600,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -aldor configure 1.4 +aldor configure 1.4.0 generated by GNU Autoconf 2.71 Copyright (C) 2021 Free Software Foundation, Inc. @@ -1818,7 +1818,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by aldor $as_me 1.4, which was +It was created by aldor $as_me 1.4.0, which was generated by GNU Autoconf 2.71. Invocation command line was $ $0$ac_configure_args_raw @@ -3167,7 +3167,7 @@ fi # Define the identity of the package. PACKAGE='aldor' - VERSION='1.4' + VERSION='1.4.0' printf "%s\n" "#define PACKAGE \"$PACKAGE\"" >>confdefs.h @@ -13459,7 +13459,7 @@ printf %s "checking Strict options for C compiler... " >&6; } $cfg_no_sign_compare $cfg_no_shift_negative_value" case "${CC}" in gcc*) - cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -Wno-error=clobbered -Wno-error=address" + cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -Wno-error=clobbered" ;; clang*) cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -fcolor-diagnostics -Wno-error=enum-conversion \ @@ -13807,7 +13807,7 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$safe_CFLAGS -git_build_id="" +gitid=false if test "$ld_has_build_id" = ""; then { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 @@ -13819,25 +13819,26 @@ fi if test ${enable_git_build_id+y} then : enableval=$enable_git_build_id; case "${enableval}" in - yes) git_build_id=1;; - no) git_build_id=0;; - *) as_fn_error $? "bad value ${enableval} for --enable-git-build-id" "$LINENO" 5 ;; - esac + yes) gitid=true;; + no) gitid=false;; + *) as_fn_error $? "bad value ${enableval} for --enable-git-build-id" "$LINENO" 5 ;; + esac else $as_nop if test -f $srcdir/../.git/config ; then gitid=true; else gitid=false; fi - if test $gitid = true; then git_build_id=1; fi fi # Git SHA1 hash as ld build-id. +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: gitid $gitid ld: $ld_has_build_id " >&5 +printf "%s\n" "$as_me: gitid $gitid ld: $ld_has_build_id " >&6;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking build id" >&5 printf %s "checking build id... " >&6; } -if test yes = "$ld_has_build_id" && test 1 = "$git_build_id"; then +if test yes = "$ld_has_build_id" && test true = "$gitid"; then VCSVERSION=`cd $srcdir; git rev-parse HEAD` build_id="-Wl,--build-id=0x$VCSVERSION" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: git: $VCSVERSION ld: yes" >&5 printf "%s\n" "git: $VCSVERSION ld: yes" >&6; } -elif test 1 = "$git_build_id"; then +elif test true = "$gitid"; then VCSVERSION=`cd $srcdir; git rev-parse HEAD` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: git: $VCSVERSION ld: no" >&5 printf "%s\n" "git: $VCSVERSION ld: no" >&6; } @@ -13851,7 +13852,7 @@ fi # Generate Makefiles -ac_config_files="$ac_config_files Makefile aldor/Makefile aldor/subcmd/Makefile 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 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 aldor/tools/unix/aldor aldor/tools/unix/gdb-aldor lib/Makefile 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 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 lib/aldor/test/Makefile 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 lib/algebra/src/numbers/Makefile lib/algebra/src/extree/Makefile lib/algebra/src/extree/operators/Makefile lib/algebra/src/extree/parser/Makefile 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 lib/algebra/src/mat/modular/compbug/Makefile lib/algebra/src/mat/linalg/Makefile lib/algebra/src/multpoly/multpolydata/Makefile lib/algebra/src/multpoly/exponent/Makefile lib/algebra/src/univpoly/categories/Makefile lib/algebra/src/mat/linalg2/Makefile lib/algebra/src/univpoly/Makefile lib/algebra/src/univpoly/gcd/Makefile lib/algebra/src/fraction/Makefile lib/algebra/src/series/Makefile lib/algebra/src/series/compbug/Makefile lib/algebra/src/mat/linalg3/Makefile lib/algebra/src/algext/Makefile lib/algebra/src/polyfactorp/Makefile lib/algebra/src/ffield/Makefile lib/algebra/src/polyfactor0/Makefile lib/algebra/src/multpoly/multpolycat/Makefile lib/algebra/src/multpoly/multpolydom/Makefile lib/algebra/src/multpoly/multpolypkg/Makefile lib/algebra/src/multpoly/multpolytest/Makefile lib/algebra/src/test/Makefile lib/algebra/test/Makefile lib/axllib/Makefile lib/axllib/include/Makefile lib/axllib/src/Makefile lib/axllib/src/al/Makefile lib/axllib/test/Makefile lib/axldem/Makefile lib/axldem/include/Makefile lib/axldem/src/Makefile lib/axldem/src/al/Makefile lib/axldem/test/Makefile lib/ax0/Makefile lib/ax0/include/Makefile lib/ax0/src/Makefile lib/ax0/src/al/Makefile lib/ax0/test/Makefile" +ac_config_files="$ac_config_files Makefile aldor/Makefile aldor/subcmd/Makefile aldor/subcmd/unitools/Makefile aldor/subcmd/testaldor/Makefile aldor/src/Makefile aldor/src/opsys_port.h aldor/src/version.c 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 aldor/tools/unix/aldor aldor/tools/unix/gdb-aldor lib/Makefile 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 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 lib/aldor/test/Makefile 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 lib/algebra/src/numbers/Makefile lib/algebra/src/extree/Makefile lib/algebra/src/extree/operators/Makefile lib/algebra/src/extree/parser/Makefile 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 lib/algebra/src/mat/modular/compbug/Makefile lib/algebra/src/mat/linalg/Makefile lib/algebra/src/multpoly/multpolydata/Makefile lib/algebra/src/multpoly/exponent/Makefile lib/algebra/src/univpoly/categories/Makefile lib/algebra/src/mat/linalg2/Makefile lib/algebra/src/univpoly/Makefile lib/algebra/src/univpoly/gcd/Makefile lib/algebra/src/fraction/Makefile lib/algebra/src/series/Makefile lib/algebra/src/series/compbug/Makefile lib/algebra/src/mat/linalg3/Makefile lib/algebra/src/algext/Makefile lib/algebra/src/polyfactorp/Makefile lib/algebra/src/ffield/Makefile lib/algebra/src/polyfactor0/Makefile lib/algebra/src/multpoly/multpolycat/Makefile lib/algebra/src/multpoly/multpolydom/Makefile lib/algebra/src/multpoly/multpolypkg/Makefile lib/algebra/src/multpoly/multpolytest/Makefile lib/algebra/src/test/Makefile lib/algebra/test/Makefile lib/axllib/Makefile lib/axllib/include/Makefile lib/axllib/src/Makefile lib/axllib/src/al/Makefile lib/axllib/test/Makefile lib/axldem/Makefile lib/axldem/include/Makefile lib/axldem/src/Makefile lib/axldem/src/al/Makefile lib/axldem/test/Makefile lib/ax0/Makefile lib/ax0/include/Makefile lib/ax0/src/Makefile lib/ax0/src/al/Makefile lib/ax0/test/Makefile" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure @@ -14452,7 +14453,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by aldor $as_me 1.4, which was +This file was extended by aldor $as_me 1.4.0, which was generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -14511,7 +14512,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ -aldor config.status 1.4 +aldor config.status 1.4.0 configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" @@ -14923,6 +14924,7 @@ do "aldor/subcmd/testaldor/Makefile") CONFIG_FILES="$CONFIG_FILES aldor/subcmd/testaldor/Makefile" ;; "aldor/src/Makefile") CONFIG_FILES="$CONFIG_FILES aldor/src/Makefile" ;; "aldor/src/opsys_port.h") CONFIG_FILES="$CONFIG_FILES aldor/src/opsys_port.h" ;; + "aldor/src/version.c") CONFIG_FILES="$CONFIG_FILES aldor/src/version.c" ;; "aldor/lib/Makefile") CONFIG_FILES="$CONFIG_FILES aldor/lib/Makefile" ;; "aldor/lib/libfoamlib/Makefile") CONFIG_FILES="$CONFIG_FILES aldor/lib/libfoamlib/Makefile" ;; "aldor/lib/libfoamlib/al/Makefile") CONFIG_FILES="$CONFIG_FILES aldor/lib/libfoamlib/al/Makefile" ;; diff --git a/aldor/configure.ac b/aldor/configure.ac index 8bb46a149..f6a750bbb 100644 --- a/aldor/configure.ac +++ b/aldor/configure.ac @@ -2,7 +2,7 @@ # Process this file with autoconf to produce a configure script. AC_PREREQ([2.68]) -AC_INIT([aldor],[1.4],[aldor@xinutec.org]) +AC_INIT([aldor],[1.4.0],[aldor@xinutec.org]) AC_CONFIG_MACRO_DIR([m4]) AC_CONFIG_SRCDIR([aldor/src/main.c]) AC_CONFIG_AUX_DIR([amaux]) @@ -100,6 +100,7 @@ AC_CONFIG_FILES( aldor/subcmd/testaldor/Makefile aldor/src/Makefile aldor/src/opsys_port.h + aldor/src/version.c aldor/lib/Makefile aldor/lib/libfoamlib/Makefile diff --git a/aldor/lib/aldor/src/Makefile.am b/aldor/lib/aldor/src/Makefile.am index ddbfe5459..e1939e49f 100644 --- a/aldor/lib/aldor/src/Makefile.am +++ b/aldor/lib/aldor/src/Makefile.am @@ -1,7 +1,7 @@ SUBDIRS = lang base arith datastruc util $(GMPDIR) lisp test @BUILD_JAVA_TRUE@JAVA_SUBDIRS = $(filter-out gmp, $(SUBDIRS)) -@BUILD_JAVA_TRUE@JAVA_TARGET = aldor.jar +@BUILD_JAVA_TRUE@JAVA_TARGET = aldor.jar aldor-sources.jar if GMP GMPDIR = gmp diff --git a/aldor/lib/aldor/src/Makefile.in b/aldor/lib/aldor/src/Makefile.in index 1aa3593b2..d13dcf6ce 100644 --- a/aldor/lib/aldor/src/Makefile.in +++ b/aldor/lib/aldor/src/Makefile.in @@ -527,7 +527,7 @@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ SUBDIRS = lang base arith datastruc util $(GMPDIR) lisp test @BUILD_JAVA_TRUE@JAVA_SUBDIRS = $(filter-out gmp, $(SUBDIRS)) -@BUILD_JAVA_TRUE@JAVA_TARGET = aldor.jar +@BUILD_JAVA_TRUE@JAVA_TARGET = aldor.jar aldor-sources.jar @GMP_TRUE@GMPDIR = gmp @GMP_TRUE@GMP_FILES = \ @GMP_TRUE@ gmp/sal_fltgmp.c \ @@ -623,8 +623,16 @@ 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_V_LIBSRCJAR = $(am__v_LIBSRCJAR_$(V)) +am__v_LIBSRCJAR_ = $(am__v_LIBSRCJAR_$(AM_DEFAULT_VERBOSITY)) +am__v_LIBSRCJAR_0 = @echo " LIBSRCJAR " $@; +AM_V_PREREQ = $(am__v_PREREQ_$(V)) +am__v_PREREQ_ = $(am__v_PREREQ_$(AM_DEFAULT_VERBOSITY)) +am__v_PREREQ_0 = @echo " PREREQ " $@; AM_CFLAGS = -I$(aldorsrcdir) CLEANFILES = lib$(libraryname).al $(datalib_DATA) +eq = $(and $(findstring $1,$2),$(findstring $2,$1)) +lst_prefix = $(warning 1 $1 2 $2)$(if $(or $(if $2,,xx), $(call eq,$1,$(firstword $2))),,$(firstword $2) $(call lst_prefix,$1,$(wordlist 2,$(words $2),$2))) aldorincdir = $(srcdir)/../include datalibdir = $(datadir)/lib datalib_DATA = libaldor.al aldor_gloop.ao $(JAVA_TARGET) #aldor_gloopd.ao @@ -1541,10 +1549,27 @@ lib$(libraryname).al: $(foreach i,$(SUBDIRS),$i/_sublib_$(libraryname).al) $(libraryname).jar: $(foreach i, $(JAVA_SUBDIRS),$i/$(libraryname).jar) $(AM_V_LIBJAR) \ rm -rf jar; \ - mkdir jar; \ + $(MKDIR_P) jar; \ for i in $(foreach j, $(JAVA_SUBDIRS),$j/$(libraryname).jar); \ do (cd jar; jar xf ../$$i); done; \ - (cd jar; jar cf ../$@ .) + (cd jar; jar cf ../$@ .); \ + rm -rf jar + +$(libraryname)-sources.jar: $(foreach i, $(JAVA_SUBDIRS),$i/$(libraryname).jar) + $(AM_V_LIBSRCJAR) \ + rm -rf sources-jar; \ + $(MKDIR_P) sources-jar; \ + for i in $(foreach j, $(JAVA_SUBDIRS),$j/$(libraryname)-sources.jar); \ + do (cd sources-jar; jar xf ../$$i); done; \ + (cd sources-jar; jar cf ../$@ .); \ + rm -rf sources-jar + +$(patsubst %,prereq-%,$(SUBDIRS)): prereq-%: + $(AM_V_PREREQ) \ + for dir in $(call lst_prefix,$*,$(SUBDIRS)); do \ + echo $$dir;\ + (cd $$dir; $(MAKE) $(AM_MAKEFLAGS) all || exit 1); \ + done %d.ao: %.as $(aldorexedir)/aldor libaldor.al $(aldorexedir)/aldor -DDEBUG \ diff --git a/aldor/lib/aldor/src/datastruc/Makefile.in b/aldor/lib/aldor/src/datastruc/Makefile.in index 998098574..a12bbf7ab 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/aldor/src/gmp/sal_fltgmp.as b/aldor/lib/aldor/src/gmp/sal_fltgmp.as index 2fddde86e..1b528e0bc 100644 --- a/aldor/lib/aldor/src/gmp/sal_fltgmp.as +++ b/aldor/lib/aldor/src/gmp/sal_fltgmp.as @@ -5,6 +5,8 @@ -- Copyright (c) Helene Prieto 2000 -- Copyright (c) INRIA 2000, Version 9-2-2000 -- Logiciel Salli ŠINRIA 2000, dans sa version du 9/2/2000 +-- +-- Updated: 2023 Peter Broadbery ------------------------------------------------------------------------------- #include "aldor" @@ -144,56 +146,70 @@ call to {\tt realloc}.} macro Rec32 == Record(pr:Z, sz:Z, expo:Z, lmbs:Pointer); macro Rec64 == Record(szpr:Z, expo:Z, lmbs:Pointer); - -- Cannot use the mpf_... names because they are macros in gmp.h + import { int: Type; mpf__srcptr: Type; mpz__ptr: Type; mpf__ptr: Type; } from Foreign C; + import { size__t: Type; mp__bitcnt__t: Type; Ptr: Type; LPtr: Type; int: Type } from Foreign C; + import { mp__ext__t: Type } from Foreign C; import { - ____gmpf__init: Rep -> (); - ____gmpf__clear:Rep -> (); - - ____gmpf__set__default__prec: Z -> (); - ____gmpf__get__default__prec: () -> Z; - ____gmpf__set__prec: (Rep,Z) -> (); - ____gmpf__get__prec: (Rep) -> Z; - ____gmpf__set: (Rep, Rep) -> (); - ____gmpf__set__ui: (Rep, Z) -> (); - ____gmpf__set__si: (Rep, Z) -> (); - ____gmpf__set__z: (Rep,GMPInteger) -> (); - ____gmpf__set__d: (Rep,DoubleFloat) -> (); - ____gmpf__set__str: (Rep, Pointer, Z) -> Z; - - ____gmpf__get__str: (Pointer, Pointer, Z, Z, Rep) -> Pointer; - - ____gmpf__add: (Rep,Rep,Rep) -> (); - ____gmpf__add__ui: (Rep,Rep,Z) -> (); - ____gmpf__sub: (Rep,Rep,Rep) -> (); - ____gmpf__sub__ui: (Rep,Rep,Z) -> (); - ____gmpf__mul: (Rep,Rep,Rep) -> (); - ____gmpf__mul__ui: (Rep,Rep,Z) -> (); - - ____gmpf__div: (Rep,Rep,Rep) -> (); - ____gmpf__ui__div: (Rep,Z,Rep) -> (); - ____gmpf__div__ui: (Rep,Rep,Z) -> (); - - ____gmpf__sqrt: (Rep,Rep) -> (); - ____gmpf__sqrt__ui: (Rep,Rep,Rep) -> (); - ____gmpf__pow__ui: (Rep,Rep,Z) -> (); - ____gmpf__neg: (Rep,Rep) -> (); - ____gmpf__abs: (Rep,Rep) -> (); - ____gmpf__mul__2exp: (Rep,Rep,Z) -> (); - ____gmpf__div__2exp: (Rep,Rep,Z) -> (); - ____gmpf__cmp: (Rep,Rep) -> Z; - ____gmpf__cmp__ui: (Rep,Z) -> Z; - ____gmpf__cmp__si: (Rep,Z) -> Z; - ____gmpf__sgn: Rep -> Z; - - ____gmpf__size: Rep -> Z; - ____gmpf__sizeinbase: (Rep,Z) -> Z; - - ____gmpf__trunc: (Rep,Rep) -> (); - - ____gmpf__out__str: (Pointer,Z,Z,Rep) -> (); - ____gmpf__inp__str:(Rep, Pointer,Z) -> (); + mpf__init: mpf__ptr -> (); + mpf__clear: mpf__ptr -> (); + + mpf__set__default__prec: mp__bitcnt__t -> (); + mpf__get__default__prec: () -> mp__bitcnt__t; + mpf__set__prec: (mpf__ptr,mp__bitcnt__t) -> (); + mpf__get__prec: mpf__srcptr -> mp__bitcnt__t; + mpf__set: (mpf__ptr, mpf__srcptr) -> (); + mpf__set__ui: (mpf__ptr, SInt$Machine) -> (); + mpf__set__si: (mpf__ptr, SInt$Machine) -> (); + mpf__set__z: (mpf__ptr, mpz__ptr) -> (); + mpf__set__d: (mpf__ptr, DFlo$Machine) -> (); + mpf__set__str: (mpf__ptr, Ptr, int) -> Z; + + mpf__get__str: (Ptr, LPtr, Z, Z, mpf__srcptr) -> Ptr; + + mpf__add: (mpf__ptr,mpf__srcptr,mpf__srcptr) -> (); + mpf__add__ui: (mpf__ptr,mpf__srcptr,Z) -> (); + mpf__sub: (mpf__ptr,mpf__srcptr,mpf__srcptr) -> (); + mpf__sub__ui: (mpf__ptr,mpf__srcptr,Z) -> (); + mpf__mul: (mpf__ptr,mpf__srcptr,mpf__srcptr) -> (); + mpf__mul__ui: (mpf__ptr,mpf__srcptr,mpf__srcptr,Z) -> (); + + mpf__div: (mpf__ptr,mpf__srcptr,mpf__srcptr) -> (); + mpf__ui__div: (mpf__ptr,Z,mpf__srcptr) -> (); + mpf__div__ui: (mpf__ptr,mpf__srcptr,Z) -> (); + + mpf__sqrt: (mpf__ptr,mpf__srcptr) -> (); + mpf__sqrt__ui: (mpf__ptr,mpf__srcptr,Z) -> (); + mpf__pow__ui: (mpf__ptr,mpf__srcptr,Z) -> (); + mpf__neg: (mpf__ptr,mpf__srcptr) -> (); + mpf__abs: (mpf__ptr,mpf__srcptr) -> (); + mpf__mul__2exp: (mpf__ptr,mpf__srcptr,Z) -> (); + mpf__div__2exp: (mpf__ptr,mpf__srcptr,Z) -> (); + mpf__cmp: (mpf__ptr,mpf__ptr) -> Z; + mpf__cmp__ui: (mpf__srcptr,Z) -> Z; + mpf__cmp__si: (mpf__srcptr,Z) -> Z; + mpf__sgn: mpf__srcptr -> Z; + + mpf__size: mpf__srcptr -> Z; + mpf__sizeinbase: (mpf__srcptr,Z) -> Z; + + mpf__trunc: (mpf__ptr, mpf__srcptr) -> (); + mpz__set__f: (mpz__ptr, mpf__srcptr) -> (); + mpf__get__d: mpf__ptr -> (DFlo$Machine); + + mpf__out__str: (Pointer,Z,Z,Rep) -> (); + mpf__inp__str:(Rep, Pointer,Z) -> (); } from Foreign C("gmp.h"); + local gmpIn(a: GMPInteger): mpz__ptr == a pretend mpz__ptr; + local gmpIn(a: %): mpf__srcptr == rep(a) pretend mpf__srcptr; + local gmpIn(a: %): mpf__ptr == rep(a) pretend mpf__ptr; + local gmpOut(a: mpf__srcptr): % == per(a pretend Rep); + + local gmpZIn(n: Z): mp__bitcnt__t == n pretend mp__bitcnt__t; + local gmpZIn(n: Z): int == n pretend int; + local gmpZOut(c: mp__bitcnt__t): Z == c pretend Z; + local gmpZOut(c: size__t): Z == c pretend Z; + import from Z,Rep; local wordsize:Z == bytes; @@ -204,19 +220,20 @@ call to {\tt realloc}.} local char0:Character == { import from String; char "0"; } local chare:Character == { import from String; char "e"; } - local nlimbs(a:%):Z == ____gmpf__size(rep a); + local nlimbs(a:%):Z == mpf__size(gmpIn(a)); new():% == { n: Pointer := { b64? => [0,0,nil]$Rec64 pretend Pointer; [0,0,0,nil]$Rec32 pretend Pointer; } - ____gmpf__init(n); + mpf__init(n pretend mpf__ptr); per n; } - -- HACK SINCE CANNOT USE ____gmpf__sgn BECAUSE IT IS A MACRO THAT TAKES + -- HACK SINCE CANNOT USE mpf__sgn BECAUSE IT IS A MACRO THAT TAKES -- A POINTER AND CANNOT BE USED WITH AN FiWord + local hi32:Z == shift(4294967295, 32); -- 32 1's and 32 0's sign(a:%):Z == { @@ -236,18 +253,18 @@ call to {\tt realloc}.} (rep(a) pretend Rec32).expo; } - free!(a:%): () == ____gmpf__clear(rep a); + free!(a:%): () == mpf__clear(gmpIn(a)); - precision(a:%): Z == ____gmpf__get__prec(rep a); + precision(a:%): Z == gmpZOut mpf__get__prec(gmpIn(a)); setPrecision!(a:%,b:Z): % == { - ____gmpf__set__prec(rep a,b); + mpf__set__prec(gmpIn(a), gmpZIn(b)); a; } - defaultPrecision():Z == ____gmpf__get__default__prec(); + defaultPrecision():Z == gmpZOut mpf__get__default__prec(); setDefaultPrecision(p:Z):Z == { old := defaultPrecision(); - ____gmpf__set__default__prec(p); + mpf__set__default__prec(gmpZIn p); old; } @@ -270,44 +287,41 @@ call to {\tt realloc}.} float(a:Literal):% == { e:% := new(); import from String; - ____gmpf__set__str(rep e, pointer(a pretend String), 10::Z); + mpf__set__str(gmpIn e, a pretend Ptr, gmpZIn(10::Z)); e; } - truncate(a:%): AldorInteger == { + truncate(a:%): AldorInteger == { import from GMPInteger; - import { - ____gmpz__set__f:(GMPInteger,Pointer) -> (); - } from Foreign C("gmp.h"); e:% := new(); res: GMPInteger := new(); - ____gmpf__trunc(rep e, rep a); - ____gmpz__set__f(res,rep e); + mpf__trunc(gmpIn e, gmpIn a); + mpz__set__f(gmpIn res, gmpIn e); res::AldorInteger; } fraction(a:%):% == { e:% := new(); - ____gmpf__trunc(rep e, rep a); + mpf__trunc(gmpIn e, gmpIn a); a-e; } copy(a:%): % == { e:% := new(); - ____gmpf__set(rep e,rep a); + mpf__set(gmpIn e, gmpIn a); e; } coerce(a:Z):% == { e:% := new(); - ____gmpf__set__si(rep e, a); + mpf__set__si(gmpIn e, a::(SInt$Machine)); e; } coerce(a:GMPInteger):% == { e:% := new(); - ____gmpf__set__z(rep e, a); + mpf__set__z(gmpIn e, gmpIn a); e; } @@ -323,114 +337,112 @@ call to {\tt realloc}.} coerce(a:DoubleFloat):% == { e:% := new(); - ____gmpf__set__d(rep e, a); + mpf__set__d(gmpIn e, a::(DFlo$Machine)); e; } + machine(x:%):DoubleFloat == { import from Machine, DoubleFloat; - import { - ____gmpf__get__d: Rep -> DFlo; - } from Foreign C("gmp.h"); - ____gmpf__get__d(rep x)::DoubleFloat; + mpf__get__d(gmpIn x)::DoubleFloat; } - =(a:%,b:%): Boolean == ____gmpf__cmp(rep a,rep b) = 0; - ~=(a:%,b:%): Boolean == ____gmpf__cmp(rep a,rep b) ~= 0; + =(a:%,b:%): Boolean == mpf__cmp(gmpIn a, gmpIn b) = 0; + ~=(a:%,b:%): Boolean == mpf__cmp(gmpIn a, gmpIn b) ~= 0; 0: % == { h:% := new(); - ____gmpf__set__si(rep h,0); + mpf__set__si(gmpIn h, 0::(SInt$Machine)); h; } 1: % == { g:% := new(); - ____gmpf__set__si(rep g,1); + mpf__set__si(gmpIn g,1::(SInt$Machine)); g; } (a:%) < (b:%):Boolean == { - r:Z := ____gmpf__cmp(rep a,rep b); + r:Z := mpf__cmp(gmpIn a, gmpIn b); r < 0; } (a:%) + (b:%):% == { e:% := new(); - ____gmpf__add(rep e,rep a,rep b); + mpf__add(gmpIn e, gmpIn a, gmpIn b); e; } (a:%) * (b:%):% == { e:% := new(); - ____gmpf__mul(rep e,rep a,rep b); + mpf__mul(gmpIn e, gmpIn a, gmpIn b); e; } (a:%) - (b:%):% == { e:% := new(); - ____gmpf__sub(rep e,rep a,rep b); + mpf__sub(gmpIn e, gmpIn a, gmpIn b); e; } -(a:%):% == { b:% := new(); - ____gmpf__sub(rep b, rep 0, rep a); + mpf__sub(gmpIn b, gmpIn 0, gmpIn a); b; } add!(a:%,b:%):% == { - ____gmpf__add(rep a,rep a,rep b); + mpf__add(gmpIn a, gmpIn a, gmpIn b); a; } times!(a:%,b:%):% == { - ____gmpf__mul(rep a,rep a,rep b); + mpf__mul(gmpIn a, gmpIn a, gmpIn b); a; } next(a:%):% == { e:%:=new(); - ____gmpf__add__ui(rep e, rep a, 1::Z); + mpf__add__ui(gmpIn e, gmpIn a, 1::Z); e; } prev(a:%):% == { e:% := new(); - ____gmpf__sub__ui(rep e, rep a, 1::Z); + mpf__sub__ui(gmpIn e, gmpIn a, 1::Z); e; } (a:%) > (b:%):Boolean == ~(a<=b); - (a:%) <= (b:%):Boolean == ____gmpf__cmp(rep a,rep b) <= 0; - (a:%) >= (b:%):Boolean == ____gmpf__cmp(rep a,rep b) >= 0; + (a:%) <= (b:%):Boolean == mpf__cmp(gmpIn a, gmpIn b) <= 0; + (a:%) >= (b:%):Boolean == mpf__cmp(gmpIn a, gmpIn b) >= 0; max(a:%,b:%):% == {a < b => b; a}; min(a:%,b:%):% == {a < b => a; b}; minus!(a:%):% == -a; minus!(a:%,b:%):% == a-b; - zero?(a:%):Boolean == ____gmpf__cmp(rep a, rep 0) = 0; - one?(a:%):Boolean == ____gmpf__cmp(rep a, rep 1) = 0; + zero?(a:%):Boolean == mpf__cmp(gmpIn a, gmpIn 0) = 0; + one?(a:%):Boolean == mpf__cmp(gmpIn a, gmpIn 1) = 0; abs(a:%):% == { b:% := new(); - ____gmpf__abs(rep b,rep a); + mpf__abs(gmpIn b, gmpIn a); b; } (a:%) ^ (b:Z): % == { e:% := new(); - ____gmpf__pow__ui(rep e,rep a, b); + mpf__pow__ui(gmpIn e, gmpIn a, b); e; } (a:%) / (b:%): % == { e:% := new(); - ____gmpf__div(rep e, rep a, rep b); + mpf__div(gmpIn e, gmpIn a, gmpIn b); e; } @@ -439,7 +451,7 @@ call to {\tt realloc}.} writelimbs!(p << exponent x, sign x, nlimbs x, limbs x); } - << (p:BinaryReader):% == { + << (p:BinaryReader):% == { import from GMPTools, Rec32, Rec64; xpo:Z := << p; -- read exponent first sgn:Z := << p; -- read sign @@ -459,7 +471,7 @@ call to {\tt realloc}.} (rec pretend Rec32).pr := s; (rec pretend Rec32).sz := s; } - if sgn < 0 then ____gmpf__neg(rep x, rep x); + if sgn < 0 then mpf__neg(gmpIn x, gmpIn x); x; } @@ -467,8 +479,8 @@ call to {\tt realloc}.} macro PZ == Record(z:Z); import from Z, Character, String, Pointer; pexp:PZ := [0]; - ptr := ____gmpf__get__str(nil, pexp pretend Pointer,10,0,rep x); - s := string ptr; + ptr := mpf__get__str((nil$Pointer) pretend Ptr, pexp pretend LPtr, 10, 0, gmpIn x); + s := ptr pretend String; n:Z := 0; if s.0 = minus then { p := p << minus; @@ -479,6 +491,7 @@ call to {\tt realloc}.} p << "e" << pexp.z; } +#if 0 local scanfloat(p:TextReader):List Character == { import from Character, String; local c:Character; @@ -531,8 +544,38 @@ call to {\tt realloc}.} i := next i; } e := new(); - ____gmpf__set__str(rep e, pointer s, 10); + mpf__set__str(rep e, pointer s, 10); e; } - +#endif } + + +#if ALDORTEST +---------------------- test sal_intgmp.as -------------------------- +#include "aldor" +#include "aldortest" +#pile + +import from Assert GMPFloat +import from Assert Integer +import from Assert String +import from Assert Boolean +import from GMPFloat +import from Integer +Z ==> GMPInteger + +local test():Boolean == + assertEquals(12345, truncate 12345.0) + true + +test1(): Boolean == + f: GMPFloat := 1.0 + assertTrue(-f < f) + assertTrue(f < f+f) + true + +test() +test1() + +#endif diff --git a/aldor/lib/aldor/src/gmp/sal_intgmp.as b/aldor/lib/aldor/src/gmp/sal_intgmp.as index 31fbe5157..8e37cd310 100644 --- a/aldor/lib/aldor/src/gmp/sal_intgmp.as +++ b/aldor/lib/aldor/src/gmp/sal_intgmp.as @@ -76,7 +76,7 @@ as parameters to explicit calls to {\tt mpz\_} functions.} export from IntegerSegment %; == add - import { int: Type; mpz__srcptr: Type; mpz__ptr: Type } from Foreign C; + import { int: Type; mpz__srcptr: Type; mpz__ptr: Type; mpf__ptr: Type; Ptr: Type } from Foreign C("gmp.h") import mpz__add: (mpz__ptr, mpz__srcptr, mpz__srcptr) -> () mpz__and: (mpz__ptr, mpz__srcptr, mpz__srcptr) -> () @@ -95,7 +95,7 @@ as parameters to explicit calls to {\tt mpz\_} functions.} mpz__pow__ui: (mpz__ptr, mpz__srcptr, int) -> () mpz__scan1: (mpz__srcptr, Z) -> Z mpz__set__si: (mpz__ptr, MachineInteger) -> () - mpz__set__str: (mpz__ptr, Pointer, int) -> () + mpz__set__str: (mpz__ptr, Ptr, int) -> () mpz__sign: mpz__ptr -> () mpz__sizeinbase: (mpz__srcptr, int) -> int mpz__size: (mpz__ptr) -> int @@ -146,7 +146,7 @@ as parameters to explicit calls to {\tt mpz\_} functions.} integer(l: Literal): % == e: % := new() - mpz__set__str(gmpIn e, l pretend Pointer, (10@MachineInteger) pretend int) + mpz__set__str(gmpIn e, l pretend Ptr, (10@MachineInteger) pretend int) return e bit?(a: %, n: Z): Boolean == diff --git a/aldor/lib/aldor/src/lisp/sal_sexpr.as b/aldor/lib/aldor/src/lisp/sal_sexpr.as index dd124b7be..bf58190a1 100644 --- a/aldor/lib/aldor/src/lisp/sal_sexpr.as +++ b/aldor/lib/aldor/src/lisp/sal_sexpr.as @@ -54,6 +54,7 @@ SExpression: Join(InputType, OutputType, PrimitiveType) with sexpr: String -> % sexpr: Cons -> % nil: % + list?: % -> Boolean cons?: % -> Boolean int?: % -> Boolean str?: % -> Boolean @@ -92,6 +93,8 @@ SExpression: Join(InputType, OutputType, PrimitiveType) with sexpr(str: String): % == per [str] sexpr(cons: Cons): % == per [cons] + list? sx: Boolean == nil? sx or cons? sx + 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 @@ -268,26 +271,30 @@ FnLStream(T: Type): LStream T with SExpressionReader: with - read: (TextReader) -> Partial SExpression; + read: (TextReader) -> Partial SExpression; + readCased: (TextReader) -> Partial SExpression; == add Token == Record(type: 'sym,escsym,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 - if hasNext? s then readOneToken! s else failed + read(rdr: TextReader): Partial SExpression == read(rdr, false) + readCased(rdr: TextReader): Partial SExpression == read(rdr, true) - read(rdr: TextReader): Partial SExpression == + local read(rdr: TextReader, cased: Boolean): Partial SExpression == import from TextLStream import from FnLStream Token s := tstream rdr tokstrm := tstream((): Partial Token +-> readOneToken! s) - sxMaybe: Partial SExpression := read(tokstrm) + sxMaybe: Partial SExpression := read(tokstrm, cased) sxMaybe - readOneToken!(s: TextLStream): Partial Token == + local readOneToken(rdr: TextReader, cased: Boolean): Partial Token == + import from TextLStream + s := tstream rdr + if hasNext? s then readOneToken! s else failed + + local readOneToken!(s: TextLStream): Partial Token == import from Character not hasNext? s => failed c := peek s; @@ -314,7 +321,7 @@ SExpressionReader: with stdout << "Unknown token prefix " << c << newline failed - readString(s: TextLStream): Token == + local readString(s: TextLStream): Token == buffer: StringBuffer := new() writer: TextWriter := coerce buffer next! s @@ -328,7 +335,7 @@ SExpressionReader: with next! s [str, string buffer] - readReference(s: TextLStream): Token == + local readReference(s: TextLStream): Token == next! s text := "" while hasNext? s and digit? peek s repeat @@ -340,7 +347,7 @@ SExpressionReader: with if peek s = char "#" then next! s [getref, text] - readWhitespace(s: TextLStream): Token == + local readWhitespace(s: TextLStream): Token == buffer: StringBuffer := new() writer: TextWriter := coerce buffer import from Character @@ -351,7 +358,7 @@ SExpressionReader: with next! s [ws, string buffer] - readEscaped(s: TextLStream): Token == + local readEscaped(s: TextLStream): Token == import from Character buffer: StringBuffer := new() writer: TextWriter := coerce buffer @@ -364,13 +371,13 @@ SExpressionReader: with next! s [escsym, string buffer] - readBackslashEscaped(s: TextLStream): Token == + local readBackslashEscaped(s: TextLStream): Token == next! s text := peek(s)::String next! s [escsym, text] - readNumber(s: TextLStream): Token == + local readNumber(s: TextLStream): Token == buffer: StringBuffer := new() writer: TextWriter := coerce buffer while hasNext? s and numberPart? peek s repeat @@ -378,7 +385,7 @@ SExpressionReader: with next! s [number, string buffer] - readSymbol(s: TextLStream): Token == + local readSymbol(s: TextLStream): Token == buffer: StringBuffer := new() writer: TextWriter := coerce buffer while hasNext? s and symPart? peek s repeat @@ -386,7 +393,7 @@ SExpressionReader: with next! s [sym, string buffer] - read(s: FnLStream Token): Partial SExpression == + local read(s: FnLStream Token, cased: Boolean): Partial SExpression == import from SExpression, Symbol tbl: HashTable(String, SExpression) := table() setref!(id: String, psx: Partial SExpression): Partial SExpression == @@ -458,7 +465,7 @@ 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])] + [if cased then sexpr(-tok.txt) else 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] @@ -498,72 +505,72 @@ test(): () == assertEquals(foo, retract sxMaybe) sxMaybe := readOne("23") - stdout << "SX: " << sxMaybe << newline + --stdout << "SX: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals(sexpr 23, retract sxMaybe) sxMaybe := readOne( "_"hello_"") - stdout << "SX: " << sxMaybe << newline + --stdout << "SX: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals(sexpr "hello", retract sxMaybe) sxMaybe := readOne("(foo)") - stdout << "SX: " << sxMaybe << newline + --stdout << "SX: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals(cons(foo, nil), retract sxMaybe) sxMaybe := readOne("(foo 2)") - stdout << "SX: " << sxMaybe << newline + --stdout << "SX: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals(cons(foo, cons(sexpr 2, nil)), retract sxMaybe) sxMaybe := readOne("(foo . 2)") - stdout << "SX: " << sxMaybe << newline + --stdout << "SX: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals(cons(foo, sexpr 2), retract sxMaybe) sxMaybe := readOne("|+->|") - stdout << "SX: " << sxMaybe << newline + --stdout << "SX: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals(sexpr (-"+->"), retract sxMaybe) sxMaybe := readOne("(foo () 2)") - stdout << "SX: " << sxMaybe << newline + --stdout << "SX: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals([sexpr(-"FOO"), [], sexpr 2], retract sxMaybe) sxMaybe := readOne("symbol?") - stdout << "SX: " << sxMaybe << newline + --stdout << "SX: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals(sexpr(-"SYMBOL?"), retract sxMaybe) sxMaybe := readOne("_"hello\_"_"") - stdout << "strsx: " << sxMaybe << newline + --stdout << "strsx: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals(sexpr("hello_""), retract sxMaybe) sxMaybe := readOne("_"\\_"") - stdout << "strsx: " << sxMaybe << newline + --stdout << "strsx: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals(sexpr("\"), retract sxMaybe) sxMaybe := readOne("|\||") - stdout << "strsx: " << sxMaybe << newline + --stdout << "strsx: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals(sexpr(-"|"), retract sxMaybe) sxMaybe := readOne("|__\|__|") - stdout << "strsx: " << sxMaybe << newline + --stdout << "strsx: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals(sexpr(-"__|__"), retract sxMaybe) sxMaybe := readOne("'x") - stdout << "strsx: " << sxMaybe << newline + --stdout << "strsx: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals([sexpr(-"QUOTE"), sexpr(-"X")], retract sxMaybe) sxMaybe := readOne("(((foo) . 1) ((|bar|) . 2))") - stdout << "strsx: " << sxMaybe << newline + --stdout << "strsx: " << sxMaybe << newline assertFalse failed? sxMaybe assertEquals([cons([sexpr(-"FOO")], sexpr 1), cons([sexpr(-"bar")], sexpr 2)], retract sxMaybe) diff --git a/aldor/lib/aldor/src/test/tst_assert.as b/aldor/lib/aldor/src/test/tst_assert.as index bd7297d02..01d8acce9 100644 --- a/aldor/lib/aldor/src/test/tst_assert.as +++ b/aldor/lib/aldor/src/test/tst_assert.as @@ -93,7 +93,6 @@ Assert(F: (X: Type) -> BoundedFiniteDataStructureType X, D: Type): with { 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); diff --git a/aldor/lib/algebra/src/Makefile.am b/aldor/lib/algebra/src/Makefile.am index 454ac4928..cc74c2598 100644 --- a/aldor/lib/algebra/src/Makefile.am +++ b/aldor/lib/algebra/src/Makefile.am @@ -35,7 +35,7 @@ SUBDIRS = \ test @BUILD_JAVA_TRUE@JAVA_SUBDIRS = $(SUBDIRS) -@BUILD_JAVA_TRUE@JAVA_TARGET = algebra.jar +@BUILD_JAVA_TRUE@JAVA_TARGET = algebra.jar algebra-sources.jar lib_LIBRARIES = libalgebra.a diff --git a/aldor/lib/algebra/src/Makefile.in b/aldor/lib/algebra/src/Makefile.in index 6dd2df4a5..33877f489 100644 --- a/aldor/lib/algebra/src/Makefile.in +++ b/aldor/lib/algebra/src/Makefile.in @@ -946,7 +946,7 @@ SUBDIRS = \ test @BUILD_JAVA_TRUE@JAVA_SUBDIRS = $(SUBDIRS) -@BUILD_JAVA_TRUE@JAVA_TARGET = algebra.jar +@BUILD_JAVA_TRUE@JAVA_TARGET = algebra.jar algebra-sources.jar lib_LIBRARIES = libalgebra.a libalgebra_a_SOURCES = algext/sit_algext.c algext/sit_sae.c \ algext/sit_saexcpt.c algext/sit_upmod.c \ @@ -1078,8 +1078,16 @@ 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_V_LIBSRCJAR = $(am__v_LIBSRCJAR_$(V)) +am__v_LIBSRCJAR_ = $(am__v_LIBSRCJAR_$(AM_DEFAULT_VERBOSITY)) +am__v_LIBSRCJAR_0 = @echo " LIBSRCJAR " $@; +AM_V_PREREQ = $(am__v_PREREQ_$(V)) +am__v_PREREQ_ = $(am__v_PREREQ_$(AM_DEFAULT_VERBOSITY)) +am__v_PREREQ_0 = @echo " PREREQ " $@; AM_CFLAGS = -I$(aldorsrcdir) CLEANFILES = lib$(libraryname).al +eq = $(and $(findstring $1,$2),$(findstring $2,$1)) +lst_prefix = $(warning 1 $1 2 $2)$(if $(or $(if $2,,xx), $(call eq,$1,$(firstword $2))),,$(firstword $2) $(call lst_prefix,$1,$(wordlist 2,$(words $2),$2))) all: all-recursive .SUFFIXES: @@ -3003,10 +3011,27 @@ lib$(libraryname).al: $(foreach i,$(SUBDIRS),$i/_sublib_$(libraryname).al) $(libraryname).jar: $(foreach i, $(JAVA_SUBDIRS),$i/$(libraryname).jar) $(AM_V_LIBJAR) \ rm -rf jar; \ - mkdir jar; \ + $(MKDIR_P) jar; \ for i in $(foreach j, $(JAVA_SUBDIRS),$j/$(libraryname).jar); \ do (cd jar; jar xf ../$$i); done; \ - (cd jar; jar cf ../$@ .) + (cd jar; jar cf ../$@ .); \ + rm -rf jar + +$(libraryname)-sources.jar: $(foreach i, $(JAVA_SUBDIRS),$i/$(libraryname).jar) + $(AM_V_LIBSRCJAR) \ + rm -rf sources-jar; \ + $(MKDIR_P) sources-jar; \ + for i in $(foreach j, $(JAVA_SUBDIRS),$j/$(libraryname)-sources.jar); \ + do (cd sources-jar; jar xf ../$$i); done; \ + (cd sources-jar; jar cf ../$@ .); \ + rm -rf sources-jar + +$(patsubst %,prereq-%,$(SUBDIRS)): prereq-%: + $(AM_V_PREREQ) \ + for dir in $(call lst_prefix,$*,$(SUBDIRS)); do \ + echo $$dir;\ + (cd $$dir; $(MAKE) $(AM_MAKEFLAGS) all || exit 1); \ + done # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. diff --git a/aldor/lib/algebra/src/categories/sit_intgmp.as b/aldor/lib/algebra/src/categories/sit_intgmp.as index 94d5c88d5..166c93df8 100644 --- a/aldor/lib/algebra/src/categories/sit_intgmp.as +++ b/aldor/lib/algebra/src/categories/sit_intgmp.as @@ -8,13 +8,18 @@ #include "algebrauid" extend GMPInteger: IntegerCategory == add { - import { - mpz__divexact: (%,%,%) -> (); - mpz__gcdext: (%,%,%,%,%) -> (); - mpz__tdiv__r: (%,%,%) -> (); - mpz__tdiv__qr: (%,%,%,%) -> (); + import { int: Type; mpz__srcptr: Type; mpz__ptr: Type; mpf__ptr: Type; Ptr: Type } from Foreign C("gmp.h"); + import { + mpz__divexact: (mpz__ptr, mpz__srcptr,mpz__srcptr) -> (); + mpz__gcdext: (mpz__ptr,mpz__ptr,mpz__ptr,mpz__srcptr, mpz__srcptr) -> (); + mpz__tdiv__r: (mpz__ptr,mpz__srcptr, mpz__srcptr) -> (); + mpz__tdiv__qr: (mpz__ptr,mpz__ptr,mpz__srcptr,mpz__srcptr) -> (); } from Foreign C("gmp.h"); + local gmpIn(a: %): mpz__srcptr == a pretend mpz__srcptr; + local gmpIn(a: %): mpz__ptr == a pretend mpz__ptr; + local gmpOut(a: mpz__srcptr): % == a pretend %; + #if GMP -- Those 2 assume that Integer == GmpInteger integer(u:%):Integer == u; @@ -29,7 +34,7 @@ extend GMPInteger: IntegerCategory == add { remainder!(a:%, b:%):% == { zero? a => 0; one? a => { unit? b => 0; 1 } - mpz__tdiv__r(a, a, b); + mpz__tdiv__r(gmpIn a, gmpIn a, gmpIn b); a; } @@ -42,22 +47,27 @@ extend GMPInteger: IntegerCategory == add { } if zero? q or one? q then q := new(); r:% := new(); - mpz__tdiv__qr(q, r, a, b); + mpz__tdiv__qr(gmpIn q, gmpIn r, gmpIn a, gmpIn b); (q, r); } quotient(x:%, y:%): % == { one? y => x; q:% := new(); - mpz__divexact(q,x,y); + mpz__divexact(gmpIn q, gmpIn x, gmpIn y); q; } - extendedEuclidean(a:%, b:%): (%,%,%) == { - import from MachineInteger; + local gcdext(a: %, b: %): (%, %) == { g:% := new(); s:% := new(); - mpz__gcdext(g,s,NULL,a,b); + mpz__gcdext(gmpIn g, gmpIn s,gmpIn(NULL), gmpIn a, gmpIn b); + (g, s) + } + + extendedEuclidean(a:%, b:%): (%,%,%) == { + import from MachineInteger; + (g, s) := gcdext(a, b); s := remainder!(s, b); (g, s, quotient(g - a * s, b)); } @@ -73,9 +83,7 @@ extend GMPInteger: IntegerCategory == add { failed?(u := exactQuotient(c, b)) => failed; [(0, retract u)]; } - g:% := new(); - s:% := new(); - mpz__gcdext(g,s,NULL,a,b); + (g, s) := gcdext(a, b); failed?(u := exactQuotient(c, g)) => failed; s := remainder!(times!(s, retract u), b); [s, quotient(c - a * s, b)]; @@ -85,9 +93,7 @@ extend GMPInteger: IntegerCategory == add { assert(~zero? m); zero?(b := b rem m) => [0]; zero?(a := a rem m) => failed; - g:% := new(); - c:% := new(); - mpz__gcdext(g,c,NULL,a,m); + (g, c) := gcdext(a, m); failed?(u := exactQuotient(b, g)) => u; [remainder!(times!(c, retract u), m)]; } diff --git a/aldor/lib/algebra/src/extree/Makefile.in b/aldor/lib/algebra/src/extree/Makefile.in index 2dfada14b..86cebbe79 100644 --- a/aldor/lib/algebra/src/extree/Makefile.in +++ b/aldor/lib/algebra/src/extree/Makefile.in @@ -22,7 +22,9 @@ otherfiles := alg_leaf alg_op include $(abs_top_srcdir)/lib/algebra/src/common.mk -install-data: +local-install-targets=local-install-data + +local-install-data: $(MKDIR_P) $(DESTDIR)$(datarootdir)/aldor/lib/$(libraryname)/$(libsubdir) for i in $(otherfiles); do \ if test -f $(abs_srcdir)/$$i.as; then \ diff --git a/aldor/lib/algebra/src/numbers/sit_primes.as b/aldor/lib/algebra/src/numbers/sit_primes.as index 04a4f12dc..c6f197105 100644 --- a/aldor/lib/algebra/src/numbers/sit_primes.as +++ b/aldor/lib/algebra/src/numbers/sit_primes.as @@ -16,8 +16,12 @@ macro Z == MachineInteger; PrimesSmall: PrimeTable == add { import from Z; + local smallPrimes: () -> Array Z; + local primitiveRoots: () -> Array Z; + -- the first 1000 odd primes - primes:Array Z == [_ + primes:Array Z == smallPrimes(); + smallPrimes(): Array Z == [_ 3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,_ 61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,_ 149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,_ @@ -101,7 +105,11 @@ PrimesSmall: PrimeTable == add { 7901,7907,7919,7927]; -- primitive roots for the above primes - roots:Array Z == [ + roots: Array Z == primitiveRoots(); + -- small primes of the form 2^n k + 1 for n = 1,2,..., + fourier:Array Z == []; + + primitiveRoots(): Array Z == [ 2,2,3,2,2,3,2,5,2,3,2,6,3,5,2,2,2,2,7,5,3,2,3,5,_ 2,5,2,6,3,3,2,3,2,2,6,5,2,5,2,2,2,19,5,2,3,2,3,2,6,3,7,7,6,3,_ 5,2,6,5,3,3,2,5,17,10,2,3,10,2,2,3,7,6,2,2,5,2,5,3,21,2,2,7,5,_ @@ -138,8 +146,6 @@ PrimesSmall: PrimeTable == add { 3,7,2,2,2,13,13,2,3,5,2,6,2,5,2,7,2,3,2,3,17,6,2,3,5,2,3,5,7,_ 10,2,3,2,3,3,5,2,12,2,3,5,2,3,2,2,2,7,3]; - -- small primes of the form 2^n k + 1 for n = 1,2,..., - fourier:Array Z == []; } Primes13: PrimeTable == add { diff --git a/aldor/lib/algebra/src/test/Makefile.in b/aldor/lib/algebra/src/test/Makefile.in index ca04a7a01..f1d2b6658 100644 --- a/aldor/lib/algebra/src/test/Makefile.in +++ b/aldor/lib/algebra/src/test/Makefile.in @@ -18,13 +18,18 @@ subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) library = alg_assert tst_test tst_ring tests = tst_random tst_complex tst_mint tst_int tst_fold tst_dup doc_poly doc_intpoly doc_series +include $(abs_top_srcdir)/mk/step.mk include $(abs_top_srcdir)/lib/algebra/src/common.mk +STEPS := ALDORINTERP +$(call am_define_steps, $(STEPS)) + check: $(addsuffix .test,$(tests)) .PHONY: $(addsuffix .test,$(tests)) $(addsuffix .test,$(tests)): %.test: %.ao + $(AM_V_ALDORINTERP) \ cp $(SUBLIB_DEPEND).al lib$(libraryname)_$*.al; \ ${AR} r lib$(libraryname)_$*.al $(addsuffix .ao, $(shell $(UNIQ) $*.dep)); \ $(DBG) $(aldorexedir)/aldor \ diff --git a/aldor/lib/ax0/include/ax0.as b/aldor/lib/ax0/include/ax0.as index 310550704..69e9b9aa5 100644 --- a/aldor/lib/ax0/include/ax0.as +++ b/aldor/lib/ax0/include/ax0.as @@ -13,7 +13,7 @@ macro { --import from Integer, PositiveInteger, NonNegativeInteger, SingleInteger; --import from Float, DoubleFloat; -import { true: %, false: % } from Boolean; +import { true: %; false: % } from Boolean; import { string: Literal -> %; } from String; diff --git a/aldor/lib/ax0/src/Makefile.in b/aldor/lib/ax0/src/Makefile.in index d2a85c3c1..85116a2c7 100644 --- a/aldor/lib/ax0/src/Makefile.in +++ b/aldor/lib/ax0/src/Makefile.in @@ -365,8 +365,16 @@ 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_V_LIBSRCJAR = $(am__v_LIBSRCJAR_$(V)) +am__v_LIBSRCJAR_ = $(am__v_LIBSRCJAR_$(AM_DEFAULT_VERBOSITY)) +am__v_LIBSRCJAR_0 = @echo " LIBSRCJAR " $@; +AM_V_PREREQ = $(am__v_PREREQ_$(V)) +am__v_PREREQ_ = $(am__v_PREREQ_$(AM_DEFAULT_VERBOSITY)) +am__v_PREREQ_0 = @echo " PREREQ " $@; AM_CFLAGS = -I$(aldorsrcdir) CLEANFILES = lib$(libraryname).al +eq = $(and $(findstring $1,$2),$(findstring $2,$1)) +lst_prefix = $(warning 1 $1 2 $2)$(if $(or $(if $2,,xx), $(call eq,$1,$(firstword $2))),,$(firstword $2) $(call lst_prefix,$1,$(wordlist 2,$(words $2),$2))) all: all-recursive .SUFFIXES: @@ -719,10 +727,27 @@ lib$(libraryname).al: $(foreach i,$(SUBDIRS),$i/_sublib_$(libraryname).al) $(libraryname).jar: $(foreach i, $(JAVA_SUBDIRS),$i/$(libraryname).jar) $(AM_V_LIBJAR) \ rm -rf jar; \ - mkdir jar; \ + $(MKDIR_P) jar; \ for i in $(foreach j, $(JAVA_SUBDIRS),$j/$(libraryname).jar); \ do (cd jar; jar xf ../$$i); done; \ - (cd jar; jar cf ../$@ .) + (cd jar; jar cf ../$@ .); \ + rm -rf jar + +$(libraryname)-sources.jar: $(foreach i, $(JAVA_SUBDIRS),$i/$(libraryname).jar) + $(AM_V_LIBSRCJAR) \ + rm -rf sources-jar; \ + $(MKDIR_P) sources-jar; \ + for i in $(foreach j, $(JAVA_SUBDIRS),$j/$(libraryname)-sources.jar); \ + do (cd sources-jar; jar xf ../$$i); done; \ + (cd sources-jar; jar cf ../$@ .); \ + rm -rf sources-jar + +$(patsubst %,prereq-%,$(SUBDIRS)): prereq-%: + $(AM_V_PREREQ) \ + for dir in $(call lst_prefix,$*,$(SUBDIRS)); do \ + echo $$dir;\ + (cd $$dir; $(MAKE) $(AM_MAKEFLAGS) all || exit 1); \ + done # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. diff --git a/aldor/lib/ax0/src/al/Makefile.in b/aldor/lib/ax0/src/al/Makefile.in index c3e3ee096..6f856aa74 100644 --- a/aldor/lib/ax0/src/al/Makefile.in +++ b/aldor/lib/ax0/src/al/Makefile.in @@ -17,7 +17,7 @@ subdir := $(subst $(abs_top_builddir)/,,$(abs_builddir)) VPATH := $(VPATH):$(top_srcdir)/lib/axllib/src/al VPATH := $(VPATH):$(srcdir)/.. -VPATH := $(VPATH):$(srcdir)/../ax +VPATH := $(VPATH):$(srcdir)/../ap # Build starts here library = \ @@ -29,7 +29,7 @@ library = \ stub \ # -axlibrary = \ +aplibrary = \ basecliq \ aggcat \ any \ diff --git a/aldor/lib/ax0/src/ax/aggcat.ax b/aldor/lib/ax0/src/ap/aggcat.ap similarity index 100% rename from aldor/lib/ax0/src/ax/aggcat.ax rename to aldor/lib/ax0/src/ap/aggcat.ap diff --git a/aldor/lib/ax0/src/ax/any.ax b/aldor/lib/ax0/src/ap/any.ap similarity index 100% rename from aldor/lib/ax0/src/ax/any.ax rename to aldor/lib/ax0/src/ap/any.ap diff --git a/aldor/lib/ax0/src/ax/array1.ax b/aldor/lib/ax0/src/ap/array1.ap similarity index 100% rename from aldor/lib/ax0/src/ax/array1.ax rename to aldor/lib/ax0/src/ap/array1.ap diff --git a/aldor/lib/ax0/src/ax/array2.ax b/aldor/lib/ax0/src/ap/array2.ap similarity index 100% rename from aldor/lib/ax0/src/ax/array2.ax rename to aldor/lib/ax0/src/ap/array2.ap diff --git a/aldor/lib/ax0/src/ax/basecliq.ax b/aldor/lib/ax0/src/ap/basecliq.ap similarity index 100% rename from aldor/lib/ax0/src/ax/basecliq.ax rename to aldor/lib/ax0/src/ap/basecliq.ap diff --git a/aldor/lib/ax0/src/ax/equation1.ax b/aldor/lib/ax0/src/ap/equation1.ap similarity index 100% rename from aldor/lib/ax0/src/ax/equation1.ax rename to aldor/lib/ax0/src/ap/equation1.ap diff --git a/aldor/lib/ax0/src/ax/equation2.ax b/aldor/lib/ax0/src/ap/equation2.ap similarity index 100% rename from aldor/lib/ax0/src/ax/equation2.ax rename to aldor/lib/ax0/src/ap/equation2.ap diff --git a/aldor/lib/ax0/src/ax/float.ax b/aldor/lib/ax0/src/ap/float.ap similarity index 100% rename from aldor/lib/ax0/src/ax/float.ax rename to aldor/lib/ax0/src/ap/float.ap diff --git a/aldor/lib/ax0/src/ax/fr.ax b/aldor/lib/ax0/src/ap/fr.ap similarity index 100% rename from aldor/lib/ax0/src/ax/fr.ax rename to aldor/lib/ax0/src/ap/fr.ap diff --git a/aldor/lib/ax0/src/ax/fraction.ax b/aldor/lib/ax0/src/ap/fraction.ap similarity index 100% rename from aldor/lib/ax0/src/ax/fraction.ax rename to aldor/lib/ax0/src/ap/fraction.ap diff --git a/aldor/lib/ax0/src/ax/fspace.ax b/aldor/lib/ax0/src/ap/fspace.ap similarity index 100% rename from aldor/lib/ax0/src/ax/fspace.ax rename to aldor/lib/ax0/src/ap/fspace.ap diff --git a/aldor/lib/ax0/src/ax/indexedp.ax b/aldor/lib/ax0/src/ap/indexedp.ap similarity index 100% rename from aldor/lib/ax0/src/ax/indexedp.ax rename to aldor/lib/ax0/src/ap/indexedp.ap diff --git a/aldor/lib/ax0/src/ax/integer.ax b/aldor/lib/ax0/src/ap/integer.ap similarity index 100% rename from aldor/lib/ax0/src/ax/integer.ax rename to aldor/lib/ax0/src/ap/integer.ap diff --git a/aldor/lib/ax0/src/ax/kl.ax b/aldor/lib/ax0/src/ap/kl.ap similarity index 100% rename from aldor/lib/ax0/src/ax/kl.ax rename to aldor/lib/ax0/src/ap/kl.ap diff --git a/aldor/lib/ax0/src/ax/list.ax b/aldor/lib/ax0/src/ap/list.ap similarity index 100% rename from aldor/lib/ax0/src/ax/list.ax rename to aldor/lib/ax0/src/ap/list.ap diff --git a/aldor/lib/ax0/src/ax/matcat.ax b/aldor/lib/ax0/src/ap/matcat.ap similarity index 100% rename from aldor/lib/ax0/src/ax/matcat.ax rename to aldor/lib/ax0/src/ap/matcat.ap diff --git a/aldor/lib/ax0/src/ax/matrix.ax b/aldor/lib/ax0/src/ap/matrix.ap similarity index 100% rename from aldor/lib/ax0/src/ax/matrix.ax rename to aldor/lib/ax0/src/ap/matrix.ap diff --git a/aldor/lib/ax0/src/ax/misc.ax b/aldor/lib/ax0/src/ap/misc.ap similarity index 100% rename from aldor/lib/ax0/src/ax/misc.ax rename to aldor/lib/ax0/src/ap/misc.ap diff --git a/aldor/lib/ax0/src/ax/mkfunc.ax b/aldor/lib/ax0/src/ap/mkfunc.ap similarity index 100% rename from aldor/lib/ax0/src/ax/mkfunc.ax rename to aldor/lib/ax0/src/ap/mkfunc.ap diff --git a/aldor/lib/ax0/src/ax/multpoly.ax b/aldor/lib/ax0/src/ap/multpoly.ap similarity index 100% rename from aldor/lib/ax0/src/ax/multpoly.ax rename to aldor/lib/ax0/src/ap/multpoly.ap diff --git a/aldor/lib/ax0/src/ax/op.ax b/aldor/lib/ax0/src/ap/op.ap similarity index 100% rename from aldor/lib/ax0/src/ax/op.ax rename to aldor/lib/ax0/src/ap/op.ap diff --git a/aldor/lib/ax0/src/ax/patmatch1.ax b/aldor/lib/ax0/src/ap/patmatch1.ap similarity index 100% rename from aldor/lib/ax0/src/ax/patmatch1.ax rename to aldor/lib/ax0/src/ap/patmatch1.ap diff --git a/aldor/lib/ax0/src/ax/patmatch2.ax b/aldor/lib/ax0/src/ap/patmatch2.ap similarity index 100% rename from aldor/lib/ax0/src/ax/patmatch2.ax rename to aldor/lib/ax0/src/ap/patmatch2.ap diff --git a/aldor/lib/ax0/src/ax/pattern.ax b/aldor/lib/ax0/src/ap/pattern.ap similarity index 100% rename from aldor/lib/ax0/src/ax/pattern.ax rename to aldor/lib/ax0/src/ap/pattern.ap diff --git a/aldor/lib/ax0/src/ax/poly.ax b/aldor/lib/ax0/src/ap/poly.ap similarity index 100% rename from aldor/lib/ax0/src/ax/poly.ax rename to aldor/lib/ax0/src/ap/poly.ap diff --git a/aldor/lib/ax0/src/ax/polycat.ax b/aldor/lib/ax0/src/ap/polycat.ap similarity index 100% rename from aldor/lib/ax0/src/ax/polycat.ax rename to aldor/lib/ax0/src/ap/polycat.ap diff --git a/aldor/lib/ax0/src/ax/seg.ax b/aldor/lib/ax0/src/ap/seg.ap similarity index 100% rename from aldor/lib/ax0/src/ax/seg.ax rename to aldor/lib/ax0/src/ap/seg.ap diff --git a/aldor/lib/ax0/src/ax/sex.ax b/aldor/lib/ax0/src/ap/sex.ap similarity index 100% rename from aldor/lib/ax0/src/ax/sex.ax rename to aldor/lib/ax0/src/ap/sex.ap diff --git a/aldor/lib/ax0/src/ax/sf.ax b/aldor/lib/ax0/src/ap/sf.ap similarity index 100% rename from aldor/lib/ax0/src/ax/sf.ax rename to aldor/lib/ax0/src/ap/sf.ap diff --git a/aldor/lib/ax0/src/ax/si.ax b/aldor/lib/ax0/src/ap/si.ap similarity index 100% rename from aldor/lib/ax0/src/ax/si.ax rename to aldor/lib/ax0/src/ap/si.ap diff --git a/aldor/lib/ax0/src/ax/stream.ax b/aldor/lib/ax0/src/ap/stream.ap similarity index 100% rename from aldor/lib/ax0/src/ax/stream.ax rename to aldor/lib/ax0/src/ap/stream.ap diff --git a/aldor/lib/ax0/src/ax/symbol.ax b/aldor/lib/ax0/src/ap/symbol.ap similarity index 100% rename from aldor/lib/ax0/src/ax/symbol.ax rename to aldor/lib/ax0/src/ap/symbol.ap diff --git a/aldor/lib/ax0/src/ax/variable.ax b/aldor/lib/ax0/src/ap/variable.ap similarity index 100% rename from aldor/lib/ax0/src/ax/variable.ax rename to aldor/lib/ax0/src/ap/variable.ap diff --git a/aldor/lib/ax0/src/ax/vector.ax b/aldor/lib/ax0/src/ap/vector.ap similarity index 100% rename from aldor/lib/ax0/src/ax/vector.ax rename to aldor/lib/ax0/src/ap/vector.ap diff --git a/aldor/lib/ax0/src/nax/equation.ax b/aldor/lib/ax0/src/nax/equation.ap similarity index 100% rename from aldor/lib/ax0/src/nax/equation.ax rename to aldor/lib/ax0/src/nax/equation.ap diff --git a/aldor/lib/ax0/src/nax/evalable.ax b/aldor/lib/ax0/src/nax/evalable.ap similarity index 100% rename from aldor/lib/ax0/src/nax/evalable.ax rename to aldor/lib/ax0/src/nax/evalable.ap diff --git a/aldor/lib/ax0/src/nax/patmatch1.ax b/aldor/lib/ax0/src/nax/patmatch1.ap similarity index 100% rename from aldor/lib/ax0/src/nax/patmatch1.ax rename to aldor/lib/ax0/src/nax/patmatch1.ap diff --git a/aldor/lib/ax0/src/nax/patmatch2.ax b/aldor/lib/ax0/src/nax/patmatch2.ap similarity index 100% rename from aldor/lib/ax0/src/nax/patmatch2.ax rename to aldor/lib/ax0/src/nax/patmatch2.ap diff --git a/aldor/lib/axldem/src/Makefile.in b/aldor/lib/axldem/src/Makefile.in index ccc80f7c2..e3fbbe45e 100644 --- a/aldor/lib/axldem/src/Makefile.in +++ b/aldor/lib/axldem/src/Makefile.in @@ -434,8 +434,16 @@ 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_V_LIBSRCJAR = $(am__v_LIBSRCJAR_$(V)) +am__v_LIBSRCJAR_ = $(am__v_LIBSRCJAR_$(AM_DEFAULT_VERBOSITY)) +am__v_LIBSRCJAR_0 = @echo " LIBSRCJAR " $@; +AM_V_PREREQ = $(am__v_PREREQ_$(V)) +am__v_PREREQ_ = $(am__v_PREREQ_$(AM_DEFAULT_VERBOSITY)) +am__v_PREREQ_0 = @echo " PREREQ " $@; AM_CFLAGS = -I$(aldorsrcdir) CLEANFILES = lib$(libraryname).al +eq = $(and $(findstring $1,$2),$(findstring $2,$1)) +lst_prefix = $(warning 1 $1 2 $2)$(if $(or $(if $2,,xx), $(call eq,$1,$(firstword $2))),,$(firstword $2) $(call lst_prefix,$1,$(wordlist 2,$(words $2),$2))) all: all-recursive .SUFFIXES: @@ -936,10 +944,27 @@ lib$(libraryname).al: $(foreach i,$(SUBDIRS),$i/_sublib_$(libraryname).al) $(libraryname).jar: $(foreach i, $(JAVA_SUBDIRS),$i/$(libraryname).jar) $(AM_V_LIBJAR) \ rm -rf jar; \ - mkdir jar; \ + $(MKDIR_P) jar; \ for i in $(foreach j, $(JAVA_SUBDIRS),$j/$(libraryname).jar); \ do (cd jar; jar xf ../$$i); done; \ - (cd jar; jar cf ../$@ .) + (cd jar; jar cf ../$@ .); \ + rm -rf jar + +$(libraryname)-sources.jar: $(foreach i, $(JAVA_SUBDIRS),$i/$(libraryname).jar) + $(AM_V_LIBSRCJAR) \ + rm -rf sources-jar; \ + $(MKDIR_P) sources-jar; \ + for i in $(foreach j, $(JAVA_SUBDIRS),$j/$(libraryname)-sources.jar); \ + do (cd sources-jar; jar xf ../$$i); done; \ + (cd sources-jar; jar cf ../$@ .); \ + rm -rf sources-jar + +$(patsubst %,prereq-%,$(SUBDIRS)): prereq-%: + $(AM_V_PREREQ) \ + for dir in $(call lst_prefix,$*,$(SUBDIRS)); do \ + echo $$dir;\ + (cd $$dir; $(MAKE) $(AM_MAKEFLAGS) all || exit 1); \ + done # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. diff --git a/aldor/lib/axldem/src/al/dirprod.as b/aldor/lib/axldem/src/al/dirprod.as index bfe370e9f..7e0738fc3 100644 --- a/aldor/lib/axldem/src/al/dirprod.as +++ b/aldor/lib/axldem/src/al/dirprod.as @@ -10,7 +10,7 @@ OrderedDirectProduct(dim: SI, lessThan?: (Array S, Array S) -> Boolean): OrderedDirectProductCat == add { - Rep ==> Array S; + Rep == Array S; import from Rep; map(f:S-> S, v: %):% == { diff --git a/aldor/lib/axldem/src/al/gb.as b/aldor/lib/axldem/src/al/gb.as index 86ea21ca1..3574acb47 100644 --- a/aldor/lib/axldem/src/al/gb.as +++ b/aldor/lib/axldem/src/al/gb.as @@ -126,7 +126,7 @@ sugarPol(Dpol: BasicType): BasicType with apply: (%, 'totdeg') -> NNI apply: (%, 'pol') -> Dpol == add - Rep ==> Record( totdeg: NonNegativeInteger, pol : Dpol) + Rep == Record( totdeg: NonNegativeInteger, pol : Dpol) import from Rep sample: % == nil$Pointer pretend % --!! (p1:%) = (p2:%):Boolean == rep(p1).pol = rep(p2).pol diff --git a/aldor/lib/axldem/src/al/ibits.as b/aldor/lib/axldem/src/al/ibits.as index 69f06ed5f..f3f574ba5 100644 --- a/aldor/lib/axldem/src/al/ibits.as +++ b/aldor/lib/axldem/src/al/ibits.as @@ -12,7 +12,7 @@ IndexedBits(mn:SI): Join(BasicType, Aggregate(Boolean), Logic) with { string:Literal -> %; } == add { - Rep ==> Record(size: SI, nvalues:SI, values: BArr); + Rep == Record(size: SI, nvalues:SI, values: BArr); import from Rep; import from Machine; diff --git a/aldor/lib/axldem/src/al/matrix.as b/aldor/lib/axldem/src/al/matrix.as index 05db6bedd..4c91529e1 100644 --- a/aldor/lib/axldem/src/al/matrix.as +++ b/aldor/lib/axldem/src/al/matrix.as @@ -198,7 +198,7 @@ Matrix(R : Ring): MD == MatrixDefinition where MatrixDefinition ==> add - Rep ==> Vector Vector R + Rep == Vector Vector R import from Rep, Vector SingleInteger import from Vector R, R, SingleInteger diff --git a/aldor/lib/axldem/src/al/poly.as b/aldor/lib/axldem/src/al/poly.as index d56418c04..a3cbaf380 100644 --- a/aldor/lib/axldem/src/al/poly.as +++ b/aldor/lib/axldem/src/al/poly.as @@ -11,7 +11,7 @@ Term(S: Ring, Expon: AbelianMonoid): BasicType with { apply: (%, 'expon') -> Expon; } == add { - Rep ==> Record(expon:Expon, coef:S); + Rep == Record(expon:Expon, coef:S); import from Rep; sample: % == nil$Pointer pretend %; apply(f:%, tag:'coef'):S == rep(f).coef; diff --git a/aldor/lib/axldem/src/al/spf.as b/aldor/lib/axldem/src/al/spf.as index c80bfe6c6..e3b5cd374 100644 --- a/aldor/lib/axldem/src/al/spf.as +++ b/aldor/lib/axldem/src/al/spf.as @@ -3,7 +3,7 @@ macro SI == SingleInteger; SmallPrimeField(p:SI): FiniteField == add { - Rep ==> SI; + Rep == SI; import from Rep; 0:% == per 0; 1:% == per 1; @@ -48,7 +48,7 @@ SmallPrimeField(p:SI): FiniteField == add { } Zmod2: FiniteField == add { - Rep ==> Boolean; + Rep == Boolean; import from Rep; import from SI; 0:% == per false; diff --git a/aldor/lib/axllib/src/Makefile.in b/aldor/lib/axllib/src/Makefile.in index 99c27b666..af4bfc7e7 100644 --- a/aldor/lib/axllib/src/Makefile.in +++ b/aldor/lib/axllib/src/Makefile.in @@ -494,8 +494,16 @@ 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_V_LIBSRCJAR = $(am__v_LIBSRCJAR_$(V)) +am__v_LIBSRCJAR_ = $(am__v_LIBSRCJAR_$(AM_DEFAULT_VERBOSITY)) +am__v_LIBSRCJAR_0 = @echo " LIBSRCJAR " $@; +AM_V_PREREQ = $(am__v_PREREQ_$(V)) +am__v_PREREQ_ = $(am__v_PREREQ_$(AM_DEFAULT_VERBOSITY)) +am__v_PREREQ_0 = @echo " PREREQ " $@; AM_CFLAGS = -I$(aldorsrcdir) -ffloat-store CLEANFILES = lib$(libraryname).al +eq = $(and $(findstring $1,$2),$(findstring $2,$1)) +lst_prefix = $(warning 1 $1 2 $2)$(if $(or $(if $2,,xx), $(call eq,$1,$(firstword $2))),,$(firstword $2) $(call lst_prefix,$1,$(wordlist 2,$(words $2),$2))) all: all-recursive .SUFFIXES: @@ -1118,10 +1126,27 @@ lib$(libraryname).al: $(foreach i,$(SUBDIRS),$i/_sublib_$(libraryname).al) $(libraryname).jar: $(foreach i, $(JAVA_SUBDIRS),$i/$(libraryname).jar) $(AM_V_LIBJAR) \ rm -rf jar; \ - mkdir jar; \ + $(MKDIR_P) jar; \ for i in $(foreach j, $(JAVA_SUBDIRS),$j/$(libraryname).jar); \ do (cd jar; jar xf ../$$i); done; \ - (cd jar; jar cf ../$@ .) + (cd jar; jar cf ../$@ .); \ + rm -rf jar + +$(libraryname)-sources.jar: $(foreach i, $(JAVA_SUBDIRS),$i/$(libraryname).jar) + $(AM_V_LIBSRCJAR) \ + rm -rf sources-jar; \ + $(MKDIR_P) sources-jar; \ + for i in $(foreach j, $(JAVA_SUBDIRS),$j/$(libraryname)-sources.jar); \ + do (cd sources-jar; jar xf ../$$i); done; \ + (cd sources-jar; jar cf ../$@ .); \ + rm -rf sources-jar + +$(patsubst %,prereq-%,$(SUBDIRS)): prereq-%: + $(AM_V_PREREQ) \ + for dir in $(call lst_prefix,$*,$(SUBDIRS)); do \ + echo $$dir;\ + (cd $$dir; $(MAKE) $(AM_MAKEFLAGS) all || exit 1); \ + done # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. diff --git a/aldor/lib/axllib/src/al/list.as b/aldor/lib/axllib/src/al/list.as index 86ffe6c1f..08be37a0a 100644 --- a/aldor/lib/axllib/src/al/list.as +++ b/aldor/lib/axllib/src/al/list.as @@ -104,9 +104,6 @@ List(S: Type): ListCategory S with == FakedConditionalOperations S add { macro Rep == P; macro R == Record(first: S, rest: Rep); - --!! Remove when cascaded imports can be inferred in the correct order. - import from S, 'first', 'rest'; - -- This local domain gives an untagged union of -- Records and Nil. P: with { diff --git a/aldor/lib/buildlib.am b/aldor/lib/buildlib.am index c7f097d43..7460a4356 100644 --- a/aldor/lib/buildlib.am +++ b/aldor/lib/buildlib.am @@ -5,6 +5,14 @@ AM_V_LIBJAR = $(am__v_LIBJAR_$(V)) am__v_LIBJAR_ = $(am__v_LIBJAR_$(AM_DEFAULT_VERBOSITY)) am__v_LIBJAR_0 = @echo " LIBJAR " $@; +AM_V_LIBSRCJAR = $(am__v_LIBSRCJAR_$(V)) +am__v_LIBSRCJAR_ = $(am__v_LIBSRCJAR_$(AM_DEFAULT_VERBOSITY)) +am__v_LIBSRCJAR_0 = @echo " LIBSRCJAR " $@; + +AM_V_PREREQ = $(am__v_PREREQ_$(V)) +am__v_PREREQ_ = $(am__v_PREREQ_$(AM_DEFAULT_VERBOSITY)) +am__v_PREREQ_0 = @echo " PREREQ " $@; + AM_CFLAGS = -I$(aldorsrcdir) lib$(libraryname).al: $(foreach i,$(SUBDIRS),$i/_sublib_$(libraryname).al) @@ -18,9 +26,29 @@ lib$(libraryname).al: $(foreach i,$(SUBDIRS),$i/_sublib_$(libraryname).al) $(libraryname).jar: $(foreach i, $(JAVA_SUBDIRS),$i/$(libraryname).jar) $(AM_V_LIBJAR) \ rm -rf jar; \ - mkdir jar; \ + $(MKDIR_P) jar; \ for i in $(foreach j, $(JAVA_SUBDIRS),$j/$(libraryname).jar); \ do (cd jar; jar xf ../$$i); done; \ - (cd jar; jar cf ../$@ .) + (cd jar; jar cf ../$@ .); \ + rm -rf jar + +$(libraryname)-sources.jar: $(foreach i, $(JAVA_SUBDIRS),$i/$(libraryname).jar) + $(AM_V_LIBSRCJAR) \ + rm -rf sources-jar; \ + $(MKDIR_P) sources-jar; \ + for i in $(foreach j, $(JAVA_SUBDIRS),$j/$(libraryname)-sources.jar); \ + do (cd sources-jar; jar xf ../$$i); done; \ + (cd sources-jar; jar cf ../$@ .); \ + rm -rf sources-jar CLEANFILES = lib$(libraryname).al + +eq=$(and $(findstring $1,$2),$(findstring $2,$1)) +lst_prefix=$(warning 1 $1 2 $2)$(if $(or $(if $2,,xx), $(call eq,$1,$(firstword $2))),,$(firstword $2) $(call lst_prefix,$1,$(wordlist 2,$(words $2),$2))) + +$(patsubst %,prereq-%,$(SUBDIRS)): prereq-%: + $(AM_V_PREREQ) \ + for dir in $(call lst_prefix,$*,$(SUBDIRS)); do \ + echo $$dir;\ + (cd $$dir; $(MAKE) $(AM_MAKEFLAGS) all || exit 1); \ + done diff --git a/aldor/lib/buildlib.mk b/aldor/lib/buildlib.mk index a6ebae7b5..156c173a0 100644 --- a/aldor/lib/buildlib.mk +++ b/aldor/lib/buildlib.mk @@ -13,18 +13,23 @@ librarydocdir := $(top_builddir)/lib/$(libraryname)/doc UNIQ := perl $(top_srcdir)/aldor/tools/unix/uniq asdomains := $(internal) $(library) $(tests) -axdomains := $(axlibrary) -alldomains := $(asdomains) $(axdomains) +apdomains := $(aplibrary) +alldomains := $(asdomains) $(apdomains) docdomains := $(asdomains) $(documentation) libsubdir := $(subst $(abs_libdir)/,,$(abs_builddir)/.) +space=$(subst @,,@ @) + include $(top_builddir)/lib/config.mk include $(top_srcdir)/mk/step.mk +include $(top_srcdir)/mk/topsort.mk + +STEPS := ALDOR AO2C AO2FM AR DEP FOAMJ JAR JAR JAVAC SRCJAR +QUIET_STEPS := ALDORTEST ALDORTESTJ ALDORTESTEXE -$(call am_define_steps,\ - ALDOR AO2C AO2FM AR DEP FOAMJ JAR JAVAC AS2TEX \ - ALDORTEST ALDORTESTBLD ALDORTESTEXE ALDORTESTJ) +$(call am_define_steps, $(STEPS)) +$(call am_define_steps_quiet, $(QUIET_STEPS)) # Check the makefile @@ -67,12 +72,12 @@ aldor_args = $(aldor_common_args) \ -Fao=$*.ao \ -Fabn=$*.abn \ $(filter %$*.as,$^) \ - $(filter %$*.ax,$^) + $(filter %$*.ap,$^) $(addsuffix .dep,$(asdomains)): %.dep: %.as Makefile.in Makefile.deps -$(addsuffix .dep,$(axdomains)): %.dep: %.ax Makefile.in Makefile.deps +$(addsuffix .dep,$(apdomains)): %.dep: %.ap Makefile.in Makefile.deps $(addsuffix .ao, $(asdomains)): %.ao: %.as -$(addsuffix .ao, $(axdomains)): %.ao: %.ax +$(addsuffix .ao, $(apdomains)): %.ao: %.ap $(addsuffix .ao, $(alldomains)): %.ao: $(foreach x,$(librarydeps),$(top_builddir)/lib/$(x)/src/lib$(x).al) $(addsuffix .abn, $(alldomains)): %.abn: %.ao @@ -109,7 +114,7 @@ $(addsuffix .fm,$(alldomains)): %.fm: %.ao $(if $(_withdocs),$(patsubst %,$(librarydocdir)/tex/gen/%.tex,$(docdomains)),): $(librarydocdir)/tex/gen/%.tex: %.as $(AM_V_AS2TEX) \ - mkdir -p $(librarydocdir)/tex/gen; \ + $(MKDIR_P) $(librarydocdir)/tex/gen; \ $(unixtooldir)/extract -mALDOC -o $@ $(srcdir)/$*.as .PHONY: $(addsuffix .gloop, $(alldomains)) @@ -179,7 +184,7 @@ endif ifneq ($(BUILD_JAVA),) ifneq ($(javalibrary),) -_javalibrary = $(filter-out $(java_blacklist), $(javalibrary)) +_javalibrary = $(call topsort_list, $(filter-out $(java_blacklist), $(javalibrary))) $(patsubst %,aldorcode/%.java, $(_javalibrary)): aldorcode/%.java: %.ao $(AM_V_FOAMJ)$(AM_DBG) \ @@ -195,21 +200,32 @@ $(libraryname).jar: $(patsubst %,aldorcode/%.class, $(_javalibrary)) $(top_srcdi $(AM_V_JAR) \ rm -f $@; \ rm -rf jar; \ - mkdir jar; \ - jar cf $@ $(patsubst %,aldorcode/%*.class, $(_javalibrary)) + $(MKDIR_P) jar; \ + 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 \ - $(patsubst %,aldorcode/%.class,$(_javalibrary)) +$(libraryname)-sources.jar: $(patsubst %,aldorcode/%.java, $(_javalibrary)) $(top_srcdir)/lib/buildlib.mk + $(AM_V_SRCJAR) \ + rm -f $@; \ + rm -rf sources-jar; \ + $(MKDIR_P) sources-jar; \ + jar cf $@ $(patsubst %,aldorcode/%.java, $(_javalibrary)); \ + for i in $(foreach i, $(SUBDIRS), $i/$(libraryname)-sources.jar); do \ + (cd sources-jar; jar xf ../$$i); \ + jar uf ../$@ -C sources-jar .; done; \ + rm -rf sources-jar + +all: $(libraryname)-sources.jar $(libraryname).jar + endif endif -aldorinterptests := $(patsubst %,%.aldortest-exec-interp,$(filter-out $(interp_test_blacklist), library)) +aldorinterptests := $(patsubst %,%-aldortest-exec-interp,$(filter-out $(interp_test_blacklist), library)) -$(aldorinterptests): %.aldortest-exec-interp: Makefile +$(aldorinterptests): %-aldortest-exec-interp: Makefile $(AM_V_ALDORTEST) \ (if ! grep -q '^#if ALDORTEST' $(srcdir)/$*.as; then exit 0; fi; \ echo " ALDORTEST $*.as"; \ @@ -224,7 +240,7 @@ $(aldorinterptests): %.aldortest-exec-interp: Makefile CHECK_TEST_STATUS = \ status=$$?; \ - exstatus=$(filter $*, $(XFAIL) $(XFAIL_$(subst $*.aldortest-exec-,,$@))); \ + exstatus=$(filter $*, $(XFAIL) $(XFAIL_$(subst $*-aldortest-exec-,,$@))); \ if ! [ "$$exstatus" = "" ] ; then \ if [ $$status = 0 ] ; then echo XPASS: $*; exit 1; else echo XFAIL: $*; exit 0; fi; \ fi;\ @@ -242,17 +258,18 @@ foamdir = $(abs_top_builddir)/aldor/lib/libfoam foamlibdir = $(abs_top_builddir)/aldor/lib/libfoamlib $(aldortestexecs): %.aldortest.exe: Makefile %.as - $(AM_V_ALDORTESTBLD) \ + $(AM_V_ALDORTEST) \ (if ! grep -q '^#if ALDORTEST' $(srcdir)/$*.as; then touch $@; chmod a+x $@; else \ - rm -f $@; \ - sed -n -e '/^#if ALDORTEST/,/^#endif/p' < $(srcdir)/$*.as > $*_test.as; \ - $(AM_DBG) $(aldorexedir)/aldor $(aldor_common_args) -Y$(aldorlibdir)/libfoam/al \ - -Ccc=$(aldortooldir)/unicl \ - -Y$(foamdir) \ - -l$(libraryname) $(exec_test_runtime) $(patsubst %,-l%,$(librarydeps)) \ + rm -f $@; \ + echo " ALDORTEST $*.as"; \ + sed -n -e '/^#if ALDORTEST/,/^#endif/p' < $(srcdir)/$*.as > $*_test.as; \ + $(AM_DBG) $(aldorexedir)/aldor $(aldor_common_args) -Y$(aldorlibdir)/libfoam/al \ + -Ccc=$(aldortooldir)/unicl \ + -Y$(foamdir) -Y \ + -Y$(foamlibdir) -l$(libraryname) $(exec_test_runtime) $(patsubst %,-l%,$(librarydeps)) \ -Cargs="-Wconfig=$(aldorsrcdir)/aldor.conf -I$(aldorsrcdir) $(UNICLFLAGS)" \ -I$(top_srcdir)/lib/aldor/include -Y$(top_builddir)/lib/aldor/src \ - -Y$(librarylibdir) -I$(libraryincdir) -fc -fx=$@ -DALDORTEST \ + -Y$(librarylibdir) -I$(libraryincdir) -fc -fx=$@ -DALDORTEST $($*_TESTAXLFLAGS) \ $*_test.as; fi) $(aldortest_run): %-aldortest-exec-exe: Makefile %.as %.aldortest.exe @@ -263,23 +280,23 @@ $(aldortest_run): %-aldortest-exec-exe: Makefile %.as %.aldortest.exe ifneq ($(BUILD_JAVA),) ifneq ($(javalibrary),) -aldortestjavas := $(patsubst %,%.aldortest-exec-java, \ +aldortestjavas := $(patsubst %,%-aldortest-exec-java, \ $(filter-out $(java_test_blacklist), $(_javalibrary))) - -$(aldortestjavas): %.aldortest-exec-java: Makefile %.as +libclasspath := $(subst $(space),:,$(foreach lib,$(librarydeps) $(libraryname),$(top_builddir)/lib/$(lib)/src/$(lib).jar)) +$(aldortestjavas): %-aldortest-exec-java: Makefile %.as $(AM_V_ALDORTESTJ) \ (if grep -q '^#if ALDORTEST' $(srcdir)/$*.as; then \ - echo " Running $*"; \ + echo " ALDORTESTJ $*"; \ sed -n -e '/^#if ALDORTEST/,/^#endif/p' < $(srcdir)/$*.as > $*_jtest.as; \ $(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://') \ + -Y$(librarylibdir) -I$(libraryincdir) -DALDORTEST $$(cat $*_jtest.as | grep ^aldoroptions: | sed -e 's/aldoroptions://') \ -Fjava -Ffm -Jmain \ $($*_test_AXLFLAGS) \ $*_jtest.as; \ 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; \ + java -cp .:$(aldorlibdir)/java/src/foamj.jar:$(aldorlibdir)/libfoam/al/foam.jar:$(libclasspath) aldorcode.$*_jtest; \ $(CHECK_TEST_STATUS) \ fi;) @@ -318,7 +335,7 @@ distclean: clean maintainer-clean: distclean -install-data: +install-data: $(local-install-targets) $(MKDIR_P) $(DESTDIR)$(datarootdir)/aldor/lib/$(libraryname)/$(libsubdir) for i in $(library); do \ if test -f $(abs_srcdir)/$$i.as; then \ diff --git a/aldor/m4/git.m4 b/aldor/m4/git.m4 index 034c2bb51..c3483e02c 100644 --- a/aldor/m4/git.m4 +++ b/aldor/m4/git.m4 @@ -1,7 +1,7 @@ # Force git build id. AC_DEFUN([ALDOR_GIT_BUILD_ID], -[git_build_id="" +[gitid=false if test "$ld_has_build_id" = ""; then AC_MSG_FAILURE([Need to set ld_has_build_id]) @@ -10,20 +10,19 @@ AC_ARG_ENABLE([git-build-id], [AS_HELP_STRING([--enable-git-build-id], [Force git sha1 hash as build id])], [case "${enableval}" in - yes) git_build_id=1;; - no) git_build_id=0;; - *) 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]) + 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]) # Git SHA1 hash as ld build-id. AC_MSG_CHECKING([build id]) -if test yes = "$ld_has_build_id" && test 1 = "$git_build_id"; then +if test yes = "$ld_has_build_id" && test true = "$gitid"; then VCSVERSION=`cd $srcdir; git rev-parse HEAD` build_id="-Wl,--build-id=0x$VCSVERSION" AC_MSG_RESULT([git: $VCSVERSION ld: yes]) -elif test 1 = "$git_build_id"; then +elif test true = "$gitid"; then VCSVERSION=`cd $srcdir; git rev-parse HEAD` AC_MSG_RESULT([git: $VCSVERSION ld: no]) else diff --git a/aldor/m4/strict_compile.m4 b/aldor/m4/strict_compile.m4 index 10ea21c6a..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-error=address" + cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -Wno-error=clobbered" ;; clang*) cfgSTRICTCFLAGS="${cfgSTRICTCFLAGS} -fcolor-diagnostics -Wno-error=enum-conversion \ diff --git a/aldor/mk/step.mk b/aldor/mk/step.mk index de4d6ef64..38588049f 100644 --- a/aldor/mk/step.mk +++ b/aldor/mk/step.mk @@ -1,11 +1,30 @@ +# Makefile.in will need _AM_DEFAULT_VERBOSITY defined +# AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +$(if $(AM_DEFAULT_VERBOSITY),,$(error "oops - AM_DEFAULT_VERBOSITY should be defined in source makefile")) + +# Echo step name and target 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)) " $$(if $$*,$$*,$$@); +am__v_$(1)_1 = +am__v_$(1)_2 = @echo " $(subst _,-,$(1)) " $$(if $$*,$$*,$$@); set -x; +endef + +# Silence unless told otherwise +define am_auto_template_quiet +AM_V_$(1) = $$(am__v_$(1)_$$(V)) +am__v_$(1)_ = $$(am__v_$(1)_$$(AM_DEFAULT_VERBOSITY)) +am__v_$(1)_0 = @ endef define am_define_steps $(foreach rule,$(1), \ $(eval $(call am_auto_template,$(rule)))) endef + +define am_define_steps_quiet +$(foreach rule,$(1), \ + $(eval $(call am_auto_template_quiet,$(rule)))) +endef diff --git a/aldor/mk/topsort.mk b/aldor/mk/topsort.mk new file mode 100644 index 000000000..d4fa06cd3 --- /dev/null +++ b/aldor/mk/topsort.mk @@ -0,0 +1,9 @@ +define rec_dep_template +$(foreach l, $($1_deps),$(call rec_dep_template,$(l)) $(l)) +endef + +uniq_0 = $(if $1,$(firstword $1) $(call uniq,$(filter-out $(firstword $1),$1))) +uniq = $(call uniq_0,$1) +topsort_one = $(call uniq,call rec_dep_template,$1)) +topsort_list = $(call uniq,$(foreach x,$1,$(call rec_dep_template,$(x)) $(x))) + diff --git a/debian/.gitignore b/debian/.gitignore index e5e18d6d2..336345044 100644 --- a/debian/.gitignore +++ b/debian/.gitignore @@ -2,7 +2,7 @@ /aldor.substvars /files /*.log -.debhelper +/.debhelper autoreconf.before autoreconf.after debhelper-build-stamp diff --git a/debian/changelog b/debian/changelog index 0872e7f33..4588bd34b 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,7 @@ +aldor (1.3.0+20190802) precise; urgency=low + + * Lots of things + aldor (1.2.0+20131001) precise; urgency=low * Fixes for mutually dependent domains. diff --git a/debian/compat b/debian/compat index 9a037142a..f599e28b8 100644 --- a/debian/compat +++ b/debian/compat @@ -1 +1 @@ -10 \ No newline at end of file +10 diff --git a/debian/rules b/debian/rules index e9ba387cf..a5e8ee0a5 100755 --- a/debian/rules +++ b/debian/rules @@ -6,21 +6,24 @@ # dh-make output file, you may use that output file without restriction. # This special exception was added by Craig Small in version 0.37 of dh-make. -# Uncomment this to turn on verbose mode. -#export DH_VERBOSE=1 +# For a silent build. +export DH_QUIET=1 # FIXME: This breaks the Aldor B-tree based GC. #export DEB_BUILD_HARDENING=1 +OPTIONS_build=--enable-git-build-id=no + %: dh $@ \ --sourcedirectory=aldor \ --builddirectory=build \ - --parallel + --parallel \ + $(OPTIONS_$(@)) override_dh_auto_configure: dh_auto_configure -- --enable-silent-rules build: aldor/configure -aldor/configure: aldor/autogen.sh +aldor/configure: aldor/autogen.sh aldor/configure.ac cd $(dir $@) && sh autogen.sh