module Curry.RunTimeSystem.BaseCurry (
module Curry.RunTimeSystem.BaseCurry,
module Curry.RunTimeSystem.Store) where
import Curry.RunTimeSystem.Store
import Data.IORef
import System.IO.Unsafe
type State = Store
data ConsKind = Val | Branching | Failed deriving (Show,Eq)
type HNFMode = Bool
type Branches a = [a]
data Exception
= ErrorCall String
| PatternMatchFail String
| AssertionFailed String
| PreludeFailed
| IOException String deriving Eq
type C_Exceptions = Exception
type Result a = State -> a
type Result' a = Store -> a
class BaseCurry a where
nf :: BaseCurry b => (a -> Result b) -> a -> Result b
gnf :: BaseCurry b => (a -> Result b) -> a -> Result b
generator :: Int -> a
failed :: C_Exceptions -> a
branching :: OrRef -> Branches a -> a
consKind :: a -> ConsKind
exceptions :: a -> C_Exceptions
orRef :: a -> OrRef
branches :: a -> Branches a
ctcStore :: (BaseCurry a,BaseCurry b) => HNFMode -> (a -> Result b) -> a -> Result b
ctcStore mode cont x state =
case consKind x of
Val -> cont x state
Failed -> addException err x
Branching -> let ref = orRef x
bs = branches x
in manipulateStore
(failed (curryError "ctcStore"))
contCTC
(\ ref' contSt -> if mode || not (isGenerator ref)
then lift contCTC (narrowOrRef ref) bs contSt
else cont (branching ref' bs) state)
( \ ref' x' state' -> branching ref' [contCTC x' state'])
ref bs state
where
contCTC = ctcStore mode cont
err = curryError ("Prelude."++if mode then "$#" else "$!")
mapOr :: BaseCurry b => (a -> Result b) -> OrRef -> Branches a -> Result b
mapOr cont ref bs = manipulateStore
(failed (curryError "mapOr"))
cont
(\ _ -> lift cont (narrowOrRef ref) bs)
(\ ref x st -> branching ref [cont x st])
ref bs
lift :: BaseCurry b => (a -> Result b) -> OrRef -> Branches a
-> (Int -> State) -> b
lift cont ref bs contSt =
branching ref (zipWith (\ x i -> cont x (contSt i)) bs [0..])
addException :: (BaseCurry a,BaseCurry b) => Exception -> a -> b
addException _ x = failed (exceptions x)
curryError :: String -> Exception
curryError = ErrorCall