suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added a type-class for retrieving the (AST) type of things

Browse Source 
This patch hides all the old typeOfExpression, typeOfName, typeOfVariable, etc, and unifies them into a single type-class with an "astTypeOf" function.  The type-class is currently named Typed, but that can easily be changed (it's only explicitly referred to in the Types module).  The patch is essentially the type-class with a giant find-and-replace on the other modules.
This commit is contained in:
Neil Brown 2008-05-17 11:41:52 +00:00
parent 3daf82d318
commit 89c25e3f6c
16 changed files with 147 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
backends/BackendPasses.hs
View File

@ -107,7 +107,7 @@ declareSizesArray = doGeneric `ext1M` doStructured
retypesSizes :: Meta -> A.Name -> [A.Dimension] -> A.Type -> A.Variable -> PassM A.Specification
retypesSizes m n_sizes ds elemT v@(A.Variable _ nSrc)
= do biDest <- bytesInType (A.Array ds elemT)
tSrc <- typeOfVariable v
tSrc <- astTypeOf v
biSrc <- bytesInType tSrc
-- Figure out the size of the source.
@ -158,10 +158,10 @@ declareSizesArray = doGeneric `ext1M` doStructured
varSrcSizes <- case innerV of
A.Variable _ srcN -> return (A.Variable m $ append_sizes srcN)
A.SubscriptedVariable _ (A.SubscriptField _ fieldName) recordV ->
do A.Record recordName <- typeOfVariable recordV
do A.Record recordName <- astTypeOf recordV
return (A.Variable m $ A.Name m A.VariableName $ A.nameName recordName ++ A.nameName fieldName ++ "_sizes")
-- Get the dimensions of the source variable:
(A.Array srcDs _) <- typeOfVariable innerV
(A.Array srcDs _) <- astTypeOf innerV
-- Calculate the correct subscript into the source _sizes variable to get to the dimensions for the destination:
let sizeDiff = length srcDs - length ds
subSrcSizeVar = A.SubscriptedVariable m (A.SubscriptFromFor m (makeConstant m sizeDiff) (makeConstant m $ length ds)) varSrcSizes
@ -296,7 +296,7 @@ addSizesActualParameters = doGeneric `extM` doProcess
transformActualVariable :: A.Actual -> A.Variable -> PassM [A.Actual]
transformActualVariable a v@(A.Variable m n)
= do t <- typeOfVariable v
= do t <- astTypeOf v
case t of
A.Array ds _ ->
return [a, A.ActualVariable a_sizes]
@ -320,7 +320,7 @@ simplifySlices = doGeneric `extM` doVariable
return (A.SubscriptedVariable m (A.SubscriptFromFor m' (makeConstant m' 0) for') v')
doVariable (A.SubscriptedVariable m (A.SubscriptFrom m' from) v)
= do v' <- doGeneric v
A.Array (d:_) _ <- typeOfVariable v'
A.Array (d:_) _ <- astTypeOf v'
limit <- case d of
A.Dimension n -> return n
A.UnknownDimension -> return $ A.SizeVariable m' v'

44
backends/GenerateC.hs
View File

@ -258,7 +258,7 @@ genRightB = tell ["}"]
-- | Map an operation over every item of an occam array.
cgenOverArray :: Meta -> A.Variable -> (SubscripterFunction -> Maybe (CGen ())) -> CGen ()
cgenOverArray m var func
= do A.Array ds _ <- typeOfVariable var
= do A.Array ds _ <- astTypeOf var
specs <- sequence [csmLift $ makeNonceVariable "i" m A.Int A.VariableName A.Original | _ <- ds]
let indices = [A.Variable m n | A.Specification _ n _ <- specs]
@ -457,10 +457,10 @@ cgenCheckedConversion m fromT toT exp
cgenConversion :: Meta -> A.ConversionMode -> A.Type -> A.Expression -> CGen ()
cgenConversion m A.DefaultConversion toT e
= do fromT <- typeOfExpression e
= do fromT <- astTypeOf e
call genCheckedConversion m fromT toT (call genExpression e)
cgenConversion m cm toT e
= do fromT <- typeOfExpression e
= do fromT <- astTypeOf e
case (isSafeConversion fromT toT, isRealType fromT, isRealType toT) of
(True, _, _) ->
-- A safe conversion -- no need for a check.
@ -583,7 +583,7 @@ cgenUnfoldedExpression e = call genExpression e
-- | Generate a variable inside a record literal.
cgenUnfoldedVariable :: Meta -> A.Variable -> CGen ()
cgenUnfoldedVariable m var
= do t <- typeOfVariable var
= do t <- astTypeOf var
case t of
A.Array ds _ ->
do genLeftB
@ -720,7 +720,7 @@ cgenVariable' checkValid v
-- If we are dealing with an array element, treat it as if it had the original abbreviation mode,
-- regardless of the abbreviation mode of the array:
(_, Just t') -> return (A.Original, t')
(am,Nothing) -> do t <- typeOfName n
(am,Nothing) -> do t <- astTypeOf n
return (am, t)
let ind' = case (am, t, indirectedType t) of
-- For types that are referred to by pointer (such as records)
@ -738,7 +738,7 @@ cgenVariable' checkValid v
_ -> ind
return (genName n, ind')
inner ind (A.DerefVariable _ v) mt
= do (A.Mobile t) <- typeOfVariable v
= do (A.Mobile t) <- astTypeOf v
case t of
A.Array {} -> inner ind v mt
A.Record {} -> inner ind v mt
@ -749,16 +749,16 @@ cgenVariable' checkValid v
inner ind sv@(A.SubscriptedVariable m (A.Subscript _ subCheck _) v) mt
= do (es, v, t') <- collectSubs sv
t <- if checkValid
then typeOfVariable sv
then astTypeOf sv
else return t'
A.Array ds _ <- typeOfVariable v
A.Array ds _ <- astTypeOf v
(cg, n) <- inner ind v (Just t)
let check = if checkValid then subCheck else A.NoCheck
return ((if (length ds /= length es) then tell ["&"] else return ()) >> cg
>> call genArraySubscript check v (map (\e -> (findMeta e, call genExpression e)) es), n)
inner ind sv@(A.SubscriptedVariable _ (A.SubscriptField m n) v) mt
= do (cg, ind') <- inner ind v mt
t <- typeOfVariable sv
t <- astTypeOf sv
let outerInd :: Int
outerInd = if indirectedType t then -1 else 0
return (addPrefix (addPrefix cg ind' >> tell ["->"] >> genName n) outerInd, 0)
@ -795,7 +795,7 @@ cgenVariable' checkValid v
= do (es', v', t') <- collectSubs v
t <- trivialSubscriptType m t'
return (es' ++ [e], v', t)
collectSubs v = do t <- typeOfVariable v
collectSubs v = do t <- astTypeOf v
return ([], v, t)
@ -809,7 +809,7 @@ cgenDirectedVariable var _ = var
cgenArraySubscript :: A.SubscriptCheck -> A.Variable -> [(Meta, CGen ())] -> CGen ()
cgenArraySubscript check v es
= do t <- typeOfVariable v
= do t <- astTypeOf v
let numDims = case t of A.Array ds _ -> length ds
tell ["["]
sequence_ $ intersperse (tell ["+"]) $ genPlainSub (genDynamicDim v) es [0..(numDims - 1)]
@ -867,7 +867,7 @@ cgenExpression (A.SizeExpr m e)
= do call genExpression e
call genSizeSuffix "0"
cgenExpression (A.SizeVariable m v)
= do t <- typeOfVariable v
= do t <- astTypeOf v
case t of
A.Array (d:_) _ ->
case d of
@ -919,7 +919,7 @@ cgenSimpleMonadic s e
cgenFuncMonadic :: Meta -> String -> A.Expression -> CGen ()
cgenFuncMonadic m s e
= do t <- typeOfExpression e
= do t <- astTypeOf e
call genTypeSymbol s t
tell [" ("]
call genExpression e
@ -943,7 +943,7 @@ cgenSimpleDyadic s e f
cgenFuncDyadic :: Meta -> String -> A.Expression -> A.Expression -> CGen ()
cgenFuncDyadic m s e f
= do t <- typeOfExpression e
= do t <- astTypeOf e
call genTypeSymbol s t
tell [" ("]
call genExpression e
@ -985,7 +985,7 @@ cgenListConcat _ _ = call genMissing "C backend does not yet support lists"
cgenInputItem :: A.Variable -> A.InputItem -> CGen ()
cgenInputItem c (A.InCounted m cv av)
= do call genInputItem c (A.InVariable m cv)
t <- typeOfVariable av
t <- astTypeOf av
tell ["ChanIn(wptr,"]
call genVariable c
tell [","]
@ -997,7 +997,7 @@ cgenInputItem c (A.InCounted m cv av)
call genBytesIn m subT (Right av)
tell [");"]
cgenInputItem c (A.InVariable m v)
= do t <- typeOfVariable v
= do t <- astTypeOf v
let rhs = call genVariableAM v A.Abbrev
case t of
A.Int ->
@ -1018,7 +1018,7 @@ cgenInputItem c (A.InVariable m v)
cgenOutputItem :: A.Variable -> A.OutputItem -> CGen ()
cgenOutputItem c (A.OutCounted m ce ae)
= do call genOutputItem c (A.OutExpression m ce)
t <- typeOfExpression ae
t <- astTypeOf ae
case ae of
A.ExprVariable m v ->
do tell ["ChanOut(wptr,"]
@ -1032,7 +1032,7 @@ cgenOutputItem c (A.OutCounted m ce ae)
call genBytesIn m subT (Right v)
tell [");"]
cgenOutputItem c (A.OutExpression m e)
= do t <- typeOfExpression e
= do t <- astTypeOf e
case (t, e) of
(A.Int, _) ->
do tell ["ChanOutInt(wptr,"]
@ -1101,7 +1101,7 @@ cgenReplicatorLoop _ = cgenMissing "ForEach loops not yet supported in the C bac
cgenVariableAM :: A.Variable -> A.AbbrevMode -> CGen ()
cgenVariableAM v am
= do when (am == A.Abbrev) $
do t <- typeOfVariable v
do t <- astTypeOf v
case (indirectedType t, t) of
(True, _) -> return ()
(False, A.Array {}) -> return ()
@ -1302,7 +1302,7 @@ cintroduceSpec (A.Specification _ n (A.ProtocolCase _ ts))
cintroduceSpec (A.Specification _ n st@(A.Proc _ _ _ _))
= genProcSpec n st False
cintroduceSpec (A.Specification _ n (A.Retypes m am t v))
= do origT <- typeOfVariable v
= do origT <- astTypeOf v
let rhs = call genVariableAM v A.Abbrev
call genDecl am t n
tell ["="]
@ -1472,7 +1472,7 @@ cgenProcess p = case p of
--{{{ assignment
cgenAssign :: Meta -> [A.Variable] -> A.ExpressionList -> CGen ()
cgenAssign m [v] (A.ExpressionList _ [e])
= do t <- typeOfVariable v
= do t <- astTypeOf v
f <- fget getScalarType
case f t of
Just _ -> doAssign v e
@ -1522,7 +1522,7 @@ cgenOutput c ois = sequence_ $ map (call genOutputItem c) ois
cgenOutputCase :: A.Variable -> A.Name -> [A.OutputItem] -> CGen ()
cgenOutputCase c tag ois
= do t <- typeOfVariable c
= do t <- astTypeOf c
let proto = case t of A.Chan _ _ (A.UserProtocol n) -> n
tell ["ChanOutInt(wptr,"]
call genVariable c

26
backends/GenerateCPPCSP.hs
View File

@ -184,7 +184,7 @@ cppgenStop m s
-- | Generates code from a channel 'A.Variable' that will be of type Chanin\<\>
genCPPCSPChannelInput :: A.Variable -> CGen()
genCPPCSPChannelInput var
= do t <- typeOfVariable var
= do t <- astTypeOf var
case t of
(A.Chan A.DirInput _ _) -> call genVariable var
(A.Chan A.DirUnknown _ _) -> do call genVariable var
@ -194,7 +194,7 @@ genCPPCSPChannelInput var
-- | Generates code from a channel 'A.Variable' that will be of type Chanout\<\>
genCPPCSPChannelOutput :: A.Variable -> CGen()
genCPPCSPChannelOutput var
= do t <- typeOfVariable var
= do t <- astTypeOf var
case t of
(A.Chan A.DirOutput _ _) -> call genVariable var
(A.Chan A.DirUnknown _ _) -> do call genVariable var
@ -207,7 +207,7 @@ genCPPCSPChannelOutput var
--the remainder is taken to trim the timer back down to something that will be useful in an int
cppgenTimerRead :: A.Variable -> A.Variable -> CGen ()
cppgenTimerRead c v = do
tt <- typeOfVariable c
tt <- astTypeOf c
case tt of
A.Timer A.RainTimer ->
do tell ["csp::CurrentTime (&"]
@ -291,13 +291,13 @@ cppgenInputItem c dest
recvBytes av (
do call genVariable cv
tell ["*"]
t <- typeOfVariable av
t <- astTypeOf av
subT <- trivialSubscriptType m t
call genBytesIn m subT (Right av)
)
(A.InVariable m v) ->
do ct <- typeOfVariable c
t <- typeOfVariable v
do ct <- astTypeOf c
t <- astTypeOf v
case (byteArrayChan ct,t) of
(True,_)-> recvBytes v (call genBytesIn m t (Right v))
(False,A.Array {}) -> do tell ["tockRecvArray("]
@ -325,8 +325,8 @@ cppgenOutputItem chan item
= case item of
(A.OutCounted m (A.ExprVariable _ cv) (A.ExprVariable _ av)) -> (sendBytes cv) >> (sendBytes av)
(A.OutExpression _ (A.ExprVariable _ sv)) ->
do t <- typeOfVariable chan
tsv <- typeOfVariable sv
do t <- astTypeOf chan
tsv <- astTypeOf sv
case (byteArrayChan t,tsv) of
(True,_) -> sendBytes sv
(False,A.Array {}) -> do tell ["tockSendArray("]
@ -353,11 +353,11 @@ byteArrayChan (A.Chan _ _ (A.Counted _ _)) = True
byteArrayChan _ = False
genPoint :: A.Variable -> CGen()
genPoint v = do t <- typeOfVariable v
genPoint v = do t <- astTypeOf v
when (not $ isPoint t) $ tell ["&"]
call genVariable v
genNonPoint :: A.Variable -> CGen()
genNonPoint v = do t <- typeOfVariable v
genNonPoint v = do t <- astTypeOf v
when (isPoint t) $ tell ["*"]
call genVariable v
isPoint :: A.Type -> Bool
@ -373,7 +373,7 @@ infixComma [] = return ()
cppgenOutputCase :: A.Variable -> A.Name -> [A.OutputItem] -> CGen ()
cppgenOutputCase c tag ois
= do t <- typeOfVariable c
= do t <- astTypeOf c
let proto = case t of A.Chan _ _ (A.UserProtocol n) -> n
tell ["tockSendInt("]
genCPPCSPChannelOutput c
@ -717,7 +717,7 @@ cppgenListConcat a b
cppgenReplicatorLoop :: A.Replicator -> CGen ()
cppgenReplicatorLoop rep@(A.For {}) = cgenReplicatorLoop rep
cppgenReplicatorLoop (A.ForEach m n (A.ExprVariable _ v))
= do t <- typeOfVariable v
= do t <- astTypeOf v
call genType t
tell ["::iterator "]
genName n
@ -750,7 +750,7 @@ cppgenUnfoldedExpression e = call genExpression e
-- | Changed to remove array size:
cppgenUnfoldedVariable :: Meta -> A.Variable -> CGen ()
cppgenUnfoldedVariable m var
= do t <- typeOfVariable var
= do t <- astTypeOf var
case t of
A.Record _ ->
do genLeftB

2
checks/ArrayUsageCheck.hs
View File

@ -82,7 +82,7 @@ checkArrayUsage (m,p) = mapM_ (checkIndexes m) $ Map.toList $
checkIndexes :: Meta -> (String,ParItems ([A.Expression],[A.Expression])) -> m ()
checkIndexes m (arrName, indexes)
= do userArrName <- getRealName (A.Name undefined undefined arrName)
arrType <- typeOfName (A.Name undefined undefined arrName)
arrType <- astTypeOf (A.Name undefined undefined arrName)
arrLength <- case arrType of
A.Array (A.Dimension d:_) _ -> return d
-- Unknown dimension, use the maximum value for a (assumed 32-bit for INT) integer:

10
common/EvalConstants.hs
View File

@ -45,7 +45,7 @@ import Utils
constantFold :: (CSMR m, Die m) => A.Expression -> m (A.Expression, Bool, ErrorReport)
constantFold e
= do ps <- getCompState
t <- typeOfExpression e
t <- astTypeOf e
case runEvaluator ps (evalExpression e) of
Left err -> return (e, False, err)
Right val ->
@ -152,7 +152,7 @@ evalExpression (A.MostNeg _ A.Int32) = return $ OccInt32 minBound
evalExpression (A.MostPos _ A.Int64) = return $ OccInt64 maxBound
evalExpression (A.MostNeg _ A.Int64) = return $ OccInt64 minBound
evalExpression (A.SizeExpr m e)
= do t <- typeOfExpression e >>= underlyingType m
= do t <- astTypeOf e >>= underlyingType m
case t of
A.Array (A.Dimension n:_) _ -> evalExpression n
_ ->
@ -161,7 +161,7 @@ evalExpression (A.SizeExpr m e)
OccArray vs -> return $ OccInt (fromIntegral $ length vs)
_ -> throwError (Just m, "size of non-constant expression " ++ show e ++ " used")
evalExpression (A.SizeVariable m v)
= do t <- typeOfVariable v >>= underlyingType m
= do t <- astTypeOf v >>= underlyingType m
case t of
A.Array (A.Dimension n:_) _ -> evalExpression n
_ -> throwError (Just m, "size of non-fixed-size variable " ++ show v ++ " used")
@ -171,7 +171,7 @@ evalExpression (A.True _) = return $ OccBool True
evalExpression (A.False _) = return $ OccBool False
evalExpression (A.SubscriptedExpr _ sub e) = evalExpression e >>= evalSubscript sub
evalExpression (A.BytesInExpr m e)
= do b <- typeOfExpression e >>= underlyingType m >>= bytesInType
= do b <- astTypeOf e >>= underlyingType m >>= bytesInType
case b of
BIJust n -> evalExpression n
_ -> throwError (Just m, "BYTESIN non-constant-size expression " ++ show e ++ " used")
@ -341,7 +341,7 @@ renderLiteral m t v
return (t', A.ArrayElemArray aes)
renderArrayElem t v
= do e <- renderValue m t v
t' <- typeOfExpression e
t' <- astTypeOf e
return (t', A.ArrayElemExpr e)
renderRecord :: [OccValue] -> m (A.Type, A.LiteralRepr)

18
common/Types.hs
View File

@ -19,7 +19,7 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
-- | Type inference and checking.
module Types
(
specTypeOfName, typeOfSpec, abbrevModeOfName, typeOfName, typeOfExpression, typeOfVariable, underlyingType, stripArrayType, abbrevModeOfVariable, abbrevModeOfSpec
specTypeOfName, typeOfSpec, abbrevModeOfName, underlyingType, stripArrayType, abbrevModeOfVariable, abbrevModeOfSpec
, isRealType, isIntegerType, isNumericType, isCaseableType, isScalarType, isDataType, isCommunicableType, isSequenceType
, resolveUserType, isSafeConversion, isPreciseConversion, isImplicitConversionRain
, returnTypesOfFunction
@ -32,6 +32,7 @@ module Types
, leastGeneralSharedTypeRain
, Typed(..)
) where
import Control.Monad.State
@ -53,6 +54,12 @@ import ShowCode
import TypeSizes
import Utils
class Typed a where
astTypeOf :: (CSMR m, Die m) => a -> m A.Type
instance Typed A.Type where
astTypeOf = return
-- | 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.
specTypeOfName :: (CSMR m, Die m) => A.Name -> m A.SpecType
specTypeOfName n
@ -63,6 +70,9 @@ abbrevModeOfName :: (CSMR m, Die m) => A.Name -> m A.AbbrevMode
abbrevModeOfName n
= liftM A.ndAbbrevMode (lookupNameOrError n $ dieP (A.nameMeta n) $ "Could not find abbreviation mode in abbrevModeOfName for: " ++ (show $ A.nameName n))
instance Typed A.Name where
astTypeOf = typeOfName
-- | Gets the 'A.Type' for a given 'A.Name' by looking at its definition in the 'CompState'. Dies with an error if the name is unknown.
typeOfName :: (CSMR m, Die m) => A.Name -> m A.Type
typeOfName n
@ -166,6 +176,9 @@ trivialSubscriptType _ (A.Array [d] t) = return t
trivialSubscriptType _ (A.Array (d:ds) t) = return $ A.Array ds t
trivialSubscriptType m t = diePC m $ formatCode "not plain array type: %" t
instance Typed A.Variable where
astTypeOf = typeOfVariable
-- | Gets the 'A.Type' of a 'A.Variable' by looking at the types recorded in the 'CompState'.
typeOfVariable :: (CSMR m, Die m) => A.Variable -> m A.Type
typeOfVariable (A.Variable m n) = typeOfName n
@ -199,6 +212,9 @@ dyadicIsBoolean A.MoreEq = True
dyadicIsBoolean A.After = True
dyadicIsBoolean _ = False
instance Typed A.Expression where
astTypeOf = typeOfExpression
-- | Gets the 'A.Type' of an 'A.Expression'. This function assumes that the expression has already been type-checked.
typeOfExpression :: (CSMR m, Die m) => A.Expression -> m A.Type
typeOfExpression e

2
frontends/OccamPasses.hs
View File

@ -67,7 +67,7 @@ fixConstructorTypes = applyDepthM doExpression
where
doExpression :: A.Expression -> PassM A.Expression
doExpression (A.ExprConstr m (A.RepConstr m' _ rep expr))
= do t <- typeOfExpression expr
= do t <- astTypeOf expr
let count = countReplicator rep
t' = A.Array [A.Dimension count] t
return $ A.ExprConstr m $ A.RepConstr m' t' rep expr

90
frontends/OccamTypes.hs
View File

@ -162,7 +162,7 @@ checkList m rawT
-- | Check the type of an expression.
checkExpressionType :: A.Type -> A.Expression -> PassM ()
checkExpressionType et e = typeOfExpression e >>= checkType (findMeta e) et
checkExpressionType et e = astTypeOf e >>= checkType (findMeta e) et
-- | Check that an expression is of integer type.
checkExpressionInt :: Check A.Expression
@ -275,7 +275,7 @@ classifyOp A.Concat = ListOp
-- | Check a monadic operator.
checkMonadicOp :: A.MonadicOp -> A.Expression -> PassM ()
checkMonadicOp op e
= do t <- typeOfExpression e
= do t <- astTypeOf e
let m = findMeta e
case classifyMOp op of
NumericOp -> checkNumeric m t
@ -285,9 +285,9 @@ checkMonadicOp op e
-- | Check a dyadic operator.
checkDyadicOp :: A.DyadicOp -> A.Expression -> A.Expression -> PassM ()
checkDyadicOp op l r
= do lt <- typeOfExpression l
= do lt <- astTypeOf l
let lm = findMeta l
rt <- typeOfExpression r
rt <- astTypeOf r
let rm = findMeta r
case classifyOp op of
NumericOp ->
@ -338,8 +338,8 @@ checkActuals m n fs as
checkActual :: A.Formal -> A.Actual -> PassM ()
checkActual (A.Formal newAM et _) a
= do rt <- case a of
A.ActualVariable v -> typeOfVariable v
A.ActualExpression e -> typeOfExpression e
A.ActualVariable v -> astTypeOf v
A.ActualExpression e -> astTypeOf e
checkType (findMeta a) et rt
origAM <- case a of
A.ActualVariable v -> abbrevModeOfVariable v
@ -393,7 +393,7 @@ checkAllocMobile m rawT me
_ -> ok
case me of
Just e ->
do et <- typeOfExpression e
do et <- astTypeOf e
checkType (findMeta e) innerT et
Nothing -> ok
_ -> diePC m $ formatCode "Expected mobile type in allocation; found %" t
@ -414,7 +414,7 @@ checkWritable v
checkChannel :: A.Direction -> A.Variable -> PassM A.Type
checkChannel wantDir c
= do -- Check it's a channel.
t <- typeOfVariable c >>= resolveUserType m
t <- astTypeOf c >>= resolveUserType m
case t of
A.Chan dir (A.ChanAttributes ws rs) innerT ->
do -- Check the direction is appropriate
@ -440,7 +440,7 @@ checkChannel wantDir c
-- Return the type of the timer's value.
checkTimer :: A.Variable -> PassM A.Type
checkTimer tim
= do t <- typeOfVariable tim >>= resolveUserType m
= do t <- astTypeOf tim >>= resolveUserType m
case t of
A.Timer A.OccamTimer -> return A.Int
A.Timer A.RainTimer -> return A.Time
@ -503,7 +503,7 @@ checkExpressionList ets el
dieP m $ "Wrong number of items in expression list; found "
++ (show $ length es) ++ ", expected "
++ (show $ length ets)
sequence_ [do rt <- typeOfExpression e
sequence_ [do rt <- astTypeOf e
checkType (findMeta e) et rt
| (e, et) <- zip es ets]
@ -522,7 +522,7 @@ checkReplicator (A.For _ _ start count)
= do checkExpressionInt start
checkExpressionInt count
checkReplicator (A.ForEach _ _ e)
= do t <- typeOfExpression e
= do t <- astTypeOf e
checkSequence (findMeta e) t
-- | Check a 'Structured', applying the given check to each item found inside
@ -651,8 +651,8 @@ inferTypes = applyX $ baseX
A.Dyadic m op le re ->
let -- Both types are the same.
bothSame
= do lt <- inferTypes le >>= typeOfExpression
rt <- inferTypes re >>= typeOfExpression
= do lt <- inferTypes le >>= astTypeOf
rt <- inferTypes re >>= astTypeOf
inTypeContext (Just $ betterType lt rt) $
descend outer
-- The RHS type is always A.Int.
@ -676,7 +676,7 @@ inferTypes = applyX $ baseX
Just t -> unsubscriptType s t >>* Just
Nothing -> return Nothing
e' <- inTypeContext ctx' $ inferTypes e
t <- typeOfExpression e'
t <- astTypeOf e'
s' <- inferTypes s >>= fixSubscript t
return $ A.SubscriptedExpr m s' e'
A.BytesInExpr _ _ -> noTypeContext $ descend outer
@ -751,7 +751,7 @@ inferTypes = applyX $ baseX
t' <- inferTypes t
v' <- inTypeContext (Just t') $ inferTypes v
t'' <- case t' of
A.Infer -> typeOfVariable v'
A.Infer -> astTypeOf v'
_ -> return t'
return $ A.Is m am' t'' v'
A.IsExpr m am t e ->
@ -759,7 +759,7 @@ inferTypes = applyX $ baseX
t' <- inferTypes t
e' <- inTypeContext (Just t') $ inferTypes e
t'' <- case t' of
A.Infer -> typeOfExpression e'
A.Infer -> astTypeOf e'
_ -> return t'
return $ A.IsExpr m am' t'' e'
A.IsChannelArray m t vs ->
@ -770,7 +770,7 @@ inferTypes = applyX $ baseX
let dim = makeDimension m $ length vs'
t'' <- case (t', vs') of
(A.Infer, (v:_)) ->
do elemT <- typeOfVariable v
do elemT <- astTypeOf v
return $ addDimensions [dim] elemT
(A.Infer, []) ->
dieP m "Cannot infer type of empty channel array"
@ -807,7 +807,7 @@ inferTypes = applyX $ baseX
= case p of
A.Assign m vs el ->
do vs' <- inferTypes vs
ts <- mapM typeOfVariable vs'
ts <- mapM astTypeOf vs'
el' <- doExpressionList ts el
return $ A.Assign m vs' el'
A.Output m v ois ->
@ -834,7 +834,7 @@ inferTypes = applyX $ baseX
A.If _ _ -> inTypeContext (Just A.Bool) $ descend p
A.Case m e so ->
do e' <- inferTypes e
t <- typeOfExpression e'
t <- astTypeOf e'
so' <- inTypeContext (Just t) $ inferTypes so
return $ A.Case m e' so'
A.While _ _ _ -> inTypeContext (Just A.Bool) $ descend p
@ -876,7 +876,7 @@ inferTypes = applyX $ baseX
doVariable :: ExplicitTrans A.Variable
doVariable descend (A.SubscriptedVariable m s v)
= do v' <- inferTypes v
t <- typeOfVariable v'
t <- astTypeOf v'
s' <- inferTypes s >>= fixSubscript t
return $ A.SubscriptedVariable m s' v'
doVariable descend v = descend v
@ -961,7 +961,7 @@ inferTypes = applyX $ baseX
-- An expression: descend into it with the right context.
doArrayElem wantT (A.ArrayElemExpr e)
= do e' <- inTypeContext (Just wantT) $ doExpression descend e
t <- typeOfExpression e'
t <- astTypeOf e'
checkType (findMeta e') wantT t
return (t, A.ArrayElemExpr e')
@ -1019,15 +1019,15 @@ checkVariables = checkDepthM doVariable
where
doVariable :: Check A.Variable
doVariable (A.SubscriptedVariable m s v)
= do t <- typeOfVariable v
= do t <- astTypeOf v
checkSubscript m s t
doVariable (A.DirectedVariable m _ v)
= do t <- typeOfVariable v >>= resolveUserType m
= do t <- astTypeOf v >>= resolveUserType m
case t of
A.Chan _ _ _ -> ok
_ -> dieP m $ "Direction applied to non-channel variable"
doVariable (A.DerefVariable m v)
= do t <- typeOfVariable v >>= resolveUserType m
= do t <- astTypeOf v >>= resolveUserType m
case t of
A.Mobile _ -> ok
_ -> dieP m $ "Dereference applied to non-mobile variable"
@ -1046,13 +1046,13 @@ checkExpressions = checkDepthM doExpression
doExpression (A.MostNeg m t) = checkNumeric m t
doExpression (A.SizeType m t) = checkSequence m t
doExpression (A.SizeExpr m e)
= do t <- typeOfExpression e
= do t <- astTypeOf e
checkSequence m t
doExpression (A.SizeVariable m v)
= do t <- typeOfVariable v
= do t <- astTypeOf v
checkSequence m t
doExpression (A.Conversion m _ t e)
= do et <- typeOfExpression e
= do et <- astTypeOf e
checkScalar m t >> checkScalar (findMeta e) et
doExpression (A.Literal m t lr) = doLiteralRepr t lr
doExpression (A.FunctionCall m n es)
@ -1062,7 +1062,7 @@ checkExpressions = checkDepthM doExpression
doExpression (A.IntrinsicFunctionCall m s es)
= checkIntrinsicFunctionCall m s es
doExpression (A.SubscriptedExpr m s e)
= do t <- typeOfExpression e
= do t <- astTypeOf e
checkSubscript m s t
doExpression (A.OffsetOf m rawT n)
= do t <- resolveUserType m rawT
@ -1098,13 +1098,13 @@ checkSpecTypes = checkDepthM doSpecType
doSpecType (A.Place _ e) = checkExpressionInt e
doSpecType (A.Declaration _ _) = ok
doSpecType (A.Is m am t v)
= do tv <- typeOfVariable v
= do tv <- astTypeOf v
checkType (findMeta v) t tv
when (am /= A.Abbrev) $ unexpectedAM m
amv <- abbrevModeOfVariable v
checkAbbrev m amv am
doSpecType (A.IsExpr m am t e)
= do te <- typeOfExpression e
= do te <- astTypeOf e
checkType (findMeta e) t te
when (am /= A.ValAbbrev) $ unexpectedAM m
checkAbbrev m A.ValAbbrev am
@ -1112,7 +1112,7 @@ checkSpecTypes = checkDepthM doSpecType
= do t <- resolveUserType m rawT
case t of
A.Array [d] et@(A.Chan _ _ _) ->
do sequence_ [do rt <- typeOfVariable c
do sequence_ [do rt <- astTypeOf c
checkType (findMeta c) et rt
am <- abbrevModeOfVariable c
checkAbbrev m am A.Abbrev
@ -1158,10 +1158,10 @@ checkSpecTypes = checkDepthM doSpecType
-- FIXME: Need to know the name of the function to do this
doFunctionBody rs (Right p) = dieP m "Cannot check function process body"
doSpecType (A.Retypes m _ t v)
= do fromT <- typeOfVariable v
= do fromT <- astTypeOf v
checkRetypes m fromT t
doSpecType (A.RetypesExpr m _ t e)
= do fromT <- typeOfExpression e
= do fromT <- astTypeOf e
checkRetypes m fromT t
unexpectedAM :: Check Meta
@ -1177,7 +1177,7 @@ checkProcesses = checkDepthM doProcess
doProcess (A.Assign m vs el)
-- We ignore dimensions here because we do the check at runtime.
-- (That is, [2]INT := []INT is legal.)
= do vts <- sequence [typeOfVariable v >>* removeFixedDimensions
= do vts <- sequence [astTypeOf v >>* removeFixedDimensions
| v <- vs]
mapM_ checkWritable vs
checkExpressionList vts el
@ -1185,7 +1185,7 @@ checkProcesses = checkDepthM doProcess
doProcess (A.Output m v ois) = doOutput m v ois
doProcess (A.OutputCase m v tag ois) = doOutputCase m v tag ois
doProcess (A.ClearMobile _ v)
= do t <- typeOfVariable v
= do t <- astTypeOf v
case t of
A.Mobile _ -> ok
_ -> diePC (findMeta v) $ formatCode "Expected mobile type; found %" t
@ -1195,7 +1195,7 @@ checkProcesses = checkDepthM doProcess
doProcess (A.Seq _ s) = checkStructured (\p -> ok) s
doProcess (A.If _ s) = checkStructured doChoice s
doProcess (A.Case _ e s)
= do t <- typeOfExpression e
= do t <- astTypeOf e
checkCaseable (findMeta e) t
checkStructured (doOption t) s
doProcess (A.While _ e _) = checkExpressionBool e
@ -1242,25 +1242,25 @@ checkProcesses = checkDepthM doProcess
doInputItem t ii
doInput c (A.InputTimerAfter m e)
= do t <- checkTimer c
et <- typeOfExpression e
et <- astTypeOf e
checkType (findMeta e) t et
doInput c (A.InputTimerFor m e)
= do t <- checkTimer c
et <- typeOfExpression e
et <- astTypeOf e
checkType (findMeta e) t et
doInputItem :: A.Type -> A.InputItem -> PassM ()
doInputItem (A.Counted wantCT wantAT) (A.InCounted m cv av)
= do ct <- typeOfVariable cv
= do ct <- astTypeOf cv
checkType (findMeta cv) wantCT ct
checkWritable cv
at <- typeOfVariable av
at <- astTypeOf av
checkType (findMeta cv) wantAT at
checkWritable av
doInputItem t@(A.Counted _ _) (A.InVariable m v)
= diePC m $ formatCode "Expected counted item of type %; found %" t v
doInputItem wantT (A.InVariable _ v)
= do t <- typeOfVariable v
= do t <- astTypeOf v
case wantT of
A.Any -> checkCommunicable (findMeta v) t
_ -> checkType (findMeta v) wantT t
@ -1268,7 +1268,7 @@ checkProcesses = checkDepthM doProcess
doOption :: A.Type -> A.Option -> PassM ()
doOption et (A.Option _ es _)
= sequence_ [do rt <- typeOfExpression e
= sequence_ [do rt <- astTypeOf e
checkType (findMeta e) et rt
| e <- es]
doOption _ (A.Else _ _) = ok
@ -1285,14 +1285,14 @@ checkProcesses = checkDepthM doProcess
doOutputItem :: A.Type -> A.OutputItem -> PassM ()
doOutputItem (A.Counted wantCT wantAT) (A.OutCounted m ce ae)
= do ct <- typeOfExpression ce
= do ct <- astTypeOf ce
checkType (findMeta ce) wantCT ct
at <- typeOfExpression ae
at <- astTypeOf ae
checkType (findMeta ae) wantAT at
doOutputItem t@(A.Counted _ _) (A.OutExpression m e)
= diePC m $ formatCode "Expected counted item of type %; found %" t e
doOutputItem wantT (A.OutExpression _ e)
= do t <- typeOfExpression e
= do t <- astTypeOf e
case wantT of
A.Any -> checkCommunicable (findMeta e) t
_ -> checkType (findMeta e) wantT t

2
frontends/RainPasses.hs
View File

@ -265,7 +265,7 @@ pullUpForEach = doGeneric `ext1M` doStructured
doStructured (A.Rep m (A.ForEach m' loopVar loopExp) s)
= do (extra, loopExp') <- case loopExp of
A.ExprVariable {} -> return (id, loopExp)
_ -> do t <- typeOfExpression loopExp
_ -> do t <- astTypeOf loopExp
spec@(A.Specification _ n _) <- makeNonceIsExpr
"loop_expr" m' t loopExp
return (A.Spec m' spec, A.ExprVariable m' (A.Variable m' n))

42
frontends/RainTypes.hs
View File

@ -38,7 +38,7 @@ recordInfNameTypes = everywhereM (mkM recordInfNameTypes')
where
recordInfNameTypes' :: A.Replicator -> PassM A.Replicator
recordInfNameTypes' input@(A.ForEach m n e)
= do arrType <- typeOfExpression e
= do arrType <- astTypeOf e
innerT <- case arrType of
A.List t -> return t
_ -> diePC m $ formatCode "Cannot do a foreach loop over a non-list type: %" arrType
@ -94,7 +94,7 @@ annotateListLiteralTypes = applyDepthM doExpression
where
doExpression :: A.Expression -> PassM A.Expression
doExpression (A.Literal m _ (A.ListLiteral m' es))
= do ts <- mapM typeOfExpression es
= do ts <- mapM astTypeOf es
sharedT <- case (ts, leastGeneralSharedTypeRain ts) of
(_, Just t) -> return t
([], Nothing) -> return A.Any
@ -105,8 +105,8 @@ annotateListLiteralTypes = applyDepthM doExpression
es' <- mapM (coerceIfNecessary sharedT) (zip ts es)
return $ A.Literal m (A.List sharedT) $ A.ListLiteral m' es'
doExpression (A.ExprConstr m (A.RangeConstr m' t b e))
= do bt <- typeOfExpression b
et <- typeOfExpression e
= do bt <- astTypeOf b
et <- astTypeOf e
sharedT <- case leastGeneralSharedTypeRain [bt, et] of
Just t -> return t
Nothing -> diePC m'
@ -161,7 +161,7 @@ matchParamPass = everywhereM ((mkM matchParamPassProc) `extM` matchParamPassFunc
--Checks the type of a parameter (A.Actual), and inserts a cast if it is safe to do so
doParam :: Meta -> String -> (Int,A.Formal, A.Actual) -> PassM A.Actual
doParam m n (index, A.Formal formalAbbrev formalType formalName, A.ActualVariable v)
= do actualType <- typeOfVariable v
= do actualType <- astTypeOf v
if (actualType == formalType)
then return $ A.ActualVariable v
else (liftM A.ActualExpression) $ doCast index formalType actualType (A.ExprVariable (findMeta v) v )
@ -171,7 +171,7 @@ matchParamPass = everywhereM ((mkM matchParamPassProc) `extM` matchParamPassFunc
--Checks the type of a parameter (A.Expression), and inserts a cast if it is safe to do so
doExpParam :: Meta -> String -> (Int, A.Formal, A.Expression) -> PassM A.Expression
doExpParam m n (index, A.Formal formalAbbrev formalType formalName, e)
= do actualType <- typeOfExpression e
= do actualType <- astTypeOf e
if (actualType == formalType)
then return e
else doCast index formalType actualType e
@ -210,8 +210,8 @@ checkExpressionTypes = applyDepthM checkExpression
checkExpression :: A.Expression -> PassM A.Expression
checkExpression e@(A.Dyadic m op lhs rhs)
= do tlhs <- typeOfExpression lhs
trhs <- typeOfExpression rhs
= do tlhs <- astTypeOf lhs
trhs <- astTypeOf rhs
if (tlhs == A.Time || trhs == A.Time)
-- Expressions with times can have asymmetric types,
-- so we handle them specially:
@ -242,7 +242,7 @@ checkExpressionTypes = applyDepthM checkExpression
else --The operands are not equal, and are not integers, and neither of them is a time type. Therefore this must be an error:
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
= do trhs <- astTypeOf rhs
if (op == A.MonadicMinus)
then case trhs of
A.Byte -> return $ A.Monadic m op $ convert A.Int16 trhs rhs
@ -257,7 +257,7 @@ checkExpressionTypes = applyDepthM checkExpression
_ -> 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
= do src <- astTypeOf rhs
if (src == dest)
then return e
else if isImplicitConversionRain src dest
@ -306,8 +306,8 @@ checkAssignmentTypes = applyDepthM checkAssignment
where
checkAssignment :: A.Process -> PassM A.Process
checkAssignment ass@(A.Assign m [v] (A.ExpressionList m' [e]))
= do trhs <- typeOfExpression e
tlhs <- typeOfVariable v
= do trhs <- astTypeOf e
tlhs <- astTypeOf v
am <- abbrevModeOfVariable v
when (am == A.ValAbbrev) $
diePC m $ formatCode "Cannot assign to a constant variable: %" v
@ -324,7 +324,7 @@ checkConditionalTypes = applyDepthM2 checkWhile checkIf
where
checkWhile :: A.Process -> PassM A.Process
checkWhile w@(A.While m exp _)
= do t <- typeOfExpression exp
= do t <- astTypeOf exp
if (t == A.Bool)
then return w
else dieP m "Expression in while conditional must be of boolean type"
@ -332,7 +332,7 @@ checkConditionalTypes = applyDepthM2 checkWhile checkIf
checkIf :: A.Choice -> PassM A.Choice
checkIf c@(A.Choice m exp _)
= do t <- typeOfExpression exp
= do t <- astTypeOf exp
if (t == A.Bool)
then return c
else dieP m "Expression in if conditional must be of boolean type"
@ -343,8 +343,8 @@ checkCommTypes = applyDepthM2 checkInputOutput checkAltInput
where
checkInput :: A.Variable -> A.Variable -> Meta -> a -> PassM a
checkInput chanVar destVar m p
= do chanType <- typeOfVariable chanVar
destType <- typeOfVariable destVar
= do chanType <- astTypeOf chanVar
destType <- astTypeOf destVar
case chanType of
A.Chan dir _ innerType ->
if (dir == A.DirOutput)
@ -358,17 +358,17 @@ checkCommTypes = applyDepthM2 checkInputOutput checkAltInput
checkWait :: A.InputMode -> PassM ()
checkWait (A.InputTimerFor m exp)
= do t <- typeOfExpression exp
= do t <- astTypeOf exp
when (t /= A.Time) $
diePC m $ formatCode "Tried to wait for something that was not of time type: %"
t
checkWait (A.InputTimerAfter m exp)
= do t <- typeOfExpression exp
= do t <- astTypeOf exp
when (t /= A.Time) $
diePC m $ formatCode "Tried to wait for something that was not of time type: %"
t
checkWait (A.InputTimerRead m (A.InVariable _ v))
= do t <- typeOfVariable v
= do t <- astTypeOf v
when (t /= A.Time) $
diePC m $ formatCode "Tried to wait for something that was not of time type: %"
t
@ -387,8 +387,8 @@ checkCommTypes = applyDepthM2 checkInputOutput checkAltInput
= do checkWait im
return p
checkInputOutput p@(A.Output m chanVar [A.OutExpression m' srcExp])
= do chanType <- typeOfVariable chanVar
srcType <- typeOfExpression srcExp
= do chanType <- astTypeOf chanVar
srcType <- astTypeOf srcExp
case chanType of
A.Chan dir _ innerType ->
if (dir == A.DirInput)

4
frontends/RainTypesTest.hs
View File

@ -442,14 +442,14 @@ checkExpressionTest = TestList
check t e
= do eot <- errorOrType
case eot of
Left err -> assertFailure ("checkExpressionTest " ++ show n ++ " typeOfExpression failed")
Left err -> assertFailure ("checkExpressionTest " ++ show n ++ " astTypeOf failed")
Right t' -> do assertEqual ("checkExpressionTest " ++ show n) t t'
--Now feed it through again, to make sure it isn't changed:
if (e /= act) then pass' (10000 + n) t (mkPattern e) e else return ()
where
errorOrType :: IO (Either ErrorReport A.Type)
errorOrType
= (flip runPassM (typeOfExpression e) (execState state emptyState))
= (flip runPassM (astTypeOf e) (execState state emptyState))
>>* \(x,_,_) -> x

2
pass/Properties.hs
View File

@ -306,7 +306,7 @@ findAssignVars _ = []
filterArrayAndRecord :: (CSMR m, Die m) => A.Variable -> m Bool
filterArrayAndRecord v
= do t <- typeOfVariable v
= do t <- astTypeOf v
return $ case t of
A.Array {} -> True
A.Record {} -> True

2
transformations/SimplifyComms.hs
View File

@ -69,7 +69,7 @@ outExprs = doGeneric `extM` doProcess
return (A.ExprVariable m $ A.Variable m nm, spec)
abbrevExpr :: Meta -> A.Expression -> PassM (A.Name, A.Structured A.Process -> A.Structured A.Process)
abbrevExpr m e = do t <- typeOfExpression e
abbrevExpr m e = do t <- astTypeOf e
specification@(A.Specification _ nm _) <- defineNonce m "output_var" (A.IsExpr m A.ValAbbrev t e) A.VariableName A.ValAbbrev
return (nm, A.Spec m specification)

16
transformations/SimplifyExprs.hs
View File

@ -111,7 +111,7 @@ removeAfter = doGeneric `extM` doExpression
doExpression (A.Dyadic m A.After a b)
= do a' <- removeAfter a
b' <- removeAfter b
t <- typeOfExpression a'
t <- astTypeOf a'
case t of
A.Byte -> do let one = A.Literal m t $ A.IntLiteral m "1"
oneTwoSeven = A.Literal m t $ A.IntLiteral m "127"
@ -130,7 +130,7 @@ expandArrayLiterals = doGeneric `extM` doArrayElem
doArrayElem :: A.ArrayElem -> PassM A.ArrayElem
doArrayElem ae@(A.ArrayElemExpr e)
= do e' <- expandArrayLiterals e
t <- typeOfExpression e'
t <- astTypeOf e'
case t of
A.Array ds _ -> expand ds e
_ -> doGeneric ae
@ -181,7 +181,7 @@ pullRepCounts = doGeneric `extM` doProcess
return $ A.ProcThen m p' s'
pullRepCountSeq (A.Several m ss) = mapM pullRepCountSeq ss >>* A.Several m
pullRepCountSeq (A.Rep m (A.For m' n from for) s)
= do t <- typeOfExpression for
= do t <- astTypeOf for
spec@(A.Specification _ nonceName _) <- makeNonceIsExpr "rep_for" m' t for
s' <- pullRepCountSeq s
return $ A.Spec m spec $ A.Rep m (A.For m' n from (A.ExprVariable m' $ A.Variable m' nonceName)) s'
@ -319,7 +319,7 @@ pullUp pullUpArraysInsideRecords
-- Convert RetypesExpr into Retypes of a variable.
doSpecification (A.Specification m n (A.RetypesExpr m' am toT e))
= do e' <- doExpression e
fromT <- typeOfExpression e'
fromT <- astTypeOf e'
spec@(A.Specification _ n' _) <- makeNonceIsExpr "retypes_expr" m' fromT e'
addPulled $ (m', Left spec)
return $ A.Specification m n (A.Retypes m' am toT (A.Variable m' n'))
@ -339,7 +339,7 @@ pullUp pullUpArraysInsideRecords
doExpression :: A.Expression -> PassM A.Expression
doExpression e
= do e' <- doExpression' e
t <- typeOfExpression e'
t <- astTypeOf e'
case t of
A.Array _ _ ->
case e' of
@ -360,7 +360,7 @@ pullUp pullUpArraysInsideRecords
doVariable :: A.Variable -> PassM A.Variable
doVariable v@(A.SubscriptedVariable m _ _)
= do v' <- doGeneric v
t <- typeOfVariable v'
t <- astTypeOf v'
case t of
A.Array _ _ ->
do origAM <- abbrevModeOfVariable v'
@ -375,7 +375,7 @@ pullUp pullUpArraysInsideRecords
convertFuncCall :: Meta -> A.Name -> [A.Expression] -> PassM [A.Variable]
convertFuncCall m n es
= do es' <- pullUpRecur es
ets <- sequence [typeOfExpression e | e <- es']
ets <- sequence [astTypeOf e | e <- es']
ps <- get
rts <- Map.lookup (A.nameName n) (csFunctionReturns ps)
@ -398,7 +398,7 @@ pullUp pullUpArraysInsideRecords
doExpression' (A.SubscriptedExpr m s e)
= do e' <- pullUpRecur e
s' <- pullUpRecur s
t <- typeOfExpression e'
t <- astTypeOf e'
spec@(A.Specification _ n _) <- makeNonceIsExpr "subscripted_expr" m t e'
addPulled $ (m, Left spec)
return $ A.ExprVariable m (A.SubscriptedVariable m s' (A.Variable m n))

4
transformations/SimplifyProcs.hs
View File

@ -81,7 +81,7 @@ removeParAssign = doGeneric `extM` doProcess
doProcess :: A.Process -> PassM A.Process
doProcess (A.Assign m vs@(_:_:_) (A.ExpressionList _ es))
= do ts <- mapM typeOfVariable vs
= do ts <- mapM astTypeOf vs
specs <- sequence [makeNonceVariable "assign_temp" m t A.VariableName A.Original | t <- ts]
let temps = [A.Variable m n | A.Specification _ n _ <- specs]
let first = [A.Assign m [v] (A.ExpressionList m [e]) | (v, e) <- zip temps es]
@ -98,7 +98,7 @@ flattenAssign = doGeneric `extM` doProcess `ext1M` doStructured
doProcess :: A.Process -> PassM A.Process
doProcess (A.Assign m [v] (A.ExpressionList m' [e]))
= do t <- typeOfVariable v
= do t <- astTypeOf v
assign m t v m' e
doProcess p = doGeneric p

2
transformations/Unnest.hs
View File

@ -131,7 +131,7 @@ removeFreeNames = doGeneric `extM` doSpecification `extM` doProcess
-- Don't bother with constants -- they get pulled up anyway.
freeNames <- filterM (liftM not . isConstantName) freeNames''
types <- mapM typeOfName freeNames
types <- mapM astTypeOf freeNames
origAMs <- mapM abbrevModeOfName freeNames
let ams = map makeAbbrevAM origAMs