diff options
author | dos-reis <gdr@axiomatics.org> | 2008-01-22 00:25:02 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2008-01-22 00:25:02 +0000 |
commit | d0bef3fbe5196f2ac1211af52cc48d7d34187d3d (patch) | |
tree | 87976cf8eb431957d78b526f5200dffde52725d9 | |
parent | 1fec2e3a2ab2f97db90e18f03ec1c5df09a306b7 (diff) | |
download | open-axiom-d0bef3fbe5196f2ac1211af52cc48d7d34187d3d.tar.gz |
Apply patch byStephen Wilson <<wilsons@multiboard.com>
Fix AW/370
* interp/compiler.boot (compWithMappingMode): Consult current
environment to decide which variabes are free.
* testsuite/compiler/cwmm-test.spad: New.
-rw-r--r-- | src/ChangeLog | 8 | ||||
-rw-r--r-- | src/interp/compiler.boot | 15 | ||||
-rw-r--r-- | src/testsuite/compiler/cwmm-test.spad | 79 |
3 files changed, 95 insertions, 7 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index e19df674..a574d36e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,13 @@ 2008-01-21 Gabriel Dos Reis <gdr@cs.tamu.edu> + Apply patch byStephen Wilson <<wilsons@multiboard.com> + Fix AW/370 + * interp/compiler.boot (compWithMappingMode): Consult current + environment to decide which variabes are free. + * testsuite/compiler/cwmm-test.spad: New. + +2008-01-21 Gabriel Dos Reis <gdr@cs.tamu.edu> + * algebra/syntax.spad.pamphlet (Syntax): Assert a member of SetCategory. Implement equality. * algebra/Makefile.pamphlet (axiom_algebra_layer_0): Move diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 283b8868..1fba5482 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -188,39 +188,40 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) == $FUNNAME :local := nil $FUNNAME__TAIL :local := [nil] expandedFunction:=COMP_-TRAN CADR uu - frees:=FreeList(expandedFunction,vl,nil) - where FreeList(u,bound,free) == + frees:=FreeList(expandedFunction,vl,nil,e) + where FreeList(u,bound,free,e) == atom u => not IDENTP u => free MEMQ(u,bound) => free v:=ASSQ(u,free) => RPLACD(v,1+CDR v) free + null getmode(u,e) => free [[u,:1],:free] op:=CAR u MEMQ(op, '(QUOTE GO function)) => free EQ(op,'LAMBDA) => bound:=UNIONQ(bound,CADR u) for v in CDDR u repeat - free:=FreeList(v,bound,free) + free:=FreeList(v,bound,free,e) free EQ(op,'PROG) => bound:=UNIONQ(bound,CADR u) for v in CDDR u | NOT ATOM v repeat - free:=FreeList(v,bound,free) + free:=FreeList(v,bound,free,e) free EQ(op,'SEQ) => for v in CDR u | NOT ATOM v repeat - free:=FreeList(v,bound,free) + free:=FreeList(v,bound,free,e) free EQ(op,'COND) => for v in CDR u repeat for vv in v repeat - free:=FreeList(vv,bound,free) + free:=FreeList(vv,bound,free,e) free if ATOM op then u:=CDR u --Atomic functions aren't descended for v in u repeat - free:=FreeList(v,bound,free) + free:=FreeList(v,bound,free,e) free expandedFunction := --One free can go by itself, more than one needs a vector diff --git a/src/testsuite/compiler/cwmm-test.spad b/src/testsuite/compiler/cwmm-test.spad new file mode 100644 index 00000000..ab820d18 --- /dev/null +++ b/src/testsuite/compiler/cwmm-test.spad @@ -0,0 +1,79 @@ +++ Contributed by Stephen Wilson. + +)abbrev domain CWMMT CompWithMappingModeTest + +CompWithMappingModeTest() : Exports == Implementation where + + Exports == with + runTests : () -> Boolean + + Implementation == add + + REC ==> Record(field1 : Integer, field2 : String) + UN ==> Union(rec : REC, str : String) + + -- The following function accepts a map as argument to test + -- compWithMappingMode. + mapper(fn : Integer -> Boolean, n: Integer) : Boolean == fn n + + -- We use the following as a target for currying and to pass to + -- mapper above. + pred(x: Integer, y: Integer) : Boolean == + x < y => true + true + + test1(x : Integer) : Boolean == + r : REC := [1, ""] + mapper(pred(r.field1, #1), 1) + + test2(x : Integer) : Boolean == + r : REC := [1, ""] + i : Integer := 1 + mapper(pred(r.field1 + x, #1), 1) + + test3(x : Integer) : Boolean == + r : REC := [1, ""] + i : Integer := 1 + mapper(pred(r.field1 + i, #1), 1) + + test4(x : Integer) : Boolean == + r : REC := [1, ""] + i : Integer := 1 + mapper(pred((r.field1 + min(#(r.field2), i)), #1), 1) + + test5(x : Integer) : Boolean == + r : REC := [1, ""] + i : Integer := 1 + mapper(pred((r.field1 + min(#(r.field2), i + x)), #1), 1) + + test6(x : Integer) : Boolean == + u : UN := [[1, ""]$REC] + mapper(pred(u.rec.field1, #1), 1) + + test7(x : Integer) : Boolean == + u : UN := [[1, ""]$REC] + i : Integer := 1 + mapper(pred(u.rec.field1 + x, #1), 1) + + test8(x : Integer) : Boolean == + u : UN := [[1, ""]$REC] + i : Integer := 1 + mapper(pred(u.rec.field1 + i, #1), 1) + + test9(x : Integer) : Boolean == + u : UN := [[1, ""]$REC] + i : Integer := 1 + mapper(pred((u.rec.field1 + min(#(u.rec.field2), i)), #1), 1) + + test10(x : Integer) : Boolean == + u : UN := [[1, ""]$REC] + i : Integer := 1 + mapper(pred((u.rec.field1 + min(#(u.rec.field2), i + x)), #1), 1) + + runTests() : Boolean == + test1(1) and test2(1) and test3(1) _ + and test4(1) and test5(1) _ + and test6(1) and test7(1) _ + and test8(1) and test9(1) _ + and test10(1) + |