suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Identify and deal with constant expressions/variables

Browse Source
This commit is contained in:
Adam Sampson 2007-04-19 00:17:02 +00:00
parent 325199d16d
commit 4b9e3a1ed5
3 changed files with 105 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
fco2/Parse.hs
View File

@ -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 }

72
fco2/Types.hs
View File

@ -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

27
fco2/Unnest.hs
View File

@ -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 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