diff --git a/fco2/AST.hs b/fco2/AST.hs index 2ff6dcf..1f49e5c 100644 --- a/fco2/AST.hs +++ b/fco2/AST.hs @@ -50,7 +50,7 @@ data Type = deriving (Show, Eq, Typeable, Data) data Dimension = - Dimension Expression + Dimension Int | UnknownDimension deriving (Show, Eq, Typeable, Data) diff --git a/fco2/EvalConstants.hs b/fco2/EvalConstants.hs index a20c796..584c00e 100644 --- a/fco2/EvalConstants.hs +++ b/fco2/EvalConstants.hs @@ -1,5 +1,5 @@ -- | Evaluate constant expressions. -module EvalConstants (constantFold, isConstantName) where +module EvalConstants (constantFold, isConstantName, evalIntExpression) where import Control.Monad.Error import Control.Monad.Identity @@ -55,14 +55,28 @@ isConstantName n Just _ -> True 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 -- constant bits. simplifyExpression :: ParseState -> A.Expression -> Either String A.Expression simplifyExpression ps e - = case runIdentity (evalStateT (runErrorT (evalExpression e)) ps) of + = case runEvaluator ps e of Left err -> Left err 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 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) = (t, A.ArrayLiteral m es) 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 --}}} diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index 965b9fc..c00ea76 100644 --- a/fco2/GenerateC.hs +++ b/fco2/GenerateC.hs @@ -148,8 +148,8 @@ genBytesInType :: A.Type -> CGen () genBytesInType (A.Array ds t) = genBytesInDims ds >> genBytesInType t where genBytesInDims [] = return () - genBytesInDims ((A.Dimension e):ds) - = genBytesInDims ds >> genExpression e >> tell [" * "] + genBytesInDims ((A.Dimension n):ds) + = genBytesInDims ds >> tell [show n, " * "] genBytesInDims _ = missing "genBytesInType with empty dimension" --bytesInType (A.UserDataType n) genBytesInType t @@ -664,7 +664,7 @@ abbrevExpression am t@(A.Array _ _) e genTypeSize :: A.Type -> (A.Name -> CGen ()) 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 = (genExpression e, noSize) --}}} @@ -686,7 +686,7 @@ genDimensions :: [A.Dimension] -> CGen () genDimensions ds = do 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 ["]"] genDeclaration :: A.Type -> A.Name -> CGen () @@ -711,7 +711,7 @@ declareArraySizes ds name = do tell ["const int "] name tell ["_sizes[] = { "] - sequence_ $ intersperse genComma [genExpression e | (A.Dimension e) <- ds] + sequence_ $ intersperse genComma [tell [show n] | A.Dimension n <- ds] tell [" };\n"] -- | Initialise an item being declared. diff --git a/fco2/Parse.hs b/fco2/Parse.hs index 485537a..0be1444 100644 --- a/fco2/Parse.hs +++ b/fco2/Parse.hs @@ -416,10 +416,10 @@ listType :: Meta -> [A.Type] -> OccParser A.Type listType m l = listType' m (length l) l where 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 : _)) = 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. matchType :: A.Type -> A.Type -> OccParser () @@ -580,7 +580,8 @@ newTagName = anyName A.TagName arrayType :: OccParser A.Type -> OccParser A.Type arrayType 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 @@ -707,7 +708,7 @@ stringLiteral = do m <- md char '"' 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" character :: OccParser String