Commit b5cf28f0 authored by bbr's avatar bbr
Browse files

intermediate state

- some info about children gets lost during computation
parent d394b7b1
......@@ -41,7 +41,7 @@ class BaseCurry a where
gnf :: BaseCurry b => (a -> Result b) -> a -> Result b
-- constructors
generator :: () -> a
generator :: Int -> a
failed :: C_Exceptions -> a
branching :: OrRef -> Branches a -> a
......@@ -83,7 +83,7 @@ ctcStore mode cont x state = --trace' "ctc" $
chain :: BaseCurry b => (a -> Result b) -> OrRef -> Branches a -> Result b
chain cont ref bs st = maybe (failed $ curryError "chain")
(\ st -> branching ref [cont (head bs) st])
(chainInStore ref st)
(addToStore ref 0 st)
lift :: BaseCurry b => (a -> Result b) -> OrRef -> Branches a -> Result b
lift cont ref bs st =
......@@ -92,7 +92,9 @@ lift cont ref bs st =
-- pulling continuations into each branch of an or
ctcBranch :: BaseCurry b => (a -> Result b) -> OrRef -> Store -> Int -> a -> b
ctcBranch cont orRef store nr x =
maybe (failed (curryError "ctcBranch")) (cont x) (addToStore orRef nr store)
maybe (failed (curryError "ctcBranch"))
(cont x)
(addToStore orRef nr store)
......
......@@ -422,12 +422,9 @@ transTypeExprF opts (TCons name ts)
= C.TCons (consName opts name) (map (transTypeExprF opts) ts)
newConsDecls (m,n) vs
= [C.Cons (m,n++"FreeVar") 1 private False [tFreeVarRef newT],
C.Cons (m,n++"Fail") 0 private False [tExceptions],
= [C.Cons (m,n++"Fail") 0 private False [tExceptions],
C.Cons (m,n++"Or") 2 private False
[tOrRef, tBranches newT],
C.Cons (m,n++"Susp") 2 private False
[tSuspRef, tSusp newT]]
[tOrRef, tBranches newT]]
where
newT = C.TCons (m,n) (map toTVar vs)
......@@ -522,7 +519,7 @@ curryInstance opts t@(Type origName vis vars consdecls)
C.Rule [C.PVar "mode",C.PVar "store",
C.PComb (consName opts cname) (map toPVar [1..arity])]
(noguard $ fapp (baseTypesym isPrelude "C_Data")
[toInt isPrelude nr,c_string_ origMod (snd cname),
[toInt nr,c_string_ origMod (snd cname),
dList isPrelude (map su [1..arity])]) []
where
su i = fapp (basesym "ctcStore")
......@@ -555,9 +552,9 @@ curryInstance opts t@(Type origName vis vars consdecls)
baseCurryInstance opts (Type origName vis vars consdecls)
= inst newModName name vars "BaseCurry"
[nf False, nf True,
free "free" "free",free "pattern" "freeIORef",failed,freeVarFunc,branching,suspend,
free "generator" "generator",failed,branching,
consKind,
exceptions,freeVarRef,orRef,branches,suspRef,suspCont]
exceptions,orRef,branches]
where
(newModName,name) = consName opts origName
......@@ -587,12 +584,20 @@ baseCurryInstance opts (Type origName vis vars consdecls)
[C.Lambda [toPVar' "v" i,toPVar' "state" i] e,toVar i,toVar' "state" (i-1)]
free s t = C.Func (newModName,s) (transvis vis) untyped
(Just [C.Rule [_x] (noguard (app (basesym "orsCTC")
(list_ (map freeCons consdecls)))) []])
(Just [C.Rule [C.PVar "i"] (noguard $
fapp (basesym "withRef") [
C.Lambda [C.PVar "r"] $
fapp (sym (orName opts origName))
[fapp (basesym "mkRef") [C.Var "r",maxAr,C.Var "i"],
list_ (map freeCons consdecls)],
maxAr]) []])
where
maxAr = C.Var (show (foldr max 0 (map consArity consdecls)))
freeCons (Cons cname arity _ _) =
fapp (sym (consName opts cname))
(replicate arity (app (basesym t) hasUnit))
(snd $ foldr addOne (0,[]) (replicate arity (app (basesym t))))
addOne e (n,es) =
(n+1,e (fapp (hasPresym "+") [C.Var "r",toHInt n]):es)
failed = constructor "failed" failName
freeVarFunc = constructor "freeVar" freeVarName
......@@ -602,10 +607,8 @@ baseCurryInstance opts (Type origName vis vars consdecls)
consKind = C.Func (newModName,"consKind") (transvis vis) untyped
(Just
(map tester [(freeVarName,1, "Free"),
(orName, 2, "Branching"),
(failName, 1, "Failed"),
(suspName, 2,"Suspended")] ++
(map tester [(orName, 2, "Branching"),
(failName, 1, "Failed")] ++
[C.Rule [_x]
(noguard $ (basesym "Val")) []]))
......@@ -725,7 +728,7 @@ transExpr _ (Case _ _ _) = error "unlifted case"
transLit :: Options -> Literal -> C.Expr
transLit opts (Charc c) = toChar opts c
transLit opts (Floatc f) = toFloat opts f
transLit opts (Intc i) = toInt opts i
transLit opts (Intc i) = toInt i
transBranching :: CaseType -> ([VarIndex],[VarIndex]) -> Options -> QName ->
......@@ -747,17 +750,8 @@ transBranching caseMode vs@(as,v:bs) opts f tm oName branches
newLhs p e = rule (map toPVar as ++ (p:map toPVar bs)) e []
newRules =
[newLhs freePat
(noguard (if caseMode==Flex
then fapp (cusym "narrowCTC")
(addStateArg [C.Var "x", applyf])
else fapp (cusym "suspCTC")
(addStateArg [C.Var "ref", applyf])))
,newLhs orPat
[newLhs orPat
(noguard (fapp (cusym "mapOr") (addStateArg [applyf,C.Var "i",C.Var "xs"])))
,newLhs suspPat
(noguard (fapp (cusym "treatSusp")
(addStateArg [applyf,C.Var "ref",C.Var "susp"])))
,newLhs (C.PVar "x")
(noguard (fapp (cusym "patternFail")
[qname_ oName,C.Var "x"]))]
......@@ -813,7 +807,7 @@ showFunction showQ opts t@(Type origName vis vars consdecls)
| maybe False (elem Show) (lookup (snd $ typeName t) (extInsts opts))
= showsPrec [C.Rule [] (C.SimpleExpr (hasPresym "showsPrec")) []]
| otherwise = showsPrec (map showsPrecRule consdecls
++[showFreeVar,showGenerator])
++[showGenerator])
where
showParenArg (_,'(':_) = hasPresym "True"
showParenArg _ = if showQ then hasPresym "True" else lt (C.Var "d") app_prec
......@@ -861,7 +855,7 @@ showFunction showQ opts t@(Type origName vis vars consdecls)
showTuple = C.Func (newModName,showsPrecName) (transvis vis) untyped
(Just (map showTupleRule consdecls++[showFreeVar]))
(Just (map showTupleRule consdecls++[showGenerator]))
showTupleRule (Cons cname arity _ args) =
C.Rule [C.PVar "d", C.PComb (consName opts cname) (map toPVar [1..arity])]
......@@ -870,13 +864,6 @@ showFunction showQ opts t@(Type origName vis vars consdecls)
(fapp (sym ("",snd cname))
(map toVar [1..arity]))))) []
showFreeVar = C.Rule [_x,
C.PComb (newModName,name++"FreeVar") [C.PVar "i"]]
(C.SimpleExpr
(app (hasPresym "showString")
(cons_ (char_ '_')
(app (hasPresym "show") (C.Var "i"))))) []
showGenerator = C.Rule [_x,
C.PComb (newModName,name++"Or") [C.PVar "r",_x]]
(C.SimpleExpr
......@@ -1203,11 +1190,12 @@ toPFloat opts n = primPValue opts (C.PLit (C.Floatc n))
primPValue opts p = C.PComb (consName opts{extCons=True} (addPre "PrimValue")) [p]
toLit opts (Intc i) = toInt opts i
toLit opts (Intc i) = toInt i
toLit opts (Charc c) = toChar opts c
toLit opts (Floatc f) = toFloat opts f
toInt opts n = C.Lit (C.Intc (toInteger n))
toInt n = C.Lit (C.Intc (toInteger n))
toHInt n = C.Lit (C.HasIntc (toInteger n))
c_int isP = baseTypesym isP "C_Int"
......
......@@ -241,6 +241,7 @@ data BranchExpr = Branch Pattern Expr
--- It is either an integer, a float, or a character constant.
data Literal = Intc Integer
| HasIntc Integer
| Floatc Double
| Charc Char
deriving (Show,Eq,Read)
......
......@@ -32,12 +32,6 @@ ghnfCTC = ctcStore True
-- treatment for the basic cases of flexible pattern matching
-----------------------------------------------------------------
-- called by generated functions for narrowing
narrowCTC :: (BaseCurry a,BaseCurry b) => a -> (a -> Result b) -> Result b
narrowCTC x f st = case binding x of
Left var -> let p = pattern () in bind (freeVarRef var) p (f p st)
Right val -> f val st
-- called by generated functions for matching failure
patternFail :: (BaseCurry a,BaseCurry b) => String -> a -> b
patternFail s x = case consKind x of
......@@ -50,36 +44,24 @@ patternFail s x = case consKind x of
----------------------------------------------------------------------
-- generate branching
orsCTC :: BaseCurry a => [a] -> a
orsCTC xs = branching (nextOrRef Generator) xs
-- generate free variable
freeIORef :: BaseCurry a => () -> a
freeIORef x = freeVar (nextFreeRef x)
withRef :: (Int -> a) -> Int -> a
withRef f 0 = f 0
withRef f i = f $! nextRef i
---------------------------------------------------------------
-- manipulating references: the unsafe part of CurryToHaskell
---------------------------------------------------------------
-- the global state of references
storeRefCounter :: IORef (Int,Int)
storeRefCounter = unsafePerformIO (newIORef (1,1))
storeRefCounter :: IORef Int
storeRefCounter = unsafePerformIO (newIORef 1)
-- generate a new reference
nextRef :: Bool -> OrRefKind -> OrRef
nextRef b k = unsafePerformIO (do
(v,o) <- readIORef storeRefCounter
writeIORef storeRefCounter (if b then (v+1,o) else (v,o+1))
return (mkRefWithGenInfo k (if b then v else o)))
-- generate a reference for a branching
nextOrRef :: OrRefKind -> OrRef
nextOrRef = nextRef False
-- generate a reference for a free variable
nextFreeRef :: BaseCurry a => () -> FreeVarRef a
nextFreeRef _ = FreeVarRef (deref (nextRef True Generator))
(unsafePerformIO (newIORef (failed (ErrorCall ""))))
nextRef :: Int -> Int
nextRef i = unsafePerformIO (do
v <- readIORef storeRefCounter
writeIORef storeRefCounter (v+i+1)
return v)
---------------------------------------------------------------
-- run-time options (also unsafe)
......@@ -89,13 +71,10 @@ nextFreeRef _ = FreeVarRef (deref (nextRef True Generator))
-- a global state of run-time options.
-- the settings are only read once and stay the same during the whole computation.
data RunTimeOptions =
RTO {freeFunc :: forall a . forall b . (BaseCurry a, BaseCurry b) => (a -> b) -> b,
orFunc :: forall a . BaseCurry a => a -> a -> a,
currentModule :: String}
data RunTimeOptions = RTO {currentModule :: String}
runTimeDefaults :: RunTimeOptions
runTimeDefaults = withFree
runTimeDefaults = RTO {currentModule = ""}
runTimeOptions :: IORef RunTimeOptions
runTimeOptions = unsafePerformIO (newIORef runTimeDefaults)
......@@ -104,10 +83,10 @@ setRunTimeOptions :: RunTimeOptions -> IO ()
setRunTimeOptions = writeIORef runTimeOptions
freeF :: (BaseCurry b, BaseCurry a) => (b -> a) -> a
freeF = unsafePerformIO (readIORef runTimeOptions >>= return . freeFunc)
freeF = freeOrBased
orF :: BaseCurry a => a -> a -> a
orF = unsafePerformIO (readIORef runTimeOptions >>= return . orFunc)
orF = orCTC
-----------------------------------------------------------------------
-- implementation of getProgName (module System) expressions
......@@ -119,9 +98,7 @@ setProgName n = do
writeIORef runTimeOptions (opts{currentModule=n})
setProgNameAndOrBased :: String -> IO ()
setProgNameAndOrBased n = do
opts <- readIORef runTimeOptions
writeIORef runTimeOptions (opts{currentModule=n,freeFunc=freeOrBased})
setProgNameAndOrBased = setProgName
getProgName :: IO String
getProgName = readIORef runTimeOptions >>= return . currentModule
......@@ -130,21 +107,12 @@ getProgName = readIORef runTimeOptions >>= return . currentModule
-- alternatives for implementation of options
----------------------------------------------------------------------
withFree :: RunTimeOptions
withFree = RTO {freeFunc = freeCTC, orFunc = orCTC, currentModule = ""}
freeCTC :: (BaseCurry b, BaseCurry a) => (b -> a) -> a
freeCTC f = let x=freeIORef () in f x
orCTC :: BaseCurry a => a -> a -> a
orCTC x y = branching (nextOrRef Narrowed) [x,y]
orBased :: RunTimeOptions
orBased = withFree {freeFunc = freeOrBased}
orCTC x y = branching (mkRefWithGenInfo NoGenerator (nextRef 0)) [x,y]
-- free variables in or-based mode
freeOrBased :: (BaseCurry b, BaseCurry a) => (b -> a) -> a
freeOrBased f = f (free ())
freeOrBased f = f (generator (nextRef 0))
----------------------------------------------------------
-- some declarations for external read and show instances
......
......@@ -337,6 +337,7 @@ showBranchExpr opts (Branch pattern expr)
= showPatternOpt opts pattern ++ " -> " ++ showExprOpt opts expr
showLiteral :: Literal -> String
showLiteral (HasIntc i) = '(':show i++"::Int)"
showLiteral (Intc i) = '(':show i++"::C_Int)"
showLiteral (Floatc f) = '(':show f++"::Float)"
showLiteral (Charc c) = "'"++showCharc c++"'"
......
module Store
(Store,
emptyStore,addToStore,fromStore, storeSize,chainInStore,
emptyStore,addToStore,fromStore, storeSize,
OrRef,OrRefKind(..),
deref,cover,uncover,mkRef,isCovered,
deref,genInfo,cover,uncover,mkRef,isCovered,
mkRefWithGenInfo,equalityFromTo,childInfo,
isGenerator, isConstr,
mkRefWithGenInfo, isGenerator, isChain, chainTo,
narrowOrRef
) where
......@@ -16,18 +19,20 @@ import Data.IntMap
import Prelude hiding (lookup)
import System.IO.Unsafe
trace _ x = x --unsafePerformIO (putStrLn s >> return x)
trace s x = x --unsafePerformIO (putStrLn s >> return x)
trace' x = trace (show x) x
----------------------------
-- or references
----------------------------
data OrRefKind = Generator Int Int | Narrowed
deriving (Eq,Show,Read)
data OrRefKind = Generator Int Int | Narrowed Int Int | NoGenerator
deriving (Eq,Ord,Show,Read)
data OrRef = OrRef OrRefKind Int
| Layer OrRef
| Chain Int Int Int Int Int Int deriving (Eq,Show,Read)
| Equality Int Int Int Int Int Int
| ChildInfo Int Int Int deriving (Eq,Ord,Show,Read)
uncover :: OrRef -> OrRef
uncover (Layer x) = x
......@@ -38,7 +43,7 @@ cover :: OrRef -> OrRef
cover = Layer
mkRef :: Int -> Int -> Int -> OrRef
mkRef i j = OrRef (Generator i j)
mkRef i j = OrRef (Generator i (i+j-1))
mkRefWithGenInfo :: OrRefKind -> Int -> OrRef
mkRefWithGenInfo = OrRef
......@@ -48,6 +53,9 @@ deref :: OrRef -> Int
deref r = case uncover r of
OrRef _ i -> i
genInfo :: OrRef -> (Int,Int,Int)
genInfo r = case uncover r of
OrRef (Generator i j) k -> (i,j,k)
--refKind :: OrRef -> OrRefKind
--refKind r = (\ (OrRef x _) -> x) (uncover r)
......@@ -62,29 +70,32 @@ isGenerator r = case uncover r of
OrRef (Generator _ _) _ -> True
_ -> False
isNarrowed :: OrRef -> Bool
isNarrowed r = case uncover r of
OrRef Narrowed _ -> True
_ -> False
--operations
updKind :: (OrRefKind -> OrRefKind) -> OrRef -> OrRef
updKind f (Layer r) = Layer (updKind f r)
updKind f (OrRef k i) = OrRef (f k) i
updKind f c@(Chain _ _ _ _ _ _) = c
updKind f c@(Equality _ _ _ _ _ _) = c
updKind f c@(ChildInfo _ _ _) = c
narrowOrRef :: OrRef -> OrRef
narrowOrRef = updKind narrow
where narrow o@Narrowed = o
narrow (Generator _ _) = Narrowed
where
narrow o@NoGenerator = o
narrow o@(Narrowed _ _)= o
narrow (Generator i j) = Narrowed i j
equalFromTo :: Int -> Int -> Int -> Int -> Int -> Int -> OrRef
equalFromTo = Equality
chainTo :: Int -> Int -> Int -> Int -> Int -> Int -> OrRef
chainTo = Chain
childInfo :: Int -> Int -> Int -> OrRef
childInfo = ChildInfo
isChain :: OrRef -> Bool
isChain (Chain _ _ _ _ _ _) = True
isChain _ = False
isConstr :: OrRef -> Bool
isConstr (Equality _ _ _ _ _ _) = True
isConstr (ChildInfo _ _ _ _ _ _) = True
isConstr _ = False
-------------------------------------------------------
-- finally: the store
......@@ -92,59 +103,91 @@ isChain _ = False
-- negative numbers are references to other variables
-------------------------------------------------------
data Entry = Choice Int
| Equal Int
| Binding Int Int Int deriving Show
data Entry = Equal Int
| Choice Int
| Binding Int Int Int deriving (Eq,Ord,Show)
data Store = Store (IntMap Entry)
| Add (OrRef,Int) Store
| Ch (Int,Int,Int,Int,Int,Int) Store deriving (Eq,Ord,Show)
kern (Add _ st) = kern st
kern (Ch _ st) = kern st
kern x@(Store _) = x
infM :: (Store -> Store) -> Store -> Maybe Store -> Maybe Store
infM f st1 mst = mst >>= Just . inf f st1
inf :: (Store -> Store) -> Store -> Store -> Store
inf f (Add x st) st' = Add x (inf f st st')
inf f (Ch x st) st' = Ch x (inf f st st')
inf f (Store _) st' = f st'
newtype Store = Store (IntMap Entry) deriving (Show)
emptyStore :: Store
emptyStore = Store empty
data StoreResult = NoBinding (\ Int -> Store)
| Updated Store
| Inconsistent
| NewInfo OrRef Store
addToStore :: OrRef -> Int -> Store -> Maybe Store
addToStore r i st = trace (show (st,r,i)) $
addToStore r i st' = trace ("add "++show (st',r,i)) $ trace' $
let st = kern st' in infM (Add (r,i)) st' $
case uncover r of
OrRef Narrowed r -> insertAndCutChains r (Choice i) st
OrRef NoGenerator r -> insertAndCutChains r (Choice i) st
OrRef (Narrowed childMin childMax) r ->
insertAndCutChains r (Binding childMin childMax i) st
OrRef (Generator childMin childMax) r ->
insertAndCutChains r (Binding childMin childMax i) st
_ -> error "add applied to bad arguments"
Equality a b c d e f -> chainInStore a b c d e f st
ChildInfo a b c -> error "child info"
fromStore :: OrRef -> Store -> Maybe Int
fromStore r st@(Store store) = from (deref r)
fromStore r st = trace ("From: "++show (r,st)) $
trace' $ case uncover r of
Chain _ _ _ _ _ _ -> Nothing
OrRef _ i -> from i
where
Store store = kern st
from i = maybe Nothing follow (lookup i store)
follow (Choice i) = Just i
follow (Equal i) = from i
follow (Binding _ _ i) = Just i
chainInStore :: OrRef -> Store -> Maybe Store
chainInStore (Chain fromMin fromMax from toMin toMax to) st =
chainInStore :: Int -> Int -> Int -> Int -> Int -> Int ->
Store -> Maybe Store
chainInStore fromMin fromMax from toMin toMax to st' =
let st = kern st' in
trace' $
foldl (>>=) (Just st)
(zipWith insertChain (from:[fromMin .. fromMax])
(to:[toMin .. toMax]))
chainInStore _ _ = error "chainInStore applied to bad arguments"
insertChain :: Int -> Int -> Store -> Maybe Store
insertChain key val st@(Store store) =
case lookupAndCutChains val st of
insertChain key val st@(Store store)
= case lookupAndCutChains val st of
Nothing -> insertAndCutChains key (Equal val) st
Just (val',newSt) -> insertAndCutChains key val' newSt
insertAndCutChains :: Int -> Entry -> Store -> Maybe Store
insertAndCutChains key val st@(Store store) =
case insertLookupWithKey (\ _ -> lessChain) key val store of
insertAndCutChains key val st@(Store store)
| Equal key == val = Just st
| otherwise = case insertLookupWithKey (\ _ -> max) key val store of
(Nothing,newStore) -> Just (Store newStore)
(Just b,newStore) -> cmpBinds b val newStore
where
lessChain (Choice _) y@(Binding _ _ _) = y
lessChain x@(Choice _) _ = x
lessChain x@(Binding _ _ _) _ = x
lessChain (Equal _) y = y
cmpBinds (Equal v) val st' = insertAndCutChains v val (Store st')
cmpBinds val (Equal v) st' = insertAndCutChains v val (Store st')
cmpBinds (Binding amin amax i) (Binding bmin bmax j) st'
| i/=j = Nothing
| otherwise = foldl (>>=) (Just (Store st'))
(zipWith insertChain [amin .. amax]
[bmin .. bmax])
cmpBinds x y st | choice x==choice y = Just (Store st)
| otherwise = Nothing
......@@ -160,8 +203,5 @@ lookupAndCutChains i st@(Store store) = case lookup i store of
Just (j',Store store') -> Just (j',Store (insert i j' store'))
Just j -> Just (j,st)
storeSize :: Store -> Int
storeSize (Store st) = size st
\ No newline at end of file
......@@ -14,46 +14,30 @@ instance Read C_Context where
readsPrec _ _ = error "reading contest"
-}
data C_OrRef = C_OrRef OrRef
| C_OrRefFreeVar (Curry.FreeVarRef C_OrRef)
| C_OrRefFail Curry.C_Exceptions
| C_OrRefOr Curry.OrRef (Curry.Branches C_OrRef)
| C_OrRefSusp Curry.SuspRef (Curry.SuspCont C_OrRef)
instance BaseCurry C_OrRef where
nf f x state = f(x)(state)
gnf f x state = f(x)(state)
free _ = error "free Variable of type OrRef"
pattern _ = error "pattern of type OrRef"
generator _ = error "free Variable of type OrRef"
failed = C_OrRefFail
freeVar = C_OrRefFreeVar
branching = C_OrRefOr
suspend = C_OrRefSusp
consKind (C_OrRefFreeVar _) = Curry.Free
consKind (C_OrRefOr _ _) = Curry.Branching
consKind (C_OrRefFail _) = Curry.Failed
consKind (C_OrRefSusp _ _) = Curry.Suspended
consKind _ = Curry.Val
exceptions (C_OrRefFail x) = x
freeVarRef (C_OrRefFreeVar x) = x
orRef (C_OrRefOr x _) = x
branches (C_OrRefOr _ x) = x
suspRef (C_OrRefSusp x _) = x
suspCont (C_OrRefSusp _ x) = x
instance Curry C_OrRef where
strEq (C_OrRef x1) (C_OrRef y1) _
= if x1 Prelude.== y1 then strEqSuccess else strEqFail "OrRef"
......@@ -78,9 +62,6 @@ instance Curry C_OrRef where
instance Show C_OrRef where
showsPrec d (C_OrRef x1) = showParen (d>10) (showString "OrRef" . showsPrec d x1)
showsPrec _ (C_OrRefFreeVar i) = Prelude.showString((:)('_')(Prelude.show(i)))
instance Read C_OrRef where
readsPrec d r = [ (C_OrRef ref,s) | (ref,s) <- readsPrec d r]
......
......@@ -14,31 +14,24 @@ type C_Float = Prim Float
-----------------------------------------------------------------
data C_IO t0 = C_IO (State -> IO (IOVal t0))
| C_IOFreeVar (FreeVarRef (C_IO t0))
| C_IOFail C_Exceptions
| C_IOOr OrRef (Branches (C_IO t0))
| C_IOSusp SuspRef (SuspCont (C_IO t0))