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

Fixed the fixConstructorTypes pass to work properly and put it back into the pass list (having removed it earlier today)

Browse Source
This commit is contained in:
Neil Brown 2009-02-02 18:27:04 +00:00
parent 1cde2bd959
commit 4b3090b66a
1 changed files with 10 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
frontends/OccamPasses.hs
View File

@ -41,7 +41,7 @@ occamPasses =
[ occamOnlyPass "Dummy occam pass" [] (Prop.agg_namesDone ++ [Prop.mainTagged]) return
, inferTypes
, foldConstants
-- , fixConstructorTypes
, fixConstructorTypes
, checkConstants
, resolveAmbiguities
, checkTypes
@ -56,26 +56,21 @@ fixConstructorTypes = occamOnlyPass "Fix the types of array constructors"
where
doExpression :: A.Expression -> PassM A.Expression
doExpression (A.Literal m prevT lit@(A.ArrayListLiteral _ expr))
= do t' <- doExpr (Left $ getDims prevT) expr
= do t' <- doExpr [] (getDims prevT) expr
return $ A.Literal m t' lit
where
getEither = either id id
addRight x = Right . either (const [x]) (++[x])
getDims :: A.Type -> [A.Dimension]
getDims (A.Array ds _) = ds
getDims t = error $ "Cannot deduce dimensions of array constructor: " ++ show t
-- Left means previous guess (to be used if there's no replicator)
-- Right means current accumulation
doExpr :: Either [A.Dimension] [A.Dimension] -> A.Structured A.Expression -> PassM A.Type
doExpr dims (A.Several m ss@(s:_))
= doExpr (addRight (A.Dimension $ makeConstant m $ length ss) dims) s
doExpr dims (A.Only _ e)
= astTypeOf e >>* A.Array (getEither dims)
doExpr dims (A.ProcThen _ _ e) = doExpr dims e
doExpr dims (A.Spec _ (A.Specification _ _ (A.Rep _ rep)) body)
= doExpr (addRight count dims) body
doExpr :: [A.Dimension] -> [A.Dimension] -> A.Structured A.Expression -> PassM A.Type
doExpr prev (d:dims) (A.Several m ss@(s:_))
= doExpr (prev ++ [d]) dims s
doExpr prev _ (A.Only _ e)
= astTypeOf e >>* addDimensions prev
doExpr prev dims (A.ProcThen _ _ e) = doExpr prev dims e
doExpr prev (_:dims) (A.Spec _ (A.Specification _ _ (A.Rep _ rep)) body)
= doExpr (prev ++ [count]) (dims) body
where
count = A.Dimension $ countReplicator rep