open-axiom-patches Mailing List for OpenAxiom: Scientific Computation System
A system for computer algebra and symbolic mathematics
Brought to you by:
dos-reis
You can subscribe to this list here.
2007 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(45) |
Sep
(57) |
Oct
(13) |
Nov
(15) |
Dec
(35) |
---|---|---|---|---|---|---|---|---|---|---|---|---|
2008 |
Jan
(24) |
Feb
(14) |
Mar
(1) |
Apr
(5) |
May
(10) |
Jun
|
Jul
(13) |
Aug
(21) |
Sep
(8) |
Oct
(16) |
Nov
(29) |
Dec
(23) |
2009 |
Jan
(13) |
Feb
(7) |
Mar
(2) |
Apr
(20) |
May
(7) |
Jun
(16) |
Jul
|
Aug
|
Sep
(3) |
Oct
(2) |
Nov
(5) |
Dec
|
2010 |
Jan
(1) |
Feb
(3) |
Mar
|
Apr
|
May
(2) |
Jun
(5) |
Jul
(1) |
Aug
(18) |
Sep
(1) |
Oct
|
Nov
(2) |
Dec
(1) |
2011 |
Jan
|
Feb
(8) |
Mar
|
Apr
|
May
(2) |
Jun
(1) |
Jul
(3) |
Aug
(13) |
Sep
(14) |
Oct
(7) |
Nov
(17) |
Dec
(7) |
2012 |
Jan
(1) |
Feb
(1) |
Mar
|
Apr
|
May
(4) |
Jun
|
Jul
(1) |
Aug
(7) |
Sep
|
Oct
|
Nov
|
Dec
|
2013 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(3) |
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
2015 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
(2) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
From: Gabriel D. R. <gd...@in...> - 2015-07-09 13:14:41
|
Patch OK. Many thanks for tracking this down! -- Gaby On Wed, Jul 8, 2015 at 12:39 PM, Игорь Пашев <pas...@gm...> wrote: > Revision 3107 breaks Linux build (at least): > > AC_PROG_CC should not be used twice: > > > Although AC_PROG_CC is safe to directly expand multiple times, > > it performs certain checks (such as the proper value of EXEEXT) > > only on the first invocation. Therefore, care must be used when invoking > > this macro from within another macro rather than at the top level > ( > https://www.gnu.org/savannah-checkouts/gnu/autoconf/manual/autoconf-2.69/html_node/C-Compiler.html > ) > > PATCH: > > --- config/open-axiom.m4 (revision 3107) > +++ config/open-axiom.m4 (working copy) > @@ -288,14 +288,16 @@ > ## anything sane going on on this fine platform. > case $host in > *apple*) > - AC_PROG_CC([clang]) > - AC_PROG_CXX([clang++]) > + oa_cc_list="clang" > + oa_cxx_list="clang++" > ;; > *) > - AC_PROG_CC > - AC_PROG_CXX([g++ clang++ icpc icc CC xlC c++]) > + oa_cc_list="gcc clang cc" > + oa_cxx_list="g++ clang++ CC c++" > ;; > esac > +AC_PROG_CC($oa_cc_list) > +AC_PROG_CXX($oa_cxx_list) > ## Where are the compilers coming from? GNU? Clang? > oa_cxx_compiler_lineage=unknown > case `$CXX -v` in > > > > Synopsis on Linux: > > checking for gcc... gcc > checking whether we are using the GNU C compiler... no > checking whether gcc accepts -g... no > checking for gcc option to accept ISO C89... unsupported > checking whether gcc understands -c and -o together... yes > checking dependency style of gcc... none > checking for g++... g++ > checking whether we are using the GNU C++ compiler... no > checking whether g++ accepts -g... no > checking dependency style of g++... none > Using built-in specs. > COLLECT_GCC=/usr/bin/g++-4.9.real > COLLECT_LTO_WRAPPER=/usr/lib/gcc/x86_64-linux-gnu/4.9/lto-wrapper > Target: x86_64-linux-gnu > Configured with: ../src/configure -v --with-pkgversion='Debian > 4.9.3-1' --with-bugurl=file:///usr/share/doc/gcc-4.9/README.Bugs > --enable-languages=c,c++,java,go,d,fortran,objc,obj-c++ --prefix=/usr > --program-suffix=-4.9 --enable-shared --enable-linker-build-id > --libexecdir=/usr/lib --without-included-gettext > --enable-threads=posix --with-gxx-include-dir=/usr/include/c++/4.9 > --libdir=/usr/lib --enable-nls --with-sysroot=/ --enable-clocale=gnu > --enable-libstdcxx-debug --enable-libstdcxx-time=yes > --enable-gnu-unique-object --disable-vtable-verify --enable-plugin > --with-system-zlib --disable-browser-plugin --enable-java-awt=gtk > --enable-gtk-cairo > --with-java-home=/usr/lib/jvm/java-1.5.0-gcj-4.9-amd64/jre > --enable-java-home > --with-jvm-root-dir=/usr/lib/jvm/java-1.5.0-gcj-4.9-amd64 > --with-jvm-jar-dir=/usr/lib/jvm-exports/java-1.5.0-gcj-4.9-amd64 > --with-arch-directory=amd64 > --with-ecj-jar=/usr/share/java/eclipse-ecj.jar --enable-objc-gc > --enable-multiarch --with-arch-32=i586 --with-abi=m64 > --with-multilib-list=m32,m64,mx32 --enable-multilib > --with-tune=generic --enable-checking=release --build=x86_64-linux-gnu > --host=x86_64-linux-gnu --target=x86_64-linux-gnu > Thread model: posix > gcc version 4.9.3 (Debian 4.9.3-1) > checking how to run the C preprocessor... gcc -E > checking how to run the C++ preprocessor... g++ -E > checking for llvm-config... no > checking whether g++ supports -std=c++11... configure: error: > OpenAxiom requires a C++11 compiler > > > AFAIK I'm able to commit to trunk. If this patch is ok, I'll do [with > updated configure] :-) > > > ------------------------------------------------------------------------------ > Don't Limit Your Business. Reach for the Cloud. > GigeNET's Cloud Solutions provide you with the tools and support that > you need to offload your IT needs and focus on growing your business. > Configured For All Businesses. Start Your Cloud Today. > https://www.gigenetcloud.com/ > _______________________________________________ > open-axiom-patches mailing list > ope...@li... > https://lists.sourceforge.net/lists/listinfo/open-axiom-patches > |
From: Игорь П. <pas...@gm...> - 2015-07-08 19:40:42
|
Revision 3107 breaks Linux build (at least): AC_PROG_CC should not be used twice: > Although AC_PROG_CC is safe to directly expand multiple times, > it performs certain checks (such as the proper value of EXEEXT) > only on the first invocation. Therefore, care must be used when invoking > this macro from within another macro rather than at the top level (https://www.gnu.org/savannah-checkouts/gnu/autoconf/manual/autoconf-2.69/html_node/C-Compiler.html) PATCH: --- config/open-axiom.m4 (revision 3107) +++ config/open-axiom.m4 (working copy) @@ -288,14 +288,16 @@ ## anything sane going on on this fine platform. case $host in *apple*) - AC_PROG_CC([clang]) - AC_PROG_CXX([clang++]) + oa_cc_list="clang" + oa_cxx_list="clang++" ;; *) - AC_PROG_CC - AC_PROG_CXX([g++ clang++ icpc icc CC xlC c++]) + oa_cc_list="gcc clang cc" + oa_cxx_list="g++ clang++ CC c++" ;; esac +AC_PROG_CC($oa_cc_list) +AC_PROG_CXX($oa_cxx_list) ## Where are the compilers coming from? GNU? Clang? oa_cxx_compiler_lineage=unknown case `$CXX -v` in Synopsis on Linux: checking for gcc... gcc checking whether we are using the GNU C compiler... no checking whether gcc accepts -g... no checking for gcc option to accept ISO C89... unsupported checking whether gcc understands -c and -o together... yes checking dependency style of gcc... none checking for g++... g++ checking whether we are using the GNU C++ compiler... no checking whether g++ accepts -g... no checking dependency style of g++... none Using built-in specs. COLLECT_GCC=/usr/bin/g++-4.9.real COLLECT_LTO_WRAPPER=/usr/lib/gcc/x86_64-linux-gnu/4.9/lto-wrapper Target: x86_64-linux-gnu Configured with: ../src/configure -v --with-pkgversion='Debian 4.9.3-1' --with-bugurl=file:///usr/share/doc/gcc-4.9/README.Bugs --enable-languages=c,c++,java,go,d,fortran,objc,obj-c++ --prefix=/usr --program-suffix=-4.9 --enable-shared --enable-linker-build-id --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --with-gxx-include-dir=/usr/include/c++/4.9 --libdir=/usr/lib --enable-nls --with-sysroot=/ --enable-clocale=gnu --enable-libstdcxx-debug --enable-libstdcxx-time=yes --enable-gnu-unique-object --disable-vtable-verify --enable-plugin --with-system-zlib --disable-browser-plugin --enable-java-awt=gtk --enable-gtk-cairo --with-java-home=/usr/lib/jvm/java-1.5.0-gcj-4.9-amd64/jre --enable-java-home --with-jvm-root-dir=/usr/lib/jvm/java-1.5.0-gcj-4.9-amd64 --with-jvm-jar-dir=/usr/lib/jvm-exports/java-1.5.0-gcj-4.9-amd64 --with-arch-directory=amd64 --with-ecj-jar=/usr/share/java/eclipse-ecj.jar --enable-objc-gc --enable-multiarch --with-arch-32=i586 --with-abi=m64 --with-multilib-list=m32,m64,mx32 --enable-multilib --with-tune=generic --enable-checking=release --build=x86_64-linux-gnu --host=x86_64-linux-gnu --target=x86_64-linux-gnu Thread model: posix gcc version 4.9.3 (Debian 4.9.3-1) checking how to run the C preprocessor... gcc -E checking how to run the C++ preprocessor... g++ -E checking for llvm-config... no checking whether g++ supports -std=c++11... configure: error: OpenAxiom requires a C++11 compiler AFAIK I'm able to commit to trunk. If this patch is ok, I'll do [with updated configure] :-) |
From: Gabriel D. R. <gd...@cs...> - 2013-05-11 22:39:56
|
The subject says is it all. Applied to trunk. 2013-05-11 Gabriel Dos Reis <gd...@in...> * interp/database.boot (getConstructorModemap): Try to load fresh module first before looking into cached database data. * algebra/Makefile.am (oa_algebra_layer_11): Remove IARRAY2. * algebra/array2.spad.pamphlet (InnerIndexedTwoDimensionalArray): Drop starting index parameters. Tidy. Adjust users. (IndexedTwoDimensionalArray): Remove as unused. 2013-05-11 Gabriel Dos Reis <gd...@in...> Index: src/algebra/Makefile.am =================================================================== --- src/algebra/Makefile.am (revision 2834) +++ src/algebra/Makefile.am (working copy) @@ -1799,7 +1799,7 @@ ASTACK COMBINAT POINT PTCAT \ CSTTOOLS FARRAY \ FLALG GALUTIL HEAP \ - IARRAY2 IFARRAY INTCAT INTHEORY \ + IFARRAY INTCAT INTHEORY \ IRREDFFX LFCAT LODOCAT LODOCAT- \ MATSTOR \ ORESUP OREPCTO OREUP PLOT3D \ Index: src/algebra/array2.spad.pamphlet =================================================================== --- src/algebra/array2.spad.pamphlet (revision 2834) +++ src/algebra/array2.spad.pamphlet (working copy) @@ -262,12 +262,11 @@ \section{domain IIARRAY2 InnerIndexedTwoDimensionalArray} <<domain IIARRAY2 InnerIndexedTwoDimensionalArray>>= )abbrev domain IIARRAY2 InnerIndexedTwoDimensionalArray -InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col):_ +InnerIndexedTwoDimensionalArray(R,Row,Col):_ Exports == Implementation where ++ This is an internal type which provides an implementation of ++ 2-dimensional arrays as PrimitiveArray's of PrimitiveArray's. R : Type - mnRow, mnCol : Integer Row : FiniteLinearAggregate R Col : FiniteLinearAggregate R @@ -294,10 +293,10 @@ --% Size inquiries - minRowIndex m == mnRow - minColIndex m == mnCol - maxRowIndex m == nrows m + mnRow - 1 - maxColIndex m == ncols m + mnCol - 1 + minRowIndex m == 1 + minColIndex m == 1 + maxRowIndex m == nrows m + maxColIndex m == ncols m nrows m == # rep m ncols m == empty? m => 0 @@ -339,27 +338,7 @@ concat(s, "\end{array} \right]")$String @ -\section{domain IARRAY2 IndexedTwoDimensionalArray} -<<domain IARRAY2 IndexedTwoDimensionalArray>>= -)abbrev domain IARRAY2 IndexedTwoDimensionalArray -IndexedTwoDimensionalArray(R,mnRow,mnCol):Exports == Implementation where - ++ An IndexedTwoDimensionalArray is a 2-dimensional array where - ++ the minimal row and column indices are parameters of the type. - ++ Rows and columns are returned as IndexedOneDimensionalArray's with - ++ minimal indices matching those of the IndexedTwoDimensionalArray. - ++ The index of the 'first' row may be obtained by calling the - ++ function 'minRowIndex'. The index of the 'first' column may - ++ be obtained by calling the function 'minColIndex'. The index of - ++ the first element of a 'Row' is the same as the index of the - ++ first column in an array and vice versa. - R : Type - mnRow, mnCol : Integer - macro Row == IndexedOneDimensionalArray(R,mnCol) - macro Col == IndexedOneDimensionalArray(R,mnRow) - Exports == TwoDimensionalArrayCategory(R,Row,Col) - Implementation == InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col) -@ \section{domain ARRAY2 TwoDimensionalArray} <<domain ARRAY2 TwoDimensionalArray>>= )abbrev domain ARRAY2 TwoDimensionalArray @@ -372,7 +351,7 @@ Exports == TwoDimensionalArrayCategory(R,Row,Col) with shallowlyMutable ++ One may destructively alter TwoDimensionalArray's. - Implementation == InnerIndexedTwoDimensionalArray(R,1,1,Row,Col) + Implementation == InnerIndexedTwoDimensionalArray(R,Row,Col) @ \section{License} @@ -413,7 +392,6 @@ <<category ARR2CAT TwoDimensionalArrayCategory>> <<domain IIARRAY2 InnerIndexedTwoDimensionalArray>> -<<domain IARRAY2 IndexedTwoDimensionalArray>> <<domain ARRAY2 TwoDimensionalArray>> @ \eject Index: src/algebra/exposed.lsp.pamphlet =================================================================== --- src/algebra/exposed.lsp.pamphlet (revision 2834) +++ src/algebra/exposed.lsp.pamphlet (working copy) @@ -823,7 +823,6 @@ (|IndexedExponents| . INDE) (|IndexedFlexibleArray| . IFARRAY) (|IndexedOneDimensionalArray| . IARRAY1) - (|IndexedTwoDimensionalArray| . IARRAY2) (|IndexedVector| . IVECTOR) (|InnerAlgFactor| . IALGFACT) (|InnerAlgebraicNumber| . IAN) Index: src/algebra/matrix.spad.pamphlet =================================================================== --- src/algebra/matrix.spad.pamphlet (revision 2834) +++ src/algebra/matrix.spad.pamphlet (working copy) @@ -30,8 +30,6 @@ R : Ring Row ==> Vector R Col ==> Vector R - mnRow ==> 1 - mnCol ==> 1 MATLIN ==> MatrixLinearAlgebraFunctions(R,Row,Col,$) MATSTOR ==> StorageEfficientMatrixOperations(R) @@ -60,7 +58,7 @@ -- ++ vector of vectors Implementation ==> - InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col) add + InnerIndexedTwoDimensionalArray(R,Row,Col) add minr ==> minRowIndex maxr ==> maxRowIndex minc ==> minColIndex @@ -68,8 +66,8 @@ mini ==> minIndex maxi ==> maxIndex - minRowIndex x == mnRow - minColIndex x == mnCol + minRowIndex x == 1 + minColIndex x == 1 swapRows!(x,i1,i2) == (i1 < minRowIndex(x)) or (i1 > maxRowIndex(x)) or _ Index: src/interp/database.boot =================================================================== --- src/interp/database.boot (revision 2834) +++ src/interp/database.boot (working copy) @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2012, Gabriel Dos Reis. +-- Copyright (C) 2007-2013, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -94,8 +94,8 @@ ++ of the constructor `form'. getConstructorModemap: %Symbol -> %Mode getConstructorModemap ctor == + db := loadDBIfCan constructorDB ctor => dbConstructorModemap db GETDATABASE(ctor, 'CONSTRUCTORMODEMAP) - or dbConstructorModemap loadDBIfNecessary constructorDB ctor getConstructorFormFromDB: %Symbol -> %Form getConstructorFormFromDB ctor == |
From: Gabriel D. R. <gd...@cs...> - 2013-05-10 09:26:45
|
this patch adds opposite? to AbelianMonoid, and annihilate? to Rng. They admit more efficient implementations in AbelianGroup and EntireRing, and more specific domains. 2013-05-10 Gabriel Dos Reis <gd...@in...> * algebra/catdef.spad.pamphlet (AbelianMonoid) [opposite?]: New. (Rng)[annihilate?]: New. (EntireRing) [annihilate?]: Implement. * algebra/integer.spad.pamphlet (Integer): Implement new exports. Index: src/algebra/catdef.spad.pamphlet =================================================================== --- src/algebra/catdef.spad.pamphlet (revision 2825) +++ src/algebra/catdef.spad.pamphlet (working copy) @@ -223,7 +223,7 @@ )abbrev category ABELMON AbelianMonoid ++ Author: ++ Date Created: -++ Date Last Updated: +++ Date Last Updated: May 10, 2013. ++ Basic Functions: ++ Related Constructors: ++ Also See: @@ -240,7 +240,6 @@ -- following domain must be compiled with subsumption disabled -- define SourceLevelSubset to be EQUAL AbelianMonoid(): Category == AbelianSemiGroup with - --operations 0: % ++ 0 is the additive identity element. sample: % @@ -249,6 +248,9 @@ ++ zero?(x) tests if x is equal to 0. *: (NonNegativeInteger,%) -> % ++ n * x is left-multiplication by a non negative integer + opposite?: (%,%) -> Boolean + ++ \spad{opposite?(x,y)} holds if the sum of \spad{x} + ++ and \spad{y} is \spad{0}. add import RepeatedDoubling(%) zero? x == x = 0 @@ -258,6 +260,7 @@ n:NonNegativeInteger * x:% == zero? n => 0 double(n pretend PositiveInteger,x) + opposite?(x,y) == zero?(x + y) @ @@ -792,7 +795,7 @@ )abbrev category ENTIRER EntireRing ++ Author: ++ Date Created: -++ Date Last Updated: +++ Date Last Updated: May 10, 2013. ++ Basic Functions: ++ Related Constructors: ++ Also See: @@ -809,6 +812,8 @@ EntireRing():Category == Join(Ring,BiModule(%,%)) with noZeroDivisors ++ if a product is zero then one of the factors ++ must be zero. + add + annihilate?(x,y) == zero? x or zero? y @ @@ -1433,6 +1438,7 @@ positive? x => x negative? x => -x 0 + opposite?(x,y) == x = -y @ \section{category OAMON OrderedAbelianMonoid} @@ -2020,7 +2026,12 @@ ++ ++ Conditional attributes: ++ \spadnoZeroDivisors\tab{25}\spad{ ab = 0 => a=0 or b=0} -Rng(): Category == Join(AbelianGroup,SemiGroup) +Rng(): Category == Join(AbelianGroup,SemiGroup) with + annihilate?: (%,%) -> Boolean + ++ \spad{annihilate?(x,y)} holds when the product + ++ of \spad{x} and \spad{y} is \spad{0}. + add + annihilate?(x,y) == zero?(x * y) @ @@ -2188,7 +2199,7 @@ <<license>>= --Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --All rights reserved. ---Copyright (C) 2007-2012, Gabriel Dos Reis. +--Copyright (C) 2007-2013, Gabriel Dos Reis. --All rights reversed. -- --Redistribution and use in source and binary forms, with or without Index: src/algebra/integer.spad.pamphlet =================================================================== --- src/algebra/integer.spad.pamphlet (revision 2825) +++ src/algebra/integer.spad.pamphlet (working copy) @@ -205,6 +205,8 @@ zero? p => unitCanonical q zero? q => unitCanonical p gcd([p,q])$HeuGcd(ZP) + opposite?(x,y) == x = -y + annihilate?(x,y) == zero? x or zero? y -- myNextPrime: (%,NonNegativeInteger) -> % -- myNextPrime(x,n) == -- nextPrime(x)$IntegerPrimesPackage(%) Index: src/hyper/pages/releaseNotes.ht =================================================================== --- src/hyper/pages/releaseNotes.ht (revision 2825) +++ src/hyper/pages/releaseNotes.ht (working copy) @@ -35,6 +35,8 @@ IndexedProductTerm The compiler now accepts and process do-statement, like the interpreter. Fix for an interpreter performance regression introduced in 1.4.2. + The category AbelianMonoid has a new export: opposite?. + The category Rng has a new export: annihilate?. \endscroll \autobuttons |
From: Gabriel D. R. <gd...@cs...> - 2013-05-09 16:45:55
|
Several operation implementations on domains isomorphic to IDPO share the same structure. I added this function to capture that. Applied to trunk. 2013-05-09 Gabriel Dos Reis <gd...@in...> * algebra/indexedp.spad.pamphlet (IndexedDirectProductObject) [combineWithIf]: New. Index: src/algebra/indexedp.spad.pamphlet =================================================================== --- src/algebra/indexedp.spad.pamphlet (revision 2820) +++ src/algebra/indexedp.spad.pamphlet (working copy) @@ -93,7 +93,12 @@ IndexedDirectProductObject(A,S): Public == Private where A: BasicType S: OrderedType - Public == IndexedDirectProductCategory(A,S) + Public == IndexedDirectProductCategory(A,S) with + combineWithIf: (%,%, (A,A) -> A, (A,A) -> Boolean) -> % + ++ \spad{combineWithIf(u,v,f,p)} returns the result of combining + ++ index-wise, coefficients of \spad{u} and \spad{u} if when + ++ satisfy the predicate \spad{p}. Those pairs of coefficients + ++ which fail\spad{p} are implicitly ignored. Private == List IndexedProductTerm(A,S) add if A has CoercibleTo OutputForm and S has CoercibleTo OutputForm then coerce(x:%):OutputForm == @@ -113,4 +118,36 @@ index first rep x terms x == rep x convert l == per l + combineWithIf(u, v, f, p) == + x := rep u + y := rep v + empty? x => v + empty? y => u + z: Rep := nil + prev: Rep := nil + while not empty? x and not empty? y repeat + xt := first x + yt := first y + index xt > index yt => + t := [xt] + if empty? z then z := t + else setrest!(prev,t) + prev := t + x := rest x + index xt < index yt => + t := [yt] + if empty? z then z := t + else setrest!(prev,t) + prev := t + y := rest y + not p(coefficient xt, coefficient yt) => iterate + t := [term(index xt, f(coefficient xt, coefficient yt))] + if empty? z then z := t + else setrest!(prev,t) + prev := t + x := rest x + y := rest y + if empty? x then setrest!(prev,y) + else if empty? y then setrest!(prev,x) + per z |
From: Gabriel D. R. <gd...@cs...> - 2012-08-26 22:57:46
|
Alfredo Portes <doy...@gm...> writes: | Build breaks with change to hthits. | | cd hyper && make all-hyper-post | ../../libtool --tag=CXX --mode=compile g++ -c -m32 -o hthits.o -g -O2 | -O2 -Wall -I../../../src/include -I../../config -I. | ../../../src/hyper/hthits.c | libtool: compile: g++ -c -m32 -g -O2 -O2 -Wall -I../../../src/include | -I../../config -I. ../../../src/hyper/hthits.c -fno-common -DPIC -o | .libs/hthits.o | ../../../src/hyper/hthits.c: In function 'void splitpage(char*, | char**, char**)': | ../../../src/hyper/hthits.c:159: error: invalid conversion from 'const | char*' to 'char*' | ../../../src/hyper/hthits.c:162: error: assignment of read-only location | ../../../src/hyper/hthits.c:163: error: invalid conversion from 'const | char*' to 'char*' | ../../../src/hyper/hthits.c: In function 'int main(int, char**)': | ../../../src/hyper/hthits.c:416: warning: deprecated conversion from | string constant to 'char*' | make[2]: *** [hthits.o] Error 1 | make[1]: *** [all-hyper-post] Error 2 | make: *** [all-local] Error 2 right you are. Sorry about that. I don't know how I managed to miss this. Fixed with the patch below. Applied to both trunk and branch. 2012-08-26 Gabriel Dos Reis <gd...@cs...> * hyper/hthits.c (splitpage): Revert unintended change from last commit. * hyper/initx.c (is_it_850): Likewise. *** src/hyper/hthits.c (revision 23089) --- src/hyper/hthits.c (local) *************** *** 1,7 **** /* Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd. All rights reserved. ! Copyright (C) 2007-2009, Gabriel Dos Reis. All rights reserved. Redistribution and use in source and binary forms, with or without --- 1,7 ---- /* Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd. All rights reserved. ! Copyright (C) 2007-2012, Gabriel Dos Reis. All rights reserved. Redistribution and use in source and binary forms, with or without *************** static void *** 136,142 **** splitpage(char* buf, char** ptitle, char** pbody) { int n, depth, tno; ! const char* s; switch (buf[1]) { case 'p': --- 136,142 ---- splitpage(char* buf, char** ptitle, char** pbody) { int n, depth, tno; ! char* s; switch (buf[1]) { case 'p': *** src/hyper/initx.c (revision 23089) --- src/hyper/initx.c (local) *************** *** 1,7 **** /* Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd. All rights reserved. ! Copyright (C) 2007-2010, Gabriel Dos Reis. All rights reserved. Redistribution and use in source and binary forms, with or without --- 1,7 ---- /* Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd. All rights reserved. ! Copyright (C) 2007-2012, Gabriel Dos Reis. All rights reserved. Redistribution and use in source and binary forms, with or without *************** mergeDatabases(void) *** 1000,1006 **** int is_it_850(XFontStruct *fontarg) { ! const char* s; int i,val; static struct { const char *name; --- 1000,1006 ---- int is_it_850(XFontStruct *fontarg) { ! char* s; int i,val; static struct { const char *name; |
From: Gabriel D. R. <gd...@cs...> - 2012-08-25 16:43:39
|
This is the second part of the patch that I prepared to fix the SBCL-based build of OpenAxiom on Windows. The fundamental problem is that SBCL does not support the construction of Lisp programs that use foreign functions defined in DLLs. Of course, since the only supported way to add a foreign function to a Lisp program in SBCL is through DLLs, we do have a problem. Instead of fixing the problem just for SBCL on Windows, I generalized the fix to cover CLisp and Clozure Lisp too. The idea is that just before saving the running core image to disk, we undefine all foreign functions. Here, we are hoping that the Lisp system does not do any of execution time JIT+inlining (if it does, then well all bets are off.) Doing this fixes a long standing problem with CLisp that affects unixoid systems too. Applied to trunk and branch. 2012-08-23 Gabriel Dos Reis <gd...@cs...> * boot/ast.boot ($ffs): New. (genImportDeclaration): Update it. * boot/translator.boot (genModuleFinalization): Tidy. Generate code to update $dynamicForeignFunctions where necessary. (atLoadOrExecutionTime): New. * lisp/core.lisp.in (UNBIND-FOREIGN-FUNCTION-SYMBOLS): New. (saveCore): Use it. ($dynamicForeignFunctions): New. Export. *** src/boot/ast.boot (revision 178) --- src/boot/ast.boot (local) *************** genCLOZUREnativeTranslation(op,s,t,op') *** 1919,1924 **** --- 1919,1927 ---- -- Finally, return the definition form [["DEFUN", op, parms, call]] + ++ List of foreign function symbols defined in this module. + $ffs := nil + ++ Generate an import declaration for `op' as equivalent of the ++ foreign signature `sig'. Here, `foreign' operationally means that ++ the entity is from the C language world. *************** genImportDeclaration(op, sig) == *** 1926,1931 **** --- 1929,1935 ---- sig isnt ["%Signature", op', m] => coreError '"invalid signature" m isnt ["%Mapping", t, s] => coreError '"invalid function type" if s ~= nil and symbol? s then s := [s] + $ffs := [op,:$ffs] %hasFeature KEYWORD::GCL => genGCLnativeTranslation(op,s,t,op') %hasFeature KEYWORD::SBCL => genSBCLnativeTranslation(op,s,t,op') *** src/boot/translator.boot (revision 178) --- src/boot/translator.boot (local) *************** reallyPrettyPrint(x,st == _*STANDARD_-OU *** 53,69 **** writeNewline st genModuleFinalization(stream) == %hasFeature KEYWORD::CLISP => $foreignsDefsForCLisp = nil => nil ! $currentModuleName = nil => ! coreError '"current module has no name" ! init := ! ["EVAL-WHEN", [KEYWORD::LOAD_-TOPLEVEL,KEYWORD::EXECUTE], ! ["PROGN", ! ["MAPC",["FUNCTION", "FMAKUNBOUND"], ! quote [second d for d in $foreignsDefsForCLisp]], ! :[["EVAL",quote d] for d in $foreignsDefsForCLisp]]] ! reallyPrettyPrint(init,stream) nil genOptimizeOptions stream == --- 53,67 ---- writeNewline st genModuleFinalization(stream) == + $ffs = nil => nil + $currentModuleName = nil => coreError '"current module has no name" + setFFS := ["SETQ","$dynamicForeignFunctions", + ["append!",quote $ffs,"$dynamicForeignFunctions"]] + reallyPrettyPrint(atLoadOrExecutionTime setFFS,stream) %hasFeature KEYWORD::CLISP => $foreignsDefsForCLisp = nil => nil ! init := ["PROGN", :[["EVAL",quote d] for d in $foreignsDefsForCLisp]] ! reallyPrettyPrint(atLoadOrExecutionTime init,stream) nil genOptimizeOptions stream == *************** inAllContexts x == *** 403,408 **** --- 401,409 ---- KEYWORD::LOAD_-TOPLEVEL, KEYWORD::EXECUTE], x] + atLoadOrExecutionTime x == + ["EVAL-WHEN",[KEYWORD::LOAD_-TOPLEVEL,KEYWORD::EXECUTE],x] + exportNames ns == ns = nil => nil [inAllContexts ["EXPORT",quote ns]] *** src/lisp/core.lisp.in (revision 178) --- src/lisp/core.lisp.in (local) *************** *** 186,191 **** --- 186,192 ---- "$StandardLinking" "$ECLVersionNumber" "$FilesToRetain" + "$dynamicForeignFunctions" "getOptionValue" "getCommandLineArguments" *************** *** 368,373 **** --- 369,379 ---- (defconstant |$FilesToRetain| '(@oa_keep_files@)) + ;; List of foreign function symbols to unload before saving the + ;; Lisp image. This is meaningful only for those systems not + ;; using standard linking and that delay FFI modules to runtime. + (defparameter |$dynamicForeignFunctions| nil) + ;; Lisp compiler optimization settings. (defconstant |$LispOptimizeOptions| '(@oa_optimize_options@)) *************** *** 817,822 **** --- 823,840 ---- (let ((prologue (|getOptionValue| (|Option| "prologue") options))) (if prologue (read-from-string prologue) nil))) + ;; This is meaningful only for systems that delay FFI. + ;; Unbind foreign function symbols in case delaying FFI modules + ;; is needed. Indeed, these systems should not have references to + ;; foreign symbols that cannot be guaranteed to work properly + ;; when the saved image is restarted. + (defun unbind-foreign-function-symbols () + (when |$delayedFFI| + (mapc #'(lambda (s) + (when (fboundp s) + (fmakunbound s))) + |$dynamicForeignFunctions|))) + ;; Save current image on disk as executable and quit. (defun |saveCore| (core-image &optional (entry-point nil)) ;; When building the OpenAxiom system, and in many other cases I suspect, *************** *** 827,832 **** --- 845,851 ---- (when (consp entry-point) (setq entry-point (apply (car entry-point) (cdr entry-point)))) + (unbind-foreign-function-symbols) #+:sbcl (if (null entry-point) (sb-ext::save-lisp-and-die core-image :executable t) (sb-ext::save-lisp-and-die core-image *************** *** 995,1001 **** (args (member "--" all-args :test #'equal))) (cons (car all-args) (if args (cdr args) args)))) - ;; ;; -*- Building Standalone Executable -*- ;; --- 1014,1019 ---- |
From: Alfredo P. <doy...@gm...> - 2012-08-24 23:34:14
|
Oked by Gaby. Modified: trunk/src/interp/setvars.boot =================================================================== --- trunk/src/interp/setvars.boot 2012-08-23 14:20:14 UTC (rev 2766) +++ trunk/src/interp/setvars.boot 2012-08-24 23:27:33 UTC (rev 2767) @@ -99,7 +99,7 @@ ["type" , :'"set message type"],_ ["unexpose" , :'"set expose drop constructor"],_ ["up" , :'"zsystemdevelopment )update"],_ - ["version" , :'"lisp *yearweek*"],_ + ["version" , :'"lisp *build-version*"],_ ["w" , :'"what"],_ ["wc" , :'"what categories"],_ ["wd" , :'"what domains"],_ |
From: Gabriel D. R. <gd...@cs...> - 2012-08-20 04:41:21
|
Gabriel Dos Reis <gd...@cs...> writes: [...] | Unfortunately, this patch introduces a regression with respect to | CLisp builds (on all platforms I think.) To be fixed in follow patch. With this. 2012-08-19 Gabriel Dos Reis <gd...@cs...> * interp/util.lisp (BUILD-INTERPSYS): loadDelayedFFI early. * interp/sys-driver.boot (%sysInit): Do not call sys-osInitCLispFFI (no longer necessary.) * boot/translator.boot (genModuleFinalization): Generate forms to be evaluated at load and execution time, instead of a function call. * interp/spad.lisp (process): Remove. *** src/boot/translator.boot (revision 170) --- src/boot/translator.boot (local) *************** genModuleFinalization(stream) == *** 58,67 **** $currentModuleName = nil => coreError '"current module has no name" init := ! ["DEFUN", makeSymbol strconc($currentModuleName,'"InitCLispFFI"), nil, ! ["MAPC",["FUNCTION", "FMAKUNBOUND"], ! quote [second d for d in $foreignsDefsForCLisp]], ! :[["EVAL",quote d] for d in $foreignsDefsForCLisp]] reallyPrettyPrint(init,stream) nil --- 58,68 ---- $currentModuleName = nil => coreError '"current module has no name" init := ! ["EVAL-WHEN", [KEYWORD::LOAD_-TOPLEVEL,KEYWORD::EXECUTE], ! ["PROGN", ! ["MAPC",["FUNCTION", "FMAKUNBOUND"], ! quote [second d for d in $foreignsDefsForCLisp]], ! :[["EVAL",quote d] for d in $foreignsDefsForCLisp]]] reallyPrettyPrint(init,stream) nil *** src/interp/spad.lisp (revision 170) --- src/interp/spad.lisp (local) *************** *** 149,161 **** (MAKEPROP 'END_UNIT 'KEY T) - (defun |process| (x) - (COND ((NOT (EQ TOK 'END_UNIT)) - (SETQ DEBUGMODE 'NO) - (SPAD_SYNTAX_ERROR) - (if |$InteractiveMode| (|spadThrow|)) - (|translateSpad| x)))) - (defmacro try (X) `(LET ((|$autoLine|)) (declare (special |$autoLine|)) --- 149,154 ---- *** src/interp/sys-driver.boot (revision 170) --- src/interp/sys-driver.boot (local) *************** symbolFunction('%sysInit) := () +-> *** 63,70 **** SETQ(_*LOAD_-VERBOSE_*,false) initMemoryConfig() )if %hasFeature KEYWORD::CLISP - -- a goat for CLisp FFI, please. - sys_-osInitCLispFFI() -- Tell CLISP to stop being anal retentive, please. SETF(CUSTOM::_*WARN_-ON_-FLOATING_-POINT_-CONTAGION_*,false) )endif --- 63,68 ---- *** src/interp/util.lisp (revision 170) --- src/interp/util.lisp (local) *************** *** 247,255 **** (defun build-interpsys () (reroot) (|resetWorkspaceVariables|) (|AxiomCore|::|%sysInit|) - (|loadDelayedFFI|) (|buildHtMacroTable|) (|initHist|) (|initNewWorld|) --- 247,255 ---- (defun build-interpsys () (reroot) + (|loadDelayedFFI|) (|resetWorkspaceVariables|) (|AxiomCore|::|%sysInit|) (|buildHtMacroTable|) (|initHist|) (|initNewWorld|) |
From: Gabriel D. R. <gd...@cs...> - 2012-08-20 04:38:06
|
Gabriel Dos Reis <gd...@cs...> writes: | In an offline conversation with Alfredo concerning Windows builds, I observed: | | | I run into a build failure but at a different point: | | | | 1. bootsys is fully created | | 2. build of interpsys fails on sys-utility.boot with the claimed | | error that _oa_chdir missing. However, when I do | | | | nm libopen-axiom-code.dll | grep _oa_chdir | | | | It is there with a strong definition. | | | | My GCC is from TDM-GCC (4.6.1) | | | | Is yours from rubenv build? (I am using mingw64 tool chains.) | | | It turned out that a long time ago, we needed to baby-sit SBCL on | Windows with astoundingly painful details, including prepending an | underscore on x86 builds. Since then SBCL's support of Win32 builds has | improved and we no longer need that. | Fixed with the patch below. Applied to trunk and branch. | Now, I can build bootsys and interpsys. Algebra bootstrap fails. | I'll address that in a different patch as it touches a much broader issue. The patch below enables full builds based on SBCL on Windows (32-bit). The problem is not completely fixed though, as the final executable still suffers from the SBCL limited support for DLLs on Windows. Unfortunately, this patch introduces a regression with respect to CLisp builds (on all platforms I think.) To be fixed in follow patch. Applied to trunk and branch. 2012-08-19 Gabriel Dos Reis <gd...@cs...> * configure.ac: Define Automake conditional OA_DELAYED_FFI. * config/open-axiom.m4 (OPENAXIOM_CHECK_DELAYED_FFI): New. (OPENAXIOM_HOST_COMPILERS): Call it. src/ 2012-08-19 Gabriel Dos Reis <gd...@cs...> * lisp/core.lisp.in (primitiveLoad): New. Export. ($delayedFFI): Likewise. * lisp/Makefile.in (oa_delay_ffi): New. (edit): Update. * interp/sys-utility.boot: import sys-constants instead of sys-os. * interp/sys-driver.boot (%sysInit): Do not loadSystemRuntimeCore. (loadDelayedFFI): New. (executeSpadScript): Call it. (compileSpadLibrary): Likewise. (buildInitdbHandler): Likewise. (systemMain): Likewise. * interp/util.lisp (BUILD-INTERPSYS): Likewise. * interp/Makefile.in (oa_target_moddir): New. (OA_FFI_MOD): Likewise. (OA_FFI_OBJ): Define conditionally. (OBJS): Use it. ($(oa_target_delayed)): New rule. (oa_target_delayed): New. (oa_target_ffi): Define conditionally. (${SAVESYS}): Require it. (${AXIOMSYS}): Likewise. (sys-utility.$(FASLEXT)): Now require sys-constants.$(FASLEXT). *** config/open-axiom.m4 (revision 169) --- config/open-axiom.m4 (local) *************** AC_DEFINE_UNQUOTED([OPENAXIOM_BASE_RTS], *** 176,181 **** --- 176,199 ---- [The kind of base runtime system for this build.]) ]) + dnl --------------------------------- + dnl -- OPENAXIOM_CHECK_DELAYED_FFI -- + dnl --------------------------------- + dnl Check whether loading modules for dynamic FFI support + dnl should be delayed to runtime. This is needed for Lisp + dnl systems that have trouble with DLLs. + AC_DEFUN([OPENAXIOM_CHECK_DELAYED_FFI], [ + case ${axiom_lisp_flavor},$host in + sbcl,* | clozure,* | clisp,*) + oa_delay_ffi=yes + ;; + *) + oa_delay_ffi=no + ;; + esac + AC_SUBST([oa_delay_ffi]) + ]) + dnl -------------------------------------------- dnl -- OPENAXIOM_CPPFLAGS_FOR_VENDOR_LOCK_INS -- dnl -------------------------------------------- *************** OPENAXIOM_PROG_LISP *** 207,212 **** --- 225,231 ---- OPENAXIOM_LISP_FLAVOR OPENAXIOM_REJECT_ROTTED_LISP OPENAXIOM_HOST_LISP_CPU_PRECISION + OPENAXIOM_CHECK_DELAYED_FFI ## Are we using compilers from GNU? oa_gnu_compiler=no AC_PROG_CC *** configure.ac (revision 169) --- configure.ac (local) *************** AC_LANG([C++]) *** 81,86 **** --- 81,87 ---- OPENAXIOM_HOST_COMPILERS AM_CONDITIONAL([OA_BUILD_GCL], [test x$oa_include_gcl = xyes]) + AM_CONDITIONAL([OA_DELAYED_FFI], [test x$oa_delay_ffi = xyes]) OPENAXIOM_HOST_DATA_PROPERTIES *** src/Makefile.in (revision 169) --- src/Makefile.in (local) *************** mandir = @mandir@ *** 260,265 **** --- 260,266 ---- mkdir_p = @mkdir_p@ oa_c_runtime = @oa_c_runtime@ oa_c_runtime_extra = @oa_c_runtime_extra@ + oa_delay_ffi = @oa_delay_ffi@ oa_editor = @oa_editor@ oa_enable_checking = @oa_enable_checking@ oa_enable_profiling = @oa_enable_profiling@ *** src/boot/ast.boot (revision 169) --- src/boot/ast.boot (local) *************** genImportDeclaration(op, sig) == *** 1933,1938 **** %hasFeature KEYWORD::ECL => genECLnativeTranslation(op,s,t,op') %hasFeature KEYWORD::CLOZURE => genCLOZUREnativeTranslation(op,s,t,op') fatalError '"import declaration not implemented for this Lisp" - - - --- 1933,1935 ---- *** src/interp/Makefile.in (revision 169) --- src/interp/Makefile.in (local) *************** *** 1,6 **** ## Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ## All rights reserved. ! ## Copyright (C) 2007-2011, Gabriel Dos Reis. ## All rights reserved. ## ## Redistribution and use in source and binary forms, with or without --- 1,6 ---- ## Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ## All rights reserved. ! ## Copyright (C) 2007-2012, Gabriel Dos Reis. ## All rights reserved. ## ## Redistribution and use in source and binary forms, with or without *************** IN=$(srcdir) *** 39,44 **** --- 39,55 ---- DOC=$(axiom_target_docdir)/src/interp BOOK=$(axiom_target_docdir) + ## Where to put interp modules + oa_target_moddir = $(axiom_targetdir)/interp + + ## FFI module. + OA_FFI_MOD = sys-os.$(FASLEXT) + @OA_DELAYED_FFI_FALSE@OA_FFI_OBJ = $(OA_FFI_MOD) + + ## Installed FFI delayed module. + oa_target_delayed = $(oa_target_moddir)/$(OA_FFI_MOD) + @OA_DELAYED_FFI_TRUE@oa_target_ffi = $(oa_target_delayed) + # Driver to launch translation and compilation DRIVER = $(top_builddir)/src/driver/open-axiom$(EXEEXT) *************** SAVESYS= interpsys$(EXEEXT) *** 52,61 **** AXIOMSYS= $(axiom_target_bindir)/AXIOMsys$(EXEEXT) OBJS= boot-pkg.$(FASLEXT) types.$(FASLEXT) \ sys-driver.$(FASLEXT) sys-constants.$(FASLEXT) \ hash.$(FASLEXT) lisp-backend.$(FASLEXT) \ sys-globals.$(FASLEXT) vmlisp.$(FASLEXT) \ ! io.$(FASLEXT) sys-os.$(FASLEXT) \ sys-utility.$(FASLEXT) lexing.$(FASLEXT) \ diagnostics.$(FASLEXT) \ union.$(FASLEXT) sys-macros.$(FASLEXT) \ --- 63,73 ---- AXIOMSYS= $(axiom_target_bindir)/AXIOMsys$(EXEEXT) OBJS= boot-pkg.$(FASLEXT) types.$(FASLEXT) \ + $(OA_FFI_OBJ) \ sys-driver.$(FASLEXT) sys-constants.$(FASLEXT) \ hash.$(FASLEXT) lisp-backend.$(FASLEXT) \ sys-globals.$(FASLEXT) vmlisp.$(FASLEXT) \ ! io.$(FASLEXT) \ sys-utility.$(FASLEXT) lexing.$(FASLEXT) \ diagnostics.$(FASLEXT) \ union.$(FASLEXT) sys-macros.$(FASLEXT) \ *************** clean-local: mostlyclean-local *** 175,180 **** --- 187,195 ---- distclean-local: clean-local + $(oa_target_delayed): $(OA_FFI_MOD) + $(mkdir_p) $(oa_target_moddir) + cp -p $< $@ $(axiom_target_datadir)/msgs/s2-us.msgs: \ $(axiom_src_docdir)/msgs/s2-us.msgs *************** makeint.lisp: Makefile *** 192,198 **** @ echo '#+:gcl (si::gbc-time 0)' >> makeint.lisp @ echo '#+:GCL (si::gbc t)' >> makeint.lisp ! ${SAVESYS}: database.date $(axiom_target_datadir)/msgs/s2-us.msgs $(OBJS) $(DRIVER) --execpath=$(BOOTSYS) \ --syslib=$(axiom_target_libdir) \ --system="$(AXIOM)/" --system-algebra \ --- 207,213 ---- @ echo '#+:gcl (si::gbc-time 0)' >> makeint.lisp @ echo '#+:GCL (si::gbc t)' >> makeint.lisp ! ${SAVESYS}: database.date $(axiom_target_datadir)/msgs/s2-us.msgs $(OBJS) $(oa_target_ffi) $(DRIVER) --execpath=$(BOOTSYS) \ --syslib=$(axiom_target_libdir) \ --system="$(AXIOM)/" --system-algebra \ *************** all-axiomsys: ${AXIOMSYS} *** 208,214 **** ${AXIOMSYS}: database.date \ $(axiom_targetdir)/algebra/exposed.$(FASLEXT) \ $(axiom_target_datadir)/msgs/s2-us.msgs \ ! $(OBJS) makeint.$(LNKEXT) $(DRIVER) --execpath=$(BOOTSYS) \ --syslib=$(axiom_target_libdir) \ --system="$(AXIOM)/" \ --- 223,229 ---- ${AXIOMSYS}: database.date \ $(axiom_targetdir)/algebra/exposed.$(FASLEXT) \ $(axiom_target_datadir)/msgs/s2-us.msgs \ ! $(OBJS) $(oa_target_ffi) makeint.$(LNKEXT) $(DRIVER) --execpath=$(BOOTSYS) \ --syslib=$(axiom_target_libdir) \ --system="$(AXIOM)/" \ *************** hash.$(FASLEXT): types.$(FASLEXT) *** 380,386 **** union.$(FASLEXT): vmlisp.$(FASLEXT) ggreater.$(FASLEXT): vmlisp.$(FASLEXT) lisp-backend.$(FASLEXT): sys-macros.$(FASLEXT) nlib.$(FASLEXT) ! sys-utility.$(FASLEXT): vmlisp.$(FASLEXT) sys-os.$(FASLEXT) hash.$(FASLEXT) vmlisp.$(FASLEXT): types.$(FASLEXT) sys-globals.$(FASLEXT) io.$(FASLEXT): sys-constants.$(FASLEXT) types.$(FASLEXT): boot-pkg.$(FASLEXT) --- 395,401 ---- union.$(FASLEXT): vmlisp.$(FASLEXT) ggreater.$(FASLEXT): vmlisp.$(FASLEXT) lisp-backend.$(FASLEXT): sys-macros.$(FASLEXT) nlib.$(FASLEXT) ! sys-utility.$(FASLEXT): vmlisp.$(FASLEXT) sys-constants.$(FASLEXT) hash.$(FASLEXT) vmlisp.$(FASLEXT): types.$(FASLEXT) sys-globals.$(FASLEXT) io.$(FASLEXT): sys-constants.$(FASLEXT) types.$(FASLEXT): boot-pkg.$(FASLEXT) *** src/interp/sys-driver.boot (revision 169) --- src/interp/sys-driver.boot (local) *************** symbolFunction('%sysInit) := () +-> *** 62,68 **** SETQ(_*PACKAGE_*, FIND_-PACKAGE '"BOOT") SETQ(_*LOAD_-VERBOSE_*,false) initMemoryConfig() - loadSystemRuntimeCore() )if %hasFeature KEYWORD::CLISP -- a goat for CLisp FFI, please. sys_-osInitCLispFFI() --- 62,67 ---- *************** initializeDatabases firstTime? == *** 187,192 **** --- 186,196 ---- fillDatabasesInCore() mkLowerCaseConTable() + ++ If the FFI was delayed to runtime, load it. + loadDelayedFFI() == + not $delayedFFI => nil + primitiveLoad strconc(systemRootDirectory(),'"interp/sys-os") + ++ Initialize all global states that need to. Sub-routine of the command ++ line compiler, the script executor, etc. Mess with care. initializeGlobalState() == *************** executeSpadScript(progname,options,file) *** 261,266 **** --- 265,271 ---- $ReadingFile: local := true -- $ProcessInteractiveValue: local := true $verbose: local := false + loadDelayedFFI() initializeGlobalState() outfile := getOptionValue "output" testing := getOptionValue "test" *************** associateRequestWithFileType(Option '"sc *** 290,295 **** --- 295,301 ---- ++ compiler Spad Library File. compileSpadLibrary(progname,options,file) == $displayStartMsgs := false + loadDelayedFFI() initializeGlobalState() $Echo: local := false $verbose := false *************** associateRequestWithFileType(Option '"co *** 306,311 **** --- 312,318 ---- buildDatabasesHandler(prog,options,args) == $displayStartMsgs := false + loadDelayedFFI() initializeGlobalState() MAKE_-DATABASES args coreQuit(errorCount() > 0 => 1; 0) *************** installDriver(Option '"build-databases", *** 315,320 **** --- 322,328 ---- buildInitdbHandler(prog,options,args) == $displayStartMsgs := false + loadDelayedFFI() initializeGlobalState() srcdir := getOptionValue "spad-srcdir" or coreError '"missing --spad-srcdir=<dir> argument" *************** systemMain() == *** 337,342 **** --- 345,351 ---- -- ??? do any substantial work if we call from it. AxiomCore::topLevel() REROOT() + loadDelayedFFI() -- ??? Make this call unconditional if $StandardLinking then initializeGlobalState() *** src/interp/sys-utility.boot (revision 169) --- src/interp/sys-utility.boot (local) *************** *** 33,39 **** -- This file defines some utility functions common to both the compiler -- and interpreter. ! import sys_-os import vmlisp import hash namespace BOOT --- 33,39 ---- -- This file defines some utility functions common to both the compiler -- and interpreter. ! import sys_-constants import vmlisp import hash namespace BOOT *** src/interp/util.lisp (revision 169) --- src/interp/util.lisp (local) *************** *** 249,254 **** --- 249,255 ---- (reroot) (|resetWorkspaceVariables|) (|AxiomCore|::|%sysInit|) + (|loadDelayedFFI|) (|buildHtMacroTable|) (|initHist|) (|initNewWorld|) *** src/lisp/Makefile.in (revision 169) --- src/lisp/Makefile.in (local) *************** $(oa_target_lispdir)/linkset: $(oa_targe *** 132,137 **** --- 132,138 ---- echo '$(base_lisp_objects)' > $@ oa_optimize_options = @oa_optimize_options@ + oa_delay_ffi = @oa_delay_ffi@ oa_editor = @oa_editor@ *************** edit = sed \ *** 161,166 **** --- 162,168 ---- -e 's|@oa_c_runtime_extra[@]|$(patsubst %,"%",$(oa_c_runtime_extra))|g' \ -e 's|@oa_standard_linking[@]|$(oa_standard_linking)|g' \ -e 's|@oa_enable_profiling[@]|$(oa_enable_lisp_profiling)|g' \ + -e 's|@oa_delay_ffi[@]|$(oa_delay_ffi)|g' \ -e 's|@void_type[@]|$(void_type)|g' \ -e 's|@char_type[@]|$(char_type)|g' \ -e 's|@int_type[@]|$(int_type)|g' \ *** src/lisp/core.lisp.in (revision 169) --- src/lisp/core.lisp.in (local) *************** *** 139,144 **** --- 139,145 ---- "%FunctorDefaultTable" "%FunctorLookupFunction" + "primitiveLoad" "coreQuit" "fatalError" "internalError" *************** *** 176,181 **** --- 177,183 ---- "$targetPlatform" "$faslType" + "$delayedFFI" "$effectiveFaslType" "$NativeModuleExt" "$systemInstallationDirectory" *************** *** 420,425 **** --- 422,431 ---- #+:gcl nil #-(or :ecl :gcl) t) + ;; True if FFI modules were delayed till runtime. + (defconstant |$delayedFFI| + (eq '@oa_delay_ffi@ 'yes)) + ;; The top level read-eval-print loop function of the base ;; Lisp system we are using. This is a very brittle way ;; of achieving something conceptually simple. *************** *** 852,857 **** --- 858,867 ---- (error "don't know how to save Lisp image")) + ;; Load a module designated by `f'. + (defmacro |primitiveLoad| (f) + `(load ,f)) + ;; ;; -*- Program Termination -*- ;; |
From: Gabriel D. R. <gd...@cs...> - 2012-08-19 05:16:55
|
In an offline conversation with Alfredo concerning Windows builds, I observed: | I run into a build failure but at a different point: | | 1. bootsys is fully created | 2. build of interpsys fails on sys-utility.boot with the claimed | error that _oa_chdir missing. However, when I do | | nm libopen-axiom-code.dll | grep _oa_chdir | | It is there with a strong definition. | | My GCC is from TDM-GCC (4.6.1) | | Is yours from rubenv build? (I am using mingw64 tool chains.) It turned out that a long time ago, we needed to baby-sit SBCL on Windows with astoundingly painful details, including prepending an underscore on x86 builds. Since then SBCL's support of Win32 builds has improved and we no longer need that. Fixed with the patch below. Applied to trunk and branch. Now, I can build bootsys and interpsys. Algebra bootstrap fails. I'll address that in a different patch as it touches a much broader issue. -- Gaby 2012-08-18 Gabriel Dos Reis <gd...@cs...> * boot/ast.boot (genSBCLnativeTranslation): Do no prepend an underbar when WIN32 (no longer necessary.) * include/open-axiom.h (OPENAXIOM_EXPORT): Fix thino. *** src/boot/ast.boot (revision 23069) --- src/boot/ast.boot (local) *************** genSBCLnativeTranslation(op,s,t,op') == *** 1854,1862 **** if needsStableReference? x then unstableArgs := [a,:unstableArgs] ! op' := ! %hasFeature KEYWORD::WIN32 => strconc('"__",symbolName op') ! symbolName op' unstableArgs = nil => [["DEFUN",op,args, --- 1854,1860 ---- if needsStableReference? x then unstableArgs := [a,:unstableArgs] ! op' := symbolName op' unstableArgs = nil => [["DEFUN",op,args, *** src/include/open-axiom.h (revision 23069) --- src/include/open-axiom.h (local) *************** *** 50,56 **** #ifdef __WIN32__ # ifdef DLL_EXPORT # define OPENAXIOM_EXPORT __declspec(dllexport) ! # elif defined(OPENAXIOM_DLL_IMPORT) # define OPENAXIOM_EXPORT __declspec(dllimport) # endif /* DLL_EXPORT */ # ifndef WIN32_LEAN_AND_MEAN --- 50,56 ---- #ifdef __WIN32__ # ifdef DLL_EXPORT # define OPENAXIOM_EXPORT __declspec(dllexport) ! # elif defined(DLL_IMPORT) # define OPENAXIOM_EXPORT __declspec(dllimport) # endif /* DLL_EXPORT */ # ifndef WIN32_LEAN_AND_MEAN |
From: Gabriel D. R. <gd...@cs...> - 2012-08-19 00:22:48
|
This patchlet does various cleanups that arose while looking into a build failure on 64-bit Windows 7 reported by Alfredo. Applied to both branch and trunk. 2012-08-18 Gabriel Dos Reis <gd...@cs...> * boot/translator.boot (shoeOutParse): Fix thinko. * lib/cfuns-c.c (oa_getcwd): Tidy. (oa_spawn): Likewise. * lib/sockio-c.c (send_string_len): Likewise. * utils/command.cc (option_value): Likewise. (execute_core): Likewise. *** src/boot/translator.boot (revision 23066) --- src/boot/translator.boot (local) *************** shoeOutParse toks == *** 362,371 **** catch(e: BootParserException) => e found = 'TRAPPED => nil not bStreamNull parserTokens ps => ! bpGeneralErrorHere() nil parserTrees ps = nil => ! bpGeneralErrorHere() nil first parserTrees ps --- 362,371 ---- catch(e: BootParserException) => e found = 'TRAPPED => nil not bStreamNull parserTokens ps => ! bpGeneralErrorHere ps nil parserTrees ps = nil => ! bpGeneralErrorHere ps nil first parserTrees ps *** src/lib/cfuns-c.c (revision 23066) --- src/lib/cfuns-c.c (local) *************** oa_setenv(const char* var, const char* v *** 611,620 **** OPENAXIOM_C_EXPORT char* oa_getcwd(void) { ! int bufsz = 256; char* buf = (char*) malloc(bufsz); #ifdef __WIN32__ ! int n = GetCurrentDirectory(bufsz, buf); if (n == 0) { perror("oa_getcwd"); exit(-1); --- 611,620 ---- OPENAXIOM_C_EXPORT char* oa_getcwd(void) { ! size_t bufsz = 256; char* buf = (char*) malloc(bufsz); #ifdef __WIN32__ ! DWORD n = GetCurrentDirectory(bufsz, buf); if (n == 0) { perror("oa_getcwd"); exit(-1); *************** oa_spawn(Process* proc, SpawnFlags flags *** 800,806 **** /* lpCurrentDirectory */ NULL, /* lpstartupInfo */ &startup_info, /* lpProcessInformation */ &proc_info) == 0) { ! fprintf(stderr, "oa_spawn: error %d\n", GetLastError()); return proc->id = -1; } proc->id = proc_info.dwProcessId; --- 800,806 ---- /* lpCurrentDirectory */ NULL, /* lpstartupInfo */ &startup_info, /* lpProcessInformation */ &proc_info) == 0) { ! fprintf(stderr, "oa_spawn: error %lu\n", GetLastError()); return proc->id = -1; } proc->id = proc_info.dwProcessId; *** src/lib/sockio-c.c (revision 23066) --- src/lib/sockio-c.c (local) *************** send_string_len(openaxiom_sio *sock, con *** 663,669 **** val = swrite(sock, (const Byte*) buf, len+1, "send_string_len"); } if (val == -1) { ! return -1; } return 0; } --- 663,669 ---- val = swrite(sock, (const Byte*) buf, len+1, "send_string_len"); } if (val == -1) { ! return val; } return 0; } *** src/utils/command.cc (revision 23066) --- src/utils/command.cc (local) *************** namespace OpenAxiom { *** 113,119 **** const char* option_value(const Command* command, const char* opt) { ! const int n = strlen(opt); for (int i = 1; i < command->core.argc; ++i) { const char* arg = command->core.argv[i]; if (strlen(arg) < n) --- 113,119 ---- const char* option_value(const Command* command, const char* opt) { ! const size_t n = strlen(opt); for (int i = 1; i < command->core.argc; ++i) { const char* arg = command->core.argv[i]; if (strlen(arg) < n) *************** execute_core(const Command* command, Dri *** 506,512 **** /* lpCurrentDirectory */ NULL, /* lpstartupInfo */ &startupInfo, /* lpProcessInformation */ &procInfo) == 0) { ! fprintf(stderr, "error %d\n", GetLastError()); abort(); } WaitForSingleObject(procInfo.hProcess, INFINITE); --- 506,512 ---- /* lpCurrentDirectory */ NULL, /* lpstartupInfo */ &startupInfo, /* lpProcessInformation */ &procInfo) == 0) { ! fprintf(stderr, "error %lu\n", GetLastError()); abort(); } WaitForSingleObject(procInfo.hProcess, INFINITE); |
From: Gabriel D. R. <gd...@cs...> - 2012-07-25 08:09:28
|
Aleksej Saushev <as...@in...> writes: | Hello, | | I need the following changes (attached) to build HEAD OpenAxiom without X11 support. Applied to both trunk and 1.4.x branch as below. Thanks! -- Gaby 2012-07-25 Aleksej Saushev <as...@in...> * hyper/htadd.c: Include <string.h> * hyper/lex.c: Likewise. *** src/hyper/htadd.c (revision 23039) --- src/hyper/htadd.c (local) *************** *** 43,48 **** --- 43,49 ---- #include <stdlib.h> #include <sys/stat.h> #include <stdlib.h> + #include <string.h> #include <locale.h> #include "cfuns.h" *** src/hyper/lex.c (revision 23039) --- src/hyper/lex.c (local) *************** *** 62,67 **** --- 62,68 ---- #include <ctype.h> #include <setjmp.h> #include <stdlib.h> + #include <string.h> #include "debug.h" #include "sockio.h" |
From: Gabriel D. R. <gd...@cs...> - 2012-05-21 06:59:37
|
Игорь Пашев <pas...@gm...> writes: | How I have failure on linux/amd64 too: | ..... | ../../src/utils/hammer --tangle | --output=../../x86_64-pc-linux-gnu/src/algebra/xlpoly.spad | ../../../src/algebra/xlpoly.spad.pamphlet | ../../src/utils/hammer --tangle | --output=../../x86_64-pc-linux-gnu/src/algebra/xpoly.spad | ../../../src/algebra/xpoly.spad.pamphlet | ../../src/utils/hammer --tangle | --output=../../x86_64-pc-linux-gnu/src/algebra/ystream.spad | ../../../src/algebra/ystream.spad.pamphlet | ../../src/utils/hammer --tangle | --output=../../x86_64-pc-linux-gnu/src/algebra/zerodim.spad | ../../../src/algebra/zerodim.spad.pamphlet | ../driver/open-axiom --execpath=../interp/interpsys | --system="../../x86_64-pc-linux-gnu" \ | --spad-srcdir=../../x86_64-pc-linux-gnu/src/algebra \ | --output=initdb.$$ --build-initdb && \ | ../../../config/move-if-change initdb.$$ initdb.daase | GCL (GNU Common Lisp) 2.6.7 CLtL1 May 6 2012 01:50:10 | Source License: LGPL(gcl,gmp), GPL(unexec,bfd,xgcl) | Binary License: GPL due to GPL'ed components: (XGCL READLINE UNEXEC) | Modifications of this banner must retain notice of a compatible license | Dedicated to the memory of W. Schelter | | Use (help) to get some basic information on how to use GCL. | Temporary directory for compiler files set to /tmp/ | REALSOLV abbreviates package RealSolvePackage | | >> System error: | Arg or result mismatch in call to |drop| As I said before, this is caused a type proclamation bug in GCL. The patch below avoids `drop' in AddParensAndSemisToLine, which made the construction of the initial database complete. However compilation of the very first constructor, Type, fails for similar reasons with `take'. Since, the patch actually simplifies two functions, I committed it anyway. -- Gaby 2012-05-21 Gabriel Dos Reis <gd...@cs...> * interp/spad-parser.boot (addParensAndSemisToLine): Drop 'drop', avoiding awakening GCL bug and quadratic traversal of lines. (parsePiles): Simplify. *** src/interp/spad-parser.boot (revision 105) --- src/interp/spad-parser.boot (local) *************** addParensAndSemisToLine(lines,locs) == *** 177,204 **** sc := first locs -- first line column number sc = nil or sc <= 0 => nil count := 0 -- number of semicolons added ! i := 0 -- running local line number for x in tails rest lines for y in tails rest locs repeat ! i := i + 1 ! nc := first y ! nc = nil => nil ! nc := abs nc ! nc < sc => leave nil ! nc = sc and (y.first := -nc) and not infixToken? first x => ! z := drop(i - 1,lines) ! z.first := addClose(first z,char ";") ! count := count + 1 count > 0 => first(lines).(firstNonblankCharPosition first lines - 1) := char "(" ! lines := drop(i - 1,lines) ! lines.first := addClose(first lines,char ")") nil ++ Add parens and semis to lines to aid parsing. parsePiles(locs,lines) == ! for x in tails append!(lines,['" "]) ! for y in tails append!(locs,[nil]) repeat ! addParensAndSemisToLine(x,y) lines parsePrint l == --- 177,202 ---- sc := first locs -- first line column number sc = nil or sc <= 0 => nil count := 0 -- number of semicolons added ! z := lines for x in tails rest lines for y in tails rest locs repeat ! do ! nc := first y ! nc = nil => nil ! nc := abs nc ! nc < sc => leave nil ! nc = sc and (y.first := -nc) and not infixToken? first x => ! z.first := addClose(first z,char ";") ! count := count + 1 ! z := rest z count > 0 => first(lines).(firstNonblankCharPosition first lines - 1) := char "(" ! z.first := addClose(first z,char ")") nil ++ Add parens and semis to lines to aid parsing. parsePiles(locs,lines) == ! for x in tails lines for y in tails locs repeat ! addParensAndSemisToLine(x,y) lines parsePrint l == |
From: Игорь П. <pas...@gm...> - 2012-05-10 15:14:42
|
Done :-) http://open-axiom.svn.sourceforge.net/viewvc/open-axiom?view=revision&revision=2672 |
From: Gabriel D. R. <gd...@in...> - 2012-05-10 14:32:37
|
On Thu, May 10, 2012 at 7:33 AM, Игорь Пашев <pas...@gm...> wrote: > Debian's Lintian tool is so kind, that it finds spelling errors in binaries > :-) > > Is it ok to push? Yes. Please apply to both trunk and 1.4.x branch with ChangeLog entries. Thanks! -- Gaby |
From: Gabriel D. R. <gd...@cs...> - 2012-02-26 05:08:40
|
This patch removes the artificial pessimization of higher-order function arguments. 2012-02-25 Gabriel Dos Reis <gd...@cs...> * interp/compiler.boot (compTopLevel): Do not bind $killOptimizeIfTrue. (compWithMappingMode): Likewise. (compUnnamedMapping): Likewise. (extractCode): Simplify. * interp/g-opt.boot (optClosure): New. Register. (semiSimpleRelativeTo?): An abstraction is always semisimple. * interp/nruncomp.boot ($killOptimizeIfTrue): Remove. (optDeltaEntry): Don't test for it. *** src/interp/compiler.boot (revision 22066) --- src/interp/compiler.boot (local) *************** compTopLevel: (%Form,%Mode,%Env) -> %May *** 92,98 **** compTopLevel(x,m,e) == -- signals that target is derived from lhs-- see NRTmakeSlot1Info $NRTderivedTargetIfTrue: local := false - $killOptimizeIfTrue: local := false $forceAdd: local:= false -- start with a base list of domains we may want to inline. $optimizableConstructorNames: local := $SystemInlinableConstructorNames --- 92,97 ---- *************** finishLambdaExpression(expr is ["LAMBDA" *** 338,344 **** ['%closure,fname,vec] compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) == - $killOptimizeIfTrue: local := true e := oldE isFunctor x => if get(x,"modemap",$CategoryFrame) is [[[.,target,:argModeList],.],:.] and --- 337,342 ---- *************** compWithMappingMode(x,m is ["Mapping",m' *** 360,371 **** [finishLambdaExpression(fun,e),m,oldE] extractCode(u,vars) == ! u is ['%call,fn,: =vars] => ! fn is ['%apply,a] => a ! fn is [q,:.] and q in '(ELT CONST) => ['%tref,:fn.args] ! fn ! [op,:.,env] := u ! ['%closure,['%function,op],env] compExpression(x,m,e) == $insideExpressionIfTrue: local:= true --- 358,366 ---- [finishLambdaExpression(fun,e),m,oldE] extractCode(u,vars) == ! u is ['%call,['%apply,a],: =vars] => a ! u is ['%call,[q,:etc],: =vars] and q in '(ELT CONST) => ['%tref,:etc] ! ['%closure,['%function,['%lambda,[:vars,'$],u]],'$] compExpression(x,m,e) == $insideExpressionIfTrue: local:= true *************** compRep(["rep",x],m,e) == *** 2751,2757 **** --% Lambda expressions compUnnamedMapping(parms,source,target,body,env) == - $killOptimizeIfTrue: local := true savedEnv := env for p in parms for s in source repeat [.,.,env] := compMakeDeclaration(p,s,env) --- 2746,2751 ---- *** src/interp/g-opt.boot (revision 22066) --- src/interp/g-opt.boot (local) *************** optCall (x is ['%call,:u]) == *** 551,561 **** x.first := op x.rest := a x ! fn is [q,R,n] and q in '(ELT CONST) => ! q is 'CONST => ['spadConstant,R,n] ! emitIndirectCall(fn,a,x) systemErrorHere ['optCall,x] optCons (x is ["CONS",a,b]) == a is "NIL" => b is 'NIL => (x.first := 'QUOTE; x.rest := ['NIL,:'NIL]; x) --- 551,569 ---- x.first := op x.rest := a x ! fn is ['ELT,:.] => emitIndirectCall(fn,a,x) ! fn is ['CONST,R,n] => ['spadConstant,R,n] systemErrorHere ['optCall,x] + optClosure(x is ['%closure,fun,env]) == + fun is ['%function,['%lambda,vars,body]] => + do + vars is [:vars',=env] => + body is [op,: =vars] => x.args := [['%function,op],env] + not CONTAINED(env,body) => x.args := [fun,'%nil] + x + x + optCons (x is ["CONS",a,b]) == a is "NIL" => b is 'NIL => (x.first := 'QUOTE; x.rest := ['NIL,:'NIL]; x) *************** $simpleVMoperators == *** 660,665 **** --- 668,674 ---- semiSimpleRelativeTo?(form,ops) == atomic? form => true not symbol?(form.op) or not symbolMember?(form.op,ops) => false + abstraction? form.op => true -- always, regardless of body form.op is '%when => and/[sideEffectFree? p and semiSimpleRelativeTo?(c,ops) for [p,c] in form.args] *************** for x in '((%call optCall) _ *** 996,1001 **** --- 1005,1011 ---- (%2bool opt2bool)_ (%list optList)_ (SPADCALL optSPADCALL)_ + (%closure optClosure)_ (_| optSuchthat)_ (%scope optScope)_ (%when optCond)_ *** src/interp/nruncomp.boot (revision 22066) --- src/interp/nruncomp.boot (local) *************** $NRTaddForm := nil *** 57,63 **** ++ $NRTderivedTargetIfTrue := false - $killOptimizeIfTrue := false NRTaddDeltaCode db == --NOTES: This function is called from buildFunctor to initially --- 57,62 ---- *************** needToQuoteFlags?(sig,env) == *** 154,160 **** ident? t and null get(t,"value",e) optDeltaEntry(op,sig,dc,kind) == - $killOptimizeIfTrue => nil -- references to modemaps from current domain are folded in a later -- stage of the compilation process. dc is '$ => nil --- 153,158 ---- |
From: Gabriel D. R. <gd...@cs...> - 2012-01-14 22:39:29
|
KleeneTrivalentLogic really has finite values. Reflect that in the exports. Using Byte as representation domain for KleeneTrivalentLogic smells a bit of a "system" view of the world. A higher level view is Maybe Boolean. With no loss in efficiency. Also, provide default implementation for random$Finite. Applied to mainline and 1.4.x branch. 2012-01-14 Gabriel Dos Reis <gd...@cs...> * algebra/catdef.spad.pamphlet (Finite) [random]: Provide default implementation. * algebra/boolean.spad.pamphlet (KleeneTrivalentLogic): Now satisfy Finite. Use Maybe Boolean as representation. *** src/algebra/boolean.spad.pamphlet (revision 21813) --- src/algebra/boolean.spad.pamphlet (local) *************** Bits(): Exports == Implementation where *** 611,621 **** )abbrev domain KTVLOGIC KleeneTrivalentLogic ++ Author: Gabriel Dos Reis ++ Date Created: September 20, 2008 ! ++ Date Last Modified: May 27, 2009 ++ Description: ++ This domain implements Kleene's 3-valued propositional logic. KleeneTrivalentLogic(): Public == Private where ! Public == PropositionalLogic with unknown: % ++ the indefinite `unknown' case: (%,[| false |]) -> Boolean ++ x case false holds if the value of `x' is `false' --- 611,621 ---- )abbrev domain KTVLOGIC KleeneTrivalentLogic ++ Author: Gabriel Dos Reis ++ Date Created: September 20, 2008 ! ++ Date Last Modified: January 14, 2012 ++ Description: ++ This domain implements Kleene's 3-valued propositional logic. KleeneTrivalentLogic(): Public == Private where ! Public == Join(PropositionalLogic,Finite) with unknown: % ++ the indefinite `unknown' case: (%,[| false |]) -> Boolean ++ x case false holds if the value of `x' is `false' *************** KleeneTrivalentLogic(): Public == Privat *** 623,676 **** ++ x case unknown holds if the value of `x' is `unknown' case: (%,[| true |]) -> Boolean ++ s case true holds if the value of `x' is `true'. ! Private == add ! Rep == Byte -- We need only 3 bits, in fact. ! false == per(0::Byte) ! unknown == per(1::Byte) ! true == per(2::Byte) x = y == rep x = rep y x case true == x = true@% x case false == x = false@% x case unknown == x = unknown not x == x case false => true x case unknown => unknown false x and y == x case false => false x case unknown => y case false => false unknown y x or y == x case false => y x case true => x y case true => y unknown implies(x,y) == x case false => true x case true => y y case true => true unknown equiv(x,y) == x case unknown => x x case true => y not y coerce(x: %): OutputForm == ! x case true => outputForm 'true ! x case false => outputForm 'false ! outputForm 'unknown ! @ \section{License} <<license>>= --Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. --All rights reserved. ! --Copyright (C) 2007-2010, Gabriel Dos Reis. --All rights reserved. -- --Redistribution and use in source and binary forms, with or without --- 623,691 ---- ++ x case unknown holds if the value of `x' is `unknown' case: (%,[| true |]) -> Boolean ++ s case true holds if the value of `x' is `true'. ! Private == Maybe Boolean add ! false == per just(false@Boolean) ! unknown == per nothing ! true == per just(true@Boolean) x = y == rep x = rep y x case true == x = true@% x case false == x = false@% x case unknown == x = unknown + not x == x case false => true x case unknown => unknown false + x and y == x case false => false x case unknown => y case false => false unknown y + x or y == x case false => y x case true => x y case true => y unknown + implies(x,y) == x case false => true x case true => y y case true => true unknown + equiv(x,y) == x case unknown => x x case true => y not y + coerce(x: %): OutputForm == ! case rep x is ! y@Boolean => y::OutputForm ! otherwise => outputForm 'unknown + size() == 3 + index n == + n > 3 => error "index: argument out of bound" + n = 1 => false + n = 2 => unknown + true + lookup x == + x = false => 1 + x = unknown => 2 + 3 + @ \section{License} <<license>>= --Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. --All rights reserved. ! --Copyright (C) 2007-2012, Gabriel Dos Reis. --All rights reserved. -- --Redistribution and use in source and binary forms, with or without *** src/algebra/catdef.spad.pamphlet (revision 21813) --- src/algebra/catdef.spad.pamphlet (local) *************** Field(): Category == Join(EuclideanDomai *** 915,921 **** ++ \spad{index(lookup(s)) = s} Finite(): Category == SetCategory with - --operations size: () -> NonNegativeInteger ++ size() returns the number of elements in the set. index: PositiveInteger -> % --- 915,920 ---- *************** Finite(): Category == SetCategory with *** 928,934 **** ++ \spad{x = index lookup x}. random: () -> % ++ random() returns a random element from the set. ! @ \section{category FLINEXP FullyLinearlyExplicitRingOver} <<category FLINEXP FullyLinearlyExplicitRingOver>>= --- 927,941 ---- ++ \spad{x = index lookup x}. random: () -> % ++ random() returns a random element from the set. ! add ! --FIXME: Tthe only purpose of this local function is to bring ! --FIXME: the compiler to admission that the successor of a ! --FIXME: nonnegative integer has positive value. ! --FIXME: Take it out when the its logic is sufficiently advanced. ! succ(x: NonNegativeInteger): PositiveInteger == ! (1 + x) : PositiveInteger ! random() == ! index succ random(size())$NonNegativeInteger @ \section{category FLINEXP FullyLinearlyExplicitRingOver} <<category FLINEXP FullyLinearlyExplicitRingOver>>= |
From: Gabriel D. R. <gd...@cs...> - 2011-12-04 11:07:49
|
The algebra is littered with codes that do multiple assignment in one expression, e.g. x := y := z := expr This patch has the middle end split those multiple assignments into sequences of simple assignments, e.g. z := expr y := z x := y Applied to trunk and 1.4.x branch. 2011-12-04 Gabriel Dos Reis <gd...@cs...> * interp/g-util.boot (splitAssignments): New. (spliceSeqArgs): Use it. *** src/interp/g-util.boot (revision 21634) --- src/interp/g-util.boot (local) *************** mkBind(inits,expr) == *** 68,73 **** --- 68,80 ---- mkBind([:inits,:inits'],expr') ['%bind,inits,expr] + splitAssignments u == main(u,nil) where + main(u,l) == + u is ['%LET,x,v] => + v is ['%LET,y,.] => main(v,[['%LET,x,y],:l]) + [u,:l] + nil + ++ We have a list `l' of expressions to be executed sequentially. ++ Splice in any directly-embedded sequence of expressions. ++ NOTES: This function should not be called on any program with *************** spliceSeqArgs l == *** 79,84 **** --- 86,95 ---- stmts = nil => spliceSeqArgs rest l lastNode(stmts).rest := spliceSeqArgs rest l stmts + s := first l + s is ['%LET,x,y] and (stmts := splitAssignments y) => + lastNode(stmts).rest := [['%LET,x,second y],:spliceSeqArgs rest l] + stmts rest l = nil => l l.rest := spliceSeqArgs rest l l |
From: Gabriel D. R. <gd...@cs...> - 2011-12-04 03:07:41
|
On many occasions, the generated Lisp code looks a bit overly complicated making uses of SEQ/EXIT when they are semantically equivalent to PROGN. Fixed thusly. Applied to trunk and 1.4.x branch. 2011-12-03 Gabriel Dos Reis <gd...@cs...> * interp/lisp-backend.boot (hasNoExit?): New. (expandSeq): Likewise. Use it. Expand %seq forms. *** src/interp/lisp-backend.boot (revision 21633) --- src/interp/lisp-backend.boot (local) *************** expandReturn(x is ['%return,.,y]) == *** 206,211 **** --- 206,229 ---- $FUNNAME = nil => systemErrorHere ['expandReturn,x] ['RETURN_-FROM,$FUNNAME,expandToVMForm y] + + ++ Subroutine of expandSeq. + ++ Return true if the form `x' contains no %exit form. + hasNoExit? x == + atomic? x => true + x is ['%exit,:.] => false + and/[hasNoExit? s for s in x] + + ++ Expand a sequence of statements with possible non-local + ++ lexical control transfer. Attempt to recognize those with + ++ normal lexical exit. + expandSeq(x is ['%seq,:stmts]) == + [:stmts',val] := stmts + and/[hasNoExit? s for s in stmts'] and + val is ['%exit,val'] and hasNoExit? val' => + ['PROGN,:[expandToVMForm s for s in stmts'],expandToVMForm val'] + ['SEQ,:[expandToVMForm s for s in stmts]] + -- Pointer operations expandPeq ['%peq,x,y] == x = '%nil => ['NULL,expandToVMForm y] *************** for x in [ *** 637,643 **** ['%funcall, :'FUNCALL], ['%function, :'FUNCTION], ['%lambda, :'LAMBDA], - ['%seq, :'SEQ], ['%exit, :'EXIT], ['%when, :'COND], --- 655,660 ---- *************** for x in [ *** 653,659 **** ['%collect, :function expandCollect], ['%loop, :function expandLoop], ['%return, :function expandReturn], ! ['%leave, :function expandLeave], ['%bcompl, :function expandBcompl], --- 670,677 ---- ['%collect, :function expandCollect], ['%loop, :function expandLoop], ['%return, :function expandReturn], ! ['%leave, :function expandLeave], ! ['%seq, :function expandSeq], ['%bcompl, :function expandBcompl], |
From: Gabriel D. R. <gd...@cs...> - 2011-12-03 21:25:08
|
There are places where the compiler generates PROGN forms when it wants to emit a sequence of expressions. It wasn't using SEQ because that was already abused and using it for this purpose would have had the wrong semantics. Now that we replaced SEQ with %seq with clearer semantics, we can use %seq where PROGN was used. Applied to trunk and 1.4.x branch. 2011-12-03 Gabriel Dos Reis <gd...@cs...> * interp/compiler.boot: Use %seq in lieu of PROGN. * interp/g-util.boot (spliceSeqArgs): New. * interp/g-opt.boot (changeVariableDefinitionToStore): Call it before recursing on %seq forms. *** src/interp/compiler.boot (revision 21632) --- src/interp/compiler.boot (local) *************** freeVarUsage([.,vars,body],env) == *** 271,277 **** for v in CDDR u repeat free := freeList(v,bound,free,e) free ! op = "PROG" => bound := setUnion(bound, second u) for v in CDDR u | cons? v repeat free := freeList(v,bound,free,e) --- 271,277 ---- for v in CDDR u repeat free := freeList(v,bound,free,e) free ! op = 'PROG => bound := setUnion(bound, second u) for v in CDDR u | cons? v repeat free := freeList(v,bound,free,e) *************** setqMultiple(nameList,val,m,e) == *** 978,984 **** m1 is ["List",D] => for y in nameList repeat e:= giveVariableSomeValue(y,D,e) ! coerce([["PROGN",x,["%LET",nameList,g],g],m',e],m) -- 3. For a cross, do it by hand here instead of general mm. FIXME. m1 is ['Cross,:.] => n := #m1.args --- 978,984 ---- m1 is ["List",D] => for y in nameList repeat e:= giveVariableSomeValue(y,D,e) ! coerce([['%seq,x,["%LET",nameList,g],g],m',e],m) -- 3. For a cross, do it by hand here instead of general mm. FIXME. m1 is ['Cross,:.] => n := #m1.args *************** setqMultiple(nameList,val,m,e) == *** 988,994 **** for y in nameList for t in m1.args for i in 0.. repeat e := giveVariableSomeValue(y,t,e) stmts := [['%LET,y,['%call,eltRecordFun(n,i),g,i]],:stmts] ! coerce([['PROGN,x,:reverse! stmts,g],m1,e],m) -- 4. verify that the #nameList = number of parts of right-hand-side selectorModePairs:= --list of modes --- 988,994 ---- for y in nameList for t in m1.args for i in 0.. repeat e := giveVariableSomeValue(y,t,e) stmts := [['%LET,y,['%call,eltRecordFun(n,i),g,i]],:stmts] ! coerce([['%seq,x,:reverse! stmts,g],m1,e],m) -- 4. verify that the #nameList = number of parts of right-hand-side selectorModePairs:= --list of modes *************** setqMultiple(nameList,val,m,e) == *** 1005,1011 **** [([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr for x in nameList for [y,:z] in selectorModePairs] assignList="failed" => nil ! [mkpf([x,:assignList,g],'PROGN),m',e] setqMultipleExplicit(nameList,valList,m,e) == #nameList~=#valList => --- 1005,1011 ---- [([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr for x in nameList for [y,:z] in selectorModePairs] assignList="failed" => nil ! [['%seq,x,:assignList,g],m',e] setqMultipleExplicit(nameList,valList,m,e) == #nameList~=#valList => *************** setqMultipleExplicit(nameList,valList,m, *** 1020,1026 **** [[.,.,e]:= compSetq1(name,g,$EmptyMode,e) or return "failed" for g in gensymList for name in nameList] reAssignList="failed" => nil ! [["PROGN",:[T.expr for T in assignList],:[T.expr for T in reAssignList]], $NoValueMode, last(reAssignList).env] --% Quasiquotation --- 1020,1026 ---- [[.,.,e]:= compSetq1(name,g,$EmptyMode,e) or return "failed" for g in gensymList for name in nameList] reAssignList="failed" => nil ! [['%seq,:[T.expr for T in assignList],:[T.expr for T in reAssignList]], $NoValueMode, last(reAssignList).env] --% Quasiquotation *************** coerceEasy(T,m) == *** 1781,1788 **** m=$NoValueMode or m=$Void => [T.expr,m,T.env] T.mode =m => T T.mode =$Exit => ! [["PROGN", T.expr, ["userError", '"Did not really exit."]], ! m,T.env] T.mode=$EmptyMode or modeEqualSubst(T.mode,m,T.env) => [T.expr,m,T.env] --- 1781,1787 ---- m=$NoValueMode or m=$Void => [T.expr,m,T.env] T.mode =m => T T.mode =$Exit => ! [['%seq,T.expr,["userError", '"Did not really exit."]],m,T.env] T.mode=$EmptyMode or modeEqualSubst(T.mode,m,T.env) => [T.expr,m,T.env] *************** compRetractGuard(x,t,sn,sm,e) == *** 2141,2147 **** -- the condition and the body of the alternative, so just use -- assignment here and let the rest of the compiler deal with it. z := gensym() ! caseCode := ["PROGN",["%LET",z,retractCode],['%ieq,['%head,z],0]] restrictCode := ["%tail",z] -- 1.3. Everything else failed; nice try. else return stackAndThrow('"%1bp is not retractable to %2bp",[sm,t]) --- 2140,2146 ---- -- the condition and the body of the alternative, so just use -- assignment here and let the rest of the compiler deal with it. z := gensym() ! caseCode := ['%seq,["%LET",z,retractCode],['%ieq,['%head,z],0]] restrictCode := ["%tail",z] -- 1.3. Everything else failed; nice try. else return stackAndThrow('"%1bp is not retractable to %2bp",[sm,t]) *************** compRecoverGuard(x,t,sn,sm,e) == *** 2213,2219 **** [def,.,e] := compOrCroak(varDef,$EmptyMode,e) [hasTest,.,e] := compOrCroak(["has",var',cat'],$EmptyMode,e) [guard,inits,e,envFalse] := compRecoverDomain(x,var',sn,e) ! [["PROGN",def,hasTest],inits,e,envFalse] -- 2. Hand it to whoever is in charge. compRecoverDomain(x,t,sn,e) --- 2212,2218 ---- [def,.,e] := compOrCroak(varDef,$EmptyMode,e) [hasTest,.,e] := compOrCroak(["has",var',cat'],$EmptyMode,e) [guard,inits,e,envFalse] := compRecoverDomain(x,var',sn,e) ! [['%seq,def,hasTest],inits,e,envFalse] -- 2. Hand it to whoever is in charge. compRecoverDomain(x,t,sn,e) *** src/interp/g-opt.boot (revision 21632) --- src/interp/g-opt.boot (local) *************** changeVariableDefinitionToStore(form,var *** 136,141 **** --- 136,143 ---- vars form is ['%loop,:iters,body,val] => changeLoopVarDefsToStore(iters,body,val,vars) + if form is ['%seq,:.] then + form.args := spliceSeqArgs form.args for x in form repeat vars := changeVariableDefinitionToStore(x,vars) vars *** src/interp/g-util.boot (revision 21632) --- src/interp/g-util.boot (local) *************** module g_-util where *** 45,50 **** --- 45,51 ---- usedSymbol?: (%Symbol,%Code) -> %Boolean isDefaultPackageName: %Symbol -> %Boolean makeDefaultPackageName: %String -> %Symbol + spliceSeqArgs: %List %Code -> %Code --% *************** mkBind(inits,expr) == *** 67,73 **** mkBind([:inits,:inits'],expr') ['%bind,inits,expr] ! --% --- 68,87 ---- mkBind([:inits,:inits'],expr') ['%bind,inits,expr] ! ++ We have a list `l' of expressions to be executed sequentially. ! ++ Splice in any directly-embedded sequence of expressions. ! ++ NOTES: This function should not be called on any program with ! ++ an %exit-form in it. In particular, it should be called ! ++ (if at all) before any call to simplifyVMForm. ! spliceSeqArgs l == ! atomic? l => l ! l is [['%seq,:stmts],:.] => ! stmts = nil => spliceSeqArgs rest l ! lastNode(stmts).rest := spliceSeqArgs rest l ! stmts ! rest l = nil => l ! l.rest := spliceSeqArgs rest l ! l --% |
From: Gabriel D. R. <gd...@cs...> - 2011-12-03 20:23:09
|
Kostas Oikonomou <ko...@re...> writes: | One more issue: | | When I try compiling with the Sun Studio compilers, by | | ../open-axiom-1.4.1/configure | --prefix=/opt/open-axiom/1.4.1 --with-lisp=sbcl | --enable-threads CC=cc CFLAGS=-xO2 CXX=CC CXXFLAGS=-xO2 | | the build fails right away because src/lib/Makefile doesn't have a | definition for CXX, it tries to use g++. Hi Kostas, Alfredo eventually found the cause of this problem while trying to do a cross compile to Windows. It should be fixed on trunk and 1.4.x branch now. Patch below. | | There may be more problems like that down the road, I don't know. I | used to compile open axiom 1.3.x with the Sun compilers with no | difficulties. | | Kostas 2011-12-03 Alfredo Portes <doy...@gm...> Gabriel Dos Reis <gd...@cs...> * config/var-def.mk (CXX): Define as substituted. (LD): Likewise. *** config/var-def.mk (revision 21631) --- config/var-def.mk (local) *************** PACKAGE_VERSION = @PACKAGE_VERSION@ *** 53,58 **** --- 53,60 ---- AR = @AR@ CC = @CC@ + CXX = @CXX@ + LD = @LD@ CPPFLAGS = @CPPFLAGS@ CFLAGS = @CFLAGS@ CXXFLAGS = @CXXFLAGS@ |
From: Gabriel D. R. <gd...@cs...> - 2011-12-03 20:10:24
|
While I was looking into something else, my attention was drawn to the fact that multiple assignment are not always written in ways that resect scopes. For example, we have the following if not infRittWu?(b,a) then (c,d) := (a,b) else (c,d) := (b,a) in PolynomialSetUtilitiesPackage. The problem with this is that it is the first time that the local variables c and d are defined. The conditional makes them look like they are local to each branch -- the situation would have been different if they were declared or defined before. The fix is to write those definitions as (c,d) := not infRittWu?(b,a) => (a,b) (b,a) However, writing this does not work with the current compiler because of several shortcomings. Mostly fixed with this patch. I resisted the temptation of proving full support for Cross -- the semantics is far much murkier than a cursory investigation might suggest. Applied to trunk and 1.4.x branch. 2011-12-03 Gabriel Dos Reis <gd...@cs...> * interp/compiler.boot (setqMultiple): Handle lhs and rhs of type Cross instance. * interp/g-util.boot ($DomainNames): Include Cross. * interp/cattable.boot (genCategoryTable): Do not eval Cross. It is bogus to prepopulate the table with builtin functors anyway. * algebra/triset.spad.pamphlet (PolynomialSetUtilitiesPackage)[removeRedundantFactors]: Do not define `c' and `d' in conditional. Make the initializer conditional. *************** *** 14,20 **** * interp/g-opt.boot (groupVariableDefinitions): Simplify a bit. (optimizeFunctionDef): Likewise. Change %LET to %store before ! simplification. (simplifyVMForm): Do not call changeVariableDefinitionToStore. 2011-12-02 Gabriel Dos Reis <gd...@cs...> --- 25,31 ---- * interp/g-opt.boot (groupVariableDefinitions): Simplify a bit. (optimizeFunctionDef): Likewise. Change %LET to %store before ! simplification. (simplifyVMForm): Do not call changeVariableDefinitionToStore. 2011-12-02 Gabriel Dos Reis <gd...@cs...> *** src/algebra/triset.spad.pamphlet (revision 21630) --- src/algebra/triset.spad.pamphlet (local) *************** PolynomialSetUtilitiesPackage (R,E,V,P) *** 1365,1375 **** while not empty? toSee repeat b := first toSee toSee := rest toSee ! if not infRittWu?(b,a) ! then ! (c,d) := (a,b) ! else ! (c,d) := (b,a) rrf := unprotectedRemoveRedundantFactors(c,d) empty? rrf => error"in removeRedundantFactors : (LP,P) -> LP from PSETPK" c := first rrf --- 1365,1373 ---- while not empty? toSee repeat b := first toSee toSee := rest toSee ! (c,d) := ! not infRittWu?(b,a) => (a,b) ! (b,a) rrf := unprotectedRemoveRedundantFactors(c,d) empty? rrf => error"in removeRedundantFactors : (LP,P) -> LP from PSETPK" c := first rrf *** src/interp/cattable.boot (revision 21630) --- src/interp/cattable.boot (local) *************** genCategoryTable() == *** 66,72 **** -- $nonLisplibDomains, $noCategoryDomains are set in BUILDOM BOOT specialDs := setDifference($nonLisplibDomains,$noCategoryDomains) domainTable:= [:[addDomainToTable(id, getConstrCat eval([id]).3) ! for id in specialDs], :domainTable] for [id,:entry] in domainTable repeat for [a,:b] in encodeCategoryAlist(id,entry) repeat tableValue(_*HASCATEGORY_-HASH_*,[id,:a]) := b --- 66,72 ---- -- $nonLisplibDomains, $noCategoryDomains are set in BUILDOM BOOT specialDs := setDifference($nonLisplibDomains,$noCategoryDomains) domainTable:= [:[addDomainToTable(id, getConstrCat eval([id]).3) ! for id in specialDs | id ~= 'Cross], :domainTable] for [id,:entry] in domainTable repeat for [a,:b] in encodeCategoryAlist(id,entry) repeat tableValue(_*HASCATEGORY_-HASH_*,[id,:a]) := b *** src/interp/compiler.boot (revision 21630) --- src/interp/compiler.boot (local) *************** setqMultiple(nameList,val,m,e) == *** 974,985 **** T:= [.,m1,.]:= compSetq1(g,val,$EmptyMode,e) or return nil e:= put(g,"mode",m1,e) [x,m',e]:= coerce(T,m) or return nil ! -- 1.1. exit if result is a list m1 is ["List",D] => for y in nameList repeat e:= giveVariableSomeValue(y,D,e) coerce([["PROGN",x,["%LET",nameList,g],g],m',e],m) ! -- 2. verify that the #nameList = number of parts of right-hand-side selectorModePairs:= --list of modes decompose(m1,#nameList,e) or return nil where --- 974,995 ---- T:= [.,m1,.]:= compSetq1(g,val,$EmptyMode,e) or return nil e:= put(g,"mode",m1,e) [x,m',e]:= coerce(T,m) or return nil ! -- 2. exit if result is a list m1 is ["List",D] => for y in nameList repeat e:= giveVariableSomeValue(y,D,e) coerce([["PROGN",x,["%LET",nameList,g],g],m',e],m) ! -- 3. For a cross, do it by hand here instead of general mm. FIXME. ! m1 is ['Cross,:.] => ! n := #m1.args ! #nameList ~= n => ! stackMessage('"%1b must decompose into %2 components",[val,n]) ! stmts := nil ! for y in nameList for t in m1.args for i in 0.. repeat ! e := giveVariableSomeValue(y,t,e) ! stmts := [['%LET,y,['%call,eltRecordFun(n,i),g,i]],:stmts] ! coerce([['PROGN,x,:reverse! stmts,g],m1,e],m) ! -- 4. verify that the #nameList = number of parts of right-hand-side selectorModePairs:= --list of modes decompose(m1,#nameList,e) or return nil where *************** setqMultiple(nameList,val,m,e) == *** 990,996 **** stackMessage('"no multiple assigns to mode: %1p",[t]) #nameList~=#selectorModePairs => stackMessage('"%1b must decompose into %2 components",[val,#nameList]) ! -- 3. generate code; return assignList:= [([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr for x in nameList for [y,:z] in selectorModePairs] --- 1000,1006 ---- stackMessage('"no multiple assigns to mode: %1p",[t]) #nameList~=#selectorModePairs => stackMessage('"%1b must decompose into %2 components",[val,#nameList]) ! -- 5. generate code; return assignList:= [([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr for x in nameList for [y,:z] in selectorModePairs] *************** compComma(form,m,e) == *** 1956,1962 **** Tl' := [coerce(T,t) or return "failed" for T in Tl] Tl' = "failed" => nil [["asTupleNew0", ["getVMType",t], [T.expr for T in Tl']], m, e] ! T := [['%vector, :[T.expr for T in Tl]], ["Cross",:[T.mode for T in Tl]], e] coerce(T,m) --- 1966,1972 ---- Tl' := [coerce(T,t) or return "failed" for T in Tl] Tl' = "failed" => nil [["asTupleNew0", ["getVMType",t], [T.expr for T in Tl']], m, e] ! T := [['%call,mkRecordFun #argl,:[T.expr for T in Tl]], ["Cross",:[T.mode for T in Tl]], e] coerce(T,m) *** src/interp/g-util.boot (revision 21630) --- src/interp/g-util.boot (local) *************** $DomainNames == *** 93,99 **** SubDomain _ Union _ Record _ ! Enumeration) macro builtinFunctorName? x == symbolMember?(x,$DomainNames) --- 93,100 ---- SubDomain _ Union _ Record _ ! Enumeration _ ! Cross) macro builtinFunctorName? x == symbolMember?(x,$DomainNames) |
From: Gabriel D. R. <gd...@cs...> - 2011-12-02 19:42:50
|
Gabriel Dos Reis <gd...@cs...> writes: | This patch changes SEQ to %seq in the OpenAxiom intermediate language (OIL). | SEQ was used both for the input syntax, the generated intermediate code, | the generated Lisp code, and OutputForm code. | Code reuse is great, but this abuse removes clarity from the code. | Applied to trunk and 1.4.x branch. And this is the complementary patch for EXIT. EXIT is less abused than SEQ. It is used in the generated Lisp and also as an input token in the interpreter. 2011-12-02 Gabriel Dos Reis <gd...@cs...> * interp/buildom.boot (seteltRecordFun): Change EXIT to %exit. * interp/clam.boot (compHash):Likewise. * interp/g-opt.boot (changeVariableDefinitionToStore): Likewise. (jumpToToplevel?): Likewise. (groupVariableDefinitions): Likewise. (changeLeaveToExit): Likewise. (optLabelled): Likewise. (optSeq): Likewise. * interp/lisp-backend.boot: Translate %exit to EXIT. *** src/interp/buildom.boot (revision 21624) --- src/interp/buildom.boot (local) *************** seteltRecordFun(n,i) == *** 605,611 **** field := formalRecordField(n,i) body := n > 2 => ['%store,field,"#3"] ! ['%seq,['%store,field,"#3"],['EXIT,field]] ["XLAM",args,body] copyRecordFun n == --- 605,611 ---- field := formalRecordField(n,i) body := n > 2 => ['%store,field,"#3"] ! ['%seq,['%store,field,"#3"],['%exit,field]] ["XLAM",args,body] copyRecordFun n == *** src/interp/clam.boot (revision 21624) --- src/interp/clam.boot (local) *************** compHash(op,argl,body,cacheNameOrNil,eqE *** 229,235 **** ['tableValue,cacheNameOrNil,MKQ op],MKQ eqEtc] ['lassocShift,cacheArgKey,['tableValue,cacheNameOrNil,MKQ op]] ['tableValue,cacheName,g1] ! secondPredPair:= [g2,optSeq ['%seq,:hitCountCode,['EXIT,returnFoundValue]]] putCode:= null argl => cacheNameOrNil => --- 229,235 ---- ['tableValue,cacheNameOrNil,MKQ op],MKQ eqEtc] ['lassocShift,cacheArgKey,['tableValue,cacheNameOrNil,MKQ op]] ['tableValue,cacheName,g1] ! secondPredPair:= [g2,optSeq ['%seq,:hitCountCode,['%exit,returnFoundValue]]] putCode:= null argl => cacheNameOrNil => *************** compHash(op,argl,body,cacheNameOrNil,eqE *** 249,255 **** thirdPredPair:= ['%otherwise,putCode] codeBody:= optSeq ['%seq,:callCountCode, ! ['EXIT,['%bind,[[g2,getCode]],['%when,secondPredPair,thirdPredPair]]]] lamex:= ['LAM,arg,codeBody] mainFunction:= [op,lamex] computeFunction:= [auxfn,['LAMBDA,argl,:body]] --- 249,255 ---- thirdPredPair:= ['%otherwise,putCode] codeBody:= optSeq ['%seq,:callCountCode, ! ['%exit,['%bind,[[g2,getCode]],['%when,secondPredPair,thirdPredPair]]]] lamex:= ['LAM,arg,codeBody] mainFunction:= [op,lamex] computeFunction:= [auxfn,['LAMBDA,argl,:body]] *** src/interp/g-opt.boot (revision 21624) --- src/interp/g-opt.boot (local) *************** changeVariableDefinitionToStore(form,var *** 97,103 **** abstractionOperator? form.op => changeVariableDefinitionToStore(form.absBody,[:form.absParms,:vars]) vars ! form is ['%seq,:stmts,['EXIT,val]] => for s in stmts repeat vars := changeVariableDefinitionToStore(s,vars) changeVariableDefinitionToStore(val,vars) --- 97,103 ---- abstractionOperator? form.op => changeVariableDefinitionToStore(form.absBody,[:form.absParms,:vars]) vars ! form is ['%seq,:stmts,['%exit,val]] => for s in stmts repeat vars := changeVariableDefinitionToStore(s,vars) changeVariableDefinitionToStore(val,vars) *************** jumpToToplevel? x == *** 110,116 **** atomic? x => false op := x.op op is '%seq => CONTAINED('%leave,x.args) -- FIXME: what about GO? ! op in '(EXIT %leave) => true or/[jumpToToplevel? x' for x' in x] ++ Return true if `form' is just one assignment expression. --- 110,116 ---- atomic? x => false op := x.op op is '%seq => CONTAINED('%leave,x.args) -- FIXME: what about GO? ! op in '(%exit %leave) => true or/[jumpToToplevel? x' for x' in x] ++ Return true if `form' is just one assignment expression. *************** groupVariableDefinitions form == *** 135,141 **** [form.absKind,form.absParms,groupVariableDefinitions form.absBody] form is ['%loop,:iters,body,val] => [form.op,:iters,groupVariableDefinitions body,val] ! form isnt ['%seq,:stmts,['EXIT,val]] => form defs := nil for x in stmts while nonExitingSingleAssignment? x repeat defs := [x.args,:defs] --- 135,141 ---- [form.absKind,form.absParms,groupVariableDefinitions form.absBody] form is ['%loop,:iters,body,val] => [form.op,:iters,groupVariableDefinitions body,val] ! form isnt ['%seq,:stmts,['%exit,val]] => form defs := nil for x in stmts while nonExitingSingleAssignment? x repeat defs := [x.args,:defs] *************** groupVariableDefinitions form == *** 143,149 **** stmts := drop(#defs,stmts) expr := stmts = nil => val ! ['%seq,:stmts,['EXIT,val]] ['%bind,reverse! defs,expr] optimizeFunctionDef(def) == --- 143,149 ---- stmts := drop(#defs,stmts) expr := stmts = nil => val ! ['%seq,:stmts,['%exit,val]] ['%bind,reverse! defs,expr] optimizeFunctionDef(def) == *************** subrname u == *** 213,219 **** changeLeaveToExit(s,g) == s isnt [.,:.] or s.op in '(QUOTE %seq REPEAT COLLECT %collect %loop) => nil ! s is ['%leave, =g,:u] => (s.first := "EXIT"; s.rest := u) changeLeaveToExit(first s,g) changeLeaveToExit(rest s,g) --- 213,219 ---- changeLeaveToExit(s,g) == s isnt [.,:.] or s.op in '(QUOTE %seq REPEAT COLLECT %collect %loop) => nil ! s is ['%leave, =g,:u] => (s.first := '%exit; s.rest := u) changeLeaveToExit(first s,g) changeLeaveToExit(rest s,g) *************** optLabelled (x is ['%labelled,g,a]) == *** 252,265 **** removeNeedlessLeave a if a is ['%seq,:s,['%leave,=g,u]] then changeLeaveToExit(s,g) ! a.rest := [:s,["EXIT",u]] a := simplifyVMForm a if hasNoLeave(a,g) then resetTo(x,a) else changeLeaveToGo(a,g) x.first := '%seq ! x.rest := [["EXIT",a],second g,["EXIT",second g]] x optSPADCALL(form is ['SPADCALL,:argl]) == --- 252,265 ---- removeNeedlessLeave a if a is ['%seq,:s,['%leave,=g,u]] then changeLeaveToExit(s,g) ! a.rest := [:s,['%exit,u]] a := simplifyVMForm a if hasNoLeave(a,g) then resetTo(x,a) else changeLeaveToGo(a,g) x.first := '%seq ! x.rest := [['%exit,a],second g,['%exit,second g]] x optSPADCALL(form is ['SPADCALL,:argl]) == *************** optSeq ['%seq,:l] == *** 424,437 **** --this gets rid of unwanted labels generated by declarations in %seq [first l,:getRidOfTemps rest l] seqToCOND l == ! transform:= [[a,b] for x in l while (x is ['%when,[a,["EXIT",b]]])] before:= take(#transform,l) aft:= after(l,before) null before => ['%seq,:aft] null aft => ['%when,:transform,'(%otherwise (conderr))] optCond ['%when,:transform,['%otherwise,optSeq ['%seq,:aft]]] tryToRemoveSeq l == ! l is ['%seq,[op,a]] and op in '(EXIT RETURN %leave %return) => a l optSuchthat [.,:u] == ["SUCHTHAT",:u] --- 424,437 ---- --this gets rid of unwanted labels generated by declarations in %seq [first l,:getRidOfTemps rest l] seqToCOND l == ! transform:= [[a,b] for x in l while (x is ['%when,[a,['%exit,b]]])] before:= take(#transform,l) aft:= after(l,before) null before => ['%seq,:aft] null aft => ['%when,:transform,'(%otherwise (conderr))] optCond ['%when,:transform,['%otherwise,optSeq ['%seq,:aft]]] tryToRemoveSeq l == ! l is ['%seq,[op,a]] and op in '(%exit RETURN %leave %return) => a l optSuchthat [.,:u] == ["SUCHTHAT",:u] *** src/interp/g-timer.boot (revision 21624) --- src/interp/g-timer.boot (local) *************** timedEvaluate code == *** 267,275 **** displayHeapStatsIfWanted() == $printStorageIfTrue => sayBrightly OLDHEAPSTATS() - --EVALANDFILEACTQ( - -- PUTGCEXIT function displayHeapStatsIfWanted ) - --% stubs for the stats summary fns statRecordInstantiationEvent() == nil statRecordLoadEvent() == nil --- 267,272 ---- *** src/interp/lisp-backend.boot (revision 21624) --- src/interp/lisp-backend.boot (local) *************** for x in [ *** 638,643 **** --- 638,644 ---- ['%function, :'FUNCTION], ['%lambda, :'LAMBDA], ['%seq, :'SEQ], + ['%exit, :'EXIT], ['%when, :'COND], -- I/O stream functions |
From: Gabriel D. R. <gd...@cs...> - 2011-12-02 17:40:51
|
This patch changes SEQ to %seq in the OpenAxiom intermediate language (OIL). SEQ was used both for the input syntax, the generated intermediate code, the generated Lisp code, and OutputForm code. Code reuse is great, but this abuse removes clarity from the code. Applied to trunk and 1.4.x branch. 2011-12-02 Gabriel Dos Reis <gd...@cs...> * interp/buildom.boot (setelt): Change SEQ to %seq. * interp/clam.boot (compHash): Likewise. * interp/compiler.boot (freeVarUsage): Likewise. (canReturn): Likewise. * interp/i-special.boot (compileIs): Likewise. * interp/g-opt.boot (changeVariableDefinitionToStore): Likewise. (jumpToToplevel?): Likewise. (groupVariableDefinitions): Likewise. (changeLeaveToExit): Likewise. (optLabelled): Likewise. (optSeq): Rename from optSEQ. Adjust callers. * interp/lisp-backend.boot: Translate %seq to SEQ. *** src/interp/buildom.boot (revision 21623) --- src/interp/buildom.boot (local) *************** seteltRecordFun(n,i) == *** 605,611 **** field := formalRecordField(n,i) body := n > 2 => ['%store,field,"#3"] ! ['SEQ,['%store,field,"#3"],['EXIT,field]] ["XLAM",args,body] copyRecordFun n == --- 605,611 ---- field := formalRecordField(n,i) body := n > 2 => ['%store,field,"#3"] ! ['%seq,['%store,field,"#3"],['EXIT,field]] ["XLAM",args,body] copyRecordFun n == *** src/interp/clam.boot (revision 21623) --- src/interp/clam.boot (local) *************** compHash(op,argl,body,cacheNameOrNil,eqE *** 229,235 **** ['tableValue,cacheNameOrNil,MKQ op],MKQ eqEtc] ['lassocShift,cacheArgKey,['tableValue,cacheNameOrNil,MKQ op]] ['tableValue,cacheName,g1] ! secondPredPair:= [g2,optSEQ ['SEQ,:hitCountCode,['EXIT,returnFoundValue]]] putCode:= null argl => cacheNameOrNil => --- 229,235 ---- ['tableValue,cacheNameOrNil,MKQ op],MKQ eqEtc] ['lassocShift,cacheArgKey,['tableValue,cacheNameOrNil,MKQ op]] ['tableValue,cacheName,g1] ! secondPredPair:= [g2,optSeq ['%seq,:hitCountCode,['EXIT,returnFoundValue]]] putCode:= null argl => cacheNameOrNil => *************** compHash(op,argl,body,cacheNameOrNil,eqE *** 247,254 **** ['UNWIND_-PROTECT,['PROG1,putCode,['%store,g2,'%true]], ['%when,[['%not,g2],['tableRemove!,cacheName,MKQ op]]]] thirdPredPair:= ['%otherwise,putCode] ! codeBody:= optSEQ ! ['SEQ,:callCountCode, ['EXIT,['%bind,[[g2,getCode]],['%when,secondPredPair,thirdPredPair]]]] lamex:= ['LAM,arg,codeBody] mainFunction:= [op,lamex] --- 247,254 ---- ['UNWIND_-PROTECT,['PROG1,putCode,['%store,g2,'%true]], ['%when,[['%not,g2],['tableRemove!,cacheName,MKQ op]]]] thirdPredPair:= ['%otherwise,putCode] ! codeBody:= optSeq ! ['%seq,:callCountCode, ['EXIT,['%bind,[[g2,getCode]],['%when,secondPredPair,thirdPredPair]]]] lamex:= ['LAM,arg,codeBody] mainFunction:= [op,lamex] *** src/interp/compiler.boot (revision 21623) --- src/interp/compiler.boot (local) *************** freeVarUsage([.,vars,body],env) == *** 276,282 **** for v in CDDR u | cons? v repeat free := freeList(v,bound,free,e) free ! op = "SEQ" => for v in rest u | cons? v repeat free := freeList(v,bound,free,e) free --- 276,282 ---- for v in CDDR u | cons? v repeat free := freeList(v,bound,free,e) free ! op = '%seq => for v in rest u | cons? v repeat free := freeList(v,bound,free,e) free *************** compSeq1(l,$exitModeStack,e) == *** 1153,1159 **** for x in l] if c is "failed" then return nil catchTag := MKQ gensym() ! form := ["SEQ",:replaceExitEtc(c,catchTag,"TAGGEDexit",first $exitModeStack)] [['%labelled,catchTag,form],first $exitModeStack,$finalEnv] compSeqItem(x,m,e) == --- 1153,1159 ---- for x in l] if c is "failed" then return nil catchTag := MKQ gensym() ! form := ['%seq,:replaceExitEtc(c,catchTag,"TAGGEDexit",first $exitModeStack)] [['%labelled,catchTag,form],first $exitModeStack,$finalEnv] compSeqItem(x,m,e) == *************** canReturn(expr,level,exitCount,ValueFlag *** 1383,1389 **** op is "TAGGEDexit" => expr is [.,count,data] => canReturn(data.expr,level,count,count=level) level=exitCount and not ValueFlag => nil ! op is "SEQ" => or/[canReturn(u,level+1,exitCount,false) for u in rest expr] op is "TAGGEDreturn" => nil op is '%labelled => [.,gs,data]:= expr --- 1383,1389 ---- op is "TAGGEDexit" => expr is [.,count,data] => canReturn(data.expr,level,count,count=level) level=exitCount and not ValueFlag => nil ! op is '%seq => or/[canReturn(u,level+1,exitCount,false) for u in rest expr] op is "TAGGEDreturn" => nil op is '%labelled => [.,gs,data]:= expr *************** canReturn(expr,level,exitCount,ValueFlag *** 1392,1398 **** expr isnt [.,:.] => nil expr is ['%leave, =gs,data] => true --this is pessimistic, but I know of no more accurate idea ! expr is ["SEQ",:l] => or/[findThrow(gs,u,level+1,exitCount,ValueFlag) for u in l] or/[findThrow(gs,u,level,exitCount,ValueFlag) for u in rest expr] canReturn(data,level,exitCount,ValueFlag) --- 1392,1398 ---- expr isnt [.,:.] => nil expr is ['%leave, =gs,data] => true --this is pessimistic, but I know of no more accurate idea ! expr is ['%seq,:l] => or/[findThrow(gs,u,level+1,exitCount,ValueFlag) for u in l] or/[findThrow(gs,u,level,exitCount,ValueFlag) for u in rest expr] canReturn(data,level,exitCount,ValueFlag) *** src/interp/g-opt.boot (revision 21623) --- src/interp/g-opt.boot (local) *************** changeVariableDefinitionToStore(form,var *** 97,103 **** abstractionOperator? form.op => changeVariableDefinitionToStore(form.absBody,[:form.absParms,:vars]) vars ! form is ['SEQ,:stmts,['EXIT,val]] => for s in stmts repeat vars := changeVariableDefinitionToStore(s,vars) changeVariableDefinitionToStore(val,vars) --- 97,103 ---- abstractionOperator? form.op => changeVariableDefinitionToStore(form.absBody,[:form.absParms,:vars]) vars ! form is ['%seq,:stmts,['EXIT,val]] => for s in stmts repeat vars := changeVariableDefinitionToStore(s,vars) changeVariableDefinitionToStore(val,vars) *************** changeVariableDefinitionToStore(form,var *** 109,115 **** jumpToToplevel? x == atomic? x => false op := x.op ! op is 'SEQ => CONTAINED('%leave,x.args) -- FIXME: what about GO? op in '(EXIT %leave) => true or/[jumpToToplevel? x' for x' in x] --- 109,115 ---- jumpToToplevel? x == atomic? x => false op := x.op ! op is '%seq => CONTAINED('%leave,x.args) -- FIXME: what about GO? op in '(EXIT %leave) => true or/[jumpToToplevel? x' for x' in x] *************** groupVariableDefinitions form == *** 135,141 **** [form.absKind,form.absParms,groupVariableDefinitions form.absBody] form is ['%loop,:iters,body,val] => [form.op,:iters,groupVariableDefinitions body,val] ! form isnt ['SEQ,:stmts,['EXIT,val]] => form defs := nil for x in stmts while nonExitingSingleAssignment? x repeat defs := [x.args,:defs] --- 135,141 ---- [form.absKind,form.absParms,groupVariableDefinitions form.absBody] form is ['%loop,:iters,body,val] => [form.op,:iters,groupVariableDefinitions body,val] ! form isnt ['%seq,:stmts,['EXIT,val]] => form defs := nil for x in stmts while nonExitingSingleAssignment? x repeat defs := [x.args,:defs] *************** groupVariableDefinitions form == *** 143,149 **** stmts := drop(#defs,stmts) expr := stmts = nil => val ! ['SEQ,:stmts,['EXIT,val]] ['%bind,reverse! defs,expr] optimizeFunctionDef(def) == --- 143,149 ---- stmts := drop(#defs,stmts) expr := stmts = nil => val ! ['%seq,:stmts,['EXIT,val]] ['%bind,reverse! defs,expr] optimizeFunctionDef(def) == *************** subrname u == *** 212,218 **** nil changeLeaveToExit(s,g) == ! s isnt [.,:.] or s.op in '(QUOTE SEQ REPEAT COLLECT %collect %loop) => nil s is ['%leave, =g,:u] => (s.first := "EXIT"; s.rest := u) changeLeaveToExit(first s,g) changeLeaveToExit(rest s,g) --- 212,218 ---- nil changeLeaveToExit(s,g) == ! s isnt [.,:.] or s.op in '(QUOTE %seq REPEAT COLLECT %collect %loop) => nil s is ['%leave, =g,:u] => (s.first := "EXIT"; s.rest := u) changeLeaveToExit(first s,g) changeLeaveToExit(rest s,g) *************** removeNeedlessLeave x == *** 250,256 **** optLabelled (x is ['%labelled,g,a]) == a isnt [.,:.] => a removeNeedlessLeave a ! if a is ["SEQ",:s,['%leave,=g,u]] then changeLeaveToExit(s,g) a.rest := [:s,["EXIT",u]] a := simplifyVMForm a --- 250,256 ---- optLabelled (x is ['%labelled,g,a]) == a isnt [.,:.] => a removeNeedlessLeave a ! if a is ['%seq,:s,['%leave,=g,u]] then changeLeaveToExit(s,g) a.rest := [:s,["EXIT",u]] a := simplifyVMForm a *************** optLabelled (x is ['%labelled,g,a]) == *** 258,264 **** resetTo(x,a) else changeLeaveToGo(a,g) ! x.first := "SEQ" x.rest := [["EXIT",a],second g,["EXIT",second g]] x --- 258,264 ---- resetTo(x,a) else changeLeaveToGo(a,g) ! x.first := '%seq x.rest := [["EXIT",a],second g,["EXIT",second g]] x *************** replaceableTemporary?(g,x) == *** 410,417 **** x is ['GO,=g] => true or/[jumpTarget?(g,x') for x' in x] ! optSEQ ["SEQ",:l] == ! tryToRemoveSEQ SEQToCOND getRidOfTemps splicePROGN l where splicePROGN l == atomic? l => l l is [["PROGN",:stmts],:l'] => [:stmts,:l'] --- 410,417 ---- x is ['GO,=g] => true or/[jumpTarget?(g,x') for x' in x] ! optSeq ['%seq,:l] == ! tryToRemoveSeq seqToCOND getRidOfTemps splicePROGN l where splicePROGN l == atomic? l => l l is [["PROGN",:stmts],:l'] => [:stmts,:l'] *************** optSEQ ["SEQ",:l] == *** 421,437 **** l is [["%LET",g,x],:r] and replaceableTemporary?(g,r) => getRidOfTemps substitute(x,g,r) first l is "/throwAway" => getRidOfTemps rest l ! --this gets rid of unwanted labels generated by declarations in SEQs [first l,:getRidOfTemps rest l] ! SEQToCOND l == transform:= [[a,b] for x in l while (x is ['%when,[a,["EXIT",b]]])] before:= take(#transform,l) aft:= after(l,before) ! null before => ["SEQ",:aft] null aft => ['%when,:transform,'(%otherwise (conderr))] ! optCond ['%when,:transform,['%otherwise,optSEQ ["SEQ",:aft]]] ! tryToRemoveSEQ l == ! l is ["SEQ",[op,a]] and op in '(EXIT RETURN %leave %return) => a l optSuchthat [.,:u] == ["SUCHTHAT",:u] --- 421,437 ---- l is [["%LET",g,x],:r] and replaceableTemporary?(g,r) => getRidOfTemps substitute(x,g,r) first l is "/throwAway" => getRidOfTemps rest l ! --this gets rid of unwanted labels generated by declarations in %seq [first l,:getRidOfTemps rest l] ! seqToCOND l == transform:= [[a,b] for x in l while (x is ['%when,[a,["EXIT",b]]])] before:= take(#transform,l) aft:= after(l,before) ! null before => ['%seq,:aft] null aft => ['%when,:transform,'(%otherwise (conderr))] ! optCond ['%when,:transform,['%otherwise,optSeq ['%seq,:aft]]] ! tryToRemoveSeq l == ! l is ['%seq,[op,a]] and op in '(EXIT RETURN %leave %return) => a l optSuchthat [.,:u] == ["SUCHTHAT",:u] *************** optIquo(x is ['%iquo,a,b]) == *** 828,834 **** --% for x in '((%call optCall) _ ! (SEQ optSEQ)_ (%bind optBind)_ (%try optTry)_ (%not optNot)_ --- 828,834 ---- --% for x in '((%call optCall) _ ! (%seq optSeq)_ (%bind optBind)_ (%try optTry)_ (%not optNot)_ *** src/interp/i-special.boot (revision 21623) --- src/interp/i-special.boot (local) *************** compileIs(val,pattern) == *** 1649,1656 **** for var in removeDuplicates vars repeat assignCode:=[["%LET",var,["CDR",["objectAssoc",MKQ var,g]]],:assignCode] null $opIsIs => ! ['%when,[["EQ",predCode,MKQ "failed"],["SEQ",:assignCode,'%true]]] ! ['%when,[['%not,["EQ",predCode,MKQ "failed"]],["SEQ",:assignCode,'%true]]] evalIsPredicate(value,pattern,mode) == --This function pattern matches value to pattern, and returns --- 1649,1656 ---- for var in removeDuplicates vars repeat assignCode:=[["%LET",var,["CDR",["objectAssoc",MKQ var,g]]],:assignCode] null $opIsIs => ! ['%when,[["EQ",predCode,MKQ "failed"],['%seq,:assignCode,'%true]]] ! ['%when,[['%not,["EQ",predCode,MKQ "failed"]],['%seq,:assignCode,'%true]]] evalIsPredicate(value,pattern,mode) == --This function pattern matches value to pattern, and returns *** src/interp/lisp-backend.boot (revision 21623) --- src/interp/lisp-backend.boot (local) *************** for x in [ *** 637,642 **** --- 637,643 ---- ['%funcall, :'FUNCALL], ['%function, :'FUNCTION], ['%lambda, :'LAMBDA], + ['%seq, :'SEQ], ['%when, :'COND], -- I/O stream functions |