<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> <html> <head> <!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ --> <title>Control/Monad/State/Lazy.hs</title> <link type='text/css' rel='stylesheet' href='hscolour.css' /> </head> <body> <pre><a name="line-1"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span> <a name="line-2"></a><span class='hs-comment'>-- |</span> <a name="line-3"></a><span class='hs-comment'>-- Module : Control.Monad.State.Lazy</span> <a name="line-4"></a><span class='hs-comment'>-- Copyright : (c) Andy Gill 2001,</span> <a name="line-5"></a><span class='hs-comment'>-- (c) Oregon Graduate Institute of Science and Technology, 2001</span> <a name="line-6"></a><span class='hs-comment'>-- License : BSD-style (see the file LICENSE)</span> <a name="line-7"></a><span class='hs-comment'>--</span> <a name="line-8"></a><span class='hs-comment'>-- Maintainer : libraries@haskell.org</span> <a name="line-9"></a><span class='hs-comment'>-- Stability : experimental</span> <a name="line-10"></a><span class='hs-comment'>-- Portability : non-portable (multi-param classes, functional dependencies)</span> <a name="line-11"></a><span class='hs-comment'>--</span> <a name="line-12"></a><span class='hs-comment'>-- Lazy state monads.</span> <a name="line-13"></a><span class='hs-comment'>--</span> <a name="line-14"></a><span class='hs-comment'>-- This module is inspired by the paper</span> <a name="line-15"></a><span class='hs-comment'>-- /Functional Programming with Overloading and Higher-Order Polymorphism/,</span> <a name="line-16"></a><span class='hs-comment'>-- Mark P Jones (<<a href="http://web.cecs.pdx.edu/~mpj/">http://web.cecs.pdx.edu/~mpj/</a>>)</span> <a name="line-17"></a><span class='hs-comment'>-- Advanced School of Functional Programming, 1995.</span> <a name="line-18"></a> <a name="line-19"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span> <a name="line-20"></a> <a name="line-21"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span><span class='hs-varop'>.</span><span class='hs-conid'>Lazy</span> <span class='hs-layout'>(</span> <a name="line-22"></a> <span class='hs-comment'>-- * MonadState class</span> <a name="line-23"></a> <span class='hs-conid'>MonadState</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <a name="line-24"></a> <span class='hs-varid'>modify</span><span class='hs-layout'>,</span> <a name="line-25"></a> <span class='hs-varid'>gets</span><span class='hs-layout'>,</span> <a name="line-26"></a> <span class='hs-comment'>-- * The State monad</span> <a name="line-27"></a> <span class='hs-conid'>State</span><span class='hs-layout'>,</span> <a name="line-28"></a> <span class='hs-varid'>state</span><span class='hs-layout'>,</span> <a name="line-29"></a> <span class='hs-varid'>runState</span><span class='hs-layout'>,</span> <a name="line-30"></a> <span class='hs-varid'>evalState</span><span class='hs-layout'>,</span> <a name="line-31"></a> <span class='hs-varid'>execState</span><span class='hs-layout'>,</span> <a name="line-32"></a> <span class='hs-varid'>mapState</span><span class='hs-layout'>,</span> <a name="line-33"></a> <span class='hs-varid'>withState</span><span class='hs-layout'>,</span> <a name="line-34"></a> <span class='hs-comment'>-- * The StateT monad transformer</span> <a name="line-35"></a> <span class='hs-conid'>StateT</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <a name="line-36"></a> <span class='hs-varid'>evalStateT</span><span class='hs-layout'>,</span> <a name="line-37"></a> <span class='hs-varid'>execStateT</span><span class='hs-layout'>,</span> <a name="line-38"></a> <span class='hs-varid'>mapStateT</span><span class='hs-layout'>,</span> <a name="line-39"></a> <span class='hs-varid'>withStateT</span><span class='hs-layout'>,</span> <a name="line-40"></a> <span class='hs-keyword'>module</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-layout'>,</span> <a name="line-41"></a> <span class='hs-keyword'>module</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>Fix</span><span class='hs-layout'>,</span> <a name="line-42"></a> <span class='hs-keyword'>module</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>Trans</span><span class='hs-layout'>,</span> <a name="line-43"></a> <span class='hs-comment'>-- * Examples</span> <a name="line-44"></a> <span class='hs-comment'>-- $examples</span> <a name="line-45"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span> <a name="line-46"></a> <a name="line-47"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span><span class='hs-varop'>.</span><span class='hs-conid'>Class</span> <a name="line-48"></a> <a name="line-49"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>Trans</span> <a name="line-50"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>Trans</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span><span class='hs-varop'>.</span><span class='hs-conid'>Lazy</span> <a name="line-51"></a> <span class='hs-layout'>(</span><span class='hs-conid'>State</span><span class='hs-layout'>,</span> <span class='hs-varid'>state</span><span class='hs-layout'>,</span> <span class='hs-varid'>runState</span><span class='hs-layout'>,</span> <span class='hs-varid'>evalState</span><span class='hs-layout'>,</span> <span class='hs-varid'>execState</span><span class='hs-layout'>,</span> <span class='hs-varid'>mapState</span><span class='hs-layout'>,</span> <span class='hs-varid'>withState</span><span class='hs-layout'>,</span> <a name="line-52"></a> <span class='hs-conid'>StateT</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>evalStateT</span><span class='hs-layout'>,</span> <span class='hs-varid'>execStateT</span><span class='hs-layout'>,</span> <span class='hs-varid'>mapStateT</span><span class='hs-layout'>,</span> <span class='hs-varid'>withStateT</span><span class='hs-layout'>)</span> <a name="line-53"></a> <a name="line-54"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span> <a name="line-55"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>Fix</span> <a name="line-56"></a> <a name="line-57"></a><span class='hs-comment'>-- ---------------------------------------------------------------------------</span> <a name="line-58"></a><span class='hs-comment'>-- $examples</span> <a name="line-59"></a><span class='hs-comment'>-- A function to increment a counter. Taken from the paper</span> <a name="line-60"></a><span class='hs-comment'>-- /Generalising Monads to Arrows/, John</span> <a name="line-61"></a><span class='hs-comment'>-- Hughes (<<a href="http://www.math.chalmers.se/~rjmh/">http://www.math.chalmers.se/~rjmh/</a>>), November 1998:</span> <a name="line-62"></a><span class='hs-comment'>--</span> <a name="line-63"></a><span class='hs-comment'>-- > tick :: State Int Int</span> <a name="line-64"></a><span class='hs-comment'>-- > tick = do n <- get</span> <a name="line-65"></a><span class='hs-comment'>-- > put (n+1)</span> <a name="line-66"></a><span class='hs-comment'>-- > return n</span> <a name="line-67"></a><span class='hs-comment'>--</span> <a name="line-68"></a><span class='hs-comment'>-- Add one to the given number using the state monad:</span> <a name="line-69"></a><span class='hs-comment'>--</span> <a name="line-70"></a><span class='hs-comment'>-- > plusOne :: Int -> Int</span> <a name="line-71"></a><span class='hs-comment'>-- > plusOne n = execState tick n</span> <a name="line-72"></a><span class='hs-comment'>--</span> <a name="line-73"></a><span class='hs-comment'>-- A contrived addition example. Works only with positive numbers:</span> <a name="line-74"></a><span class='hs-comment'>--</span> <a name="line-75"></a><span class='hs-comment'>-- > plus :: Int -> Int -> Int</span> <a name="line-76"></a><span class='hs-comment'>-- > plus n x = execState (sequence $ replicate n tick) x</span> <a name="line-77"></a><span class='hs-comment'>--</span> <a name="line-78"></a><span class='hs-comment'>-- An example from /The Craft of Functional Programming/, Simon</span> <a name="line-79"></a><span class='hs-comment'>-- Thompson (<<a href="http://www.cs.kent.ac.uk/people/staff/sjt/">http://www.cs.kent.ac.uk/people/staff/sjt/</a>>),</span> <a name="line-80"></a><span class='hs-comment'>-- Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a</span> <a name="line-81"></a><span class='hs-comment'>-- tree of integers in which the original elements are replaced by</span> <a name="line-82"></a><span class='hs-comment'>-- natural numbers, starting from 0. The same element has to be</span> <a name="line-83"></a><span class='hs-comment'>-- replaced by the same number at every occurrence, and when we meet</span> <a name="line-84"></a><span class='hs-comment'>-- an as-yet-unvisited element we have to find a \'new\' number to match</span> <a name="line-85"></a><span class='hs-comment'>-- it with:\"</span> <a name="line-86"></a><span class='hs-comment'>--</span> <a name="line-87"></a><span class='hs-comment'>-- > data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq)</span> <a name="line-88"></a><span class='hs-comment'>-- > type Table a = [a]</span> <a name="line-89"></a><span class='hs-comment'>--</span> <a name="line-90"></a><span class='hs-comment'>-- > numberTree :: Eq a => Tree a -> State (Table a) (Tree Int)</span> <a name="line-91"></a><span class='hs-comment'>-- > numberTree Nil = return Nil</span> <a name="line-92"></a><span class='hs-comment'>-- > numberTree (Node x t1 t2)</span> <a name="line-93"></a><span class='hs-comment'>-- > = do num <- numberNode x</span> <a name="line-94"></a><span class='hs-comment'>-- > nt1 <- numberTree t1</span> <a name="line-95"></a><span class='hs-comment'>-- > nt2 <- numberTree t2</span> <a name="line-96"></a><span class='hs-comment'>-- > return (Node num nt1 nt2)</span> <a name="line-97"></a><span class='hs-comment'>-- > where</span> <a name="line-98"></a><span class='hs-comment'>-- > numberNode :: Eq a => a -> State (Table a) Int</span> <a name="line-99"></a><span class='hs-comment'>-- > numberNode x</span> <a name="line-100"></a><span class='hs-comment'>-- > = do table <- get</span> <a name="line-101"></a><span class='hs-comment'>-- > (newTable, newPos) <- return (nNode x table)</span> <a name="line-102"></a><span class='hs-comment'>-- > put newTable</span> <a name="line-103"></a><span class='hs-comment'>-- > return newPos</span> <a name="line-104"></a><span class='hs-comment'>-- > nNode:: (Eq a) => a -> Table a -> (Table a, Int)</span> <a name="line-105"></a><span class='hs-comment'>-- > nNode x table</span> <a name="line-106"></a><span class='hs-comment'>-- > = case (findIndexInList (== x) table) of</span> <a name="line-107"></a><span class='hs-comment'>-- > Nothing -> (table ++ [x], length table)</span> <a name="line-108"></a><span class='hs-comment'>-- > Just i -> (table, i)</span> <a name="line-109"></a><span class='hs-comment'>-- > findIndexInList :: (a -> Bool) -> [a] -> Maybe Int</span> <a name="line-110"></a><span class='hs-comment'>-- > findIndexInList = findIndexInListHelp 0</span> <a name="line-111"></a><span class='hs-comment'>-- > findIndexInListHelp _ _ [] = Nothing</span> <a name="line-112"></a><span class='hs-comment'>-- > findIndexInListHelp count f (h:t)</span> <a name="line-113"></a><span class='hs-comment'>-- > = if (f h)</span> <a name="line-114"></a><span class='hs-comment'>-- > then Just count</span> <a name="line-115"></a><span class='hs-comment'>-- > else findIndexInListHelp (count+1) f t</span> <a name="line-116"></a><span class='hs-comment'>--</span> <a name="line-117"></a><span class='hs-comment'>-- numTree applies numberTree with an initial state:</span> <a name="line-118"></a><span class='hs-comment'>--</span> <a name="line-119"></a><span class='hs-comment'>-- > numTree :: (Eq a) => Tree a -> Tree Int</span> <a name="line-120"></a><span class='hs-comment'>-- > numTree t = evalState (numberTree t) []</span> <a name="line-121"></a><span class='hs-comment'>--</span> <a name="line-122"></a><span class='hs-comment'>-- > testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil</span> <a name="line-123"></a><span class='hs-comment'>-- > numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil</span> <a name="line-124"></a><span class='hs-comment'>--</span> <a name="line-125"></a><span class='hs-comment'>-- sumTree is a little helper function that does not use the State monad:</span> <a name="line-126"></a><span class='hs-comment'>--</span> <a name="line-127"></a><span class='hs-comment'>-- > sumTree :: (Num a) => Tree a -> a</span> <a name="line-128"></a><span class='hs-comment'>-- > sumTree Nil = 0</span> <a name="line-129"></a><span class='hs-comment'>-- > sumTree (Node e t1 t2) = e + (sumTree t1) + (sumTree t2)</span> </pre></body> </html>
