Make Dimension take an Int rather than an Expression
This commit is contained in:
parent
8a0702dfa3
commit
80bfdcd0a6
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
--}}}
|
--}}}
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user