From d0bef3fbe5196f2ac1211af52cc48d7d34187d3d Mon Sep 17 00:00:00 2001 From: dos-reis Date: Tue, 22 Jan 2008 00:25:02 +0000 Subject: Apply patch byStephen Wilson < Fix AW/370 * interp/compiler.boot (compWithMappingMode): Consult current environment to decide which variabes are free. * testsuite/compiler/cwmm-test.spad: New. --- src/ChangeLog | 8 ++++ src/interp/compiler.boot | 15 +++---- src/testsuite/compiler/cwmm-test.spad | 79 +++++++++++++++++++++++++++++++++++ 3 files changed, 95 insertions(+), 7 deletions(-) create mode 100644 src/testsuite/compiler/cwmm-test.spad (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index e19df674..a574d36e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,11 @@ +2008-01-21 Gabriel Dos Reis + + Apply patch byStephen Wilson < + 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 * algebra/syntax.spad.pamphlet (Syntax): Assert a member of 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) + -- cgit v1.2.3