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

Fixed various bits of type-inference in OccamTypes

Browse Source
This commit is contained in:
Neil Brown 2009-04-09 10:00:03 +00:00
parent debdef4f4f
commit 998cf1c005
2 changed files with 29 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
common/Types.hs
View File

@ -337,9 +337,9 @@ returnTypesOfIntrinsic m s
-- | Get the items in a channel's protocol (for typechecking).
-- Returns Left if it's a simple protocol, Right if it's tagged.
protocolItems :: (CSMR m, Die m) => A.Variable -> m (Either [A.Type] [(A.Name, [A.Type])])
protocolItems :: (ASTTypeable a, Data a, CSMR m, Die m) => a -> m (Either [A.Type] [(A.Name, [A.Type])])
protocolItems v
= do chanT <- typeOfVariable v
= do chanT <- astTypeOf v
t <- case chanT of
A.Chan _ t -> return t
A.ChanEnd _ _ t -> return t

31
frontends/OccamTypes.hs
View File

@ -344,7 +344,7 @@ checkAllocMobile m rawT me
case t of
A.Mobile innerT ->
do case innerT of
A.Array ds _ -> mapM_ (checkFullDimension m) ds
A.Array ds _ -> ok --mapM_ (checkFullDimension m) ds
_ -> ok
case me of
Just e ->
@ -652,6 +652,7 @@ inferTypes = occamOnlyPass "Infer types"
`extOpS` doStructured
`extOp` doProcess
`extOp` doVariable
`extOp` doVariant
recurse :: Recurse
recurse = makeRecurse ops
@ -815,8 +816,28 @@ inferTypes = occamOnlyPass "Infer types"
iis' <- sequence [inTypeContext (Just t) $ recurse ii
| (t, ii) <- zip ts iis]
return $ A.InputSimple m iis'
doInputMode v (A.InputCase m sv)
= do ct <- astTypeOf v
inTypeContext (Just ct) (recurse sv) >>* A.InputCase m
doInputMode _ im = inTypeContext (Just A.Int) $ descend im
doVariant :: Transform A.Variant
doVariant (A.Variant m n iis p)
= do ctx <- getTypeContext
ets <- case ctx of
Just x -> protocolItems x
Nothing -> dieP m "Could not deduce protocol"
case ets of
Left {} -> dieP m "Simple protocol expected during input CASE"
Right ps -> case lookup n ps of
Nothing -> diePC m $ formatCode "Name % is not part of protocol %"
n (fromJust ctx)
Just ts -> do iis' <- sequence [inTypeContext (Just t) $ recurse ii
| (t, ii) <- zip ts iis]
p' <- recurse p
return $ A.Variant m n iis' p'
doStructured :: Data a => Transform (A.Structured a)
doStructured (A.Spec mspec s@(A.Specification m n st) body)
= do st' <- runReaderT (doSpecType n st) body
@ -1030,8 +1051,8 @@ inferTypes = occamOnlyPass "Infer types"
im' <- doInputMode v' im
return $ A.Input m v' im'
A.Input m v im@(A.InputCase {})
-> do im' <- recurse im
v' <- recurse v
-> do v' <- recurse v
im' <- doInputMode v' im
return $ A.Input m v' im'
_ -> descend p
where
@ -1060,7 +1081,9 @@ inferTypes = occamOnlyPass "Infer types"
ae' <- inTypeContext (Just at) $ recurse ae
return $ A.OutCounted m ce' ae'
doOutputItem A.Any o = noTypeContext $ recurse o
doOutputItem t o = inTypeContext (Just t) $ recurse o
doOutputItem t (A.OutExpression m e)
= inTypeContext (Just t) (recurse e >>= inferAllocMobile m t)
>>* A.OutExpression m
doVariable :: Transform A.Variable
doVariable (A.SubscriptedVariable m s v)