Added ShowOccam and ShowRain type-classes, and changed existing code to use these new show methods in error messages
The function showCode shows code as either occam or Rain depending on the frontend. This is then used by a formatCode function that acts similar to printf, which makes it easy to format error messages that use showCode.
This commit is contained in:
Neil Brown
parent
1c5ad805d3
commit
3e342a621c
|
|
@ -37,6 +37,7 @@ import EvalLiterals
|
|||
import Metadata
|
||||
import Pass
|
||||
import Errors
|
||||
import ShowCode
|
||||
import TLP
|
||||
import Types
|
||||
import Utils
|
||||
|
|
@ -117,6 +118,7 @@ data GenOps = GenOps {
|
|||
genLiteral :: GenOps -> A.LiteralRepr -> CGen (),
|
||||
genLiteralRepr :: GenOps -> A.LiteralRepr -> CGen (),
|
||||
genMissing :: GenOps -> String -> CGen (),
|
||||
genMissingC :: GenOps -> CGen String -> CGen (),
|
||||
genMonadic :: GenOps -> Meta -> A.MonadicOp -> A.Expression -> CGen (),
|
||||
genOutput :: GenOps -> A.Variable -> [A.OutputItem] -> CGen (),
|
||||
genOutputCase :: GenOps -> A.Variable -> A.Name -> [A.OutputItem] -> CGen (),
|
||||
|
|
@ -204,6 +206,7 @@ cgenOps = GenOps {
|
|||
genLiteral = cgenLiteral,
|
||||
genLiteralRepr = cgenLiteralRepr,
|
||||
genMissing = cgenMissing,
|
||||
genMissingC = (\ops x -> x >>= cgenMissing ops),
|
||||
genMonadic = cgenMonadic,
|
||||
genOutput = cgenOutput,
|
||||
genOutputCase = cgenOutputCase,
|
||||
|
|
@ -376,7 +379,7 @@ cgenType _ (A.Chan _ _ t) = tell ["Channel *"]
|
|||
cgenType ops t
|
||||
= case call getScalarType ops t of
|
||||
Just s -> tell [s]
|
||||
Nothing -> call genMissing ops $ "genType " ++ show t
|
||||
Nothing -> call genMissingC ops $ formatCode "genType %" t
|
||||
|
||||
-- | Generate the number of bytes in a type that must have a fixed size.
|
||||
cgenBytesIn :: GenOps -> A.Type -> Maybe A.Variable -> CGen ()
|
||||
|
|
@ -423,7 +426,7 @@ cgenBytesIn' _ (A.Chan {}) _
|
|||
cgenBytesIn' ops t _
|
||||
= case call getScalarType ops t of
|
||||
Just s -> tell ["sizeof (", s, ")"] >> return Nothing
|
||||
Nothing -> die $ "genBytesIn' " ++ show t
|
||||
Nothing -> dieC $ formatCode "genBytesIn' %" t
|
||||
--}}}
|
||||
|
||||
--{{{ declarations
|
||||
|
|
@ -817,7 +820,7 @@ cgenTypeSymbol :: GenOps -> String -> A.Type -> CGen ()
|
|||
cgenTypeSymbol ops s t
|
||||
= case call getScalarType ops t of
|
||||
Just ct -> tell ["occam_", s, "_", ct]
|
||||
Nothing -> call genMissing ops $ "genTypeSymbol " ++ show t
|
||||
Nothing -> call genMissingC ops $ formatCode "genTypeSymbol %" t
|
||||
|
||||
cgenIntrinsicFunction :: GenOps -> Meta -> String -> [A.Expression] -> CGen ()
|
||||
cgenIntrinsicFunction ops m s es
|
||||
|
|
@ -1503,7 +1506,7 @@ cgenAssign ops m [v] el
|
|||
tell [" = "]
|
||||
call genExpression ops e
|
||||
tell [";\n"]
|
||||
Nothing -> call genMissing ops $ "assignment of type " ++ show t
|
||||
Nothing -> call genMissingC ops $ formatCode "assignment of type %" t
|
||||
--}}}
|
||||
--{{{ input
|
||||
cgenInput :: GenOps -> A.Variable -> A.InputMode -> CGen ()
|
||||
|
|
|
|||
|
|
@ -87,6 +87,7 @@ import EvalLiterals
|
|||
import Metadata
|
||||
import Pass
|
||||
import Errors
|
||||
import ShowCode
|
||||
import TLP
|
||||
import Types
|
||||
import Utils
|
||||
|
|
@ -1079,7 +1080,7 @@ cppgenType _ (A.Any)
|
|||
cppgenType ops t
|
||||
= case call getScalarType ops t of
|
||||
Just s -> tell [s]
|
||||
Nothing -> call genMissing ops $ "genType " ++ show t
|
||||
Nothing -> call genMissingC ops $ formatCode "genType %" t
|
||||
|
||||
|
||||
-- | Helper function for prefixing an underscore to a name.
|
||||
|
|
|
|||
|
|
@ -127,34 +127,7 @@ data Type =
|
|||
| Any
|
||||
| Timer
|
||||
| Port Type
|
||||
deriving (Eq, Typeable, Data)
|
||||
|
||||
instance Show Type where
|
||||
show Bool = "BOOL"
|
||||
show Byte = "BYTE"
|
||||
show UInt16 = "UINT16"
|
||||
show UInt32 = "UINT32"
|
||||
show UInt64 = "UINT64"
|
||||
show Int = "INT"
|
||||
show Int8 = "INT8"
|
||||
show Int16 = "INT16"
|
||||
show Int32 = "INT32"
|
||||
show Int64 = "INT64"
|
||||
show Real32 = "REAL32"
|
||||
show Real64 = "REAL64"
|
||||
show (Array ds t)
|
||||
= concat [case d of
|
||||
Dimension n -> "[" ++ show n ++ "]"
|
||||
UnknownDimension -> "[]"
|
||||
| d <- ds] ++ show t
|
||||
show (UserDataType n) = nameName n ++ "{data type}"
|
||||
show (Record n) = nameName n ++ "{record}"
|
||||
show (UserProtocol n) = nameName n ++ "{protocol}"
|
||||
show (Chan _ _ t) = "CHAN OF " ++ show t
|
||||
show (Counted ct et) = show ct ++ "::" ++ show et
|
||||
show Any = "ANY"
|
||||
show Timer = "TIMER"
|
||||
show (Port t) = "PORT OF " ++ show t
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
-- | An array dimension.
|
||||
-- Depending on the context, an array type may have empty dimensions, which is
|
||||
|
|
|
|||
|
|
@ -24,6 +24,7 @@ import Data.Map (Map)
|
|||
import qualified Data.Map as Map
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Control.Monad.Error
|
||||
import Control.Monad.State
|
||||
|
||||
import qualified AST as A
|
||||
|
|
@ -77,7 +78,7 @@ data CompState = CompState {
|
|||
csAdditionalArgs :: Map String [A.Actual],
|
||||
csParProcs :: Set A.Name
|
||||
}
|
||||
deriving (Show, Data, Typeable)
|
||||
deriving (Data, Typeable)
|
||||
|
||||
instance Show (A.Structured -> A.Structured) where
|
||||
show p = "(function on Structured)"
|
||||
|
|
@ -247,3 +248,12 @@ makeNonceVariable :: CSM m => String -> Meta -> A.Type -> A.NameType -> A.Abbrev
|
|||
makeNonceVariable s m t nt am
|
||||
= defineNonce m s (A.Declaration m t) nt am
|
||||
--}}}
|
||||
|
||||
diePC :: (CSM m, Die m) => Meta -> m String -> m a
|
||||
diePC m str = str >>= (dieP m)
|
||||
|
||||
dieC :: (CSM m, Die m) => m String -> m a
|
||||
dieC str = str >>= die
|
||||
|
||||
throwErrorC :: (CSM m,MonadError String m) => m String -> m a
|
||||
throwErrorC str = str >>= throwError
|
||||
|
|
|
|||
|
|
@ -37,6 +37,7 @@ import Errors
|
|||
import EvalLiterals
|
||||
import Metadata
|
||||
import Pass
|
||||
import ShowCode
|
||||
import Types
|
||||
|
||||
-- | Simplify an expression by constant folding, and also return whether it's a
|
||||
|
|
@ -167,7 +168,7 @@ evalExpression (A.BytesInType _ t)
|
|||
= do b <- underlyingType t >>= bytesInType
|
||||
case b of
|
||||
BIJust n -> return $ OccInt (fromIntegral $ n)
|
||||
_ -> throwError $ "BYTESIN non-constant-size type " ++ show t ++ " used"
|
||||
_ -> throwErrorC $ formatCode "BYTESIN non-constant-size type % used" t
|
||||
evalExpression e = throwError "bad expression"
|
||||
|
||||
evalMonadicOp :: (forall t. (Num t, Integral t, Bits t) => t -> t) -> OccValue -> EvalM OccValue
|
||||
|
|
|
|||
173
common/ShowCode.hs
Normal file
173
common/ShowCode.hs
Normal file
|
|
@ -0,0 +1,173 @@
|
|||
{-# OPTIONS_GHC -fallow-incoherent-instances #-}
|
||||
{-
|
||||
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/>.
|
||||
-}
|
||||
|
||||
-- | A module with type-classes and functions for displaying code, dependent on the context.
|
||||
-- Primarily, this means showing code as occam in error messages for the occam frontend, and Rain code for the Rain frontend.
|
||||
module ShowCode where
|
||||
|
||||
import Control.Monad.State
|
||||
import Text.Regex
|
||||
import qualified AST as A
|
||||
import CompState
|
||||
|
||||
-- | A type-class that indicates that the data (AST item) is displayable as occam code.
|
||||
class ShowOccam a where
|
||||
showOccam :: a -> String
|
||||
|
||||
-- | A type-class that indicates that the data (AST item) is displayable as Rain code.
|
||||
class ShowRain a where
|
||||
showRain :: a -> String
|
||||
|
||||
-- | Shows the given code (AST item) as either occam or Rain code, depending on which frontend was selected
|
||||
showCode :: (CSM m, ShowOccam a, ShowRain a) => a -> m String
|
||||
showCode o
|
||||
= do st <- get
|
||||
return $ case csFrontend st of
|
||||
FrontendOccam -> showOccam o
|
||||
FrontendRain -> showRain o
|
||||
|
||||
-- | Some type hackery to allow formatCode to take a variable number of functions.
|
||||
class CSM m => ShowCodeFormat a m | a -> m where
|
||||
chain :: [String] -> [m String] -> a
|
||||
|
||||
instance CSM m => ShowCodeFormat (m String) m where
|
||||
chain xs ys = (liftM concat) (sequence $ interleave (map return xs) (ys))
|
||||
where
|
||||
--Given [a,b,c] [1,2], produces [a,1,b,2,c] etc
|
||||
interleave :: [a] -> [a] -> [a]
|
||||
interleave xs [] = xs
|
||||
interleave [] ys = ys
|
||||
interleave (x:xs) (y:ys) = (x:y: (interleave xs ys))
|
||||
|
||||
|
||||
instance (ShowOccam a, ShowRain a, ShowCodeFormat r m, CSM m) => ShowCodeFormat (a -> r) m where
|
||||
chain a x = (\y -> chain a (x ++ [showCode y]))
|
||||
|
||||
|
||||
-- | Formats the given code as either occam or Rain code, depending on the frontend (using showCode).
|
||||
-- Use like this:
|
||||
-- dieC $ formatCode "Types do not match: % and %" ta tb
|
||||
formatCode :: (CSM m,ShowCodeFormat r m) => String -> r
|
||||
formatCode fmt = chain (splitRegex (mkRegex "%") fmt) []
|
||||
|
||||
|
||||
--Type-class instances follow for ShowOccam and ShowRain:
|
||||
|
||||
instance ShowOccam A.Type where
|
||||
showOccam A.Bool = "BOOL"
|
||||
showOccam A.Byte = "BYTE"
|
||||
showOccam A.UInt16 = "UINT16"
|
||||
showOccam A.UInt32 = "UINT32"
|
||||
showOccam A.UInt64 = "UINT64"
|
||||
showOccam A.Int = "INT"
|
||||
showOccam A.Int8 = "INT8"
|
||||
showOccam A.Int16 = "INT16"
|
||||
showOccam A.Int32 = "INT32"
|
||||
showOccam A.Int64 = "INT64"
|
||||
showOccam A.Real32 = "REAL32"
|
||||
showOccam A.Real64 = "REAL64"
|
||||
showOccam (A.Array ds t)
|
||||
= concat [case d of
|
||||
A.Dimension n -> "[" ++ show n ++ "]"
|
||||
A.UnknownDimension -> "[]"
|
||||
| d <- ds] ++ showOccam t
|
||||
showOccam (A.UserDataType n) = A.nameName n ++ "{data type}"
|
||||
showOccam (A.Record n) = A.nameName n ++ "{record}"
|
||||
showOccam (A.UserProtocol n) = A.nameName n ++ "{protocol}"
|
||||
showOccam (A.Chan _ _ t) = "CHAN OF " ++ showOccam t
|
||||
showOccam (A.Counted ct et) = showOccam ct ++ "::" ++ showOccam et
|
||||
showOccam A.Any = "ANY"
|
||||
showOccam A.Timer = "TIMER"
|
||||
showOccam (A.Port t) = "PORT OF " ++ showOccam t
|
||||
|
||||
|
||||
instance ShowRain A.Type where
|
||||
showRain A.Bool = "bool"
|
||||
showRain A.Byte = "uint8"
|
||||
showRain A.UInt16 = "uint16"
|
||||
showRain A.UInt32 = "uint32"
|
||||
showRain A.UInt64 = "uint64"
|
||||
showRain A.Int8 = "sint8"
|
||||
showRain A.Int16 = "sint16"
|
||||
showRain A.Int32 = "sint32"
|
||||
showRain A.Int64 = "int"
|
||||
showRain A.Int = "int"
|
||||
showRain (A.Chan dir attr t)
|
||||
= case dir of
|
||||
A.DirUnknown -> "channel " ++ ao (A.caWritingShared attr) ++ "2" ++ ao (A.caReadingShared attr) ++ " " ++ showRain t
|
||||
A.DirInput -> (if A.caReadingShared attr then "shared" else "") ++ " ?" ++ showRain t
|
||||
A.DirOutput -> (if A.caWritingShared attr then "shared" else "") ++ " !" ++ showRain t
|
||||
where
|
||||
ao :: Bool -> String
|
||||
ao b = if b then "any" else "one"
|
||||
showRain x = "<invalid Rain type: " ++ show x ++ ">"
|
||||
|
||||
instance ShowOccam A.DyadicOp where
|
||||
showOccam A.Add = "+"
|
||||
showOccam A.Subtr = "-"
|
||||
showOccam A.Mul = "*"
|
||||
showOccam A.Div = "/"
|
||||
showOccam A.Rem = "REM"
|
||||
showOccam A.Plus = "PLUS"
|
||||
showOccam A.Minus = "MINUS"
|
||||
showOccam A.Times = "TIMES"
|
||||
showOccam A.BitAnd = "/\\"
|
||||
showOccam A.BitOr = "\\/"
|
||||
showOccam A.BitXor = "><"
|
||||
showOccam A.LeftShift = "<<"
|
||||
showOccam A.RightShift = ">>"
|
||||
showOccam A.And = "AND"
|
||||
showOccam A.Or = "OR"
|
||||
showOccam A.Eq = "="
|
||||
showOccam A.NotEq = "<>"
|
||||
showOccam A.Less = "<"
|
||||
showOccam A.More = ">"
|
||||
showOccam A.LessEq = "<="
|
||||
showOccam A.MoreEq = ">="
|
||||
showOccam A.After = "AFTER"
|
||||
|
||||
|
||||
instance ShowRain A.DyadicOp where
|
||||
showRain A.Div = "/"
|
||||
showRain A.Rem = "%"
|
||||
showRain A.Plus = "+"
|
||||
showRain A.Minus = "-"
|
||||
showRain A.Times = "*"
|
||||
showRain A.And = "and"
|
||||
showRain A.Or = "or"
|
||||
showRain A.Eq = "=="
|
||||
showRain A.NotEq = "<>"
|
||||
showRain A.Less = "<"
|
||||
showRain A.More = ">"
|
||||
showRain A.LessEq = "<="
|
||||
showRain A.MoreEq = ">="
|
||||
showRain x = "<invalid Rain operator: " ++ show x ++ ">"
|
||||
|
||||
instance ShowOccam A.Variable where
|
||||
showOccam (A.Variable _ n) = show n
|
||||
showOccam (A.SubscriptedVariable _ s v) = showOccam v ++ "[" ++ show s ++ "]"
|
||||
showOccam (A.DirectedVariable _ A.DirUnknown v) = showOccam v
|
||||
showOccam (A.DirectedVariable _ A.DirInput v) = showOccam v ++ "?"
|
||||
showOccam (A.DirectedVariable _ A.DirOutput v) = showOccam v ++ "!"
|
||||
|
||||
instance ShowRain A.Variable where
|
||||
showRain (A.Variable _ n) = show n
|
||||
showRain (A.DirectedVariable _ A.DirInput v) = "?" ++ showRain v
|
||||
showRain (A.DirectedVariable _ A.DirOutput v) = "!" ++ showRain v
|
||||
showRain x = "<invalid Rain variable: " ++ show x ++ ">"
|
||||
|
|
@ -49,6 +49,7 @@ import Control.Monad.State
|
|||
import Control.Monad.Error
|
||||
import Pass
|
||||
import CompState
|
||||
import PrettyShow
|
||||
import Utils
|
||||
import qualified Data.Map as Map
|
||||
|
||||
|
|
@ -332,7 +333,7 @@ testPassShouldFail testName actualPass startStateTrans =
|
|||
do ret <- runPass actualPass (execState startStateTrans emptyState)
|
||||
case ret of
|
||||
(_,Left err) -> return ()
|
||||
_ -> assertFailure $ testName ++ " pass succeeded when expected to fail, data: " ++ (show ret)
|
||||
_ -> assertFailure $ testName ++ " pass succeeded when expected to fail, data: " ++ (pshow ret)
|
||||
|
||||
-- | Asserts that a particular variable is defined in the given 'CompState'.
|
||||
assertVarDef ::
|
||||
|
|
|
|||
|
|
@ -48,6 +48,7 @@ import Errors
|
|||
import EvalLiterals
|
||||
import Intrinsics
|
||||
import Metadata
|
||||
import ShowCode
|
||||
import Utils
|
||||
|
||||
-- | Gets the 'A.SpecType' for a given 'A.Name' from the recorded types in the 'CompState'. Dies with an error if the name is unknown.
|
||||
|
|
@ -124,7 +125,7 @@ plainSubscriptType m sub (A.Array (d:ds) t)
|
|||
ok = case ds of
|
||||
[] -> t
|
||||
_ -> A.Array ds t
|
||||
plainSubscriptType m _ t = dieP m $ "subscript of non-array type " ++ show t
|
||||
plainSubscriptType m _ t = diePC m $ formatCode "subscript of non-array type: %" t
|
||||
|
||||
-- | Apply a subscript to a type, and return what the type is after it's been
|
||||
-- subscripted.
|
||||
|
|
@ -145,7 +146,7 @@ subscriptType (A.SubscriptFor m count) t
|
|||
= sliceType m (makeConstant emptyMeta 0) count t
|
||||
subscriptType (A.SubscriptField m tag) t = typeOfRecordField m t tag
|
||||
subscriptType (A.Subscript m sub) t = plainSubscriptType m sub t
|
||||
subscriptType _ t = die $ "unsubscriptable type: " ++ show t
|
||||
subscriptType sub t = diePC (findMeta sub) $ formatCode "Unsubscriptable type: %" t
|
||||
|
||||
-- | The inverse of 'subscriptType': given a type that we know is the result of
|
||||
-- a subscript, return what the type being subscripted is.
|
||||
|
|
@ -165,10 +166,10 @@ unsubscriptType (A.Subscript _ sub) t
|
|||
-- subscriptType with constant 0 as a subscript, but without the checking.
|
||||
-- This is used for the couple of cases where we know it's safe and don't want
|
||||
-- the usage check.
|
||||
trivialSubscriptType :: (Die m) => A.Type -> m A.Type
|
||||
trivialSubscriptType :: (CSM m, Die m) => A.Type -> m A.Type
|
||||
trivialSubscriptType (A.Array [d] t) = return t
|
||||
trivialSubscriptType (A.Array (d:ds) t) = return $ A.Array ds t
|
||||
trivialSubscriptType t = die $ "not plain array type: " ++ show t
|
||||
trivialSubscriptType t = dieC $ formatCode "not plain array type: %" t
|
||||
|
||||
-- | Gets the 'A.Type' of a 'A.Variable' by looking at the types recorded in the 'CompState'.
|
||||
typeOfVariable :: (CSM m, Die m) => A.Variable -> m A.Type
|
||||
|
|
|
|||
|
|
@ -38,6 +38,7 @@ import Intrinsics
|
|||
import LexOccam
|
||||
import Metadata
|
||||
import Pass
|
||||
import ShowCode
|
||||
import Types
|
||||
import Utils
|
||||
|
||||
|
|
@ -294,7 +295,7 @@ maybeSliced inner subscripter typer
|
|||
t <- typer v >>= underlyingType
|
||||
case t of
|
||||
(A.Array _ _) -> return ()
|
||||
_ -> fail $ "slice of non-array type " ++ show t
|
||||
_ -> fail $ "slice of non-array type " ++ showOccam t
|
||||
|
||||
e <- intExpr
|
||||
sub <- case ff1 of
|
||||
|
|
@ -392,7 +393,7 @@ matchType et rt
|
|||
else bad
|
||||
_ -> if rt == et then return () else bad
|
||||
where
|
||||
bad = fail $ "type mismatch (got " ++ show rt ++ "; expected " ++ show et ++ ")"
|
||||
bad = fail $ "type mismatch (got " ++ showOccam rt ++ "; expected " ++ showOccam et ++ ")"
|
||||
|
||||
-- | Check that two lists of types match (for example, for parallel assignment).
|
||||
matchTypes :: [A.Type] -> [A.Type] -> OccParser ()
|
||||
|
|
@ -672,7 +673,7 @@ makeLiteral x@(A.Literal m t lr) wantT
|
|||
|
||||
typesOK <- isValidLiteralType m t wantT
|
||||
when (not typesOK) $
|
||||
dieP m $ "default type of literal (" ++ show t ++ ") cannot be coerced to desired type (" ++ show wantT ++ ")"
|
||||
dieP m $ "default type of literal (" ++ showOccam t ++ ") cannot be coerced to desired type (" ++ showOccam wantT ++ ")"
|
||||
|
||||
case (underT, lr) of
|
||||
-- An array literal.
|
||||
|
|
@ -1936,7 +1937,7 @@ actual (A.Formal am t n)
|
|||
A.Timer -> var timer
|
||||
A.Port _ -> var (portOfType t)
|
||||
_ -> var (variableOfType t)
|
||||
<?> "actual of type " ++ show t ++ " for " ++ show n
|
||||
<?> "actual of type " ++ showOccam t ++ " for " ++ show n
|
||||
where
|
||||
var inner = liftM (A.ActualVariable am t) inner
|
||||
--}}}
|
||||
|
|
|
|||
|
|
@ -27,6 +27,7 @@ import Types
|
|||
import Control.Monad.State
|
||||
import CompState
|
||||
import Metadata
|
||||
import ShowCode
|
||||
|
||||
|
||||
-- | A pass that records inferred types. Currently the only place where types are inferred is in seqeach\/pareach loops.
|
||||
|
|
@ -148,8 +149,7 @@ coerceType :: String -> A.Type -> A.Type -> A.Expression -> PassM A.Expression
|
|||
coerceType customMsg to from item
|
||||
= if isImplicitConversionRain from to
|
||||
then return $ A.Conversion (findMeta item) A.DefaultConversion to item
|
||||
else dieP (findMeta item) $ "Could not perform implicit cast from supplied type: " ++ (show from) ++
|
||||
" to expected type: " ++ (show to) ++ customMsg
|
||||
else diePC (findMeta item) $ (liftM concat) $ sequence [formatCode "Could not perform implicit cast from supplied type: % to expected type: %" from to, return customMsg]
|
||||
|
||||
|
||||
-- | Checks the types in expressions
|
||||
|
|
@ -161,14 +161,14 @@ checkExpressionTypes = everywhereASTM checkExpression
|
|||
= do tlhs <- typeOfExpression lhs
|
||||
trhs <- typeOfExpression rhs
|
||||
if (tlhs == trhs)
|
||||
then (if validOp op tlhs then return e else dieP m $ "Operator: \"" ++ show op ++ "\" is not valid on type: \"" ++ show tlhs)
|
||||
then (if validOp op tlhs then return e else diePC m $ formatCode "Operator: \"%\" is not valid on type: \"%\"" op tlhs)
|
||||
else if (isIntegerType tlhs && isIntegerType trhs)
|
||||
then case (leastGeneralSharedTypeRain [tlhs,trhs]) of
|
||||
Nothing -> dieP m $ "Cannot find a suitable type to convert expression to, types are: " ++ show tlhs ++ " and " ++ show trhs
|
||||
Just t -> if validOp op t then return $ A.Dyadic m op (convert t tlhs lhs) (convert t trhs rhs) else dieP m $
|
||||
"Operator: \"" ++ show op ++ "\" is not valid on type: \"" ++ show tlhs
|
||||
Nothing -> diePC m $ formatCode "Cannot find a suitable type to convert expression to, types are: % and %" tlhs trhs
|
||||
Just t -> if validOp op t then return $ A.Dyadic m op (convert t tlhs lhs) (convert t trhs rhs) else diePC m $
|
||||
formatCode "Operator: \"%\" is not valid on type: \"%\"" op tlhs
|
||||
else --The operators are not equal, and are not integers. Therefore this must be an error:
|
||||
dieP m $ "Mis-matched types; no operator applies to types: " ++ show tlhs ++ " and " ++ show trhs
|
||||
diePC m $ formatCode "Mis-matched types; no operator applies to types: % and %" tlhs trhs
|
||||
checkExpression e@(A.Monadic m op rhs)
|
||||
= do trhs <- typeOfExpression rhs
|
||||
if (op == A.MonadicMinus)
|
||||
|
|
@ -176,13 +176,13 @@ checkExpressionTypes = everywhereASTM checkExpression
|
|||
A.Byte -> return $ A.Monadic m op $ convert A.Int16 trhs rhs
|
||||
A.UInt16 -> return $ A.Monadic m op $ convert A.Int32 trhs rhs
|
||||
A.UInt32 -> return $ A.Monadic m op $ convert A.Int64 trhs rhs
|
||||
A.UInt64 -> dieP m $ "Cannot apply unary minus to type: " ++ show trhs ++ " because there is no type large enough to safely contain the result"
|
||||
_ -> if (isIntegerType trhs) then return e else dieP m $ "Trying to apply unary minus to non-integer type: " ++ show trhs
|
||||
A.UInt64 -> diePC m $ formatCode "Cannot apply unary minus to type: % because there is no type large enough to safely contain the result" trhs
|
||||
_ -> if (isIntegerType trhs) then return e else diePC m $ formatCode "Trying to apply unary minus to non-integer type: %" trhs
|
||||
else if (op == A.MonadicNot)
|
||||
then
|
||||
case trhs of
|
||||
A.Bool -> return e
|
||||
_ -> dieP m $ "Cannot apply unary not to non-boolean type: " ++ show trhs
|
||||
_ -> diePC m $ formatCode "Cannot apply unary not to non-boolean type: %" trhs
|
||||
else dieP m $ "Invalid Rain operator: \"" ++ show op ++ "\""
|
||||
checkExpression e@(A.Conversion m cm dest rhs)
|
||||
= do src <- typeOfExpression rhs
|
||||
|
|
@ -190,7 +190,7 @@ checkExpressionTypes = everywhereASTM checkExpression
|
|||
then return e
|
||||
else if isImplicitConversionRain src dest
|
||||
then return e
|
||||
else dieP m $ "Invalid cast from: " ++ show dest ++ " to: " ++ show src
|
||||
else diePC m $ formatCode "Invalid cast from: % to: %" dest src
|
||||
checkExpression e = return e
|
||||
|
||||
convert :: A.Type -> A.Type -> A.Expression -> A.Expression
|
||||
|
|
@ -266,8 +266,8 @@ checkCommTypes = everywhereASTM checkInputOutput
|
|||
else
|
||||
if (innerType == destType)
|
||||
then return p
|
||||
else dieP m $ "Mis-matching types; channel: " ++ show chanVar ++ " has inner-type: " ++ show innerType ++
|
||||
" but destination variable: " ++ show destVar ++ " has type: " ++ show destType
|
||||
else diePC m $ formatCode "Mis-matching types; channel: \"%\" has inner-type: % but destination variable: \"%\" has type: %"
|
||||
chanVar innerType destVar destType
|
||||
_ -> dieP m $ "Tried to input from a variable that is not of type channel: " ++ show chanVar
|
||||
checkInputOutput p@(A.Output m chanVar [A.OutExpression m' srcExp])
|
||||
= do chanType <- typeOfVariable chanVar
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user