Add SubscriptCheck field to SubscriptFromFor etc.

This makes it possible to mark a slice as not needing runtime
checking, which is immediately useful for _sizes arrays.

This fixes cgtest03, which was previously failing to compile because
the _sizes array for one of the constants in it contained a runtime
check and thus wasn't itself constant. I've added a testcase file for
the relevant bit of code.

backends/BackendPasses.hs

@@ -97,7 +97,7 @@ declareSizesArray = applyDepthSM doStructured
     findInnerVar :: A.Variable -> (Maybe A.Expression, A.Variable)
     findInnerVar wv@(A.SubscriptedVariable m sub v) = case sub of
       A.SubscriptField {} -> (Nothing, wv)
-      A.SubscriptFromFor _ _ for -> (Just for, snd $ findInnerVar v) -- Keep the outer most
+      A.SubscriptFromFor _ _ _ for -> (Just for, snd $ findInnerVar v) -- Keep the outer most
       A.Subscript {} -> findInnerVar v
     findInnerVar v = (Nothing, v)
 
@@ -162,7 +162,7 @@ declareSizesArray = applyDepthSM doStructured
            (A.Array srcDs _) <- astTypeOf innerV
            -- Calculate the correct subscript into the source _sizes variable to get to the dimensions for the destination:
            let sizeDiff = length srcDs - length ds
-               subSrcSizeVar = A.SubscriptedVariable m (A.SubscriptFromFor m (makeConstant m sizeDiff) (makeConstant m $ length ds)) varSrcSizes
+               subSrcSizeVar = A.SubscriptedVariable m (A.SubscriptFromFor m A.NoCheck (makeConstant m sizeDiff) (makeConstant m $ length ds)) varSrcSizes
                sizeType = A.Array [makeDimension m $ length ds] A.Int
                sizeExpr = case sliceSize of
                  Just exp -> let subDims = [A.SubscriptedVariable m (A.Subscript m A.NoCheck $ makeConstant m n) varSrcSizes | n <- [1 .. (length srcDs - 1)]] in
@@ -295,12 +295,12 @@ simplifySlices :: PassType
 simplifySlices = applyDepthM doVariable
   where
     doVariable :: A.Variable -> PassM A.Variable
-    doVariable (A.SubscriptedVariable m (A.SubscriptFor m' for) v)
+    doVariable (A.SubscriptedVariable m (A.SubscriptFor m' check for) v)
-      = return (A.SubscriptedVariable m (A.SubscriptFromFor m' (makeConstant m' 0) for) v)
+      = return (A.SubscriptedVariable m (A.SubscriptFromFor m' check (makeConstant m' 0) for) v)
-    doVariable (A.SubscriptedVariable m (A.SubscriptFrom m' from) v)
+    doVariable (A.SubscriptedVariable m (A.SubscriptFrom m' check from) v)
       = do A.Array (d:_) _ <- astTypeOf v
            limit <- case d of
              A.Dimension n -> return n
              A.UnknownDimension -> return $ A.SizeVariable m' v
-           return (A.SubscriptedVariable m (A.SubscriptFromFor m' from (A.Dyadic m A.Subtr limit from)) v)
+           return (A.SubscriptedVariable m (A.SubscriptFromFor m' check from (A.Dyadic m A.Subtr limit from)) v)
     doVariable v = return v

backends/BackendPassesTest.hs

@@ -260,6 +260,7 @@ qcTestDeclareSizes =
         specSizes = A.IsExpr emptyMeta A.ValAbbrev (A.Array [dimension $ length destDims] A.Int) $
           A.ExprVariable m $
             A.SubscriptedVariable emptyMeta (A.SubscriptFromFor emptyMeta
+              A.NoCheck
               (intLiteral $ toInteger $ length srcDims - length destDims)
               (intLiteral $ toInteger $ length destDims)
               ) (variable "src_sizes")

backends/GenerateC.hs

@@ -780,20 +780,23 @@ cgenVariable' checkValid v
                   outerInd = if indirectedType t then -1 else 0
               return (addPrefix (addPrefix cg ind' >> tell ["->"] >> genName n) outerInd, 0)
 
-    inner ind sv@(A.SubscriptedVariable m (A.SubscriptFromFor m' start count) v) mt
+    inner ind sv@(A.SubscriptedVariable m (A.SubscriptFromFor m' subCheck start count) v) mt
         = return (
-           do tell ["(&"]
+           do let check = if checkValid then subCheck else A.NoCheck
+              tell ["(&"]
               join $ liftM fst $ inner ind v mt
               call genArraySubscript A.NoCheck v [(m',
-                do tell ["occam_check_slice("]
+                case check of
-                   call genExpression start
+                  A.NoCheck -> call genExpression start
-                   genComma
+                  _ -> do tell ["occam_check_slice("]
-                   call genExpression count
+                          call genExpression start
-                   genComma
+                          genComma
-                   call genExpression (A.SizeVariable m' v)
+                          call genExpression count
-                   genComma
+                          genComma
-                   genMeta m'
+                          call genExpression (A.SizeVariable m' v)
-                   tell [")"]
+                          genComma
+                          genMeta m'
+                          tell [")"]
                 )]
               tell [")"], 0)
     

backends/GenerateCTest.hs

@@ -383,7 +383,7 @@ testArraySlice = TestList
    testSlice index exp nm start count ds
      = testBothSameS ("genSlice " ++ show index) exp
       (tcall genVariable
-        (A.SubscriptedVariable emptyMeta (A.SubscriptFromFor emptyMeta (intLiteral start) (intLiteral count)) (variable nm))
+        (A.SubscriptedVariable emptyMeta (A.SubscriptFromFor emptyMeta A.CheckBoth (intLiteral start) (intLiteral count)) (variable nm))
       )
       (defineName (simpleName nm) $ simpleDefDecl nm (A.Array ds A.Int))
 

common/ShowCode.hs

@@ -375,11 +375,11 @@ instance ShowRain A.LiteralRepr where
 instance ShowOccam A.Subscript where
   showOccamM (A.Subscript _ _ e) = getTempItem >> tell ["["] >> showOccamM e >> tell ["]"]
   showOccamM (A.SubscriptField _ n) = getTempItem >> tell ["["] >> showName n >> tell ["]"]
-  showOccamM (A.SubscriptFromFor _ start count)
+  showOccamM (A.SubscriptFromFor _ _ start count)
     = tell ["["] >> getTempItem >> tell [" FROM "] >> showOccamM start >> tell [" FOR "] >> showOccamM count >> tell ["]"]
-  showOccamM (A.SubscriptFor _ count)
+  showOccamM (A.SubscriptFor _ _ count)
     = tell ["["] >> getTempItem >> tell [" FOR "] >> showOccamM count >> tell ["]"]
-  showOccamM (A.SubscriptFrom _ start)
+  showOccamM (A.SubscriptFrom _ _ start)
     = tell ["["] >> getTempItem >> tell [" FROM "] >> showOccamM start >> tell ["]"]        
   
 

common/Types.hs

@@ -141,15 +141,15 @@ subscriptType sub A.Infer
     = return $ A.Infer
 subscriptType sub t@(A.UserDataType _)
     = resolveUserType (findMeta sub) t >>= subscriptType sub
-subscriptType (A.SubscriptFromFor m _ count) (A.Array (_:ds) t)
+subscriptType (A.SubscriptFromFor m _ _ count) (A.Array (_:ds) t)
     = return $ A.Array (dimensionFromExpr count : ds) t
-subscriptType (A.SubscriptFrom m base) (A.Array (d:ds) t)
+subscriptType (A.SubscriptFrom m _ base) (A.Array (d:ds) t)
     = return $ A.Array (dim : ds) t
   where
     dim = case d of
             A.Dimension size -> dimensionFromExpr $ A.Dyadic m A.Subtr size base
             _ -> A.UnknownDimension
-subscriptType (A.SubscriptFor m count) (A.Array (_:ds) t)
+subscriptType (A.SubscriptFor m _ count) (A.Array (_:ds) t)
     = return $ A.Array (dimensionFromExpr count : ds) t
 subscriptType (A.SubscriptField m tag) t = typeOfRecordField m t tag
 subscriptType (A.Subscript m _ _) t = plainSubscriptType m t
@@ -160,11 +160,11 @@ subscriptType sub t = diePC (findMeta sub) $ formatCode "Unsubscriptable type: %
 unsubscriptType :: (CSMR m, Die m) => A.Subscript -> A.Type -> m A.Type
 unsubscriptType _ A.Infer
     = return $ A.Infer
-unsubscriptType (A.SubscriptFromFor _ _ _) t
+unsubscriptType (A.SubscriptFromFor _ _ _ _) t
     = return $ removeFixedDimension t
-unsubscriptType (A.SubscriptFrom _ _) t
+unsubscriptType (A.SubscriptFrom _ _ _) t
     = return $ removeFixedDimension t
-unsubscriptType (A.SubscriptFor _ _) t
+unsubscriptType (A.SubscriptFor _ _ _) t
     = return $ removeFixedDimension t
 unsubscriptType (A.SubscriptField m _) t
     = dieP m $ "unsubscript of record type (but we can't tell which one)"

data/AST.hs

@@ -208,13 +208,13 @@ data Subscript =
   -- inclusive.
   -- The second 'Expression' is the @FOR@; the count of items to include in the
   -- slice.
-  | SubscriptFromFor Meta Expression Expression
+  | SubscriptFromFor Meta SubscriptCheck Expression Expression
   -- | Like 'SubscriptFromFor', but without a @FOR@; it goes to the end of the
   -- array.
-  | SubscriptFrom Meta Expression
+  | SubscriptFrom Meta SubscriptCheck Expression
   -- | Like 'SubscriptFromFor', but without a @FROM@; it starts from the
   -- beginning of the array.
-  | SubscriptFor Meta Expression
+  | SubscriptFor Meta SubscriptCheck Expression
   deriving (Show, Eq, Typeable, Data)
 
 -- | The representation of a literal.

frontends/OccamTypes.hs

@@ -229,10 +229,10 @@ checkSubscript m s rawT
           -- Check the subscript itself.
           case s of
             A.Subscript m _ e -> checkExpressionInt e
-            A.SubscriptFromFor m e f ->
+            A.SubscriptFromFor m _ e f ->
               checkExpressionInt e >> checkExpressionInt f
-            A.SubscriptFrom m e -> checkExpressionInt e
+            A.SubscriptFrom m _ e -> checkExpressionInt e
-            A.SubscriptFor m e -> checkExpressionInt e
+            A.SubscriptFor m _ e -> checkExpressionInt e
             _ -> ok
 
 -- | Classes of operators.

frontends/OccamTypesTest.hs

@@ -88,12 +88,12 @@ testOccamTypes = TestList
     -- Subscript expressions
       testOK     0 $ subex $ A.Subscript m A.NoCheck intE
     , testFail   1 $ subex $ A.Subscript m A.NoCheck byteE
-    , testOK     2 $ subex $ A.SubscriptFromFor m intE intE
+    , testOK     2 $ subex $ A.SubscriptFromFor m A.NoCheck intE intE
-    , testFail   3 $ subex $ A.SubscriptFromFor m byteE byteE
+    , testFail   3 $ subex $ A.SubscriptFromFor m A.NoCheck byteE byteE
-    , testOK     4 $ subex $ A.SubscriptFrom m intE
+    , testOK     4 $ subex $ A.SubscriptFrom m A.NoCheck intE
-    , testFail   5 $ subex $ A.SubscriptFrom m byteE
+    , testFail   5 $ subex $ A.SubscriptFrom m A.NoCheck byteE
-    , testOK     6 $ subex $ A.SubscriptFor m intE
+    , testOK     6 $ subex $ A.SubscriptFor m A.NoCheck intE
-    , testFail   7 $ subex $ A.SubscriptFor m byteE
+    , testFail   7 $ subex $ A.SubscriptFor m A.NoCheck byteE
 
     -- Trivial literals
     , testOK    20 $ intE

frontends/ParseOccam.hs

@@ -289,13 +289,13 @@ maybeSliced inner subscripter
                    "FROM" ->
                      (do f <- tryXV sFOR expression
                          sRight
-                         return $ A.SubscriptFromFor m e f)
+                         return $ A.SubscriptFromFor m A.CheckBoth e f)
                      <|>
                      (do sRight
-                         return $ A.SubscriptFrom m e)
+                         return $ A.SubscriptFrom m A.CheckBoth e)
                    "FOR" ->
                      do sRight
-                        return $ A.SubscriptFor m e
+                        return $ A.SubscriptFor m A.CheckBoth e
 
           return $ subscripter m sub v
   where

testcases/fold-sizes.occ

@@ -0,0 +1,10 @@
+-- Test that _sizes arrays for constants are themselves constant.
+-- (This testcase taken from cgtest03.)
+PROC p ()
+  [10]BYTE dest:
+  INT y:
+  SEQ
+    y := 5
+    s IS [dest FROM 2 FOR y]:
+    s := "hello"
+: