IO inside

Haskell I/O can be a source of confusion and surprises for new Haskellers -

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 :: RealWorld -> (Char, RealWorld)
getChar = \ world0 -> let ... in (c, world1)
getChar :: RealWorld -> Char
getChar = \ world -> let ... in c
getLine :: RealWorld -> ([Char], RealWorld)
getLine world0 = let (c, world1) = getChar world0 in
                 if c == '\n'
                   then
                     ([], world1)
                   else
                     let (l, world2) = getLine world1 in
                     (c:l, world2)
getChar :: IO Char

getLine :: IO [Char]
getLine = getChar >>= \ c ->
          if c == '\n'
            then
              return []
            else
              getLine >>= \ l ->
              return (c:l)
getChar :: RealWorld -> (Char, RealWorld)

getLine :: RealWorld -> ([Char], RealWorld)
data () = ()              -- the unit type

data Bool = False | True  -- the boolean type

data Char                 -- the character type (usually abstract)

data Int                  -- the type of hardware-precision integers (similarly abstract)
\ () -> 'a'         :: ()        -> Char

\ ~n@97 -> 'a'      :: Int       -> Char

\ n -> ('a', n+1)   :: Int       -> (Char, Int)

\ n -> (['a'], n+1) :: Int       -> ([Char], Int)
getChar             :: RealWorld -> (Char, RealWorld)

getLine             :: RealWorld -> ([Char], RealWorld)
data RealWorld  -- extremely abstract!

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

I/O in Haskell, simplified

An unlikely type

Running with the `RealWorld`

`(>>=)` and `do` notation

Mutable data (references, arrays, hash tables...)

Encapsulated mutable data: ST

I/O actions as values

Example: a list of I/O actions

Example: returning an I/O action as a result

Example: a memory allocator generator

Example: emulating OOP with record types

Exception handling (under development)

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

Foreign calls

All about the `foreign` declaration

Marshalling simple types

Memory management

Marshalling strings

Marshalling composite types

Dynamic calls

DLLs

The dark side of the I/O monad

unsafePerformIO

inlinePerformIO

unsafeInterleaveIO

Welcome to the machine: the actual GHC implementation

The Yhc/nhc98 implementation

Further reading

To-do list

Haskell is a pure language

I/O in Haskell, simplified

An unlikely type

Running with the RealWorld

(>>=) and do notation

Mutable data (references, arrays, hash tables...)

Encapsulated mutable data: ST

I/O actions as values

Example: a list of I/O actions

Example: returning an I/O action as a result

Example: a memory allocator generator

Example: emulating OOP with record types

Exception handling (under development)

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

Foreign calls

All about the foreign declaration

Marshalling simple types

Memory management

Marshalling strings

Marshalling composite types

Dynamic calls

DLLs

The dark side of the I/O monad

unsafePerformIO

inlinePerformIO

unsafeInterleaveIO

Welcome to the machine: the actual GHC implementation

The Yhc/nhc98 implementation

Further reading

To-do list

Running with the `RealWorld`

`(>>=)` and `do` notation

All about the `foreign` declaration