diff --git a/fco2/EvalConstants.hs b/fco2/EvalConstants.hs index 0a94b3b..6cf71f8 100644 --- a/fco2/EvalConstants.hs +++ b/fco2/EvalConstants.hs @@ -68,6 +68,29 @@ evalLiteralArray :: A.ArrayElem -> EvalM OccValue evalLiteralArray (A.ArrayElemArray aes) = liftM OccArray (mapM evalLiteralArray aes) evalLiteralArray (A.ArrayElemExpr e) = evalExpression e +evalVariable :: A.Variable -> EvalM OccValue +evalVariable (A.Variable _ n) + = do me <- getConstantName n + case me of + Just e -> evalExpression e + Nothing -> throwError $ "non-constant variable " ++ show n ++ " used" +evalVariable (A.SubscriptedVariable _ sub v) = evalVariable v >>= evalSubscript sub + +evalIndex :: A.Expression -> EvalM Int +evalIndex e + = do index <- evalExpression e + case index of + OccInt n -> return $ fromIntegral n + _ -> throwError $ "index has non-INT type" + +evalSubscript :: A.Subscript -> OccValue -> EvalM OccValue +evalSubscript (A.Subscript _ e) (OccArray vs) + = do index <- evalIndex e + if index >= 0 && index < length vs + then return $ vs !! index + else throwError $ "subscript out of range" +evalSubscript _ _ = throwError $ "invalid subscript" + evalExpression :: A.Expression -> EvalM OccValue evalExpression (A.Monadic _ op e) = do v <- evalExpression e @@ -93,13 +116,10 @@ evalExpression (A.SizeVariable m v) A.Array (A.Dimension n:_) _ -> return $ OccInt (fromIntegral n) _ -> throwError $ "size of non-fixed-size variable " ++ show v ++ " used" evalExpression e@(A.Literal _ _ _) = evalLiteral e -evalExpression (A.ExprVariable _ (A.Variable _ n)) - = do me <- getConstantName n - case me of - Just e -> evalExpression e - Nothing -> throwError $ "non-constant variable " ++ show n ++ " used" +evalExpression (A.ExprVariable _ v) = evalVariable v evalExpression (A.True _) = return $ OccBool True evalExpression (A.False _) = return $ OccBool False +evalExpression (A.SubscriptedExpr _ sub e) = evalExpression e >>= evalSubscript sub evalExpression (A.BytesInExpr _ e) = do t <- typeOfExpression e b <- bytesInType t diff --git a/fco2/EvalLiterals.hs b/fco2/EvalLiterals.hs index 41a2ac8..59b3e5e 100644 --- a/fco2/EvalLiterals.hs +++ b/fco2/EvalLiterals.hs @@ -71,21 +71,24 @@ evalSimpleExpression _ = throwError "not a literal" -- | Turn the result of one of the read* functions into an OccValue, -- or throw an error if it didn't parse. -fromRead :: (t -> OccValue) -> [(t, String)] -> EvalM OccValue -fromRead cons [(v, "")] = return $ cons v -fromRead _ _ = throwError "cannot parse literal" +fromRead :: (t -> OccValue) -> (String -> [(t, String)]) -> String -> EvalM OccValue +fromRead cons reader s + = case reader s of + [(v, "")] -> return $ cons v + _ -> throwError $ "cannot parse literal: " ++ s -- | Evaluate a simple (non-array) literal. evalSimpleLiteral :: A.Expression -> EvalM OccValue evalSimpleLiteral (A.Literal _ A.Byte (A.ByteLiteral _ s)) = evalByteLiteral s -evalSimpleLiteral (A.Literal _ A.Int (A.IntLiteral _ s)) = fromRead OccInt $ readDec s -evalSimpleLiteral (A.Literal _ A.Int (A.HexLiteral _ s)) = fromRead OccInt $ readHex s +evalSimpleLiteral (A.Literal _ A.Int (A.IntLiteral _ s)) + = fromRead OccInt (readSigned readDec) s +evalSimpleLiteral (A.Literal _ A.Int (A.HexLiteral _ s)) = fromRead OccInt readHex s evalSimpleLiteral l = throwError $ "bad literal: " ++ show l -- | Evaluate a byte literal. evalByteLiteral :: String -> EvalM OccValue evalByteLiteral ('*':'#':hex) - = do OccInt n <- fromRead OccInt $ readHex hex + = do OccInt n <- fromRead OccInt readHex hex return $ OccByte (chr $ fromIntegral n) evalByteLiteral ['*', ch] = return $ OccByte (star ch)