Identify and deal with constant expressions/variables

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 }

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

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]
+                                    _ -> False,
-             ps <- get
+                                  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
-            do spec' <- doGeneric spec
+             if canPull ps st then
-               addPulled $ A.ProcSpec m spec'
+                 do spec' <- doGeneric spec
-               return A.NoSpecification
+                    addPulled $ A.ProcSpec m spec'
-          else doGeneric spec
+                    return A.NoSpecification
+               else doGeneric spec
 
-    canPull :: A.SpecType -> Bool
+    canPull :: ParseState -> A.SpecType -> Bool
-    canPull (A.Proc _ _ _) = True
+    canPull _ (A.Proc _ _ _) = True
-    canPull (A.DataType _ _) = True
+    canPull _ (A.DataType _ _) = True
-    canPull (A.DataTypeRecord _ _ _) = True
+    canPull _ (A.DataTypeRecord _ _ _) = True
-    canPull (A.Protocol _ _) = True
+    canPull _ (A.Protocol _ _) = True
-    canPull (A.ProtocolCase _ _) = True
+    canPull _ (A.ProtocolCase _ _) = True
-    -- FIXME: Should pull up constant expressions too
+    canPull ps st = isConstSpecType ps st
-    canPull _ = False
 
 -- | Remove specifications that have been turned into NoSpecifications.
 removeNoSpecs :: Data t => t -> PassM t