From 4b9e3a1ed593938a28bc7164eda0f364c465b94e Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Thu, 19 Apr 2007 00:17:02 +0000 Subject: [PATCH] Identify and deal with constant expressions/variables --- fco2/Parse.hs | 18 ++++++++++--- fco2/Types.hs | 72 ++++++++++++++++++++++++++++++++++++++++++++++++++ fco2/Unnest.hs | 35 +++++++++++++----------- 3 files changed, 105 insertions(+), 20 deletions(-) diff --git a/fco2/Parse.hs b/fco2/Parse.hs index 7830429..61bfa83 100644 --- a/fco2/Parse.hs +++ b/fco2/Parse.hs @@ -513,7 +513,7 @@ dataType <|> do { sINT64; return A.Int64 } <|> do { sREAL32; return A.Real32 } <|> do { sREAL64; return A.Real64 } - <|> try (do { sLeft; s <- intExpr; sRight; t <- dataType; return $ makeArrayType (A.Dimension s) t }) + <|> try (do { sLeft; s <- constIntExpr; sRight; t <- dataType; return $ makeArrayType (A.Dimension s) t }) <|> do { n <- dataTypeName; return $ A.UserDataType n } "dataType" @@ -521,19 +521,19 @@ dataType channelType :: OccParser A.Type channelType = do { sCHAN; sOF; p <- protocol; return $ A.Chan p } - <|> try (do { sLeft; s <- intExpr; sRight; t <- channelType; return $ makeArrayType (A.Dimension s) t }) + <|> try (do { sLeft; s <- constIntExpr; sRight; t <- channelType; return $ makeArrayType (A.Dimension s) t }) "channelType" timerType :: OccParser A.Type timerType = do { sTIMER; return $ A.Timer } - <|> try (do { sLeft; s <- intExpr; sRight; t <- timerType; return $ makeArrayType (A.Dimension s) t }) + <|> try (do { sLeft; s <- constIntExpr; sRight; t <- timerType; return $ makeArrayType (A.Dimension s) t }) "timerType" portType :: OccParser A.Type portType = do { sPORT; sOF; p <- dataType; return $ A.Port p } - <|> do { m <- md; try sLeft; s <- try intExpr; try sRight; t <- portType; return $ makeArrayType (A.Dimension s) t } + <|> do { m <- md; try sLeft; s <- try constIntExpr; try sRight; t <- portType; return $ makeArrayType (A.Dimension s) t } "portType" --}}} --{{{ literals @@ -659,6 +659,16 @@ exprOfType wantT intExpr = exprOfType A.Int "integer expression" booleanExpr = exprOfType A.Bool "boolean expression" +constExprOfType :: A.Type -> OccParser A.Expression +constExprOfType wantT + = do e <- exprOfType wantT + ps <- getState + if isConstExpression ps e + then return e + else fail "expected constant expression" + +constIntExpr = constExprOfType A.Int "constant integer expression" + monadicOperator :: OccParser A.MonadicOp monadicOperator = do { reservedOp "-" <|> sMINUS; return A.MonadicSubtr } diff --git a/fco2/Types.hs b/fco2/Types.hs index b64236d..76093bb 100644 --- a/fco2/Types.hs +++ b/fco2/Types.hs @@ -7,6 +7,7 @@ module Types where -- It'd be nice if we could provide an instance of StateMonad for the Parsec state... import Control.Monad +import Data.Maybe import qualified AST as A import ParseState @@ -34,6 +35,7 @@ typeOfName ps n Just (A.RetypesExpr m am t e) -> Just t _ -> Nothing +--{{{ identifying types typeOfRecordField :: ParseState -> A.Type -> A.Name -> Maybe A.Type typeOfRecordField ps (A.UserDataType rec) field = do st <- specTypeOfName ps rec @@ -106,6 +108,76 @@ typeOfLiteral :: ParseState -> A.Literal -> Maybe A.Type typeOfLiteral ps (A.Literal m t lr) = Just t typeOfLiteral ps (A.SubscriptedLiteral m s l) = typeOfLiteral ps l >>= subscriptType ps s +--}}} + +--{{{ identifying constants +-- | Can an expression's value be determined at compile time? +isConstExpression :: ParseState -> A.Expression -> Bool +isConstExpression ps e + = case e of + A.Monadic m op e -> isConstExpression ps e + A.Dyadic m op e f -> + isConstExpression ps e && isConstExpression ps f + A.MostPos m t -> True + A.MostNeg m t -> True + A.SizeType m t -> True + A.SizeExpr m e -> isConstExpression ps e + A.Conversion m cm t e -> isConstExpression ps e + A.ExprVariable m v -> isConstVariable ps v + A.ExprLiteral m l -> isConstLiteral ps l + A.True m -> True + A.False m -> True + -- This could be true if we could identify functions with constant + -- arguments and evaluate them at compile time, but I don't think we + -- really want to go there... + A.FunctionCall m n es -> False + A.SubscriptedExpr m s e -> + isConstSubscript ps s && isConstExpression ps e + A.BytesInExpr m e -> isConstExpression ps e + A.BytesInType m t -> True + A.OffsetOf m t n -> True + +-- | Can an literal's value be determined at compile time? +-- (Don't laugh -- array literals can't always!) +isConstLiteral :: ParseState -> A.Literal -> Bool +isConstLiteral ps (A.Literal _ _ lr) = isConstLiteralRepr ps lr +isConstLiteral ps (A.SubscriptedLiteral _ s l) + = isConstSubscript ps s && isConstLiteral ps l + +isConstLiteralRepr :: ParseState -> A.LiteralRepr -> Bool +isConstLiteralRepr ps (A.ArrayLiteral _ es) + = and [isConstExpression ps e | e <- es] +isConstLiteralRepr _ _ = True + +-- | Can a variable's value be determined at compile time? +isConstVariable :: ParseState -> A.Variable -> Bool +isConstVariable ps (A.Variable _ n) = isConstName ps n +isConstVariable ps (A.SubscriptedVariable _ s v) + = isConstSubscript ps s && isConstVariable ps v + +-- | Does a name refer to a constant variable? +isConstName :: ParseState -> A.Name -> Bool +isConstName ps n = isConstSpecType ps $ fromJust $ specTypeOfName ps n + +-- | Can a specification's value (that is, the value of a variable defined +-- using that specification) be determined at compile time? +isConstSpecType :: ParseState -> A.SpecType -> Bool +isConstSpecType ps (A.Is _ _ _ v) = isConstVariable ps v +isConstSpecType ps (A.IsExpr _ _ _ e) = isConstExpression ps e +isConstSpecType ps (A.Retypes _ _ _ v) = isConstVariable ps v +isConstSpecType ps (A.RetypesExpr _ _ _ e) = isConstExpression ps e +isConstSpecType _ _ = False + +-- | Can a subscript's value (that is, the range of subscripts it extracts) be +-- determined at compile time? +isConstSubscript :: ParseState -> A.Subscript -> Bool +isConstSubscript ps (A.Subscript _ e) = isConstExpression ps e +isConstSubscript ps (A.SubscriptField _ _) = True +isConstSubscript ps (A.SubscriptFromFor _ e f) + = isConstExpression ps e && isConstExpression ps f +isConstSubscript ps (A.SubscriptFrom _ e) = isConstExpression ps e +isConstSubscript ps (A.SubscriptFor _ e) = isConstExpression ps e +--}}} returnTypesOfFunction :: ParseState -> A.Name -> Maybe [A.Type] returnTypesOfFunction ps n diff --git a/fco2/Unnest.hs b/fco2/Unnest.hs index ca862e0..39856d4 100644 --- a/fco2/Unnest.hs +++ b/fco2/Unnest.hs @@ -108,14 +108,17 @@ removeFreeNames = doGeneric `extM` doSpecification `extM` doProcess doSpecification spec = case spec of A.Specification m n st@(A.Proc _ fs p) -> do - -- Figure out the free names + ps <- get + -- Figure out the free names. We only want to do this for channels + -- and variables, and we don't want to do it for constants because + -- they'll get pulled to the top level anyway. let allFreeNames = Map.elems $ freeNamesIn st let freeNames = [n | n <- allFreeNames, case A.nameType n of A.ChannelName -> True A.VariableName -> True - _ -> False] - ps <- get + _ -> False, + not $ isConstName ps n] let types = [fromJust $ typeOfName ps n | n <- freeNames] let ams = [case fromJust $ abbrevModeOfName ps n of A.Original -> A.Abbrev @@ -171,20 +174,20 @@ removeNesting p doSpecification :: A.Specification -> PassM A.Specification doSpecification spec@(A.Specification m _ st) - = if canPull st then - do spec' <- doGeneric spec - addPulled $ A.ProcSpec m spec' - return A.NoSpecification - else doGeneric spec + = do ps <- get + if canPull ps st then + do spec' <- doGeneric spec + addPulled $ A.ProcSpec m spec' + return A.NoSpecification + else doGeneric spec - canPull :: A.SpecType -> Bool - canPull (A.Proc _ _ _) = True - canPull (A.DataType _ _) = True - canPull (A.DataTypeRecord _ _ _) = True - canPull (A.Protocol _ _) = True - canPull (A.ProtocolCase _ _) = True - -- FIXME: Should pull up constant expressions too - canPull _ = False + canPull :: ParseState -> A.SpecType -> Bool + canPull _ (A.Proc _ _ _) = True + canPull _ (A.DataType _ _) = True + canPull _ (A.DataTypeRecord _ _ _) = True + canPull _ (A.Protocol _ _) = True + canPull _ (A.ProtocolCase _ _) = True + canPull ps st = isConstSpecType ps st -- | Remove specifications that have been turned into NoSpecifications. removeNoSpecs :: Data t => t -> PassM t