exprTypes doesn't look into operator definitions

[RyanGlScott]

The definition of exprTypes in copilot-c99 and copilot-bluespec is subtly wrong:

copilot/copilot-c99/src/Copilot/Compile/C99/Compile.hs

Lines 262 to 275 in 365fb21

	-- | List all types of an expression, returns items uniquely.
	exprTypes :: Typeable a => Expr a -> [UType]
	exprTypes e = case e of
	Const ty _ -> typeTypes ty
	Local ty1 ty2 _ e1 e2 -> typeTypes ty1 `union` typeTypes ty2
	`union` exprTypes e1 `union` exprTypes e2
	Var ty _ -> typeTypes ty
	Drop ty _ _ -> typeTypes ty
	ExternVar ty _ _ -> typeTypes ty
	Op1 _ e1 -> exprTypes e1
	Op2 _ e1 e2 -> exprTypes e1 `union` exprTypes e2
	Op3 _ e1 e2 e3 -> exprTypes e1 `union` exprTypes e2
	`union` exprTypes e3
	Label ty _ _ -> typeTypes ty

In particular, it doesn't recurse into operators in the Op1, Op2, and Op3 cases. This matters because operators have their own Type fields, which may not be reflected in the Exprs fields that Op1, Op2, and Op3 store. When emitting struct declarations in copilot-c99 or copilot-bluespec, it is crucial that every Type be considered, as if you miss a Type, then it is possible that the generated code may lack a struct declaration, which will cause the resulting code to fail to compile.

I am unable to come up with a program in today's Copilot that trips over this bug, but I did discover this when attempting to add a new operator which returns a new struct. The type of this struct is only apparent if you look at the Type field in the operator, but it is not reflected in any of the base Exprs.

To fix this, I applied the following patch:

Details

diff --git a/copilot-c99/src/Copilot/Compile/C99/Compile.hs b/copilot-c99/src/Copilot/Compile/C99/Compile.hs
index 1467af40..c481c2ff 100644
--- a/copilot-c99/src/Copilot/Compile/C99/Compile.hs
+++ b/copilot-c99/src/Copilot/Compile/C99/Compile.hs
@@ -19,9 +19,9 @@ import           System.IO           ( hPutStrLn, stderr )
 import           Text.PrettyPrint    ( render )

 -- Internal imports: Copilot
-import Copilot.Core ( Expr (..), Spec (..), Stream (..), Struct (..),
-                      Trigger (..), Type (..), UExpr (..), UType (..),
-                      Value (..) )
+import Copilot.Core ( Expr (..), Op1 (..), Op2 (..), Op3 (..), Spec (..),
+                      Stream (..), Struct (..), Trigger (..), Type (..),
+                      UExpr (..), UType (..), Value (..) )

 -- Internal imports
 import Copilot.Compile.C99.CodeGen        ( mkAccessDecln, mkBuffDecln,
@@ -268,12 +268,76 @@ exprTypes e = case e of
   Var ty _              -> typeTypes ty
   Drop ty _ _           -> typeTypes ty
   ExternVar ty _ _      -> typeTypes ty
-  Op1 _ e1              -> exprTypes e1
-  Op2 _ e1 e2           -> exprTypes e1 `union` exprTypes e2
-  Op3 _ e1 e2 e3        -> exprTypes e1 `union` exprTypes e2
-                             `union` exprTypes e3
+  Op1 op e1             -> op1Types op `union` exprTypes e1
+  Op2 op e1 e2          -> op2Types op `union` exprTypes e1
+                             `union` exprTypes e2
+  Op3 op e1 e2 e3       -> op3Types op `union` exprTypes e1
+                             `union` exprTypes e2 `union` exprTypes e3
   Label ty _ _          -> typeTypes ty

+op1Types :: (Typeable a, Typeable b) => Op1 a b -> [UType]
+op1Types op =
+  case op of
+    Not -> []
+    Abs ty -> typeTypes ty
+    Sign ty -> typeTypes ty
+    Recip ty -> typeTypes ty
+    Exp ty -> typeTypes ty
+    Sqrt ty -> typeTypes ty
+    Log ty -> typeTypes ty
+    Sin ty -> typeTypes ty
+    Tan ty -> typeTypes ty
+    Cos ty -> typeTypes ty
+    Asin ty -> typeTypes ty
+    Atan ty -> typeTypes ty
+    Acos ty -> typeTypes ty
+    Sinh ty -> typeTypes ty
+    Tanh ty -> typeTypes ty
+    Cosh ty -> typeTypes ty
+    Asinh ty -> typeTypes ty
+    Atanh ty -> typeTypes ty
+    Acosh ty -> typeTypes ty
+    Ceiling ty -> typeTypes ty
+    Floor ty -> typeTypes ty
+    BwNot ty -> typeTypes ty
+    Cast ty1 ty2 -> typeTypes ty1 `union` typeTypes ty2
+    GetField ty1 ty2 _ -> typeTypes ty1 `union` typeTypes ty2
+
+op2Types :: (Typeable a, Typeable b, Typeable c) => Op2 a b c -> [UType]
+op2Types op =
+  case op of
+  And -> []
+  Or -> []
+  Add ty -> typeTypes ty
+  Sub ty -> typeTypes ty
+  Mul ty -> typeTypes ty
+  Mod ty -> typeTypes ty
+  Div ty -> typeTypes ty
+  Fdiv ty -> typeTypes ty
+  Pow ty -> typeTypes ty
+  Logb ty -> typeTypes ty
+  Atan2 ty -> typeTypes ty
+  Eq ty -> typeTypes ty
+  Ne ty -> typeTypes ty
+  Le ty -> typeTypes ty
+  Ge ty -> typeTypes ty
+  Lt ty -> typeTypes ty
+  Gt ty -> typeTypes ty
+  BwAnd ty -> typeTypes ty
+  BwOr ty -> typeTypes ty
+  BwXor ty -> typeTypes ty
+  BwShiftL ty1 ty2 -> typeTypes ty1 `union` typeTypes ty2
+  BwShiftR ty1 ty2 -> typeTypes ty1 `union` typeTypes ty2
+  Index ty -> typeTypes ty
+  UpdateField ty1 ty2 _ -> typeTypes ty1 `union` typeTypes ty2
+
+op3Types :: (Typeable a, Typeable b, Typeable c, Typeable d)
+         => Op3 a b c d -> [UType]
+op3Types op =
+  case op of
+    Mux ty -> typeTypes ty
+    UpdateArray ty -> typeTypes ty
+
 -- | List all types of a type, returns items uniquely.
 typeTypes :: Typeable a => Type a -> [UType]
 typeTypes ty = case ty of