Do array assignment check at runtime, and produce better metadata

fco2/GenerateC.hs

@@ -60,10 +60,9 @@ genComma = tell [", "]
 
 type SubscripterFunction = A.Variable -> A.Variable
 
-overArray :: A.Variable -> (SubscripterFunction -> Maybe (CGen ())) -> CGen ()
+overArray :: Meta -> A.Variable -> (SubscripterFunction -> Maybe (CGen ())) -> CGen ()
-overArray var func
+overArray m var func
     =  do A.Array ds _ <- typeOfVariable var
-          let m = emptyMeta
           specs <- sequence [makeNonceVariable "i" m A.Int A.VariableName A.Original | _ <- ds]
           let indices = [A.Variable m n | A.Specification _ n _ <- specs]
 
@@ -883,16 +882,15 @@ declareArraySizes ds name
           tell [" };\n"]
 
 -- | Initialise an item being declared.
-declareInit :: A.Type -> A.Variable -> Maybe (CGen ())
+declareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ())
-declareInit (A.Chan _) var
+declareInit _ (A.Chan _) var
     = Just $ do tell ["ChanInit ("]
                 genVariable var
                 tell [");\n"]
-declareInit t@(A.Array ds t') var
+declareInit m t@(A.Array ds t') var
     = Just $ do init <- case t' of
                           A.Chan _ ->
-                            do let m = emptyMeta
+                            do A.Specification _ store _ <- makeNonceVariable "storage" m (A.Array ds A.Int) A.VariableName A.Original
-                               A.Specification _ store _ <- makeNonceVariable "storage" m (A.Array ds A.Int) A.VariableName A.Original
                                let storeV = A.Variable m store
                                tell ["Channel "]
                                genName store
@@ -903,14 +901,14 @@ declareInit t@(A.Array ds t') var
                                                          tell [" = &"]
                                                          genVariable (sub storeV)
                                                          tell [";\n"]
-                                                         fromJust $ declareInit t' (sub var))
+                                                         fromJust $ declareInit m t' (sub var))
-                          _ -> return (\sub -> declareInit t' (sub var))
+                          _ -> return (\sub -> declareInit m t' (sub var))
-                overArray var init
+                overArray m var init
-declareInit _ _ = Nothing
+declareInit _ _ _ = Nothing
 
 -- | Free a declared item that's going out of scope.
-declareFree :: A.Type -> A.Variable -> Maybe (CGen ())
+declareFree :: Meta -> A.Type -> A.Variable -> Maybe (CGen ())
-declareFree _ _ = Nothing
+declareFree _ _ _ = Nothing
 
 {-
                   Original        Abbrev
@@ -933,7 +931,7 @@ introduceSpec (A.Specification m n (A.Declaration _ t))
          case t of
            A.Array ds _ -> declareArraySizes ds (genName n)
            _ -> return ()
-         case declareInit t (A.Variable m n) of
+         case declareInit m t (A.Variable m n) of
            Just p -> p
            Nothing -> return ()
 introduceSpec (A.Specification _ n (A.Is _ am t v))
@@ -1027,9 +1025,9 @@ introduceSpec n = missing $ "introduceSpec " ++ show n
 removeSpec :: A.Specification -> CGen ()
 removeSpec (A.Specification m n (A.Declaration _ t))
     = case t of
-        A.Array _ t' -> overArray var (\sub -> declareFree t' (sub var))
+        A.Array _ t' -> overArray m var (\sub -> declareFree m t' (sub var))
         _ ->
-          do case declareFree t var of
+          do case declareFree m t var of
                Just p -> p
                Nothing -> return ()
   where
@@ -1091,7 +1089,7 @@ genFormal (A.Formal am t n)
 --{{{  processes
 genProcess :: A.Process -> CGen ()
 genProcess p = case p of
-  A.Assign m vs es -> genAssign vs es
+  A.Assign m vs es -> genAssign m vs es
   A.Input m c im -> genInput c im
   A.Output m c ois -> genOutput c ois
   A.OutputCase m c t ois -> genOutputCase c t ois
@@ -1110,17 +1108,17 @@ genProcess p = case p of
   A.IntrinsicProcCall m s as -> genIntrinsicProc m s as
 
 --{{{  assignment
-genAssign :: [A.Variable] -> A.ExpressionList -> CGen ()
+genAssign :: Meta -> [A.Variable] -> A.ExpressionList -> CGen ()
-genAssign [v] el
+genAssign m [v] el
     = case el of
-        A.FunctionCallList m n es -> missing "function call"
+        A.FunctionCallList _ _ _ -> missing "function call"
-        A.ExpressionList m [e] ->
+        A.ExpressionList _ [e] ->
           do t <- typeOfVariable v
              doAssign t v e
   where
     doAssign :: A.Type -> A.Variable -> A.Expression -> CGen ()
     doAssign t@(A.Array _ subT) toV (A.ExprVariable m fromV)
-        = overArray fromV (\sub -> Just $ doAssign subT (sub toV) (A.ExprVariable m (sub fromV)))
+        = overArray m fromV (\sub -> Just $ doAssign subT (sub toV) (A.ExprVariable m (sub fromV)))
     doAssign t v e
         = case scalarType t of
             Just _ ->

fco2/Parse.hs

@@ -1546,7 +1546,8 @@ assignment :: OccParser A.Process
 assignment
     =   do m <- md
            vs <- tryVX (sepBy1 variable sComma) sAssign
-           ts <- mapM typeOfVariable vs
+           -- We ignore dimensions here because we do the check at runtime.
+           ts <- sequence [liftM removeFixedDimensions $ typeOfVariable v | v <- vs]
            es <- expressionList ts
            eol
            return $ A.Assign m vs es

fco2/Types.hs

@@ -249,6 +249,11 @@ stripArrayType :: A.Type -> A.Type
 stripArrayType (A.Array _ t) = stripArrayType t
 stripArrayType t = t
 
+-- | Remove any fixed array dimensions from a type.
+removeFixedDimensions :: A.Type -> A.Type
+removeFixedDimensions (A.Array ds t) = A.Array [A.UnknownDimension | _ <- ds] t
+removeFixedDimensions t = t
+
 -- | Given the abbreviation mode of something, return what the abbreviation
 -- mode of something that abbreviated it would be.
 makeAbbrevAM :: A.AbbrevMode -> A.AbbrevMode

fco2/testcases/assign-array.occ

@@ -0,0 +1,6 @@
+PROC P ()
+  VAL size IS 32:
+  [100]BYTE src:
+  [32]BYTE dest:
+  dest := [src FROM 0 FOR size]
+: