From c787aa9fa5e466bf99b438a19015bf80e6eb6e01 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Fri, 27 Feb 2009 17:01:07 +0000 Subject: [PATCH] Fixed a bug in the occam type inference where channels of arrays were not being processed properly --- frontends/OccamTypes.hs | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/frontends/OccamTypes.hs b/frontends/OccamTypes.hs index 328e4e9..ab12bbc 100644 --- a/frontends/OccamTypes.hs +++ b/frontends/OccamTypes.hs @@ -54,6 +54,10 @@ sameType (A.Array (A.Dimension e1 : ds1) t1) sameType (A.Array (A.UnknownDimension : ds1) t1) (A.Array (A.UnknownDimension : ds2) t2) = sameType (A.Array ds1 t1) (A.Array ds2 t2) +-- We might be dealing with channels of arrays, so we must dig through channels: +sameType (A.Chan _ ta) (A.Chan _ tb) = sameType ta tb +sameType (A.ChanEnd dira _ ta) (A.ChanEnd dirb _ tb) + = liftM (dira == dirb &&) (sameType ta tb) sameType a b = return $ a == b -- | Check that the second dimension can be used in a context where the first @@ -879,18 +883,21 @@ inferTypes = occamOnlyPass "Infer types" return $ A.Proc m sm fs' body' where processFormal body f@(A.Formal am t n) - = case t of - A.Chan attr t -> + = do t' <- recurse t + case t' of + A.Chan attr innerT -> do dirs <- findDir n body case nub dirs of [dir] -> - do let t' = A.ChanEnd dir attr t + do let t' = A.ChanEnd dir attr innerT f' = A.Formal am t' n modifyName n (\nd -> nd {A.ndSpecType = A.Declaration m t'}) return f' - _ -> return f -- no direction, or two - _ -> return f + _ -> return $ A.Formal am t' n -- no direction, or two + _ -> do modifyName n (\nd -> nd {A.ndSpecType = + A.Declaration m t'}) + return $ A.Formal am t' n _ -> lift $ descend st where -- | This is a bit ugly: walk down a Structured to find the single