IO inside

cosh r = (exp r + 1/exp r)/2
cosh r = (x + 1/x)/2 where x = exp r
putStrLn "Press any key to begin formatting"
getchar :: Char

get2chars :: String
get2chars = [a, b] where a = getchar
                         b = getchar
get2chars :: String
get2chars = [x, x] where x = getchar  -- this should be a legitimate optimisation!
getchar :: Int -> Char

get2chars :: String
get2chars = [a, b] where a = getchar 1
                         b = getchar 2
now_or_later :: String
now_or_later = case getchar 0 of
                 c | c == 'y' -> "Now"
                   | c == 'Y' -> "Now"
                 _            -> "Later"
getchar :: Time -> Char

get2chars :: (Time, Time) -> String
get2chars (t1, t2) = [a, b] where a = getchar t1
                                  b = getchar t2

now_or_later :: Time -> String
now_or_later t = case getchar t of
                   c | c == 'y' -> "Now"
                     | c == 'Y' -> "Now"
                   _            -> "Later"
timeSnaps :: Time -> (Time, Time)  -- ?!
getchar :: {- starting -} Time -> (Char, {- completion -} Time)

now_or_later :: Time -> String
now_or_later t1 = case getchar t1 of
                    (c, _) | c == 'y' -> "Now"
                           | c == 'Y' -> "Now"
                    _                 -> "Later
get2chars :: Time -> String
get2chars t1 = [a, b] where (a, t2) = getchar t1
                            (b, _)  = getchar t2
getchar :: Time -> (Char, Time)

get2chars :: Time -> (String, Time)
get2chars t1 = ([a, b], t3) where (a, t2) = getchar t1
                                  (b, t3) = getchar t2

now_or_later :: Time -> (String, Time)
now_or_later t1 = case getchar t1 of
                    (c, t2) | c == 'y'  -> ("Now",   t2)
                            | c == 'Y'  -> ("Now",   t2)
                            | otherwise -> ("Later", t2)
get2chars :: Time -> (String, Time)
get2chars t1 = ([a, b], t3) where (a, t2) = getchar t3  -- this might take
                                  (b, t3) = getchar t2  --    a while...
class Monad m where
    return :: a -> m a                  -- "unit"
    (>>=)  :: m a -> (a -> m b) -> m b  -- "bind"
get2chars    = \t1 -> let (a, t2) = getchar t1 in
                      let (b, t3) = getchar t2 in
                      let r       = [a, b] in
                      (r, t3)

now_or_later = \t1 -> let (c, t2) = getchar t1 in
                      let r = if elem c "yY" then "Now" else "Later" in
                      (r, t2)
data IO a =  Act (Time -> (a, Time))

getchar   :: IO Char
instance Monad IO where
    m >>= k  = let actual (Act m) = m in
               Act $ \t1 -> case actual m t1 of (x, t2) -> actual (k x) t2
    return x = Act $ \t1 -> (x, t1)
get2chars :: IO String
get2chars =  getchar >>= \a ->
             getchar >>= \b ->
             return [a, b]

now_or_later :: IO String
now_or_later = getchar >>= \c ->
               return (if elem c "yY" then "Now" else "Later")
data IO
getchar :: IO Char
return  :: a -> IO a
(>>=)   :: IO a -> (a -> IO b) -> IO b
data Time = Now Double
data RealWorld

newtype IO a = Act (RealWorld -> (a, RealWorld))
getChar :: IO Char

main :: IO ()
main = getChar >>= \a ->
       getChar >>= \b ->
       return ()
getChar :: RealWorld -> (Char, RealWorld)

main :: RealWorld -> ((), RealWorld)
main world0 = let (a, world1) = getChar world0
                  (b, world2) = getChar world1
              in ((), world2)
main = do a <- ask "What is your name?"
          b <- ask "How old are you?"
          return ()

ask s = do putStr s
           readLn
when :: Bool -> IO () -> IO ()
when condition action =
    if condition
      then action
      else return ()
when condition action world =
    if condition
      then action world
      else ((), world)
main = do putStr "Hello!"
main = putStr "Hello!"
main = do putStr "What is your name?"
          putStr "How old are you?"
          putStr "Nice day!"
main = (putStr "What is your name?")
       >> ( (putStr "How old are you?")
            >> (putStr "Nice day!")
          )
(>>) :: IO a -> IO b -> IO b
action1 >> action2 = action1 >>= \_ -> action2
(action1 >> action2) world0 =
   let (a, world1) = action1 world0  -- note: a not used
       (b, world2) = action2 world1
   in (b, world2)
action1 >> action2 = action
  where
    action world0 = let (a, world1) = action1 world0
                        (b, world2) = action2 world1
                    in (b, world2)
main = do a <- readLn
          print a
main = readLn
       >>= (\a -> print a)
(action >>= reaction) world0 =
   let (a, world1) = action world0
       (b, world2) = reaction a world1
   in (b, world2)
newtype IO a = Act (RealWorld -> (a, RealWorld))
main = readLn >>= print
 do x <- action1
    action2
 action1 >>= (\x -> action2)
main = do putStr "What is your name?"
          a <- readLn
          putStr "How old are you?"
          b <- readLn
          print (a,b)
main = putStr "What is your name?"
       >> readLn
       >>= \a -> putStr "How old are you?"
       >> readLn
       >>= \b -> print (a,b)
return a world0  =  (a, world0)
main = do a <- readLn
          return (a*2)
main = do a <- readLn
          when (a>=0) $ do
              return ()
          print "a is negative"
main = do a <- readLn
          if (a>=0)
            then return ()
            else print "a is negative"
main = do a <- readLn
          if (a>=0) then return ()
            else do
          print "a is negative"
          ...
liftM :: (a -> b) -> (IO a -> IO b)
liftM f action = do x <- action
                    return (f x)
main = do let a0 = readVariable varA
              _  = writeVariable varA 1
              a1 = readVariable varA
          print (a0, a1)
import Data.IORef
main = do varA <- newIORef 0  -- Create and initialize a new variable
          a0 <- readIORef varA
          writeIORef varA 1
          a1 <- readIORef varA
          print (a0, a1)
import Data.Array.IO
main = do arr <- newArray (1,10) 37 :: IO (IOArray Int Int)
          a <- readArray arr 1
          writeArray arr 1 64
          b <- readArray arr 1
          print (a, b)
rand :: IO Int
foreign import ccall
   sin :: Double -> Double
foreign import ccall
   tell :: Int -> IO Int
newtype IO a = Act (RealWorld -> (a, RealWorld))
newtype ST s a = Act' (s -> (a, s))
type IO a = ST RealWorld a
newSTRef     :: a -> ST s (STRef s a)      -- these are
readSTRef    :: STRef s a -> ST s a        --  usually
writeSTRef   :: STRef s a -> a -> ST s ()  -- primitive

newSTArray   :: Ix i => (i, i) -> ST s (STArray s i e) -- also usually primitive
              ⋮

instance Monad (ST s) where
    m >>= k  = let actual' (Act' m) = m in
               Act' $ \s1 -> case actual' m s1 of (x, s2) -> actual' (k x) s2
    return x = Act' $ \s1 -> (x, s1)
runST :: (forall s . ST s a) -> a
newSTRef  :: a -> ST s (STRef s a)
newArray_ :: Ix i => (i, i) -> ST s (STArray s i e)
makeSTRef :: a -> STRef s a
makeSTRef a = runST (newSTRef a)
stToIO :: ST RealWorld a -> IO a
oneST :: ST s Integer -- note that this works correctly for any s
oneST = do var <- newSTRef 0
           modifySTRef var (+1)
           readSTRef var

one :: Int
one = runST oneST
main world0 = let skip2chars = getChar >> getChar >> return ()  -- NB: not simplified!
                  (answer, world2) = skip2chars world1
                  ((), world1) = putStr "Press two keys" world0
              in ((), world2)
main = do let skip2chars = getChar >> getChar >> return ()
          putStr "Press two keys"
          skip2chars
          return ()
ioActions :: [IO ()]
ioActions = [(print "Hello!"),
             (putStr "just kidding"),
             (getChar >> return ())
            ]
ioActions :: [RealWorld -> ((), RealWorld)]
main = do head ioActions
          ioActions !! 1
          last ioActions
sequence_ :: [IO a] -> IO ()
sequence_ [] = return ()
sequence_ (x:xs) = do x
                      sequence_ xs
main = sequence_ ioActions
while :: IO Bool -> IO ()
while action = ???
main = do let a = sequence ioActions
              b = when True getChar
              c = getChar >> getChar >> return ()
          putStr "These let-bindings are not executed!"
readi h i = do hSeek h AbsoluteSeek i
               hGetChar h
readfilei :: String -> IO (Integer -> IO Char)
readfilei name = do h <- openFile name ReadMode
                    return (readi h)
readfilei name = do h <- openFile name ReadMode
                    let readi h i = do hSeek h AbsoluteSeek i
                                       hGetChar h
                    return (readi h)
readfilei name = do h <- openFile name ReadMode
                    let readi i = do hSeek h AbsoluteSeek i
                                     hGetChar h
                    return readi
main = do myfile <- readfilei "test"
          a <- myfile 0
          b <- myfile 1
          print (a,b)
memoryAllocator :: Ptr a -> Int -> IO (Int -> IO (Ptr b),
                                       Ptr c -> IO ())

memoryAllocator buf size = do ......
                              let alloc size = do ...
                                                  ...
                                  free ptr = do ...
                                                ...
                              return (alloc, free)
memoryAllocator buf size =
   do start <- newIORef buf
      end <- newIORef (buf `plusPtr` size)
      ...
      ...
      let alloc size = do addr <- readIORef start
                          writeIORef start (addr `plusPtr` size)
                          return addr

      let free ptr = do writeIORef start ptr
main = do buf1 <- mallocBytes (2^16)
          buf2 <- mallocBytes (2^20)
          (alloc1, free1) <- memoryAllocator buf1 (2^16)
          (alloc2, free2) <- memoryAllocator buf2 (2^20)
          ptr11 <- alloc1 100
          ptr21 <- alloc2 1000
          free1 ptr11
          free2 ptr21
          ptr12 <- alloc1 100
          ptr22 <- alloc2 1000
data Figure = Figure { draw :: IO (),
                       move :: Displacement -> IO ()
                     }

type Displacement = (Int, Int)  -- horizontal and vertical displacement in points
circle    :: Point -> Radius -> IO Figure
rectangle :: Point -> Point -> IO Figure

type Point = (Int, Int)  -- point coordinates
type Radius = Int        -- circle radius in points
circle center radius = do
    let description = "  Circle at "++show center++" with radius "++show radius
    return $ Figure { draw = putStrLn description }

rectangle from to = do
    let description = "  Rectangle "++show from++"-"++show to)
    return $ Figure { draw = putStrLn description }
drawAll :: [Figure] -> IO ()
drawAll figures = do putStrLn "Drawing figures:"
                     mapM_ draw figures

main = do figures <- sequence [circle (10,10) 5,
                               circle (20,20) 3,
                               rectangle (10,10) (20,20),
                               rectangle (15,15) (40,40)]
          drawAll figures
circle center radius = do
    centerVar <- newIORef center

    let drawF = do center <- readIORef centerVar
                   putStrLn ("  Circle at "++show center
                             ++" with radius "++show radius)

    let moveF (addX,addY) = do (x,y) <- readIORef centerVar
                               writeIORef centerVar (x+addX, y+addY)

    return $ Figure { draw=drawF, move=moveF }

rectangle from to = do
    fromVar <- newIORef from
    toVar   <- newIORef to

    let drawF = do from <- readIORef fromVar
                   to   <- readIORef toVar
                   putStrLn ("  Rectangle "++show from++"-"++show to)

    let moveF (addX,addY) = do (fromX,fromY) <- readIORef fromVar
                               (toX,toY)     <- readIORef toVar
                               writeIORef fromVar (fromX+addX, fromY+addY)
                               writeIORef toVar   (toX+addX, toY+addY)

    return $ Figure { draw=drawF, move=moveF }
main = do figures <- sequence [circle (10,10) 5,
                               rectangle (10,10) (20,20)]
          drawAll figures
          mapM_ (\fig -> move fig (10,10)) figures
          drawAll figures
data Figure = Figure { draw :: IO (),
                       move :: Displacement -> IO (),
                       area :: Double,
                       origin :: IORef Point
                     }
main = print (f 2)

f 0 = "zero"
f 1 = "one"
main = print (head [])
main = print (1 + (error "Value that wasn't initialized or cannot be computed"))
{-# LANGUAGE ForeignFunctionInterface #-}

main = do print "Hello from main"
          c_routine

haskell_definition = print "Hello from haskell_definition"

foreign import ccall safe "prototypes.h"
    c_routine :: IO ()

foreign export ccall
    haskell_definition :: IO ()
#include <stdio.h>
#include "prototypes.h"

void c_routine (void)
{
  printf("Hello from c_routine\n");
  haskell_definition();
}
extern void c_routine (void);
extern void haskell_definition (void);
 ghc --make main.hs vile.c

 ghc -c vile.c
 ghc --make main.hs vile.o

#ifdef __cplusplus
extern "C" {
#endif

extern void c_routine (void);
extern void haskell_definition (void);

#ifdef __cplusplus
}
#endif
 ghc --make main.hs vile.cpp

foreign import ccall safe "prototypes.h CRoutine"
    c_routine :: IO ()

foreign export ccall "HaskellDefinition"
    haskell_definition :: IO ()
foreign import stdcall unsafe "windows.h SetFileApisToOEM"
  setFileApisToOEM :: IO ()
import Foreign.C.Types (               -- equivalent to the following C type:
         CChar, CUChar,                --  char/unsigned char
         CShort, CUShort,              --  short/unsigned short
         CInt, CUInt, CLong, CULong,   --  int/unsigned/long/unsigned long
         CFloat, CDouble...)           --  float/double
foreign import ccall unsafe "math.h"
    c_sin :: CDouble -> CDouble
-- |Type-conversion wrapper around c_sin
sin :: Double -> Double
sin = fromRational . c_sin . toRational
import Foreign.C.String (   -- representation of strings in C
         CString,           -- = Ptr CChar
         CStringLen)        -- = (Ptr CChar, Int)
foreign import ccall unsafe "string.h"
    c_strlen :: CString -> IO CSize     -- CSize defined in Foreign.C.Types and is equal to size_t
-- |Type-conversion wrapper around c_strlen
strlen :: String -> Int
strlen = ....
getchar :: Char

get2chars :: String
get2chars = [a, b] where a = getchar
                         b = getchar
void putchar(char c);
putchar :: Char -> ()
putchar c = ...
readContents :: Filename -> String
unsafePerformIO :: IO a -> a
unsafePerformIO :: (RealWorld -> (a, RealWorld)) -> a
unsafePerformIO action = let (a, world1) = action createNewWorld
                         in a
one :: Integer
one = unsafePerformIO $ do var <- newIORef 0
                           modifyIORef var (+1)
                           readIORef var
unsafePerformIO action = let (a,world1) = action createNewWorld
                         in (world1 `seq` a)
-- | Just like unsafePerformIO, but we inline it. Big performance gains as
-- it exposes lots of things to further inlining
{-# INLINE inlinePerformIO #-}
inlinePerformIO action = let (a, world1) = action createNewWorld
                         in (world1 `seq` a)
write :: Int -> (Ptr Word8 -> IO ()) -> Put ()
write !n body = Put $ \c buf@(Buffer fp o u l) ->
  if n <= l
    then write</code> c fp o u l
    else write</code> (flushOld c n fp o u) (newBuffer c n) 0 0 0

  where {-# NOINLINE write</code> #-}
        write</code> c !fp !o !u !l =
          -- warning: this is a tad hardcore
          inlinePerformIO
            (withForeignPtr fp
              (\p -> body $! (p `plusPtr` (o+u))))
          `seq` c () (Buffer fp o (u+n) (l-n))
word8 w = write 1 (\p -> poke p w)
unsafeInterleaveIO :: IO a -> IO a
{-# NOINLINE unsafeInterleaveIO #-}
unsafeInterleaveIO   :: IO a -> IO a
unsafeInterleaveIO a =  return (unsafePerformIO a)
do let c = unsafePerformIO getChar
   do_proc c
do let s = [unsafePerformIO getChar, unsafePerformIO getChar, unsafePerformIO getChar]
   do_proc s
do str <- unsafeInterleaveIO myGetContents
                    ⋮
myGetContents = do
   c <- getChar
   s <- unsafeInterleaveIO myGetContents
   return (c:s)
myGetContents = do
   l <- replicateM 512 getChar
   s <- unsafeInterleaveIO myGetContents
   return (l++s)
myGetContents = unsafeInterleaveIO $ do
   l <- replicateM 512 getChar
   s <- myGetContents
   return (l++s)
newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
data World = World
newtype IO a = IO (World -> Either IOError a)

IO inside

Haskell is a pure language[edit]

I/O in Haskell, simplified[edit]

A matter of time[edit]

Time after time[edit]

The fun of plumbing[edit]

Enter the monad[edit]

Beyond time[edit]

Running with the `RealWorld`[edit]

`(>>=)` and `do` notation[edit]

Mutable data (references, arrays, hash tables...)[edit]

Encapsulated mutable data: ST[edit]

I/O actions as values[edit]

Example: a list of I/O actions[edit]

Example: returning an I/O action as a result[edit]

Example: a memory allocator generator[edit]

Example: emulating OOP with record types[edit]

Exception handling (under development)[edit]

Interfacing with C/C++ and foreign libraries (under development)[edit]

Foreign calls[edit]

All about the `foreign` declaration[edit]

Marshalling simple types[edit]

Memory management[edit]

Marshalling strings[edit]

Marshalling composite types[edit]

Dynamic calls[edit]

DLLs[edit]

The dark side of the I/O monad[edit]

unsafePerformIO[edit]

inlinePerformIO[edit]

unsafeInterleaveIO[edit]

Welcome to the machine: the actual GHC implementation[edit]

The Yhc/nhc98 implementation[edit]

Further reading[edit]

To-do list[edit]

Haskell is a pure language[edit]

I/O in Haskell, simplified[edit]

A matter of time[edit]

Time after time[edit]

The fun of plumbing[edit]

Enter the monad[edit]

Beyond time[edit]

Running with the RealWorld[edit]

(>>=) and do notation[edit]

Mutable data (references, arrays, hash tables...)[edit]

Encapsulated mutable data: ST[edit]

I/O actions as values[edit]

Example: a list of I/O actions[edit]

Example: returning an I/O action as a result[edit]

Example: a memory allocator generator[edit]

Example: emulating OOP with record types[edit]

Exception handling (under development)[edit]

Interfacing with C/C++ and foreign libraries (under development)[edit]

Foreign calls[edit]

All about the foreign declaration[edit]

Marshalling simple types[edit]

Memory management[edit]

Marshalling strings[edit]

Marshalling composite types[edit]

Dynamic calls[edit]

DLLs[edit]

The dark side of the I/O monad[edit]

unsafePerformIO[edit]

inlinePerformIO[edit]

unsafeInterleaveIO[edit]

Welcome to the machine: the actual GHC implementation[edit]

The Yhc/nhc98 implementation[edit]

Further reading[edit]

To-do list[edit]

Running with the `RealWorld`[edit]

`(>>=)` and `do` notation[edit]

All about the `foreign` declaration[edit]