From e6980ba382ecb6144049350afa1cbdf3c18354e6 Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Sun, 6 Apr 2008 02:01:47 +0000
Subject: [PATCH] Update all specifications when constant folding. It used to
 only update IsExprs, but that meant that all the constants inside types in
 other things didn't get folded properly, which caused problems.

---
 frontends/OccamPasses.hs      |  8 ++++----
 testcases/const-array-dim.occ | 18 ++++++++++++++++++
 2 files changed, 22 insertions(+), 4 deletions(-)
 create mode 100644 testcases/const-array-dim.occ

diff --git a/frontends/OccamPasses.hs b/frontends/OccamPasses.hs
index e669c9d..44f9050 100644
--- a/frontends/OccamPasses.hs
+++ b/frontends/OccamPasses.hs
@@ -79,13 +79,13 @@ foldConstants = applyDepthM2 doExpression doSpecification
         =  do (e', _, _) <- constantFold e
               return e'
 
-    -- When an expression is abbreviated, update its definition so that it can
-    -- be used when folding later expressions.
+    -- After we're done folding a specification, update its definition.
+    -- (Even if it isn't an expression itself, it might have others inside it,
+    -- so we just update them all.)
     doSpecification :: A.Specification -> PassM A.Specification
-    doSpecification s@(A.Specification _ n st@(A.IsExpr _ _ _ _))
+    doSpecification s@(A.Specification _ n st)
         =  do modifyName n (\nd -> nd { A.ndType = st })
               return s
-    doSpecification s = return s
 
 -- | Check that things that must be constant are.
 checkConstants :: Data t => t -> PassM t
diff --git a/testcases/const-array-dim.occ b/testcases/const-array-dim.occ
new file mode 100644
index 0000000..2d74e11
--- /dev/null
+++ b/testcases/const-array-dim.occ
@@ -0,0 +1,18 @@
+VAL INT screen.width IS 80:
+VAL INT screen.height IS 24:
+
+PROC clear.buffer ([screen.height][screen.width]BYTE screen, [screen.height][screen.width]INT colour)
+  SKIP
+:
+
+PROC screen.buffer (CHAN OF BYTE in, CHAN OF BYTE out)
+  [2][screen.height][screen.width]BYTE screen:
+  [2][screen.height][screen.width]INT colour:
+  SEQ
+    clear.buffer (screen[0], colour[0])
+    clear.buffer (screen[1], colour[1])
+:
+
+PROC q7 ()
+  SKIP
+: