Refactor literal and subscript checks.

For both of these, we already examine all the places they occur for other
reasons, so there's no good reason to do a separate traversal for them.

frontends/OccamTypes.hs

@@ -181,10 +181,11 @@ checkRecordField m t n
           when (not $ n `elem` validNames) $
             diePC m $ formatCode "Invalid field name % in record type %" n t
 
--- | Check that a subscript is being applied to an appropriate type.
+-- | Check a subscript.
-checkSubscriptType :: Meta -> A.Subscript -> A.Type -> PassM ()
+checkSubscript :: Meta -> A.Subscript -> A.Type -> PassM ()
-checkSubscriptType m s rawT
+checkSubscript m s rawT
-    =  do t <- underlyingType m rawT
+    =  do -- Check the type of the thing being subscripted.
+          t <- underlyingType m rawT
           case s of
             -- A record subscript.
             A.SubscriptField m n ->
@@ -194,6 +195,15 @@ checkSubscriptType m s rawT
             -- An array slice.
             _ -> checkArray m t
 
+          -- Check the subscript itself.
+          case s of
+            A.Subscript m _ e -> checkExpressionInt m e
+            A.SubscriptFromFor m e f ->
+              checkExpressionInt m e >> checkExpressionInt m f
+            A.SubscriptFrom m e -> checkExpressionInt m e
+            A.SubscriptFor m e -> checkExpressionInt m e
+            _ -> ok
+
 -- | Classes of operators.
 data OpClass = NumericOp | IntegerOp | ShiftOp | BooleanOp | ComparisonOp
                | ListOp
@@ -328,58 +338,20 @@ checkWritable v
 -- inside the AST, but it doesn't really make sense to split it up.
 checkTypes :: Data t => t -> PassM t
 checkTypes t =
-    checkSubscripts t >>=
+    checkVariables t >>=
-    checkLiterals >>=
-    checkVariables >>=
     checkExpressions >>=
     checkInputItems >>=
     checkOutputItems >>=
     checkReplicators >>=
     checkChoices
 
-checkSubscripts :: Data t => t -> PassM t
-checkSubscripts = checkDepthM doSubscript
-  where
-    doSubscript :: A.Subscript -> PassM ()
-    doSubscript (A.Subscript m _ e) = checkExpressionInt m e
-    doSubscript (A.SubscriptFromFor m e f)
-        = checkExpressionInt m e >> checkExpressionInt m f
-    doSubscript (A.SubscriptFrom m e) = checkExpressionInt m e
-    doSubscript (A.SubscriptFor m e) = checkExpressionInt m e
-    doSubscript _ = ok
-
-checkLiterals :: Data t => t -> PassM t
-checkLiterals = checkDepthM doExpression
-  where
-    doExpression :: A.Expression -> PassM ()
-    doExpression (A.Literal m t lr) = doLiteralRepr t lr
-    doExpression _ = ok
-
-    doLiteralRepr :: A.Type -> A.LiteralRepr -> PassM ()
-    doLiteralRepr t (A.ArrayLiteral m aes)
-        = doArrayElem m t (A.ArrayElemArray aes)
-    doLiteralRepr t (A.RecordLiteral m es)
-        =  do rfs <- underlyingType m t >>= recordFields m
-              when (length es /= length rfs) $
-                dieP m $ "Record literal has wrong number of fields: found " ++ (show $ length es) ++ ", expected " ++ (show $ length rfs)
-              sequence_ [checkExpressionType (findMeta fe) ft fe
-                         | ((_, ft), fe) <- zip rfs es]
-    doLiteralRepr _ _ = ok
-
-    doArrayElem :: Meta -> A.Type -> A.ArrayElem -> PassM ()
-    doArrayElem m t (A.ArrayElemArray aes)
-        =  do checkArraySize m t (length aes)
-              t' <- subscriptType (A.Subscript m A.NoCheck undefined) t
-              sequence_ $ map (doArrayElem m t') aes
-    doArrayElem _ t (A.ArrayElemExpr e) = checkExpressionType (findMeta e) t e
-
 checkVariables :: Data t => t -> PassM t
 checkVariables = checkDepthM doVariable
   where
     doVariable :: A.Variable -> PassM ()
     doVariable (A.SubscriptedVariable m s v)
         =  do t <- typeOfVariable v
-              checkSubscriptType m s t
+              checkSubscript m s t
     doVariable (A.DirectedVariable m _ v)
         =  do t <- typeOfVariable v >>= underlyingType m
               case t of
@@ -410,19 +382,38 @@ checkExpressions = checkDepthM doExpression
     doExpression (A.Conversion m _ t e)
         =  do et <- typeOfExpression e
               checkScalar m t >> checkScalar (findMeta e) et
+    doExpression (A.Literal m t lr) = doLiteralRepr t lr
     doExpression (A.FunctionCall m n es)
         = checkFunctionCall m n es True
     doExpression (A.IntrinsicFunctionCall m s es)
         = checkIntrinsicFunctionCall m s es True
     doExpression (A.SubscriptedExpr m s e)
         =  do t <- typeOfExpression e
-              checkSubscriptType m s t
+              checkSubscript m s t
     doExpression (A.OffsetOf m rawT n)
         =  do t <- underlyingType m rawT
               checkRecordField m t n
     doExpression (A.AllocMobile m t me) = checkAllocMobile m t me
     doExpression _ = ok
 
+    doLiteralRepr :: A.Type -> A.LiteralRepr -> PassM ()
+    doLiteralRepr t (A.ArrayLiteral m aes)
+        = doArrayElem m t (A.ArrayElemArray aes)
+    doLiteralRepr t (A.RecordLiteral m es)
+        =  do rfs <- underlyingType m t >>= recordFields m
+              when (length es /= length rfs) $
+                dieP m $ "Record literal has wrong number of fields: found " ++ (show $ length es) ++ ", expected " ++ (show $ length rfs)
+              sequence_ [checkExpressionType (findMeta fe) ft fe
+                         | ((_, ft), fe) <- zip rfs es]
+    doLiteralRepr _ _ = ok
+
+    doArrayElem :: Meta -> A.Type -> A.ArrayElem -> PassM ()
+    doArrayElem m t (A.ArrayElemArray aes)
+        =  do checkArraySize m t (length aes)
+              t' <- subscriptType (A.Subscript m A.NoCheck undefined) t
+              sequence_ $ map (doArrayElem m t') aes
+    doArrayElem _ t (A.ArrayElemExpr e) = checkExpressionType (findMeta e) t e
+
 checkInputItems :: Data t => t -> PassM t
 checkInputItems = checkDepthM doInputItem
   where

frontends/OccamTypesTest.hs

@@ -68,14 +68,14 @@ testOccamTypes :: Test
 testOccamTypes = TestList
     [
     -- Subscript expressions
-      testOK     0 $ A.Subscript m A.NoCheck intE
+      testOK     0 $ subex $ A.Subscript m A.NoCheck intE
-    , testFail   1 $ A.Subscript m A.NoCheck byteE
+    , testFail   1 $ subex $ A.Subscript m A.NoCheck byteE
-    , testOK     2 $ A.SubscriptFromFor m intE intE
+    , testOK     2 $ subex $ A.SubscriptFromFor m intE intE
-    , testFail   3 $ A.SubscriptFromFor m byteE byteE
+    , testFail   3 $ subex $ A.SubscriptFromFor m byteE byteE
-    , testOK     4 $ A.SubscriptFrom m intE
+    , testOK     4 $ subex $ A.SubscriptFrom m intE
-    , testFail   5 $ A.SubscriptFrom m byteE
+    , testFail   5 $ subex $ A.SubscriptFrom m byteE
-    , testOK     6 $ A.SubscriptFor m intE
+    , testOK     6 $ subex $ A.SubscriptFor m intE
-    , testFail   7 $ A.SubscriptFor m byteE
+    , testFail   7 $ subex $ A.SubscriptFor m byteE
 
     -- Trivial literals
     , testOK    20 $ intE
@@ -232,6 +232,7 @@ testOccamTypes = TestList
                                         (OccamTypes.checkTypes orig)
                                         startState
 
+    subex sub = A.SubscriptedExpr m sub twoIntsE
     intV = variable "varInt"
     intE = intLiteral 42
     realV = variable "varReal"