From 164aa15ad3c0720518c2ef3cf450853e18b3252d Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Wed, 2 May 2007 00:07:39 +0000
Subject: [PATCH] Implement channel retyping

---
 fco2/GenerateC.hs               |  3 ++-
 fco2/Parse.hs                   | 24 ++++++++++++++++++------
 fco2/testcases/chan-retypes.occ | 19 +++++++++++++++++++
 fco2/testcases/rem-op.occ       | 12 ++++++++++++
 4 files changed, 51 insertions(+), 7 deletions(-)
 create mode 100644 fco2/testcases/chan-retypes.occ
 create mode 100644 fco2/testcases/rem-op.occ

diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs
index 7048cab..52d07c1 100644
--- a/fco2/GenerateC.hs
+++ b/fco2/GenerateC.hs
@@ -967,10 +967,11 @@ introduceSpec (A.Specification _ n (A.Retypes _ am t v))
           let (rhs, rhsSizes) = abbrevVariable A.Abbrev origT v
           genDecl am t n
           tell [" = "]
-          -- For non-array types that are VAL abbreviations (e.g. VAL INT64),
+          -- For scalar types that are VAL abbreviations (e.g. VAL INT64),
           -- we need to dereference the pointer that abbrevVariable gives us.
           let deref = case (am, t) of
                         (_, A.Array _ _) -> False
+                        (_, A.Chan _) -> False
                         (A.ValAbbrev, _) -> True
                         _ -> True
           when deref $ tell ["*"]
diff --git a/fco2/Parse.hs b/fco2/Parse.hs
index ddeb1e4..029dcfa 100644
--- a/fco2/Parse.hs
+++ b/fco2/Parse.hs
@@ -1191,7 +1191,7 @@ valIsAbbrev :: OccParser A.Specification
 valIsAbbrev
     =  do m <- md
           (n, t, e) <- do { n <- tryXVX sVAL newVariableName sIS; e <- expression; sColon; eol; t <- typeOfExpression e; return (n, t, e) }
-                       <|> do { (s, n) <- tryXVVX sVAL specifier newVariableName sIS; e <- expressionOfType s; sColon; eol; return (n, s, e) }
+                       <|> do { (s, n) <- tryXVVX sVAL dataSpecifier newVariableName sIS; e <- expressionOfType s; sColon; eol; return (n, s, e) }
           -- Do constant folding early, so that we can use names defined this
           -- way as constants elsewhere.
           (e', _, _) <- constantFold e
@@ -1226,9 +1226,7 @@ chanArrayAbbrev
            t <- listType m ts
            return $ A.Specification m n $ A.IsChannelArray m t cs
     <|> do m <- md
-           -- This one's a bit hairy because we have to do the type check to tell
-           -- if it's going to collide with an abbreviation of a slice.
-           (ct, s, n) <- try (do s <- specifier
+           (ct, s, n) <- try (do s <- channelSpecifier
                                  n <- newChannelName
                                  sIS
                                  sLeft
@@ -1286,10 +1284,14 @@ definition
     <|> retypesAbbrev
     <?> "definition"
 
+retypesReshapes :: OccParser ()
+retypesReshapes
+    = sRETYPES <|> sRESHAPES
+
 retypesAbbrev :: OccParser A.Specification
 retypesAbbrev
     =   do m <- md
-           (s, n) <- tryVVX specifier newVariableName (sRETYPES <|> sRESHAPES)
+           (s, n) <- tryVVX dataSpecifier newVariableName retypesReshapes
            v <- variable
            sColon
            eol
@@ -1297,7 +1299,15 @@ retypesAbbrev
            checkRetypes origT s
            return $ A.Specification m n $ A.Retypes m A.Abbrev s v
     <|> do m <- md
-           (s, n) <- tryXVVX sVAL specifier newVariableName (sRETYPES <|> sRESHAPES)
+           (s, n) <- tryVVX channelSpecifier newChannelName retypesReshapes
+           c <- channel
+           sColon
+           eol
+           origT <- typeOfVariable c
+           checkRetypes origT s
+           return $ A.Specification m n $ A.Retypes m A.Abbrev s c
+    <|> do m <- md
+           (s, n) <- tryXVVX sVAL dataSpecifier newVariableName retypesReshapes
            e <- expression
            sColon
            eol
@@ -1308,6 +1318,8 @@ retypesAbbrev
 
 -- | Check that a RETYPES/RESHAPES is safe.
 checkRetypes :: A.Type -> A.Type -> OccParser ()
+-- Retyping channels is always "safe".
+checkRetypes (A.Chan _) (A.Chan _) = return ()
 checkRetypes fromT toT
     =  do bf <- bytesInType fromT
           bt <- bytesInType toT
diff --git a/fco2/testcases/chan-retypes.occ b/fco2/testcases/chan-retypes.occ
new file mode 100644
index 0000000..fac5226
--- /dev/null
+++ b/fco2/testcases/chan-retypes.occ
@@ -0,0 +1,19 @@
+-- Eww -- this feature is completely unsafe (by design).
+PROC send (CHAN OF INT32 out)
+  CHAN OF REAL32 r RETYPES out:
+  r ! 3.14159
+:
+PROC recv (CHAN OF INT32 in)
+  CHAN OF REAL32 r RETYPES in:
+  REAL32 n:
+  SEQ
+    r ? n
+    ASSERT (n > 3.1)
+    ASSERT (n < 3.2)
+:
+PROC P ()
+  CHAN OF INT32 c:
+  PAR
+    send (c)
+    recv (c)
+:
diff --git a/fco2/testcases/rem-op.occ b/fco2/testcases/rem-op.occ
new file mode 100644
index 0000000..57bd222
--- /dev/null
+++ b/fco2/testcases/rem-op.occ
@@ -0,0 +1,12 @@
+-- occam's \ operator doesn't behave like C's % operator for negative arguments
+-- (i.e. it doesn't blow up).
+
+PROC P ()
+  INT n:
+  SEQ
+    n := 3   -- to defeat constant folding, for now
+    ASSERT ((  4  \   n)  = 1)
+    ASSERT (((-4) \   n)  = (-1))
+    ASSERT (((-4) \ (-n)) = (-1))
+    ASSERT ((  4  \ (-n)) = 1)
+: