diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index 8e200e9..e32ccc5 100644 --- a/fco2/GenerateC.hs +++ b/fco2/GenerateC.hs @@ -58,10 +58,6 @@ missing s = tell ["\n#error Unimplemented: ", s, "\n"] genComma :: CGen () genComma = tell [", "] -checkJust :: MonadError String m => Maybe t -> m t -checkJust (Just v) = return v -checkJust Nothing = throwError "checkJust failed" - type SubscripterFunction = A.Variable -> A.Variable overArray :: A.Variable -> (SubscripterFunction -> Maybe (CGen ())) -> CGen () @@ -147,24 +143,47 @@ genType t Just s -> tell [s] Nothing -> missing $ "genType " ++ show t +-- | Generate the number of bytes in a type that must have a fixed size. genBytesIn :: A.Type -> Maybe A.Variable -> CGen () -genBytesIn (A.Array ds t) v = genBytesInArray ds 0 >> genBytesIn t v +genBytesIn t v + = do free <- genBytesIn' t v + case free of + Nothing -> return () + Just _ -> die "genBytesIn type with unknown dimension" + +-- | Generate the number of bytes in a type that may have one free dimension. +genBytesIn' :: A.Type -> Maybe A.Variable -> CGen (Maybe Int) +genBytesIn' (A.Array ds t) v + = do free <- genBytesInArray ds 0 + genBytesIn' t v + return free where - genBytesInArray [] _ = return () + genBytesInArray [] _ = return Nothing genBytesInArray ((A.Dimension n):ds) i - = do genBytesInArray ds (i + 1) + = do free <- genBytesInArray ds (i + 1) tell [show n, " * "] + return free genBytesInArray (A.UnknownDimension:ds) i = case v of Just rv -> - do genBytesInArray ds (i + 1) + do free <- genBytesInArray ds (i + 1) genVariable rv tell ["_sizes[", show i, "] * "] - Nothing -> missing "genBytesIn array type with unknown dimension" -genBytesIn t _ + return free + Nothing -> + do free <- genBytesInArray ds (i + 1) + case free of + Nothing -> return $ Just i + Just _ -> die "genBytesIn' type with more than one free dimension" +genBytesIn' (A.UserDataType n) _ + = do tell ["sizeof ("] + genName n + tell [")"] + return Nothing +genBytesIn' t _ = case scalarType t of - Just s -> tell ["sizeof (", s, ")"] - Nothing -> missing $ "genBytesIn " ++ show t + Just s -> tell ["sizeof (", s, ")"] >> return Nothing + Nothing -> die $ "genBytesIn' " ++ show t --}}} --{{{ declarations @@ -751,43 +770,46 @@ abbrevVariable am t v -- | Generate the size part of a RETYPES/RESHAPES abbrevation of a variable. genRetypeSizes :: Meta -> A.AbbrevMode -> A.Type -> A.Name -> A.Type -> A.Variable -> CGen () genRetypeSizes m am destT destN srcT srcV - = case (destT, srcT) of - -- An array -- figure out the new dimensions. - (A.Array destDS destSubT, _) -> - do destBI <- bytesInType destT - srcBI <- bytesInType srcT - case (srcBI, destBI) of - -- Straightforward cases where we know the original size. - (_, BIJust _) -> declareArraySizes destDS (genName destN) - (BIJust srcBytes, BIOneFree destBytes _) -> - declareArraySizes [case d of - A.UnknownDimension -> - A.Dimension (srcBytes `div` destBytes) - _ -> d - | d <- destDS] - (genName destN) - -- The awkward case: the original size is dynamic, so we - -- need to compute the missing dimension at runtime. - (BIOneFree srcBytes srcNum, BIOneFree destBytes _) -> - do tell ["const int "] - genName destN - tell ["_sizes[] = { "] - let dims = [case d of - A.UnknownDimension -> - do tell ["occam_check_retype ("] - genVariable srcV - tell ["_sizes[", show srcNum, "]"] - tell [" * ", show srcBytes] - tell [", ", show destBytes, ", "] - genMeta m - tell [")"] - A.Dimension n -> tell [show n] - | d <- destDS] - sequence_ $ intersperse genComma dims - tell ["};\n"] - _ -> missing "dynamic size" - -- Not an array we're generating -- no need for sizes. - (_, _) -> return () + = do size <- makeNonce "retype_size" + tell ["int ", size, " = occam_check_retype ("] + genBytesIn srcT (Just srcV) + tell [", "] + free <- genBytesIn' destT Nothing + tell [", "] + genMeta m + tell [");\n"] + + case destT of + -- An array -- figure out the missing dimension, if there is one. + A.Array destDS _ -> + do case free of + -- No free dimensions; check the complete array matches in size. + Nothing -> + do tell ["if (", size, " != 1) {\n"] + genStop m "array size mismatch in RETYPES" + tell ["}\n"] + _ -> return () + + tell ["const int "] + genName destN + tell ["_sizes[] = { "] + let dims = [case d of + A.UnknownDimension -> + -- Unknown dimension -- insert it. + case free of + Just _ -> tell [size] + Nothing -> + die "genRetypeSizes expecting free dimension" + A.Dimension n -> tell [show n] + | d <- destDS] + sequence_ $ intersperse genComma dims + tell ["};\n"] + + -- Not array; just check the size is 1. + _ -> + do tell ["if (", size, " != 1) {\n"] + genStop m "size mismatch in RETYPES" + tell ["}\n"] -- | Generate the right-hand side of an abbreviation of an expression. abbrevExpression :: A.AbbrevMode -> A.Type -> A.Expression -> (CGen (), A.Name -> CGen ()) @@ -981,7 +1003,7 @@ introduceSpec (A.Specification _ n (A.Retypes m am t v)) (_, A.Array _ _) -> False (_, A.Chan _) -> False (A.ValAbbrev, _) -> True - _ -> True + _ -> False when deref $ tell ["*"] tell ["("] genDeclType am t diff --git a/fco2/Parse.hs b/fco2/Parse.hs index 755980e..aefa0d8 100644 --- a/fco2/Parse.hs +++ b/fco2/Parse.hs @@ -1323,15 +1323,15 @@ checkRetypes (A.Chan _) (A.Chan _) = return () checkRetypes fromT toT = do bf <- bytesInType fromT bt <- bytesInType toT - let ok = case (bf, bt) of - (BIJust a, BIJust b) -> a == b - (BIJust a, BIOneFree b _) -> (b <= a) && (a `mod` b == 0) - -- In this case we do a runtime check. - (BIOneFree _ _, BIOneFree _ _) -> True - -- Otherwise we can't tell. - _ -> False - when (not ok) $ - fail $ "RETYPES/RESHAPES sizes do not match" + case (bf, bt) of + (BIJust a, BIJust b) -> + when (a /= b) $ fail "size mismatch in RETYPES" + (BIJust a, BIOneFree b _) -> + when (not ((b <= a) && (a `mod` b == 0))) $ fail "size mismatch in RETYPES" + (_, BIManyFree) -> + fail "multiple free dimensions in RETYPES/RESHAPES type" + -- Otherwise we have to do a runtime check. + _ -> return () dataSpecifier :: OccParser A.Type dataSpecifier diff --git a/fco2/Types.hs b/fco2/Types.hs index c6a8a73..3027a35 100644 --- a/fco2/Types.hs +++ b/fco2/Types.hs @@ -317,7 +317,8 @@ simplifyType t = return t data BytesInResult = BIJust Int -- ^ Just that many bytes. | BIOneFree Int Int -- ^ An array type; A bytes, times unknown dimension B. - | BIUnknown -- ^ No idea. + | BIManyFree -- ^ An array type with multiple unknown dimensions. + | BIUnknown -- ^ We can't tell the size at compile time. deriving (Show, Eq) -- | Return the size in bytes of a data type. @@ -340,7 +341,8 @@ bytesInType a@(A.Array _ _) = bytesInArray 0 a (A.Dimension n, BIJust m) -> return $ BIJust (n * m) (A.Dimension n, BIOneFree m x) -> return $ BIOneFree (n * m) x (A.UnknownDimension, BIJust m) -> return $ BIOneFree m num - (_, _) -> return $ BIUnknown + (A.UnknownDimension, BIOneFree _ _) -> return BIManyFree + (_, _) -> return ts bytesInType (A.UserDataType n) = do st <- specTypeOfName n case st of