diff --git a/backends/BackendPasses.hs b/backends/BackendPasses.hs index d34ce92..8b7616a 100644 --- a/backends/BackendPasses.hs +++ b/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) - = return (A.SubscriptedVariable m (A.SubscriptFromFor m' (makeConstant m' 0) for) v) - doVariable (A.SubscriptedVariable m (A.SubscriptFrom m' from) v) + doVariable (A.SubscriptedVariable m (A.SubscriptFor m' check for) v) + = return (A.SubscriptedVariable m (A.SubscriptFromFor m' check (makeConstant m' 0) for) 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 diff --git a/backends/BackendPassesTest.hs b/backends/BackendPassesTest.hs index 46092c3..692552f 100644 --- a/backends/BackendPassesTest.hs +++ b/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") diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 9bc7f95..f34f3e3 100644 --- a/backends/GenerateC.hs +++ b/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("] - call genExpression start - genComma - call genExpression count - genComma - call genExpression (A.SizeVariable m' v) - genComma - genMeta m' - tell [")"] + case check of + A.NoCheck -> call genExpression start + _ -> do tell ["occam_check_slice("] + call genExpression start + genComma + call genExpression count + genComma + call genExpression (A.SizeVariable m' v) + genComma + genMeta m' + tell [")"] )] tell [")"], 0) diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index ff2a2f3..ad5d9fa 100644 --- a/backends/GenerateCTest.hs +++ b/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)) diff --git a/common/ShowCode.hs b/common/ShowCode.hs index f85fa2e..6d24f89 100644 --- a/common/ShowCode.hs +++ b/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 ["]"] diff --git a/common/Types.hs b/common/Types.hs index 85c3d79..73671c3 100644 --- a/common/Types.hs +++ b/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)" diff --git a/data/AST.hs b/data/AST.hs index 5150758..eccbdeb 100644 --- a/data/AST.hs +++ b/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. diff --git a/frontends/OccamTypes.hs b/frontends/OccamTypes.hs index e6c5354..ec2372f 100644 --- a/frontends/OccamTypes.hs +++ b/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.SubscriptFor m e -> checkExpressionInt e + A.SubscriptFrom m _ e -> checkExpressionInt e + A.SubscriptFor m _ e -> checkExpressionInt e _ -> ok -- | Classes of operators. diff --git a/frontends/OccamTypesTest.hs b/frontends/OccamTypesTest.hs index 369a8dc..2083fd9 100644 --- a/frontends/OccamTypesTest.hs +++ b/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 - , testFail 3 $ subex $ A.SubscriptFromFor m byteE byteE - , testOK 4 $ subex $ A.SubscriptFrom m intE - , testFail 5 $ subex $ A.SubscriptFrom m byteE - , testOK 6 $ subex $ A.SubscriptFor m intE - , testFail 7 $ subex $ A.SubscriptFor m byteE + , testOK 2 $ subex $ A.SubscriptFromFor m A.NoCheck intE intE + , testFail 3 $ subex $ A.SubscriptFromFor m A.NoCheck byteE byteE + , testOK 4 $ subex $ A.SubscriptFrom m A.NoCheck intE + , testFail 5 $ subex $ A.SubscriptFrom m A.NoCheck byteE + , testOK 6 $ subex $ A.SubscriptFor m A.NoCheck intE + , testFail 7 $ subex $ A.SubscriptFor m A.NoCheck byteE -- Trivial literals , testOK 20 $ intE diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs index 991e282..0bb6292 100644 --- a/frontends/ParseOccam.hs +++ b/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 diff --git a/testcases/fold-sizes.occ b/testcases/fold-sizes.occ new file mode 100644 index 0000000..0c8772c --- /dev/null +++ b/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" +: