Make Dimension take an Int rather than an Expression

This commit is contained in:
Adam Sampson 2007-04-26 20:21:03 +00:00
parent 8a0702dfa3
commit 80bfdcd0a6
4 changed files with 28 additions and 13 deletions

View File

@ -50,7 +50,7 @@ data Type =
deriving (Show, Eq, Typeable, Data) deriving (Show, Eq, Typeable, Data)
data Dimension = data Dimension =
Dimension Expression Dimension Int
| UnknownDimension | UnknownDimension
deriving (Show, Eq, Typeable, Data) deriving (Show, Eq, Typeable, Data)

View File

@ -1,5 +1,5 @@
-- | Evaluate constant expressions. -- | Evaluate constant expressions.
module EvalConstants (constantFold, isConstantName) where module EvalConstants (constantFold, isConstantName, evalIntExpression) where
import Control.Monad.Error import Control.Monad.Error
import Control.Monad.Identity import Control.Monad.Identity
@ -55,14 +55,28 @@ isConstantName n
Just _ -> True Just _ -> True
Nothing -> False Nothing -> False
-- | Evaluate a constant integer expression.
evalIntExpression :: (PSM m, Die m) => A.Expression -> m Int
evalIntExpression e
= do ps <- get
case runEvaluator ps e of
Left err -> die $ "cannot evaluate expression: " ++ err
Right (OccInt val) -> return $ int32ToInt val
Right _ -> die "expression is not of INT type"
-- | Attempt to simplify an expression as far as possible by precomputing -- | Attempt to simplify an expression as far as possible by precomputing
-- constant bits. -- constant bits.
simplifyExpression :: ParseState -> A.Expression -> Either String A.Expression simplifyExpression :: ParseState -> A.Expression -> Either String A.Expression
simplifyExpression ps e simplifyExpression ps e
= case runIdentity (evalStateT (runErrorT (evalExpression e)) ps) of = case runEvaluator ps e of
Left err -> Left err Left err -> Left err
Right val -> Right $ snd $ renderValue (metaOfExpression e) val Right val -> Right $ snd $ renderValue (metaOfExpression e) val
-- | Run the expression evaluator.
runEvaluator :: ParseState -> A.Expression -> Either String OccValue
runEvaluator ps e
= runIdentity (evalStateT (runErrorT (evalExpression e)) ps)
--{{{ expression evaluator --{{{ expression evaluator
type EvalM = ErrorT String (StateT ParseState Identity) type EvalM = ErrorT String (StateT ParseState Identity)
@ -161,6 +175,6 @@ renderLiteral m (OccInt i) = (A.Int, A.IntLiteral m $ show i)
renderLiteral m (OccArray vs) renderLiteral m (OccArray vs)
= (t, A.ArrayLiteral m es) = (t, A.ArrayLiteral m es)
where where
t = makeArrayType (A.Dimension $ makeConstant m (length vs)) (head ts) t = makeArrayType (A.Dimension $ length vs) (head ts)
(ts, es) = unzip $ map (renderValue m) vs (ts, es) = unzip $ map (renderValue m) vs
--}}} --}}}

View File

@ -148,8 +148,8 @@ genBytesInType :: A.Type -> CGen ()
genBytesInType (A.Array ds t) = genBytesInDims ds >> genBytesInType t genBytesInType (A.Array ds t) = genBytesInDims ds >> genBytesInType t
where where
genBytesInDims [] = return () genBytesInDims [] = return ()
genBytesInDims ((A.Dimension e):ds) genBytesInDims ((A.Dimension n):ds)
= genBytesInDims ds >> genExpression e >> tell [" * "] = genBytesInDims ds >> tell [show n, " * "]
genBytesInDims _ = missing "genBytesInType with empty dimension" genBytesInDims _ = missing "genBytesInType with empty dimension"
--bytesInType (A.UserDataType n) --bytesInType (A.UserDataType n)
genBytesInType t genBytesInType t
@ -664,7 +664,7 @@ abbrevExpression am t@(A.Array _ _) e
genTypeSize :: A.Type -> (A.Name -> CGen ()) genTypeSize :: A.Type -> (A.Name -> CGen ())
genTypeSize (A.Array ds _) genTypeSize (A.Array ds _)
= genArraySize False $ sequence_ $ intersperse genComma [genExpression e | A.Dimension e <- ds] = genArraySize False $ sequence_ $ intersperse genComma [tell [show n] | A.Dimension n <- ds]
abbrevExpression am _ e abbrevExpression am _ e
= (genExpression e, noSize) = (genExpression e, noSize)
--}}} --}}}
@ -686,7 +686,7 @@ genDimensions :: [A.Dimension] -> CGen ()
genDimensions ds genDimensions ds
= do tell ["["] = do tell ["["]
sequence $ intersperse (tell [" * "]) sequence $ intersperse (tell [" * "])
[case d of A.Dimension e -> genExpression e | d <- ds] [case d of A.Dimension n -> tell [show n] | d <- ds]
tell ["]"] tell ["]"]
genDeclaration :: A.Type -> A.Name -> CGen () genDeclaration :: A.Type -> A.Name -> CGen ()
@ -711,7 +711,7 @@ declareArraySizes ds name
= do tell ["const int "] = do tell ["const int "]
name name
tell ["_sizes[] = { "] tell ["_sizes[] = { "]
sequence_ $ intersperse genComma [genExpression e | (A.Dimension e) <- ds] sequence_ $ intersperse genComma [tell [show n] | A.Dimension n <- ds]
tell [" };\n"] tell [" };\n"]
-- | Initialise an item being declared. -- | Initialise an item being declared.

View File

@ -416,10 +416,10 @@ listType :: Meta -> [A.Type] -> OccParser A.Type
listType m l = listType' m (length l) l listType m l = listType' m (length l) l
where where
listType' m len [] = fail "expected non-empty list" listType' m len [] = fail "expected non-empty list"
listType' m len [t] = return $ makeArrayType (A.Dimension $ makeConstant m len) t listType' m len [t] = return $ makeArrayType (A.Dimension len) t
listType' m len (t1 : rest@(t2 : _)) listType' m len (t1 : rest@(t2 : _))
= if t1 == t2 then listType' m len rest = if t1 == t2 then listType' m len rest
else fail "multiple types in list" else fail $ "multiple types in list: " ++ show t1 ++ " and " ++ show t2
-- | Check that a type we've inferred matches the type we expected. -- | Check that a type we've inferred matches the type we expected.
matchType :: A.Type -> A.Type -> OccParser () matchType :: A.Type -> A.Type -> OccParser ()
@ -580,7 +580,8 @@ newTagName = anyName A.TagName
arrayType :: OccParser A.Type -> OccParser A.Type arrayType :: OccParser A.Type -> OccParser A.Type
arrayType element arrayType element
= do (s, t) <- tryXVXV sLeft constIntExpr sRight element = do (s, t) <- tryXVXV sLeft constIntExpr sRight element
return $ makeArrayType (A.Dimension s) t sVal <- evalIntExpression s
return $ makeArrayType (A.Dimension sVal) t
dataType :: OccParser A.Type dataType :: OccParser A.Type
dataType dataType
@ -707,7 +708,7 @@ stringLiteral
= do m <- md = do m <- md
char '"' char '"'
cs <- manyTill character sQuote cs <- manyTill character sQuote
return (A.StringLiteral m $ concat cs, A.Dimension $ makeConstant m $ length cs) return (A.StringLiteral m $ concat cs, A.Dimension $ length cs)
<?> "string literal" <?> "string literal"
character :: OccParser String character :: OccParser String