Implement channel retyping

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 ["*"]

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

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)
+:

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)
+: