KiCS-prophecy-0.1.0: dist/build/Curry/Module/CEventOracle.hs
{-# OPTIONS -cpp #-}
{-# LANGUAGE RankNTypes, ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-}
{-# INCLUDE <coracle.h> #-}
module Curry.Module.CEventOracle (module Curry.Module.CEventOracle) where
import Curry.RunTimeSystem
import Curry.Module.IOExts
import Curry.Module.Prelude
import Curry.Module.System
-- begin included
import Foreign
import Foreign
import Foreign.C.String
foreign import ccall unsafe "static coracle.h init" cinitialize :: Ref
foreign import ccall unsafe "static coracle.h nextref" cfresh :: Int -> Ref
foreign import ccall unsafe "static coracle.h collapse" ccollapse :: Ref -> ()
foreign import ccall unsafe "static coracle.h close_ref" ccloseRef :: Ref -> ()
foreign import ccall unsafe "static coracle.h inconly" creplace :: Ref -> ()
foreign import ccall unsafe "static coracle.h expand" cexpand :: Ref -> Int -> ()
foreign import ccall unsafe "coracle.h finalize" cfinalize :: CString -> ()
data CRef
type Ref = Ptr CRef
newtype C_Ref = C_Ref Ref
instance Show C_Ref
instance Read C_Ref
instance Eq C_Ref
instance BaseCurry C_Ref
instance Curry C_Ref
initRef :: Result (C_IO C_Ref)
initRef = let ref = cinitialize in seq ref (Curry.Module.Prelude.return (C_Ref ref))
finalize :: C_String -> Result (C_IO T0)
finalize s _ = C_IO (\ _ -> do
s' <- newCString (fromCurry s)
seq (cfinalize s') (Prelude.return (IOVal (T0))))
--- Side effect that computes a fresh reference.
fresh :: a -> Result C_Ref
fresh _ _ = C_Ref (cfresh 0)
--- increase couter of ref by one
replace :: C_Ref -> a -> b -> a
replace (C_Ref ref) x _ = seq (creplace ref) x
--- Remove a ref and combine and counter +1
collapse :: C_Ref -> a -> b -> a
collapse (C_Ref ref) x _ = seq (ccollapse ref) x
--- Remove a ref and combine and counter +1
closeRef :: C_Ref -> a -> b -> a
closeRef (C_Ref ref) x _ = seq (ccloseRef ref) x
--- Projection on last argument that releases an event as a side effect.
-- increment step counter of first ref and add remaining refs
-- list has to be at least of size 1
expand :: C_Ref -> List C_Ref -> a -> Result a
expand (C_Ref ref) refs x _
= seq (cexpand ref (len refs)) (seq (evalRefs refs) x)
where
len List = 0
len (_ :< rs) = 1+len rs
evalRefs List = ()
evalRefs (r :< rs) = seq r (evalRefs rs)
-- compare to BaseCurry.mapOr
c_onBranches :: (BaseCurry a,BaseCurry b) =>
C_Ref -> (C_Ref -> a -> Result b) -> OrRef -> Branches a -> Result b
c_onBranches r cont orref bs =
evalRef' True (\ r x st -> replace r (cont r x st) st) (branching orref bs) r
liftCase :: (BaseCurry a,BaseCurry b) =>
C_Ref -> (C_Ref -> a -> Result b) -> OrRef -> Branches a -> (Int -> State) -> b
liftCase ref f orref bs =
expand' ref (length bs - 1) (\ refs -> lift ($) orref (zipWith f refs bs))
expand' :: C_Ref -> Int -> ([C_Ref] -> a) -> a
expand' (C_Ref ref) l cont =
cexpand ref l `seq`
evalRefs refs `seq`
cont (map C_Ref (ref:refs))
where
refs = map cfresh (replicate l 0)
evalRefs [] = ()
evalRefs (r : rs) = seq r (evalRefs rs)
--- generating a fresh variable
unknown :: Curry a => C_Ref -> Result a
unknown r st = freeF (\x -> gen r x st)
gen :: Curry a => C_Ref -> a -> Result a
gen r x st = case consKind x of
Val -> push r x st
Branching -> liftCase r gen (orRef x) (branches x) (const st)
push :: Curry a => C_Ref -> a -> Result a
push r x st = case foldCurry (\ _ n _ -> n+1) 0 x st of
0 -> collapse r x st
1 -> replace r (propagate (\_ -> gen r) x st) st
n -> expand' r (n-1) (\ refs -> propagate (distRefs refs) x st)
where
distRefs rs i x = gen (rs!!i) x
type RefFun a b = C_Ref -> Result (Prim (a -> Result b))
($!), ($#),($!!),($##), apply :: (Curry a,Curry b) =>
Prim (RefFun a b) -> a -> C_Ref -> Result b
(cont $! x) r = Curry.Module.CEventOracle.prepApply hnfRef x cont r
(cont $# x) r = Curry.Module.CEventOracle.prepApply (evalRef True) x cont r
(cont $!! x) r st = Curry.Module.CEventOracle.prepApply hnfRef (nfCTC const x st) cont r st
(cont $## x) r st = Curry.Module.CEventOracle.prepApply (evalRef True) (gnfCTC const x st) cont r st
apply cont x r = Curry.Module.CEventOracle.prepApply (\ cont' x' r' st' ->
replace r' (Curry.Module.Prelude.apply (cont' r' st') x' st') st') x cont r
prepApply :: (BaseCurry a,BaseCurry b) =>
(RefFun b a -> b -> C_Ref -> Result a) -> b -> Prim (RefFun b a) -> C_Ref -> Result a
prepApply prep x (PrimValue f) cref st = prep f x cref st
prepApply prep x (PrimOr r bs) cref st =
c_onBranches cref (\ r' f' -> Curry.Module.CEventOracle.prepApply prep x f' r') r bs st
prepApply _ _ f r st = collapse r (patternFail "Prelude.prepApply" f) st
hnfRef :: (BaseCurry a,BaseCurry b) => RefFun b a -> b -> C_Ref -> Result a
hnfRef = evalRef False
evalRef :: (BaseCurry a,BaseCurry b) => HNFMode -> RefFun a b -> a -> C_Ref -> Result b
evalRef mode cont = evalRef' mode (\ r x st -> replace r (Curry.Module.Prelude.apply (cont r st) x st) st)
evalRef' :: (BaseCurry a,BaseCurry b) =>
HNFMode -> (C_Ref -> a -> Result b) -> a -> C_Ref -> Result b
evalRef' mode cont x r state =
case consKind x of
Failed -> closeRef r (addException err x) state
Branching -> let orref = orRef x
bs = branches x in
manipulateStore
(closeRef r (Curry.RunTimeSystem.failed (curryError "=:=")) state)
contEval
(\ ref' contSt -> if mode || not (isGenerator orref)
then liftCase r contEvalRef (narrowOrRef orref) bs contSt
else cont r (branching ref' bs) state)
(\ orref' x' st' -> branching orref' [contEval x' st'])
orref bs state
Val -> cont r x state
where
err = curryError ("Prelude."++if mode then "$#" else "$!")
contEvalRef r' x' st' = evalRef' mode cont x' r' st'
contEval = contEvalRef r
-- end included
c_initialize :: (Curry t0) => (Curry.Module.Prelude.Prim (Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.C_IO t0)) -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.C_IO Curry.Module.Prelude.T0
c_initialize x1 st = Curry.Module.Prelude.op_62_62_61(Curry.Module.System.c_getProgName(st))(Curry.Module.Prelude.pf(Curry.Module.CEventOracle.c_initialize'46_'35lambda2(x1)))(st)
c_initialize'46_'35lambda2 :: (Curry t10) => (Curry.Module.Prelude.Prim (Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.C_IO t10)) -> (Curry.Module.Prelude.List Curry.Module.Prelude.C_Char) -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.C_IO Curry.Module.Prelude.T0
c_initialize'46_'35lambda2 x1 x2 st = let {x3 = Curry.Module.Prelude.op_43_43(x2)((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('.'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('e'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('x'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('t'))(Curry.Module.Prelude.List)))))(st)} in Curry.Module.Prelude.op_62_62(Curry.Module.IOExts.c_setAssoc((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('e'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('x'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('t'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('f'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('n'))(Curry.Module.Prelude.List))))))(x3)(st))(Curry.Module.Prelude.op_62_62(Curry.Module.Prelude.c_writeFile(x3)(Curry.Module.Prelude.List)(st))(Curry.Module.Prelude.op_62_62_61(Curry.Module.CEventOracle.c_initRef(st))(Curry.Module.Prelude.pf(Curry.Module.CEventOracle.c_initialize'46_'35lambda2'46_'35lambda3(x1)(x2)))(st))(st))(st)
c_initialize'46_'35lambda2'46_'35lambda3 :: (Curry t10) => (Curry.Module.Prelude.Prim (Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.C_IO t10)) -> (Curry.Module.Prelude.List Curry.Module.Prelude.C_Char) -> Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.C_IO Curry.Module.Prelude.T0
c_initialize'46_'35lambda2'46_'35lambda3 x1 x2 x3 st = Curry.Module.Prelude.op_62_62_61(Curry.Module.Prelude.c_apply(x1)(x3)(st))(Curry.Module.Prelude.pf(Curry.Module.CEventOracle.c_initialize'46_'35lambda2'46_'35lambda3'46_'35lambda4(x2)))(st)
c_initialize'46_'35lambda2'46_'35lambda3'46_'35lambda4 :: (Curry t10) => (Curry.Module.Prelude.List Curry.Module.Prelude.C_Char) -> t10 -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.C_IO Curry.Module.Prelude.T0
c_initialize'46_'35lambda2'46_'35lambda3'46_'35lambda4 x1 x2 st = Curry.Module.Prelude.op_62_62_61(Curry.Module.Prelude.c_getSearchTree(x2)(st))(Curry.Module.Prelude.pf(Curry.Module.CEventOracle.c_initialize'46_'35lambda2'46_'35lambda3'46_'35lambda4'46_'35lambda5(x1)))(st)
c_initialize'46_'35lambda2'46_'35lambda3'46_'35lambda4'46_'35lambda5 :: (Curry t10) => (Curry.Module.Prelude.List Curry.Module.Prelude.C_Char) -> (Curry.Module.Prelude.C_SearchTree t10) -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.C_IO Curry.Module.Prelude.T0
c_initialize'46_'35lambda2'46_'35lambda3'46_'35lambda4'46_'35lambda5 x1 x2 st = Curry.Module.Prelude.op_62_62(Curry.Module.Prelude.c_catchFail(Curry.Module.Prelude.op_62_62(Curry.Module.Prelude.c_putStrLn((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('s'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('t'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('a'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('r'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('t'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('i'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('n'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('g'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char(' '))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('t'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('o'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char(' '))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('r'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('e'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('c'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('o'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('r'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('d'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char(' '))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('o'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('r'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('a'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('c'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('l'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('e'))(Curry.Module.Prelude.List))))))))))))))))))))))))))(st))(Curry.Module.Prelude.op_36_33_33(Curry.Module.Prelude.pf(Curry.Module.Prelude.c_return))(x2)(st))(st))(Curry.Module.Prelude.op_62_62(Curry.Module.Prelude.c_putStrLn((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('e'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('x'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('e'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('c'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('u'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('t'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('i'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('o'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('n'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char(' '))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('a'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('b'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('o'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('r'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('t'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('e'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('d'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('.'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char(' '))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('W'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('r'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('i'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('t'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('i'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('n'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('g'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char(' '))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('o'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('r'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('a'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('c'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('l'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('e'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char(' '))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('f'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('i'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('l'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('e'))(Curry.Module.Prelude.List)))))))))))))))))))))))))))))))))))))))(st))(Curry.Module.Prelude.c_return(Curry.Module.Prelude.c_failed(st))(st))(st))(st))(Curry.Module.CEventOracle.c_finalize(Curry.Module.Prelude.op_43_43(x1)((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('.'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('s'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('t'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('e'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('p'))((Curry.Module.Prelude.:<)(Curry.Module.Prelude.C_Char('s'))(Curry.Module.Prelude.List)))))))(st))(st))(st)
c_initRef :: Curry.RunTimeSystem.State -> Curry.Module.Prelude.C_IO Curry.Module.CEventOracle.C_Ref
c_initRef st = Curry.Module.CEventOracle.initRef(st)
c_finalize :: (Curry.Module.Prelude.List Curry.Module.Prelude.C_Char) -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.C_IO Curry.Module.Prelude.T0
c_finalize x1 st = Curry.Module.CEventOracle.finalize(x1)(st)
c_fresh :: Curry.Module.Prelude.T0 -> Curry.RunTimeSystem.State -> Curry.Module.CEventOracle.C_Ref
c_fresh x1 st = Curry.Module.CEventOracle.fresh(x1)(st)
c_replace :: (Curry t0) => Curry.Module.CEventOracle.C_Ref -> t0 -> Curry.RunTimeSystem.State -> t0
c_replace x1 x2 st = Curry.Module.CEventOracle.replace(x1)(x2)(st)
c_collapse :: (Curry t0) => Curry.Module.CEventOracle.C_Ref -> t0 -> Curry.RunTimeSystem.State -> t0
c_collapse x1 x2 st = Curry.Module.CEventOracle.collapse(x1)(x2)(st)
c_closeRef :: (Curry t0) => Curry.Module.CEventOracle.C_Ref -> t0 -> Curry.RunTimeSystem.State -> t0
c_closeRef x1 x2 st = Curry.Module.CEventOracle.closeRef(x1)(x2)(st)
c_expand :: (Curry t0) => Curry.Module.CEventOracle.C_Ref -> (Curry.Module.Prelude.List Curry.Module.CEventOracle.C_Ref) -> t0 -> Curry.RunTimeSystem.State -> t0
c_expand x1 x2 x3 st = Curry.Module.CEventOracle.expand(x1)(x2)(x3)(st)
c_unknown :: (Curry t0) => Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> t0
c_unknown x1 st = Curry.Module.CEventOracle.unknown(x1)(st)
op_36_33 :: (Curry t0,Curry t1) => (Curry.Module.Prelude.Prim (Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.Prim (t0 -> Curry.RunTimeSystem.State -> t1))) -> t0 -> Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> t1
op_36_33 x1 x2 x3 st = (Curry.Module.CEventOracle.$!)(x1)(x2)(x3)(st)
op_36_33_33 :: (Curry t0,Curry t1) => (Curry.Module.Prelude.Prim (Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.Prim (t0 -> Curry.RunTimeSystem.State -> t1))) -> t0 -> Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> t1
op_36_33_33 x1 x2 x3 st = (Curry.Module.CEventOracle.$!!)(x1)(x2)(x3)(st)
op_36_35 :: (Curry t0,Curry t1) => (Curry.Module.Prelude.Prim (Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.Prim (t0 -> Curry.RunTimeSystem.State -> t1))) -> t0 -> Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> t1
op_36_35 x1 x2 x3 st = (Curry.Module.CEventOracle.$#)(x1)(x2)(x3)(st)
op_36_35_35 :: (Curry t0,Curry t1) => (Curry.Module.Prelude.Prim (Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.Prim (t0 -> Curry.RunTimeSystem.State -> t1))) -> t0 -> Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> t1
op_36_35_35 x1 x2 x3 st = (Curry.Module.CEventOracle.$##)(x1)(x2)(x3)(st)
c_apply :: (Curry t0,Curry t1) => (Curry.Module.Prelude.Prim (Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> Curry.Module.Prelude.Prim (t0 -> Curry.RunTimeSystem.State -> t1))) -> t0 -> Curry.Module.CEventOracle.C_Ref -> Curry.RunTimeSystem.State -> t1
c_apply x1 x2 x3 st = Curry.Module.CEventOracle.apply(x1)(x2)(x3)(st)