c97d1d00c8
ErrorReport is of type (Maybe Meta, String), thereby adding an optional code position to error messages. Die has been changed so that die and dieP are now implemented in terms of dieReport (:: ErrorReport -> m a). This involved changing less code than changing die to be of type ErrorReport -> m a. All that had to be changed directly was that Die instances now implement dieReport instead of die. Any bits of code that "caught" errors has been changed so that it handles ErrorReport instead of String. This ErrorReport is eventually, in Main, passed to dieIO, which will soon be changed to read the file in and provide the context. Accordingly, MonadIO m has been added as a constraint to dieIO, and dieInternal has been changed to no longer use dieIO (because really we can't add the MonadIO constraint to dieInternal). Various error messages have been changed. Notably, all instances of fail in ParseOccam have been changed to use die or, wherever possible, dieP. A similar thing has been done in EvalConstants and EvalLiterals.
173 lines
6.2 KiB
Haskell
173 lines
6.2 KiB
Haskell
{-
|
|
Tock: a compiler for parallel languages
|
|
Copyright (C) 2007 University of Kent
|
|
|
|
This program is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU General Public License as published by the
|
|
Free Software Foundation, either version 2 of the License, or (at your
|
|
option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful, but
|
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License along
|
|
with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
-}
|
|
|
|
-- | Evaluate simple literal expressions.
|
|
module EvalLiterals where
|
|
|
|
import Control.Monad.Error
|
|
import Control.Monad.Identity
|
|
import Control.Monad.State
|
|
import Data.Bits
|
|
import Data.Char
|
|
import Data.Generics
|
|
import Data.Int
|
|
import Data.Maybe
|
|
import Data.Word
|
|
import Numeric
|
|
|
|
import qualified AST as A
|
|
import CompState
|
|
import Errors
|
|
import Metadata
|
|
|
|
type EvalM = ErrorT ErrorReport (StateT CompState Identity)
|
|
|
|
instance Die EvalM where
|
|
dieReport = throwError
|
|
|
|
-- | Occam values of various types.
|
|
data OccValue =
|
|
OccBool Bool
|
|
| OccByte Word8
|
|
-- The following four aren't occam types, but I need to put them in here for handling Rain code:
|
|
| OccUInt16 Word16
|
|
| OccUInt32 Word32
|
|
| OccUInt64 Word64
|
|
| OccInt8 Int8
|
|
|
|
| OccInt Int32
|
|
| OccInt16 Int16
|
|
| OccInt32 Int32
|
|
| OccInt64 Int64
|
|
-- FIXME This should include the type of the elements, so we can handle
|
|
-- empty arrays.
|
|
| OccArray [OccValue]
|
|
| OccRecord A.Name [OccValue]
|
|
deriving (Show, Eq, Typeable, Data)
|
|
|
|
-- | Is an expression a constant literal?
|
|
isConstant :: A.Expression -> Bool
|
|
isConstant (A.Literal _ _ (A.ArrayLiteral _ aes))
|
|
= and $ map isConstantArray aes
|
|
isConstant (A.Literal _ _ (A.RecordLiteral _ es))
|
|
= and $ map isConstant es
|
|
isConstant (A.Literal _ _ _) = True
|
|
isConstant (A.True _) = True
|
|
isConstant (A.False _) = True
|
|
isConstant _ = False
|
|
|
|
-- | Is an array literal element constant?
|
|
isConstantArray :: A.ArrayElem -> Bool
|
|
isConstantArray (A.ArrayElemArray aes) = and $ map isConstantArray aes
|
|
isConstantArray (A.ArrayElemExpr e) = isConstant e
|
|
|
|
-- | Evaluate a constant integer expression.
|
|
evalIntExpression :: (CSM m, Die m) => A.Expression -> m Int
|
|
evalIntExpression e
|
|
= do ps <- get
|
|
case runEvaluator ps (evalSimpleExpression e) of
|
|
Left (m,err) -> dieReport (m,"cannot evaluate expression: " ++ err)
|
|
Right (OccInt val) -> return $ fromIntegral val
|
|
Right _ -> die "expression is not of INT type"
|
|
|
|
-- | Evaluate a byte literal.
|
|
evalByte :: (CSM m, Die m) => String -> m Char
|
|
evalByte s
|
|
= do ps <- get
|
|
case runEvaluator ps (evalByteLiteral s) of
|
|
Left (m,err) -> dieReport (m,"cannot evaluate byte literal: " ++ err)
|
|
Right (OccByte ch) -> return (chr $ fromIntegral ch)
|
|
|
|
-- | Run an evaluator operation.
|
|
runEvaluator :: CompState -> EvalM OccValue -> Either ErrorReport OccValue
|
|
runEvaluator ps func
|
|
= runIdentity (evalStateT (runErrorT func) ps)
|
|
|
|
-- | Evaluate a simple literal expression.
|
|
evalSimpleExpression :: A.Expression -> EvalM OccValue
|
|
evalSimpleExpression e@(A.Literal _ _ _) = evalSimpleLiteral e
|
|
evalSimpleExpression e = throwError (Just $ findMeta e,"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) -> (String -> [(t, String)]) -> String -> EvalM OccValue
|
|
fromRead cons reader s
|
|
= case reader s of
|
|
[(v, "")] -> return $ cons v
|
|
_ -> throwError (Nothing,"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.Byte (A.IntLiteral _ s))
|
|
= fromRead OccByte (readSigned readDec) s
|
|
evalSimpleLiteral (A.Literal _ A.Byte (A.HexLiteral _ s))
|
|
= fromRead OccByte readHex s
|
|
evalSimpleLiteral (A.Literal _ A.UInt16 (A.IntLiteral _ s))
|
|
= fromRead OccUInt16 (readSigned readDec) s
|
|
evalSimpleLiteral (A.Literal _ A.UInt16 (A.HexLiteral _ s))
|
|
= fromRead OccUInt16 readHex s
|
|
evalSimpleLiteral (A.Literal _ A.UInt32 (A.IntLiteral _ s))
|
|
= fromRead OccUInt32 (readSigned readDec) s
|
|
evalSimpleLiteral (A.Literal _ A.UInt32 (A.HexLiteral _ s))
|
|
= fromRead OccUInt32 readHex s
|
|
evalSimpleLiteral (A.Literal _ A.UInt64 (A.IntLiteral _ s))
|
|
= fromRead OccUInt64 (readSigned readDec) s
|
|
evalSimpleLiteral (A.Literal _ A.UInt64 (A.HexLiteral _ s))
|
|
= fromRead OccUInt64 readHex s
|
|
evalSimpleLiteral (A.Literal _ A.Int8 (A.IntLiteral _ s))
|
|
= fromRead OccInt8 (readSigned readDec) s
|
|
evalSimpleLiteral (A.Literal _ A.Int8 (A.HexLiteral _ s))
|
|
= fromRead OccInt8 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 (A.Literal _ A.Int16 (A.IntLiteral _ s))
|
|
= fromRead OccInt16 (readSigned readDec) s
|
|
evalSimpleLiteral (A.Literal _ A.Int16 (A.HexLiteral _ s))
|
|
= fromRead OccInt16 readHex s
|
|
evalSimpleLiteral (A.Literal _ A.Int32 (A.IntLiteral _ s))
|
|
= fromRead OccInt32 (readSigned readDec) s
|
|
evalSimpleLiteral (A.Literal _ A.Int32 (A.HexLiteral _ s))
|
|
= fromRead OccInt32 readHex s
|
|
evalSimpleLiteral (A.Literal _ A.Int64 (A.IntLiteral _ s))
|
|
= fromRead OccInt64 (readSigned readDec) s
|
|
evalSimpleLiteral (A.Literal _ A.Int64 (A.HexLiteral _ s))
|
|
= fromRead OccInt64 readHex s
|
|
evalSimpleLiteral l = throwError (Just $ findMeta l,"bad literal: " ++ show l)
|
|
|
|
-- | Evaluate a byte literal.
|
|
evalByteLiteral :: String -> EvalM OccValue
|
|
evalByteLiteral ('*':'#':hex)
|
|
= do OccInt n <- fromRead OccInt readHex hex
|
|
return $ OccByte (fromIntegral n)
|
|
evalByteLiteral ['*', ch]
|
|
= return $ OccByte (fromIntegral $ ord $ star ch)
|
|
where
|
|
star :: Char -> Char
|
|
star 'c' = '\r'
|
|
star 'n' = '\n'
|
|
star 't' = '\t'
|
|
star 's' = ' '
|
|
star c = c
|
|
evalByteLiteral [ch]
|
|
= return $ OccByte (fromIntegral $ ord ch)
|
|
evalByteLiteral _ = throwError (Nothing,"bad BYTE literal")
|