Commit a3d388f8 authored by bbr's avatar bbr
Browse files

added the io value

- with a newtype values from io can be seen as such now
parent e6ddb223
-- #---------------------------------------------------
-- include for debugging into Prelude
------------------------------------------------------
......@@ -84,7 +83,14 @@ prim_chr = trace1 "prim_chr" (Char.chr `dot` int'ToInt)
andBreadth :: [Bool] -> Step Bool
andBreadth = trace1 "andBreadth" Prelude.and
type IO a = Prim (Step a)
newtype IOVal a = IOVal a deriving (Show, Eq)
instance StrictCurry a => StrictCurry (IOVal a) where
showCons (IOVal a) = do
sa <- showTerm a
preturn (consTerm "IO" [sa])
type IO a = Prim (Step (IOVal a))
(>>=) :: (StrictCurry a,StrictCurry b) => IO a -> Prim (a -> Step (IO b)) -> Step (IO b)
(>>=) (Prim term act) bact _ = do
......@@ -92,29 +98,31 @@ type IO a = Prim (Step a)
Prelude.return (Prim (consTerm ">>=" [term,sb])
(traceFunCall (preturn term) (bindStep act bact)))
bindStep :: StrictCurry b => Step a -> Prim (a -> Step (IO b)) -> Step b
bindStep :: StrictCurry b => Step (IOVal a) -> Prim (a -> Step (IO b)) -> Step (IOVal b)
bindStep act (Prim _ bact) mode = do
a <- act mode
b <- bact a mode
case b of
Prim term bact' -> traceFunCall (preturn term) bact' mode
IOVal a <- act mode
Prim term bact' <- bact a mode
traceFunCall (preturn term) bact' mode
addIOVal :: Step res -> Step (IOVal res)
addIOVal act mode = do
res <- act mode
preturn (IOVal res)
ioFunc0 :: (StrictCurry res) => String -> (Step res) -> Step (IO res)
ioFunc0 s act _ = Prelude.return (Prim (consTerm s []) act)
ioFunc0 s act _ = Prelude.return (Prim (consTerm s []) (addIOVal act))
ioFunc1 :: (StrictCurry a, StrictCurry b) => String -> (a -> Step b) -> a -> Step (IO b)
ioFunc1 s act x _ = do
sx <- showTerm x
Prelude.return (Prim (consTerm s [sx]) (act x))
Prelude.return (Prim (consTerm s [sx]) (addIOVal (act x)))
ioFunc2 :: (StrictCurry a1, StrictCurry a2, StrictCurry res) =>
String -> (a1 -> a2 -> Step res) -> a1 -> a2 -> Step (IO res)
ioFunc2 s act x1 x2 _ = do
sx1 <- showTerm x1
sx2 <- showTerm x2
Prelude.return (Prim (consTerm s [sx1,sx2]) (act x1 x2))
Prelude.return (Prim (consTerm s [sx1,sx2]) (addIOVal (act x1 x2)))
extVal :: Prelude.Read a => (a -> Step ()) -> Step a
extVal act st = do
......@@ -142,9 +150,7 @@ prim_show :: StrictCurry a => a -> Step String
prim_show = trace1 "prim_show" Prelude.show
getSearchTree :: StrictCurry a => a -> Step (IO (SearchTree a))
getSearchTree x _ = do
sx <- showTerm x
Prelude.return (Prim (consTerm "getSearchTree" [sx]) (return' (Value x)))
getSearchTree = ioFunc1 "getSearchTree" (return' `dot` Value)
getChar :: Step (IO Char)
getChar = ioFunc0 "getChar" (extVal addConsole)
......
......@@ -538,7 +538,7 @@ showMenu menu = do state <- get
---------------------------------------------------------------
-- safed values of external functions and their representation
-- saved values of external functions and their representation
---------------------------------------------------------------
liftDebug :: DebugMonad () -> Step ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment