basicIORun_1.hs

contents

{-# htermination (basicIORun :: IO a  ->  IOFinished a) #-} 
import qualified Prelude 
data MyBool = MyTrue | MyFalse 
data List a = Cons a (List a) | Nil 
data Either b a = Left b  | Right a ;
data Maybe a = Nothing | Just a ;
data Char = Char MyInt ;
data IOErrorKind = Junk ;

data HugsException = HugsException ;

data IO a = IO ((IOError  ->  IOResult)  ->  (a  ->  IOResult)  ->  IOResult) ;

data IOError = IOError IOErrorKind (List Char) (List Char) (Maybe (List Char)) ;

data IOFinished a = Finished_ExitWith MyInt  | Finished_Error IOError  | Finished_Return a ;

data IOResult = Hugs_ExitWith MyInt  | Hugs_Error IOError  | Hugs_Catch IOResult (HugsException  ->  IOResult) (IOError  ->  IOResult) (Obj  ->  IOResult)  | Hugs_ForkThread IOResult IOResult  | Hugs_DeadThread  | Hugs_YieldThread IOResult  | Hugs_Return Obj  | Hugs_BlockThread (Obj  ->  IOResult) ((Obj  ->  IOResult)  ->  IOResult) ;

data MyInt = Pos Nat  | Neg Nat ;

data Nat = Succ Nat | Zero ;

data Obj = Obj ;

stop :: MyBool  ->  a;
stop MyFalse = stop MyFalse;

error :: a;
error = stop MyTrue;

fromObj :: Obj  ->  a;
fromObj = fromObj;

hugs_catchCatch' :: IOResult  ->  IOResult;
hugs_catchCatch' (Hugs_Catch m' f1' f2' s') = hugs_catchCatch' (hugs_catch m' f1' f2' s');
hugs_catchCatch' x = x;

hugs_catchHugs_catch0 a f1 f2 s x = Hugs_Catch (a x) f1 f2 s;

hugs_catchHugs_catch1 f1 s f2 (Left exn) = f1 exn;
hugs_catchHugs_catch1 f1 s f2 (Right (Hugs_Return a)) = s a;
hugs_catchHugs_catch1 f1 s f2 (Right (Hugs_Error e)) = f2 e;
hugs_catchHugs_catch1 f1 s f2 (Right (Hugs_ForkThread a b)) = Hugs_ForkThread (Hugs_Catch a f1 f2 s) b;
hugs_catchHugs_catch1 f1 s f2 (Right (Hugs_YieldThread a)) = Hugs_YieldThread (Hugs_Catch a f1 f2 s);
hugs_catchHugs_catch1 f1 s f2 (Right (Hugs_BlockThread a b)) = Hugs_BlockThread (hugs_catchHugs_catch0 a f1 f2 s) b;
hugs_catchHugs_catch1 f1 s f2 (Right r) = r;

primCatchException :: a  ->  Either HugsException a;
primCatchException = primCatchException;

hugs_catch :: IOResult  ->  (HugsException  ->  IOResult)  ->  (IOError  ->  IOResult)  ->  (Obj  ->  IOResult)  ->  IOResult;
hugs_catch m f1 f2 s = hugs_catchHugs_catch1 f1 s f2 (primCatchException (hugs_catchCatch' m));

psPs :: (List a)  ->  (List a)  ->  (List a);
psPs Nil ys = ys;
psPs (Cons x xs) ys = Cons x (psPs xs ys);

loop :: (List IOResult)  ->  IOFinished a;
loop Nil = error;
loop (Cons (Hugs_Return a) Nil) = Finished_Return (fromObj a);
loop (Cons (Hugs_Return a) r) = loop (psPs r (Cons (Hugs_Return a) Nil));
loop (Cons (Hugs_Catch m f1 f2 s) r) = loop (Cons (hugs_catch m f1 f2 s) r);
loop (Cons (Hugs_Error e) vv) = Finished_Error e;
loop (Cons (Hugs_ExitWith i) vw) = Finished_ExitWith i;
loop (Cons Hugs_DeadThread r) = loop r;
loop (Cons (Hugs_ForkThread a b) r) = loop (Cons a (Cons b r));
loop (Cons (Hugs_YieldThread a) r) = loop (psPs r (Cons a Nil));
loop (Cons (Hugs_BlockThread a b) r) = loop (Cons (b a) r);
loop vx = error;

pt :: (a  ->  b)  ->  (c  ->  a)  ->  c  ->  b;
pt f g x = f (g x);

toObj :: a  ->  Obj;
toObj = toObj;

basicIORun :: IO a  ->  IOFinished a;
basicIORun (IO m) = loop (Cons (m Hugs_Error (pt Hugs_Return toObj)) Nil);

content may be truncated. 'popout' for larger text window.