aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2008-01-22 00:25:02 +0000
committerdos-reis <gdr@axiomatics.org>2008-01-22 00:25:02 +0000
commitd0bef3fbe5196f2ac1211af52cc48d7d34187d3d (patch)
tree87976cf8eb431957d78b526f5200dffde52725d9
parent1fec2e3a2ab2f97db90e18f03ec1c5df09a306b7 (diff)
downloadopen-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/ChangeLog8
-rw-r--r--src/interp/compiler.boot15
-rw-r--r--src/testsuite/compiler/cwmm-test.spad79
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)
+