Craft3e 0.1.0.10 → 0.1.1.0
raw patch · 69 files changed
+1186/−668 lines, 69 filesdep ~mtl
Dependency ranges changed: mtl
Files
- Calculator/CalcEval.hs +5/−5
- Calculator/CalcParse.hs +13/−13
- Calculator/CalcParseLib.hs +32/−24
- Calculator/CalcStore.hs +7/−7
- Calculator/CalcToplevel.hs +5/−5
- Calculator/CalcTypes.hs +9/−9
- Chapter1.hs +7/−7
- Chapter10.hs +26/−26
- Chapter11.hs +11/−11
- Chapter12.hs +7/−7
- Chapter13.hs +20/−20
- Chapter14_1.hs +11/−11
- Chapter14_2.hs +4/−4
- Chapter15/CodeTable.hs +18/−18
- Chapter15/Coding.hs +18/−18
- Chapter15/Frequency.hs +29/−29
- Chapter15/Main.hs +3/−3
- Chapter15/MakeCode.hs +8/−8
- Chapter15/MakeTree.hs +19/−19
- Chapter15/Test.hs +2/−2
- Chapter15/Types.hs +9/−9
- Chapter16/QCStoreTest.hs +3/−3
- Chapter16/Queues1.hs +2/−2
- Chapter16/Queues2.hs +2/−2
- Chapter16/Queues3.hs +3/−3
- Chapter16/Store.hs +7/−7
- Chapter16/StoreFun.hs +5/−5
- Chapter16/StoreTest.hs +6/−6
- Chapter16/Tree.hs +15/−15
- Chapter16/UseStore.hs +5/−5
- Chapter16/UseStoreFun.hs +5/−5
- Chapter16/UseTree.hs +14/−14
- Chapter17.hs +13/−13
- Chapter18.hs +38/−30
- Chapter19/ParseLib.hs +140/−0
- Chapter19/Pic.hs +63/−0
- Chapter19/Pictures.hs +256/−0
- Chapter19/QC.hs +4/−4
- Chapter19/QCfuns.hs +37/−0
- Chapter19/RegExp.hs +4/−4
- Chapter2.hs +11/−11
- Chapter20/Chapter20.hs +6/−6
- Chapter20/PerformanceI.hs +4/−4
- Chapter20/PerformanceIA.hs +4/−4
- Chapter20/PerformanceIS.hs +4/−4
- Chapter3.hs +4/−4
- Chapter4.hs +8/−8
- Chapter5.hs +7/−7
- Chapter6.hs +4/−4
- Chapter7.hs +6/−6
- Chapter8.hs +14/−14
- Chapter9.hs +18/−18
- Craft3e.cabal +2/−2
- Index.hs +5/−4
- ParseLib.hs +34/−26
- ParsingBasics.hs +50/−50
- Pic.hs +4/−4
- Pictures.hs +4/−4
- PicturesSVG.hs +4/−4
- QCfuns.hs +4/−4
- RPS.hs +5/−5
- Relation.hs +40/−40
- Set.hs +23/−23
- Simulation/Base.hs +6/−6
- Simulation/QueueState.hs +8/−8
- Simulation/RandomGen.hs +4/−4
- Simulation/ServerState.hs +7/−7
- Simulation/TopLevelServe.hs +11/−11
- UseMonads.hs +0/−3
Calculator/CalcEval.hs view
@@ -1,12 +1,12 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- CalcEval.hs+-- CalcEval.hs ----- Evaluating expressions and commands+-- Evaluating expressions and commands -- -----------------------------------------------------------------------
Calculator/CalcParse.hs view
@@ -1,12 +1,12 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- CalcParse.hs+-- CalcParse.hs ----- Parsing expressions and commands+-- Parsing expressions and commands -- ----------------------------------------------------------------------- @@ -17,16 +17,16 @@ import CalcTypes import CalcParseLib --- A parser for expressions +-- A parser for expressions -- -- --- The parser has three components, corresponding to the three --- clauses in the definition of the syntactic type. +-- The parser has three components, corresponding to the three +-- clauses in the definition of the syntactic type. -- parseExpr :: Parse Char Expr parseExpr = (litParse `alt` varParse) `alt` opExpParse -- --- Spotting variables. +-- Spotting variables. -- varParse :: Parse Char Expr varParse = spot isVar `build` Var@@ -34,7 +34,7 @@ isVar :: Char -> Bool isVar x = ('a' <= x && x <= 'z') -- --- Parsing (fully bracketed) operator applications. +-- Parsing (fully bracketed) operator applications. -- opExpParse = (token '(' >*>@@ -90,10 +90,10 @@ else n0 where nch = fromEnum ch - n0 = fromEnum '0' + n0 = fromEnum '0' -- --- The top-level parser +-- The top-level parser -- -- the b value is the result to be returned if there's no successful parse -- otherwise return the result of the first successful parse@@ -106,7 +106,7 @@ where results = [ found | (found,[]) <- p inp ] --- A parse for the type of commands. +-- A parse for the type of commands. -- parseCommand :: Parse Char Command
Calculator/CalcParseLib.hs view
@@ -1,12 +1,12 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- -- CalcParseLib.hs ----- Library functions for parsing +-- Library functions for parsing -- Note that this is not a monadic approach to parsing. -- -----------------------------------------------------------------------@@ -14,45 +14,46 @@ module CalcParseLib where +import Control.Monad (liftM, ap) import Data.Char infixr 5 >*> -- --- The type of parsers. +-- The type of parsers. -- type Parse a b = [a] -> [(b,[a])] -- --- Some basic parsers +-- Some basic parsers -- -- --- Fail on any input. +-- Fail on any input. -- none :: Parse a b none inp = [] -- --- Succeed, returning the value supplied. +-- Succeed, returning the value supplied. -- succeed :: b -> Parse a b succeed val inp = [(val,inp)] -- --- token t recognises t as the first value in the input. +-- token t recognises t as the first value in the input. -- token :: Eq a => a -> Parse a a token t (x:xs) - | t==x = [(t,xs)]- | otherwise = []+ | t==x = [(t,xs)]+ | otherwise = [] token t [] = [] -- --- spot whether an element with a particular property is the --- first element of input. +-- spot whether an element with a particular property is the +-- first element of input. -- spot :: (a -> Bool) -> Parse a a spot p (x:xs) - | p x = [(x,xs)]- | otherwise = []+ | p x = [(x,xs)]+ | otherwise = [] spot p [] = [] -- --- Examples. +-- Examples. -- bracket = token '(' dig = spot isDigit@@ -63,31 +64,31 @@ endOfInput x [] = [(x,[])] endOfInput x _ = [] -- --- Combining parsers +-- Combining parsers -- -- --- alt p1 p2 recognises anything recogniseed by p1 or by p2. +-- alt p1 p2 recognises anything recogniseed by p1 or by p2. -- alt :: Parse a b -> Parse a b -> Parse a b alt p1 p2 inp = p1 inp ++ p2 inp exam1 = (bracket `alt` dig) "234" -- --- Apply one parser then the second to the result(s) of the first. +-- Apply one parser then the second to the result(s) of the first. -- (>*>) :: Parse a b -> Parse a c -> Parse a (b,c)--- +-- (>*>) p1 p2 inp = [((y,z),rem2) | (y,rem1) <- p1 inp , (z,rem2) <- p2 rem1 ] -- --- Transform the results of the parses according to the function. +-- Transform the results of the parses according to the function. -- build :: Parse a b -> (b -> c) -> Parse a c build p f inp = [ (f x,rem) | (x,rem) <- p inp ] -- --- Recognise a list of objects. +-- Recognise a list of objects. -- --- +-- list :: Parse a b -> Parse a [b] list p = (succeed []) `alt`@@ -97,7 +98,7 @@ -- -- Some variants... --- A non-empty list of objects. +-- A non-empty list of objects. -- neList :: Parse a b -> Parse a [b] neList p = (p `build` (:[]))@@ -127,3 +128,10 @@ fail s = SParse none (SParse pr) >>= f = SParse (\st -> concat [ sparse (f x) rest | (x,rest) <- pr st ])++instance Applicative (SParse a) where+ pure = return+ (<*>) = ap++instance Functor (SParse a) where+ fmap = liftM
Calculator/CalcStore.hs view
@@ -1,13 +1,13 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- -- CalcStore.hs -- -- An abstract data type of stores of integers, implemented as--- a list of pairs of variables and values. +-- a list of pairs of variables and values. -- ----------------------------------------------------------------------- @@ -20,7 +20,7 @@ update -- Store -> Var -> Integer -> Store ) where -import CalcTypes +import CalcTypes -- The implementation is given by a newtype declaration, with one -- constructor, taking an argument of type [ (Int,Var) ].@@ -28,10 +28,10 @@ data Store = Sto [ (Integer,Var) ] instance Eq Store where - (Sto sto1) == (Sto sto2) = (sto1 == sto2) + (Sto sto1) == (Sto sto2) = (sto1 == sto2) instance Show Store where- showsPrec n (Sto sto) = showsPrec n sto + showsPrec n (Sto sto) = showsPrec n sto -- initial :: Store
Calculator/CalcToplevel.hs view
@@ -1,12 +1,12 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- CalcToplevel.hs+-- CalcToplevel.hs ----- Top-level interaction loop for a calculator+-- Top-level interaction loop for a calculator -- -----------------------------------------------------------------------
Calculator/CalcTypes.hs view
@@ -1,25 +1,25 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- CalcTypes.hs+-- CalcTypes.hs ----- Types for the calculator+-- Types for the calculator -- ----------------------------------------------------------------------- module CalcTypes where -data Expr = Lit Integer | Var Var | Op Ops Expr Expr deriving (Eq,Show)+data Expr = Lit Integer | Var Var | Op Ops Expr Expr deriving (Eq,Show) -data Ops = Add | Sub | Mul | Div | Mod deriving (Eq,Show)+data Ops = Add | Sub | Mul | Div | Mod deriving (Eq,Show) -type Var = Char +type Var = Char -data Command = Eval Expr | Assign Var Expr | Null deriving (Eq,Show)+data Command = Eval Expr | Assign Var Expr | Null deriving (Eq,Show)
Chapter1.hs view
@@ -1,14 +1,14 @@ ------------------------------------------------------------------------- -- --- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- Chapter 1+-- Chapter 1 -- --- The Pictures example code is given in the file Pitures.hs.--- This file can be used by importing it; more details are given in--- Chapter 2.+-- The Pictures example code is given in the file Pitures.hs.+-- This file can be used by importing it; more details are given in+-- Chapter 2. -- -------------------------------------------------------------------------
Chapter10.hs view
@@ -1,10 +1,10 @@ ------------------------------------------------------------------------------ ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- Chapter 10+-- Chapter 10 -- ------------------------------------------------------------------------- @@ -25,10 +25,10 @@ map,map' :: (a -> b) -> [a] -> [b] -map' f xs = [ f x | x <- xs ] -- (map.0)+map' f xs = [ f x | x <- xs ] -- (map.0) -map f [] = [] -- (map.1)-map f (x:xs) = f x : map f xs -- (map.2)+map f [] = [] -- (map.1)+map f (x:xs) = f x : map f xs -- (map.2) -- Examples using map. @@ -36,9 +36,9 @@ doubleAll :: [Integer] -> [Integer] -doubleAll xs = map double xs - where - double x = 2*x+doubleAll xs = map double xs + where + double x = 2*x -- ... convert characters to their numeric codes ... @@ -70,14 +70,14 @@ filter :: (a -> Bool) -> [a] -> [a] -filter p [] = [] -- (filter.1)+filter p [] = [] -- (filter.1) filter p (x:xs)- | p x = x : filter p xs -- (filter.2)- | otherwise = filter p xs -- (filter.3)+ | p x = x : filter p xs -- (filter.2)+ | otherwise = filter p xs -- (filter.3) -- A list comprehension also serves to define filter, -filter' p xs = [ x | x <- xs , p x ] -- (filter.0)+filter' p xs = [ x | x <- xs , p x ] -- (filter.0) -- Combining zip and map -- the zipWith function@@ -99,8 +99,8 @@ foldr1 :: (a -> a -> a) -> [a] -> a -foldr1 f [x] = x -- (foldr1.1)-foldr1 f (x:xs) = f x (foldr1 f xs) -- (foldr1.2)+foldr1 f [x] = x -- (foldr1.1)+foldr1 f (x:xs) = f x (foldr1 f xs) -- (foldr1.2) -- Examples using foldr1 @@ -112,8 +112,8 @@ -- Folding into an arbitrary list: using a starting value on the empty list. -foldr f s [] = s -- (foldr.1)-foldr f s (x:xs) = f x (foldr f s xs) -- (foldr.2)+foldr f s [] = s -- (foldr.1)+foldr f s (x:xs) = f x (foldr f s xs) -- (foldr.2) -- Concatenating a list using foldr. @@ -126,7 +126,7 @@ and bs = foldr (&&) True bs -- Can define foldr1 using foldr:--- foldr1 f (x:xs) = foldr f x xs -- (foldr1.0)+-- foldr1 f (x:xs) = foldr f x xs -- (foldr1.0) -- Folding in general -- foldr again@@ -159,10 +159,10 @@ -- Getting the first word from the front of a String ... getWord :: String -> String-getWord [] = [] -- (getWord.1)+getWord [] = [] -- (getWord.1) getWord (x:xs) - | elem x Chapter7.whitespace = [] -- (getWord.2)- | otherwise = x : getWord xs -- (getWord.3)+ | elem x Chapter7.whitespace = [] -- (getWord.2)+ | otherwise = x : getWord xs -- (getWord.3) -- ... which generalizes to a function which gets items from the front of a list -- until an item has the required property.@@ -175,8 +175,8 @@ -- The original getWord function defined from getUntil --- getWord xs --- = getUntil p xs--- where --- p x = elem x whitespace+-- getWord xs +-- = getUntil p xs+-- where +-- p x = elem x whitespace
Chapter11.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- Chapter 11+-- Chapter 11 -- ----------------------------------------------------------------------- @@ -56,8 +56,8 @@ mapFuns1 fs x = map (\f -> f x) fs mapFuns2 fs x = map applyToX fs- where- applyToX f = f x+ where+ applyToX f = f x -- A function returning a function, namely the function to `add n to its -- argument'.@@ -75,9 +75,9 @@ -- Using the `plumbing' function plumbingExample = comp2 sq add 3 4- where- sq x = x*x- add y z = y+z+ where+ sq x = x*x+ add y z = y+z -- Partial Application@@ -180,8 +180,8 @@ addNum2 :: Integer -> Integer -> Integer addNum2 n = addN- where- addN m = n+m+ where+ addN m = n+m addNum3 n = let addN m = n+m
Chapter12.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- Chapter 12+-- Chapter 12 -- ----------------------------------------------------------------------- @@ -13,7 +13,7 @@ module Chapter12 where import Pictures hiding (flipH,rotate,flipV,beside,invertColour,- superimpose,printPicture)+ superimpose,printPicture) -- Revisiting the Pictures example, yet again.@@ -151,8 +151,8 @@ clean = map toSmall . filter notPunct -toSmall = toSmall -- dummy definition-notPunct = notPunct -- dummy definition+toSmall = toSmall -- dummy definition+notPunct = notPunct -- dummy definition -- Auxiliary functions
Chapter13.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- Chapter 13+-- Chapter 13 -- ----------------------------------------------------------------------- @@ -152,7 +152,7 @@ iSort :: Ord a => [a] -> [a] -iSort [] = []+iSort [] = [] iSort (x:xs) = ins x (iSort xs) -- To insert an element at the right place into a sorted list.@@ -161,8 +161,8 @@ ins x [] = [x] ins x (y:ys)- | x <= y = x:(y:ys)- | otherwise = y : ins x ys+ | x <= y = x:(y:ys)+ | otherwise = y : ins x ys -- Multiple constraints@@ -191,7 +191,7 @@ -- Can then give vSort the type: --- vSort :: OrdVis a => [a] -> String+-- vSort :: OrdVis a => [a] -> String -- InfoCheck. Check a property for all examples @@ -228,7 +228,7 @@ -- To evaluate the type of concat . map show, type --- :type concat . map show+-- :type concat . map show -- to the Hugs prompt. @@ -248,20 +248,20 @@ example1 = fromEnum 'c' + 3 --- example2 = fromEnum 'c' + False+-- example2 = fromEnum 'c' + False --- f n = 37+n--- f True = 34+-- f n = 37+n+-- f True = 34 --- g 0 = 37--- g n = True+-- g 0 = 37+-- g n = True --- h x --- | x>0 = True--- | otherwise = 37+-- h x +-- | x>0 = True+-- | otherwise = 37 --- k x = 34--- k 0 = 35+-- k x = 34+-- k 0 = 35 -- Polymorphic type checking@@ -280,7 +280,7 @@ -- The funny function does not type check. --- funny xs = length (xs++[True]) + length (xs++[2,3,4])+-- funny xs = length (xs++[True]) + length (xs++[2,3,4]) -- Type checking and classes
Chapter14_1.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- Chapter 14, part 1+-- Chapter 14, part 1 -- Also covers the properties in Section 14.7 -- -----------------------------------------------------------------------@@ -42,7 +42,7 @@ -- The Ordering type, as used in the class Ord. --- data Ordering = LT | EQ | GT+-- data Ordering = LT | EQ | GT -- Declaring Temp an instance of Eq. @@ -82,13 +82,13 @@ -- Showing an expression. --- instance Show Expr where+-- instance Show Expr where -- --- show (Lit n) = show n--- show (Add e1 e2) --- = "(" ++ show e1 ++ "+" ++ show e2 ++ ")"--- show (Sub e1 e2) --- = "(" ++ show e1 ++ "-" ++ show e2 ++ ")"+-- show (Lit n) = show n+-- show (Add e1 e2) +-- = "(" ++ show e1 ++ "+" ++ show e2 ++ ")"+-- show (Sub e1 e2) +-- = "(" ++ show e1 ++ "-" ++ show e2 ++ ")" -- Trees of integers
Chapter14_2.hs view
@@ -1,10 +1,10 @@ -------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- Chapter 14, part 2+-- Chapter 14, part 2 -- Details of the Simulation case study in the Simulation directory. -- --------------------------------------------------------------------
Chapter15/CodeTable.hs view
@@ -1,18 +1,18 @@ ------------------------------------------------------------------------- -- --- CodeTable.hs --- --- Converting a Huffman tree to a ord table. --- --- (c) Addison-Wesley, 1996-2011. --- +-- CodeTable.hs +-- +-- Converting a Huffman tree to a ord table. +-- +-- (c) Addison-Wesley, 1996-2011. +-- ------------------------------------------------------------------------- module CodeTable ( codeTable ) where import Types ( Tree(Leaf,Node), Bit(L,R), HCode, Table ) --- Making a table from a Huffman tree. +-- Making a table from a Huffman tree. codeTable :: Tree -> Table @@ -20,26 +20,26 @@ -- Auxiliary function used in conversion to a table. The first argument is -- the HCode which codes the path in the tree to the current Node, and so--- codeTable is initialised with an empty such sequence. +-- codeTable is initialised with an empty such sequence. convert :: HCode -> Tree -> Table convert cd (Leaf c n) = [(c,cd)] convert cd (Node n t1 t2)- = (convert (cd++[L]) t1) ++ (convert (cd++[R]) t2)+ = (convert (cd++[L]) t1) ++ (convert (cd++[R]) t2) --- Show functions +-- Show functions -- ^^^^^^^^^^^^^^ --- Show a tree, using indentation to show structure. --- +-- Show a tree, using indentation to show structure. +-- showTree :: Tree -> String showTree t = showTreeIndent 0 t -- The auxiliary function showTreeIndent has a second, current --- level of indentation, as a parameter. +-- level of indentation, as a parameter. showTreeIndent :: Int -> Tree -> String @@ -56,17 +56,17 @@ spaces n = replicate n ' ' --- To show a sequence of Bits. +-- To show a sequence of Bits. showCode :: HCode -> String showCode = map conv- where- conv R = 'R'- conv L = 'L'+ where+ conv R = 'R'+ conv L = 'L' -- To show a table of codes. -showTable :: Table -> String +showTable :: Table -> String showTable = concat . map showPair where
Chapter15/Coding.hs view
@@ -1,11 +1,11 @@ ------------------------------------------------------------------------- -- --- Coding.hs --- --- Huffman coding in Haskell. --- The top-level functions for coding and decoding. --- --- (c) Addison-Wesley, 1996-2011. +-- Coding.hs +-- +-- Huffman coding in Haskell. +-- The top-level functions for coding and decoding. +-- +-- (c) Addison-Wesley, 1996-2011. -- ------------------------------------------------------------------------- @@ -13,28 +13,28 @@ import Types ( Tree(Leaf,Node), Bit(L,R), HCode, Table ) --- Code a message according to a table of codes. +-- Code a message according to a table of codes. codeMessage :: Table -> [Char] -> HCode codeMessage tbl = concat . map (lookupTable tbl) -- lookupTable looks up the meaning of an individual char in--- a Table. +-- a Table. lookupTable :: Table -> Char -> HCode lookupTable [] c = error "lookupTable" lookupTable ((ch,n):tb) c- | (ch==c) = n - | otherwise = lookupTable tb c + | (ch==c) = n + | otherwise = lookupTable tb c --- Decode a message according to a tree. --- --- The first tree arguent is constant, being the tree of codes; --- the second represents the current position in the tree relative --- to the (partial) HCode read so far. +-- Decode a message according to a tree. +-- +-- The first tree arguent is constant, being the tree of codes; +-- the second represents the current position in the tree relative +-- to the (partial) HCode read so far. decodeMessage :: Tree -> HCode -> String@@ -44,12 +44,12 @@ where decodeByt (Node n t1 t2) (L:rest)- = decodeByt t1 rest+ = decodeByt t1 rest decodeByt (Node n t1 t2) (R:rest)- = decodeByt t2 rest+ = decodeByt t2 rest decodeByt (Leaf c n) rest- = c : decodeByt tr rest+ = c : decodeByt tr rest decodeByt t [] = []
Chapter15/Frequency.hs view
@@ -1,23 +1,23 @@ ---------------------------------------------------------------------------- --- Frequency.hs --- --- Calculating the frequencies of words in a text, used in --- Huffman coding. --- --- (c) Addison-Wesley, 1996-2011. --- +-- +-- Frequency.hs +-- +-- Calculating the frequencies of words in a text, used in +-- Huffman coding. +-- +-- (c) Addison-Wesley, 1996-2011. +-- ------------------------------------------------------------------------- module Frequency ( frequency ) where import Test.QuickCheck hiding ( frequency ) --- Calculate the frequencies of characters in a list. --- --- This is done by sorting, then counting the number of --- repetitions. The counting is made part of the merge --- operation in a merge sort. +-- Calculate the frequencies of characters in a list. +-- +-- This is done by sorting, then counting the number of +-- repetitions. The counting is made part of the merge +-- operation in a merge sort. frequency :: [Char] -> [ (Char,Int) ] @@ -26,46 +26,46 @@ where start ch = (ch,1) --- Merge sort parametrised on the merge operation. This is more --- general than parametrising on the ordering operation, since --- it permits amalgamation of elements with equal keys --- for instance. +-- Merge sort parametrised on the merge operation. This is more +-- general than parametrising on the ordering operation, since +-- it permits amalgamation of elements with equal keys +-- for instance. -- mergeSort :: ([a]->[a]->[a]) -> [a] -> [a] mergeSort merge xs- | length xs < 2 = xs - | otherwise + | length xs < 2 = xs + | otherwise = merge (mergeSort merge first)- (mergeSort merge second) + (mergeSort merge second) where first = take half xs second = drop half xs half = (length xs) `div` 2 --- Order on first entry of pairs, with +-- Order on first entry of pairs, with -- accumulation of the numeric entries when equal first entry. -alphaMerge :: [(Char,Int)] -> [(Char,Int)] -> [(Char,Int)] +alphaMerge :: [(Char,Int)] -> [(Char,Int)] -> [(Char,Int)] alphaMerge xs [] = xs alphaMerge [] ys = ys alphaMerge ((p,n):xs) ((q,m):ys)- | (p==q) = (p,n+m) : alphaMerge xs ys - | (p<q) = (p,n) : alphaMerge xs ((q,m):ys) - | otherwise = (q,m) : alphaMerge ((p,n):xs) ys + | (p==q) = (p,n+m) : alphaMerge xs ys + | (p<q) = (p,n) : alphaMerge xs ((q,m):ys) + | otherwise = (q,m) : alphaMerge ((p,n):xs) ys -- Lexicographic ordering, second field more significant.--- -freqMerge :: [(Char,Int)] -> [(Char,Int)] -> [(Char,Int)] +-- +freqMerge :: [(Char,Int)] -> [(Char,Int)] -> [(Char,Int)] freqMerge xs [] = xs freqMerge [] ys = ys freqMerge ((p,n):xs) ((q,m):ys) | (n<m || (n==m && p<q)) - = (p,n) : freqMerge xs ((q,m):ys) + = (p,n) : freqMerge xs ((q,m):ys) | otherwise - = (q,m) : freqMerge ((p,n):xs) ys + = (q,m) : freqMerge ((p,n):xs) ys -- QuickCheck property
Chapter15/Main.hs view
@@ -2,9 +2,9 @@ -- -- Main.hs ----- The main module of the Huffman example+-- The main module of the Huffman example ----- (c) Addison-Wesley, 1996-2011.+-- (c) Addison-Wesley, 1996-2011. -- ------------------------------------------------------------------------- @@ -23,7 +23,7 @@ -- Examples -- ^^^^^^^^ --- The coding table generated from the text "there is a green hill". +-- The coding table generated from the text "there is a green hill". tableEx :: Table tableEx = codeTable (codes "there is a green hill")
Chapter15/MakeCode.hs view
@@ -1,11 +1,11 @@ ---------------------------------------------------------------------------- --- MakeCode.hs --- --- Huffman coding in Haskell. --- --- (c) Addison-Wesley, 1996-2011. --- +-- +-- MakeCode.hs +-- +-- Huffman coding in Haskell. +-- +-- (c) Addison-Wesley, 1996-2011. +-- ------------------------------------------------------------------------- module MakeCode ( codes, codeTable ) where@@ -15,7 +15,7 @@ import MakeTree ( makeTree ) import CodeTable ( codeTable ) --- Putting together frequency calculation and tree conversion +-- Putting together frequency calculation and tree conversion codes :: [Char] -> Tree
Chapter15/MakeTree.hs view
@@ -1,42 +1,42 @@ ---------------------------------------------------------------------------- --- MakeTree.hs --- --- Turn a frequency table into a Huffman tree --- --- (c) Addison-Wesley, 1996-2011. --- +-- +-- MakeTree.hs +-- +-- Turn a frequency table into a Huffman tree +-- +-- (c) Addison-Wesley, 1996-2011. +-- ------------------------------------------------------------------------- module MakeTree ( makeTree ) where import Types ( Tree(Leaf,Node), Bit(L,R), HCode, Table ) --- Convert the trees to a list, then amalgamate into a single --- tree. +-- Convert the trees to a list, then amalgamate into a single +-- tree. makeTree :: [ (Char,Int) ] -> Tree makeTree = makeCodes . toTreeList --- Huffman codes are created bottom up: look for the least --- two frequent letters, make these a new "isAlpha" (i.e. tree) --- and repeat until one tree formed. +-- Huffman codes are created bottom up: look for the least +-- two frequent letters, make these a new "isAlpha" (i.e. tree) +-- and repeat until one tree formed. --- The function toTreeList makes the initial data structure. +-- The function toTreeList makes the initial data structure. toTreeList :: [ (Char,Int) ] -> [ Tree ] toTreeList = map (uncurry Leaf) --- The value of a tree. +-- The value of a tree. value :: Tree -> Int value (Leaf _ n) = n value (Node n _ _) = n --- Pair two trees. +-- Pair two trees. pair :: Tree -> Tree -> Tree @@ -45,7 +45,7 @@ v1 = value t1 v2 = value t2 --- Insert a tree in a list of trees sorted by ascending value. +-- Insert a tree in a list of trees sorted by ascending value. insTree :: Tree -> [Tree] -> [Tree] @@ -53,15 +53,15 @@ insTree t (t1:ts) | (value t <= value t1) = t:t1:ts | otherwise = t1 : insTree t ts--- --- Amalgamate the front two elements of the list of trees. +-- +-- Amalgamate the front two elements of the list of trees. amalgamate :: [ Tree ] -> [ Tree ] amalgamate ( t1 : t2 : ts ) = insTree (pair t1 t2) ts --- Make codes: amalgamate the whole list. +-- Make codes: amalgamate the whole list. makeCodes :: [Tree] -> Tree
Chapter15/Test.hs view
@@ -2,9 +2,9 @@ -- -- Test.hs ----- The test module of the Huffman example+-- The test module of the Huffman example ----- (c) Addison-Wesley, 1996-2011.+-- (c) Addison-Wesley, 1996-2011. -- -------------------------------------------------------------------------
Chapter15/Types.hs view
@@ -1,25 +1,25 @@ ------------------------------------------------------------------------- -- --- Types.hs +-- Types.hs -- --- The types used in the Huffman coding example. --- --- (c) Addison-Wesley, 1996-2011. +-- The types used in the Huffman coding example. +-- +-- (c) Addison-Wesley, 1996-2011. -- ------------------------------------------------------------------------- --- The interface to the module Types is written out --- explicitly here, after the module name. +-- The interface to the module Types is written out +-- explicitly here, after the module name. module Types ( Tree(Leaf,Node), Bit(L,R), HCode , Table ) where --- Trees to represent the relative frequencies of characters --- and therefore the Huffman codes. +-- Trees to represent the relative frequencies of characters +-- and therefore the Huffman codes. data Tree = Leaf Char Int | Node Int Tree Tree --- The types of bits, Huffman codes and tables of Huffman codes. +-- The types of bits, Huffman codes and tables of Huffman codes. data Bit = L | R deriving (Eq,Show)
Chapter16/QCStoreTest.hs view
@@ -1,9 +1,9 @@ ------------------------------------------------------------------------- -- --- QCStoreTest.hs +-- QCStoreTest.hs -- --- QuickCheck tests for stores. -- --- (c) Addison-Wesley, 1996-2011. +-- QuickCheck tests for stores. -- +-- (c) Addison-Wesley, 1996-2011. -- -------------------------------------------------------------------------
Chapter16/Queues1.hs view
@@ -4,8 +4,8 @@ -- -- An abstract data type of queues, implemented as a list, with -- new elements added at the end of the list.--- --- (c) Addison-Wesley, 1996-2011. +-- +-- (c) Addison-Wesley, 1996-2011. -- -------------------------------------------------------------------------
Chapter16/Queues2.hs view
@@ -4,8 +4,8 @@ -- -- An abstract data type of queues, implemnted as a list, with -- new elements added at the beginning of the list.--- --- (c) Addison-Wesley, 1996-2011. +-- +-- (c) Addison-Wesley, 1996-2011. -- -------------------------------------------------------------------------
Chapter16/Queues3.hs view
@@ -3,9 +3,9 @@ -- Queues3.hs -- -- An abstract data type of queues, implemnted as two lists, with--- new elements added at the beginning of the second list. --- --- (c) Addison-Wesley, 1996-2011. +-- new elements added at the beginning of the second list. +-- +-- (c) Addison-Wesley, 1996-2011. -- -------------------------------------------------------------------------
Chapter16/Store.hs view
@@ -1,11 +1,11 @@ ------------------------------------------------------------------------- -- --- Store.hs+-- Store.hs -- -- An abstract data type of stores of integers, implemented as--- a list of pairs of variables and values. --- --- (c) Addison-Wesley, 1996-2011. +-- a list of pairs of variables and values. +-- +-- (c) Addison-Wesley, 1996-2011. -- ------------------------------------------------------------------------- @@ -16,7 +16,7 @@ update -- Store -> Var -> Integer -> Store ) where --- Var is the type of variables. +-- Var is the type of variables. type Var = Char @@ -26,10 +26,10 @@ data Store = Store [ (Integer,Var) ] instance Eq Store where - (Store sto1) == (Store sto2) = (sto1 == sto2) + (Store sto1) == (Store sto2) = (sto1 == sto2) instance Show Store where- showsPrec n (Store sto) = showsPrec n sto + showsPrec n (Store sto) = showsPrec n sto -- initial :: Store
Chapter16/StoreFun.hs view
@@ -1,10 +1,10 @@ ------------------------------------------------------------------------- -- --- StoreFun.hs+-- StoreFun.hs -- -- An abstract data type of stores of integers, implemented as functions.--- --- (c) Addison-Wesley, 1996-2011. +-- +-- (c) Addison-Wesley, 1996-2011. -- ------------------------------------------------------------------------- @@ -21,11 +21,11 @@ update -- Store -> Var -> Integer -> Store ) where --- Var is the type of variables. +-- Var is the type of variables. type Var = Char -newtype Store = Store (Var -> Integer) +newtype Store = Store (Var -> Integer) -- initial :: Store
Chapter16/StoreTest.hs view
@@ -1,11 +1,11 @@ ------------------------------------------------------------------------- -- --- StoreTest.hs+-- StoreTest.hs -- -- An abstract data type of stores of integers, together with -- QuickCheck generator.--- --- (c) Addison-Wesley, 1996-2011. +-- +-- (c) Addison-Wesley, 1996-2011. -- ------------------------------------------------------------------------- @@ -19,7 +19,7 @@ import Test.QuickCheck --- Var is the type of variables. +-- Var is the type of variables. type Var = Char @@ -29,10 +29,10 @@ data Store = Store [ (Integer,Var) ] instance Eq Store where - (Store sto1) == (Store sto2) = (sto1 == sto2) + (Store sto1) == (Store sto2) = (sto1 == sto2) instance Show Store where- showsPrec n (Store sto) = showsPrec n sto + showsPrec n (Store sto) = showsPrec n sto -- initial :: Store
Chapter16/Tree.hs view
@@ -2,9 +2,9 @@ -- -- Tree.hs -- --- Search trees as an ADT --- --- (c) Addison-Wesley, 1996-2011. +-- Search trees as an ADT +-- +-- (c) Addison-Wesley, 1996-2011. -- ------------------------------------------------------------------------- @@ -23,7 +23,7 @@ ) where -data Tree a = Nil | Node a (Tree a) (Tree a) +data Tree a = Nil | Node a (Tree a) (Tree a) -- nil :: Tree a@@ -56,26 +56,26 @@ insTree val Nil = (Node val Nil Nil) insTree val (Node v t1 t2)- | v==val = Node v t1 t2- | val > v = Node v t1 (insTree val t2) - | val < v = Node v (insTree val t1) t2 + | v==val = Node v t1 t2+ | val > v = Node v t1 (insTree val t2) + | val < v = Node v (insTree val t1) t2 delete :: Ord a => a -> Tree a -> Tree a delete val (Node v t1 t2)- | val < v = Node v (delete val t1) t2- | val > v = Node v t1 (delete val t2)- | isNil t2 = t1- | isNil t1 = t2- | otherwise = join t1 t2+ | val < v = Node v (delete val t1) t2+ | val > v = Node v t1 (delete val t2)+ | isNil t2 = t1+ | isNil t1 = t2+ | otherwise = join t1 t2 minTree :: Ord a => Tree a -> Maybe a minTree t- | isNil t = Nothing- | isNil t1 = Just v- | otherwise = minTree t1+ | isNil t = Nothing+ | isNil t1 = Just v+ | otherwise = minTree t1 where t1 = leftSub t v = treeVal t
Chapter16/UseStore.hs view
@@ -1,10 +1,10 @@ ------------------------------------------------------------------------- -- --- UseStore.hs+-- UseStore.hs -- --- Using the abstract data type Store of stores of integers. --- --- (c) Addison-Wesley, 1996-2011. +-- Using the abstract data type Store of stores of integers. +-- +-- (c) Addison-Wesley, 1996-2011. -- ------------------------------------------------------------------------- @@ -13,7 +13,7 @@ import Store --- Testing the exported definitions of the show and equality. +-- Testing the exported definitions of the show and equality. exam1 = show initial
Chapter16/UseStoreFun.hs view
@@ -1,13 +1,13 @@ ------------------------------------------------------------------------- -- --- UseStoreFun.hs+-- UseStoreFun.hs -- --- Using an abstract data type StoreFun of stores of integers. --- --- (c) Addison-Wesley, 1996-2011. +-- Using an abstract data type StoreFun of stores of integers. +-- +-- (c) Addison-Wesley, 1996-2011. -- -------------------------------------------------------------------------- + module UseStoreFun where
Chapter16/UseTree.hs view
@@ -2,38 +2,38 @@ -- -- UseTree.hs -- --- Using the search tree ADT --- --- (c) Addison-Wesley, 1996-2011. +-- Using the search tree ADT +-- +-- (c) Addison-Wesley, 1996-2011. -- -------------------------------------------------------------------------- + module UseTree where -import Tree +import Tree -- --- The size function definable using the operations of the --- abstype. +-- The size function definable using the operations of the +-- abstype. -- size :: Tree a -> Integer size t - | isNil t = 0- | otherwise = 1 + size (leftSub t) + size (rightSub t)+ | isNil t = 0+ | otherwise = 1 + size (leftSub t) + size (rightSub t) -- --- Finding the nth element of a tree. +-- Finding the nth element of a tree. -- indexT :: Integer -> Tree a -> a indexT n t - | isNil t = error "indexT"- | n < st1 = indexT n t1- | n == st1 = v- | otherwise = indexT (n-st1-1) t2+ | isNil t = error "indexT"+ | n < st1 = indexT n t1+ | n == st1 = v+ | otherwise = indexT (n-st1-1) t2 where v = treeVal t t1 = leftSub t
Chapter17.hs view
@@ -1,12 +1,12 @@ ------------------------------------------------------------------------- -- --- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- Chapter 17+-- Chapter 17 -- --- Lazy programming.+-- Lazy programming. -- ------------------------------------------------------------------------- @@ -16,10 +16,10 @@ module Chapter17 where -import Data.List ((\\)) -import Chapter13 (iSort) -- for iSort-import Set -- for Relation-import Relation -- for graphs+import Data.List ((\\)) +import Chapter13 (iSort) -- for iSort+import Set -- for Relation+import Relation -- for graphs -- Lazy evaluation -- ^^^^^^^^^^^^^^^@@ -207,7 +207,7 @@ | x==y = [[x]] | otherwise = [ x:r | z <- nbhrs rel x , r <- routes rel z y ]--- +-- -- The neighbours of a point in a graph. nbhrs :: Ord a => Relation a -> a -> [a]@@ -279,8 +279,8 @@ -- Iterating a function (from the Prelude) --- iterate :: (a -> a) -> a -> [a]--- iterate f x = x : iterate f (f x)+-- iterate :: (a -> a) -> a -> [a]+-- iterate f x = x : iterate f (f x) -- Sieve of Eratosthenes @@ -417,7 +417,7 @@ fac 0 = 1 fac m = m * fac (m-1)--- +-- -- Two factorial lists facMap, facs :: [Int]
Chapter18.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- Chapter 18+-- Chapter 18 -- ----------------------------------------------------------------------- @@ -13,10 +13,11 @@ import Prelude hiding (lookup) import System.IO +import Control.Monad (liftM, ap) import Control.Monad.Identity import Chapter8 (getInt) import Data.Time-import System.Locale+import System.Locale hiding (defaultTimeLocale) import System.IO.Unsafe (unsafePerformIO) -- Programming with monads@@ -28,13 +29,13 @@ -- Reading input is done by getLine and getChar: see Prelude for details. --- getLine :: IO String--- getChar :: IO Char+-- getLine :: IO String+-- getChar :: IO Char -- Text strings are written using --- --- putStr :: String -> IO ()--- putStrLn :: String -> IO ()+-- +-- putStr :: String -> IO ()+-- putStrLn :: String -> IO () -- A hello, world program @@ -159,10 +160,10 @@ -- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -- The definition of the Monad class--- class Monad m where--- (>>=) :: m a -> (a -> m b) -> m b--- return :: a -> m a--- fail :: String -> m a+-- class Monad m where+-- (>>=) :: m a -> (a -> m b) -> m b+-- return :: a -> m a+-- fail :: String -> m a -- Kelisli composition for monadic functions. @@ -180,31 +181,31 @@ -- The list monad --- instance Monad [] where--- xs >>= f = concat (map f xs)--- return x = [x]--- zero = []+-- instance Monad [] where+-- xs >>= f = concat (map f xs)+-- return x = [x]+-- zero = [] -- The Maybe monad --- instance Monad Maybe where--- (Just x) >>= k = k x--- Nothing >>= k = Nothing--- return = Just+-- instance Monad Maybe where+-- (Just x) >>= k = k x+-- Nothing >>= k = Nothing+-- return = Just -- The parsing monad --- data SParse a b = SParse (Parse a b)+-- data SParse a b = SParse (Parse a b) --- instance Monad (SParse a) where--- return x = SParse (succeed x)--- zero = SParse fail--- (SParse pr) >>= f --- = SParse (\s -> concat [ sparse (f x) rest | (x,rest) <- pr st ])+-- instance Monad (SParse a) where+-- return x = SParse (succeed x)+-- zero = SParse fail+-- (SParse pr) >>= f +-- = SParse (\s -> concat [ sparse (f x) rest | (x,rest) <- pr st ]) --- sparse :: SParse a b -> Parse a b--- sparse (SParse pr) = pr+-- sparse :: SParse a b -> Parse a b+-- sparse (SParse pr) = pr -- A state monad (the state need not be a table; this example is designed -- to support the example discussed below.)@@ -223,6 +224,13 @@ (State trans) = f y in trans newTab)++instance Applicative (State a) where+ pure = return+ (<*>) = ap++instance Functor (State a) where+ fmap = liftM -- Example: Monadic computation over trees
+ Chapter19/ParseLib.hs view
@@ -0,0 +1,140 @@+-------------------------------------------------------------------------+-- +-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011.+-- +-- ParseLib.hs+-- +-- Library functions for parsing +-- Note that this is not a monadic approach to parsing. +-- +--------------------------------------------------------------------------- ++module ParseLib where++import Control.Monad (liftM, ap)+import Data.Char++infixr 5 >*>+-- +-- The type of parsers. +-- +type Parse a b = [a] -> [(b,[a])]+-- +-- Some basic parsers +-- +-- +-- Fail on any input. +-- +none :: Parse a b+none inp = []+-- +-- Succeed, returning the value supplied. +-- +succeed :: b -> Parse a b +succeed val inp = [(val,inp)]+-- +-- token t recognises t as the first value in the input. +-- +token :: Eq a => a -> Parse a a+token t (x:xs) + | t==x = [(t,xs)]+ | otherwise = []+token t [] = []+-- +-- spot whether an element with a particular property is the +-- first element of input. +-- +spot :: (a -> Bool) -> Parse a a+spot p (x:xs) + | p x = [(x,xs)]+ | otherwise = []+spot p [] = []+-- +-- Examples. +-- +bracket = token '('+dig = spot isDigit++-- Succeeds with value given when the input is empty.++endOfInput :: b -> Parse a b+endOfInput x [] = [(x,[])]+endOfInput x _ = []+-- +-- Combining parsers +-- +-- +-- alt p1 p2 recognises anything recogniseed by p1 or by p2. +-- +alt :: Parse a b -> Parse a b -> Parse a b+alt p1 p2 inp = p1 inp ++ p2 inp+exam1 = (bracket `alt` dig) "234" +-- +-- Apply one parser then the second to the result(s) of the first. +-- ++(>*>) :: Parse a b -> Parse a c -> Parse a (b,c)+-- +(>*>) p1 p2 inp + = [((y,z),rem2) | (y,rem1) <- p1 inp , (z,rem2) <- p2 rem1 ]+-- +-- Transform the results of the parses according to the function. +-- +build :: Parse a b -> (b -> c) -> Parse a c+build p f inp = [ (f x,rem) | (x,rem) <- p inp ]+-- +-- Recognise a list of objects. +-- +-- +list :: Parse a b -> Parse a [b]+list p = (succeed []) + `alt`+ ((p >*> list p) `build` convert)+ where+ convert = uncurry (:)+-- +-- Some variants...++-- A non-empty list of objects. +-- +neList :: Parse a b -> Parse a [b]+neList p = (p `build` (:[]))+ `alt`+ ((p >*> list p) `build` (uncurry (:)))++-- Zero or one object.++optional :: Parse a b -> Parse a [b]+optional p = (succeed []) + `alt` + (p `build` (:[]))++-- A given number of objects.++nTimes :: Int -> Parse a b -> Parse a [b]+nTimes 0 p = succeed []+nTimes n p = (p >*> nTimes (n-1) p) `build` (uncurry (:))+-- +-- Monadic parsing++data SParse a b = SParse (Parse a b)++instance Monad (SParse a) where+ return x = SParse (succeed x)+ (SParse pr) >>= f + = SParse (\st -> concat [ sparse (f a) rest | (a,rest) <- pr st ])++instance Applicative (SParse a) where+ pure = return+ (<*>) = ap++instance Functor (SParse a) where+ fmap = liftM++sparse :: SParse a b -> Parse a b++sparse (SParse pr) = pr++
+ Chapter19/Pic.hs view
@@ -0,0 +1,63 @@+-----------------------------------------------------------------------+--+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011.+--+-- Pic.hs+-- +-- A deep embedding of pictures+--+-----------------------------------------------------------------------++module Pic where++import Pictures++-- Data type representing pictures++data Pic = Horse |+ Above Pic Pic |+ Beside Pic Pic |+ FlipH Pic |+ FlipV Pic ++-- Interpreting a Pic as a Picture++interpretPic :: Pic -> Picture++interpretPic Horse = horse+interpretPic (Above pic1 pic2)+ = above (interpretPic pic1) (interpretPic pic2)+interpretPic (Beside pic1 pic2)+ = beside (interpretPic pic1) (interpretPic pic2)+interpretPic (FlipH pic)+ = flipH (interpretPic pic)+interpretPic (FlipV pic)+ = flipV (interpretPic pic)++-- Tidying up a picture ...++-- remove pairs of flips+-- push flips through placement above / beside++tidyPic :: Pic -> Pic++tidyPic (FlipV (FlipV pic)) + = tidyPic pic+tidyPic (FlipV (FlipH pic)) + = FlipH (tidyPic (FlipV pic)) ++tidyPic (FlipV (Above pic1 pic2))+ = Above (tidyPic (FlipV pic1)) (tidyPic (FlipV pic2)) +tidyPic (FlipV (Beside pic1 pic2))+ = Beside (tidyPic (FlipV pic2)) (tidyPic (FlipV pic1)) ++tidyPic (FlipH (FlipH pic)) + = tidyPic pic+ +tidyPic (FlipH (Above pic1 pic2))+ = Above (tidyPic (FlipH pic2)) (tidyPic (FlipH pic1)) +tidyPic (FlipH (Beside pic1 pic2))+ = Beside (tidyPic (FlipH pic1)) (tidyPic (FlipH pic2)) +
+ Chapter19/Pictures.hs view
@@ -0,0 +1,256 @@+-----------------------------------------------------------------------+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2010.+--+-- Pictures.hs+-- +-- An implementation of a type of rectangular pictures +-- using lists of lists of characters. +-----------------------------------------------------------------------++++-- The basics+-- ^^^^^^^^^^++module Pictures where+import Test.QuickCheck+++type Picture = [[Char]]++-- The example used in Craft2e: a polygon which looks like a horse. Here+-- taken to be a 16 by 12 rectangle.++horse :: Picture++horse = [".......##...",+ ".....##..#..",+ "...##.....#.",+ "..#.......#.",+ "..#...#...#.",+ "..#...###.#.",+ ".#....#..##.",+ "..#...#.....",+ "...#...#....",+ "....#..#....",+ ".....#.#....",+ "......##...."]++-- Completely white and black pictures.++white :: Picture++white = ["......",+ "......",+ "......",+ "......",+ "......",+ "......"]++black = ["######",+ "######",+ "######",+ "######",+ "######",+ "######"]++-- Getting a picture onto the screen.++printPicture :: Picture -> IO ()++printPicture = putStr . concat . map (++"\n")+++-- Transformations of pictures.+-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^++-- Reflection in a vertical mirror.++flipV :: Picture -> Picture++flipV = map reverse++-- Reflection in a horizontal mirror.++flipH :: Picture -> Picture++flipH = reverse++-- Rotation through 180 degrees, by composing vertical and horizontal+-- reflection. Note that it can also be done by flipV.flipH, and that we+-- can prove equality of the two functions.++rotate :: Picture -> Picture++rotate = flipH . flipV++-- One picture above another. To maintain the rectangular property,+-- the pictures need to have the same width.++above :: Picture -> Picture -> Picture++above = (++)++-- One picture next to another. To maintain the rectangular property,+-- the pictures need to have the same height.++beside :: Picture -> Picture -> Picture++beside = zipWith (++)++-- Superimose one picture above another. Assume the pictures to be the same+-- size. The individual characters are combined using the combine function.++superimpose :: Picture -> Picture -> Picture++superimpose = zipWith (zipWith combine)++-- For the result to be '.' both components have to the '.'; otherwise+-- get the '#' character.++combine :: Char -> Char -> Char++combine topCh bottomCh+ = if (topCh == '.' && bottomCh == '.') + then '.'+ else '#'++-- Inverting the colours in a picture; done pointwise by invert...++invertColour :: Picture -> Picture++invertColour = map (map invert)++-- ... which works by making the result '.' unless the input is '.'.++invert :: Char -> Char++invert ch = if ch == '.' then '#' else '.'+++-- Property++prop_rotate, prop_flipV, prop_flipH :: Picture -> Bool++prop_rotate pic = flipV (flipH pic) == flipH (flipV pic)++prop_flipV pic = flipV (flipV pic) == pic++prop_flipH pic = flipH (flipV pic) == pic++test_rotate, test_flipV, test_flipH :: Bool+ +test_rotate = flipV (flipH horse) == flipH (flipV horse)++test_flipV = flipV (flipV horse) == horse++test_flipH = flipH (flipV horse) == horse++-- More properties++prop_AboveFlipV pic1 pic2 = + flipV (pic1 `above` pic2) == (flipV pic1) `above` (flipV pic2) ++prop_AboveFlipH pic1 pic2 = flipH (pic1 `above` pic2) == (flipH pic2) `above` (flipH pic1)++propAboveBeside1 nw ne sw se =+ (nw `beside` ne) `above` (sw `beside` se) + == + (nw `above` sw) `beside` (ne `above` se) ++propAboveBeside2 n s =+ (n `beside` n) `above` (s `beside` s) == (n `above` s) `beside` (n `above` s) ++propAboveBeside3 w e =+ (w `beside` e) `above` (w `beside` e) == (w `above` w) `beside` (e `above` e) ++propAboveBeside3Correct w e =+ (rectangular w && rectangular e && height w == height e) + ==>+ (w `beside` e) `above` (w `beside` e) + == + (w `above` w) `beside` (e `above` e) ++-- auxiliary properties and functions++notEmpty pic = pic /= []++rectangular pic =+ notEmpty pic &&+ and [ length first == length l | l <-rest ]+ where+ (first:rest) = pic++height, width :: Picture -> Int++height = length+width = length . head++size :: Picture -> (Int,Int)++size pic = (width pic, height pic)++propAboveBesideFull nw ne sw se =+ (rectangular nw && rectangular ne && rectangular sw && rectangular se &&+ size nw == size ne && size ne == size se && size se == size sw) ==>+ (nw `beside` ne) `above` (sw `beside` se) == (nw `above` sw) `beside` (ne `above` se) ++-- Using explicit generators ...+++prop_1 = forAll (choose (1,10)) $ \x -> x/=x+(x::Int)++prop_2 = forAll (choose (1,10)) $ \x -> x/=(x::Int)++-- Generators suited to Pictures++-- chose either '.' or '#'++genChar :: Gen Char++genChar = oneof [return '.', return '#']++-- generate a list of length n each element from generator g.++genList :: Int -> Gen a -> Gen [a]++genList n g = sequence [ g | i<-[1..n] ]++-- generate a picture of given size using '.' and '#'++genSizedPicture :: Int -> Int -> Gen [String]++genSizedPicture height width =+ sequence [ genList width genChar | i<-[1::Int .. height] ]++-- generate a picture of random size using '.' and '#'++genPicture :: Gen [String]++genPicture =+ do+ height <- choose (1,10)+ width <- choose (1,10)+ genSizedPicture height width++-- generate four pictures of the *same* random size using '.' and '#'++genFourPictures :: Gen ([String],[String],[String],[String])++genFourPictures =+ do+ height <- choose (1,10)+ width <- choose (1,10)+ nw <- genSizedPicture height width+ ne <- genSizedPicture height width+ sw <- genSizedPicture height width+ se <- genSizedPicture height width+ return (nw,ne,sw,se)++-- test that above and besides commute when used with four pictures+-- of the same size++prop_AboveBeside =+ forAll genFourPictures $ \(nw,ne,sw,se) -> propAboveBeside1 nw ne sw se
Chapter19/QC.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- QC.hs+-- QC.hs -- -- Generating values randomly. --
+ Chapter19/QCfuns.hs view
@@ -0,0 +1,37 @@+-------------------------------------------------------------------------+--+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011.+--+-- QCfuns+--+-------------------------------------------------------------------------++module QCfuns where++import Test.QuickCheck+import System.IO.Unsafe -- for unsafePerformIO++-- Sampling and showing functions++sampleFun :: (Arbitrary a,Show a, Show b) => (a -> b) -> IO String++sampleFun f =+ do+ inputs <- sample' arbitrary+ let list = [ (a,f a) | a <- inputs ]+ return $ showMap list++showMap :: (Show a, Show b) => [(a,b)] -> String++showMap [] = "\n"+showMap [(a,b)] = showPair (a,b) ++ "\n"+showMap (p:ps) = showPair p ++ " ," ++ showMap ps++showPair :: (Show a, Show b) => (a,b) -> String++showPair (a,b) = "("++show a ++ "|->" ++ show b ++ ")"++instance (Arbitrary a, Show a, Show b) => Show (a -> b) where+ show = unsafePerformIO . sampleFun
Chapter19/RegExp.hs view
@@ -1,12 +1,12 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- -- RegExp.hs -- --- Regular Expressions+-- Regular Expressions -- -----------------------------------------------------------------------
Chapter2.hs view
@@ -1,12 +1,12 @@ ------------------------------------------------------------------------------ ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 2011. -- --- Chapter 2+-- Chapter 2 -- --- The example script FirstScript.hs is provided separately,+-- The example script FirstScript.hs is provided separately, -- as are the Pictures.hs and PicturesSVG.hs modules. -- ------------------------------------------------------------------------------@@ -23,9 +23,9 @@ -- Some examples of expressions which cause errors; that's why -- they appear as comments and not as Haskell text. -- --- 2+(3+4--- 2+(3+4))--- double square--- 4 double--- 4 5--- 4 `div` (3*2-6)+-- 2+(3+4+-- 2+(3+4))+-- double square+-- 4 double+-- 4 5+-- 4 `div` (3*2-6)
Chapter20/Chapter20.hs view
@@ -1,9 +1,9 @@ --- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2010.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2010. --- Chapter 20+-- Chapter 20 -- Time and space behaviour -- ^^^^^^^^^^^^^^^^^^^^^^^^@@ -140,8 +140,8 @@ aFac n p = aFac (n-1) (p*n) -- This can be modified thus:--- aFac n p--- | p==p = aFac (n-1) (p*n)+-- aFac n p+-- | p==p = aFac (n-1) (p*n) -- Miscellaneous functions
Chapter20/PerformanceI.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- PerformanceI.hs+-- PerformanceI.hs -- -----------------------------------------------------------------------
Chapter20/PerformanceIA.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- PerformanceIA.hs+-- PerformanceIA.hs -- -----------------------------------------------------------------------
Chapter20/PerformanceIS.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- PerformanceIS.hs+-- PerformanceIS.hs -- -----------------------------------------------------------------------
Chapter3.hs view
@@ -1,10 +1,10 @@ ------------------------------------------------------------------------------ ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- Chapter 3+-- Chapter 3 -- ------------------------------------------------------------------------------
Chapter4.hs view
@@ -1,10 +1,10 @@ -------------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- Chapter 4+-- Chapter 4 -- -------------------------------------------------------------------------- @@ -250,7 +250,7 @@ | n>0 = sumFacs (n-1) + fac n -- The sum of the values of a function up to a particular value: --- f 0 + f 1 + ... f n+-- f 0 + f 1 + ... f n -- from which you can reconstruct sumFacs: sumFacs n = sumFun fac n sumFun :: (Integer -> Integer) -> Integer -> Integer@@ -347,13 +347,13 @@ blackSquares :: Integer -> Picture blackSquares n- | n<=1 = black+ | n<=1 = black | otherwise = black `beside` blackSquares (n-1) blackWhite :: Integer -> Picture blackWhite n- | n<=1 = black+ | n<=1 = black | otherwise = black `beside` whiteBlack (n-1) whiteBlack = error "exercise for you"@@ -361,7 +361,7 @@ blackChess :: Integer -> Integer -> Picture blackChess n m- | n<=1 = blackWhite m+ | n<=1 = blackWhite m | otherwise = blackWhite m `above` whiteChess (n-1) m whiteChess n m = error "exercise for you"
Chapter5.hs view
@@ -1,10 +1,10 @@ ------------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- Chapter 5+-- Chapter 5 -- ------------------------------------------------------------------------- @@ -122,7 +122,7 @@ data Shape = Circle Float | Rectangle Float Float- deriving (Eq,Ord,Show,Read)+ deriving (Eq,Ord,Show,Read) shape1 = Circle 3.0 shape2 = Rectangle 45.9 87.6@@ -141,8 +141,8 @@ -- Derived instances ... --- data Season = Spring | Summer | Autumn | Winter --- deriving (Eq,Ord,Enum,Show,Read)+-- data Season = Spring | Summer | Autumn | Winter +-- deriving (Eq,Ord,Enum,Show,Read)
Chapter6.hs view
@@ -1,10 +1,10 @@ -------------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- Chapter 6+-- Chapter 6 -- --------------------------------------------------------------------------
Chapter7.hs view
@@ -1,10 +1,10 @@ ------------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- Chapter 7+-- Chapter 7 -- ------------------------------------------------------------------------- @@ -17,7 +17,7 @@ -- standard Prelude. They are repeated in this file, and so the original -- definitions have to be hidden when the Prelude is imported: -import Prelude hiding (id,head,tail,null,sum,concat,(++),zip,take,getLine)+import Prelude hiding (Word,id,head,tail,null,sum,concat,(++),zip,take,getLine) import qualified Prelude import Chapter5 (digits,isEven) @@ -256,7 +256,7 @@ dropLine :: Int -> [Word] -> Line -dropLine = dropLine -- DUMMY DEFINITION+dropLine = dropLine -- DUMMY DEFINITION -- Splitting into lines.
Chapter8.hs view
@@ -1,17 +1,17 @@ ------------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- Chapter 8+-- Chapter 8 -- ------------------------------------------------------------------------- module Chapter8 where import Data.Time-import System.Locale+import System.Locale hiding (defaultTimeLocale) import System.IO.Unsafe import System.IO import Test.QuickCheck@@ -186,13 +186,13 @@ -- Reading input is done by getLine and getChar: see Prelude for details. --- getLine :: IO String--- getChar :: IO Char+-- getLine :: IO String+-- getChar :: IO Char -- Text strings are written using --- --- putStr :: String -> IO ()--- putStrLn :: String -> IO ()+-- +-- putStr :: String -> IO ()+-- putStrLn :: String -> IO () -- A hello, world program @@ -201,7 +201,7 @@ -- Writing values in general --- print :: Show a => a -> IO ()+-- print :: Show a => a -> IO () -- The do notation: a series of sequencing examples.@@ -209,9 +209,9 @@ -- Put a string and newline. --- putStrLn :: String -> IO ()--- putStrLn str = do putStr str--- putStr "\n"+-- putStrLn :: String -> IO ()+-- putStrLn str = do putStr str+-- putStr "\n" -- Put four times.
Chapter9.hs view
@@ -1,10 +1,10 @@ --------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- Chapter 9+-- Chapter 9 -- --------------------------------------------------------------------- @@ -55,18 +55,18 @@ sum :: [Integer] -> Integer -sum [] = 0 -- (sum.1)-sum (x:xs) = x + sum xs -- (sum.2)+sum [] = 0 -- (sum.1)+sum (x:xs) = x + sum xs -- (sum.2) -- Double every element of an integer list. doubleAll :: [Integer] -> [Integer] -doubleAll [] = [] -- (doubleAll.1)-doubleAll (z:zs) = 2*z : doubleAll zs -- (doubleAll.2)+doubleAll [] = [] -- (doubleAll.1)+doubleAll (z:zs) = 2*z : doubleAll zs -- (doubleAll.2) -- The property linking the two:--- sum (doubleAll xs) = 2 * sum xs -- (sum+dblAll)+-- sum (doubleAll xs) = 2 * sum xs -- (sum+dblAll) prop_SumDoubleAll :: [Integer] -> Bool @@ -81,13 +81,13 @@ length :: [a] -> Int -length [] = 0 -- (length.1)-length (z:zs) = 1 + length zs -- (length.2)+length [] = 0 -- (length.1)+length (z:zs) = 1 + length zs -- (length.2) (++) :: [a] -> [a] -> [a] -[] ++ zs = zs -- (++.1)-(w:ws) ++ zs = w:(ws++zs) -- (++.2)+[] ++ zs = zs -- (++.1)+(w:ws) ++ zs = w:(ws++zs) -- (++.2) -- QuickCheck property @@ -98,8 +98,8 @@ reverse :: [a] -> [a] -reverse [] = [] -- (reverse.1)-reverse (z:zs) = reverse zs ++ [z] -- (reverse.2)+reverse [] = [] -- (reverse.1)+reverse (z:zs) = reverse zs ++ [z] -- (reverse.2) -- QuickCheck properties -- Why does prop_reversePlusPlus' not fail? Because a defaults to ().@@ -150,8 +150,8 @@ shunt :: [a] -> [a] -> [a] -shunt [] ys = ys -- (shunt.1)-shunt (x:xs) ys = shunt xs (x:ys) -- (shunt.2)+shunt [] ys = ys -- (shunt.1)+shunt (x:xs) ys = shunt xs (x:ys) -- (shunt.2) -- QuickCheck property of shunt. @@ -164,7 +164,7 @@ rev :: [a] -> [a] -rev xs = shunt xs [] -- (rev.1)+rev xs = shunt xs [] -- (rev.1) -- Do they always match?
Craft3e.cabal view
@@ -1,6 +1,6 @@ name: Craft3e-version: 0.1.0.10+version: 0.1.1.0 license: MIT license-file: LICENSE copyright: (c) Addison Wesley@@ -40,7 +40,7 @@ QuickCheck >= 2.1 && < 3, old-locale == 1.0.*, time >= 1.1 && < 2.0,- mtl >= 1.1 && < 2.2,+ mtl >= 1.1 && < 2.3, HUnit == 1.2.* exposed-modules:
Index.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- Index+-- Index -- ----------------------------------------------------------------------- @@ -12,6 +12,7 @@ module Index where +import Prelude hiding (Word) import Chapter11 ((>.>)) import qualified Chapter7
ParseLib.hs view
@@ -1,57 +1,58 @@ ------------------------------------------------------------------------- -- --- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- ParseLib.hs+-- ParseLib.hs -- --- Library functions for parsing --- Note that this is not a monadic approach to parsing. +-- Library functions for parsing +-- Note that this is not a monadic approach to parsing. -- --------------------------------------------------------------------------- module ParseLib where +import Control.Monad (liftM, ap) import Data.Char infixr 5 >*> -- --- The type of parsers. +-- The type of parsers. -- type Parse a b = [a] -> [(b,[a])] -- --- Some basic parsers +-- Some basic parsers -- -- --- Fail on any input. +-- Fail on any input. -- none :: Parse a b none inp = [] -- --- Succeed, returning the value supplied. +-- Succeed, returning the value supplied. -- succeed :: b -> Parse a b succeed val inp = [(val,inp)] -- --- token t recognises t as the first value in the input. +-- token t recognises t as the first value in the input. -- token :: Eq a => a -> Parse a a token t (x:xs) - | t==x = [(t,xs)]- | otherwise = []+ | t==x = [(t,xs)]+ | otherwise = [] token t [] = [] -- --- spot whether an element with a particular property is the --- first element of input. +-- spot whether an element with a particular property is the +-- first element of input. -- spot :: (a -> Bool) -> Parse a a spot p (x:xs) - | p x = [(x,xs)]- | otherwise = []+ | p x = [(x,xs)]+ | otherwise = [] spot p [] = [] -- --- Examples. +-- Examples. -- bracket = token '(' dig = spot isDigit@@ -62,31 +63,31 @@ endOfInput x [] = [(x,[])] endOfInput x _ = [] -- --- Combining parsers +-- Combining parsers -- -- --- alt p1 p2 recognises anything recogniseed by p1 or by p2. +-- alt p1 p2 recognises anything recogniseed by p1 or by p2. -- alt :: Parse a b -> Parse a b -> Parse a b alt p1 p2 inp = p1 inp ++ p2 inp exam1 = (bracket `alt` dig) "234" -- --- Apply one parser then the second to the result(s) of the first. +-- Apply one parser then the second to the result(s) of the first. -- (>*>) :: Parse a b -> Parse a c -> Parse a (b,c)--- +-- (>*>) p1 p2 inp = [((y,z),rem2) | (y,rem1) <- p1 inp , (z,rem2) <- p2 rem1 ] -- --- Transform the results of the parses according to the function. +-- Transform the results of the parses according to the function. -- build :: Parse a b -> (b -> c) -> Parse a c build p f inp = [ (f x,rem) | (x,rem) <- p inp ] -- --- Recognise a list of objects. +-- Recognise a list of objects. -- --- +-- list :: Parse a b -> Parse a [b] list p = (succeed []) `alt`@@ -96,7 +97,7 @@ -- -- Some variants... --- A non-empty list of objects. +-- A non-empty list of objects. -- neList :: Parse a b -> Parse a [b] neList p = (p `build` (:[]))@@ -124,6 +125,13 @@ return x = SParse (succeed x) (SParse pr) >>= f = SParse (\st -> concat [ sparse (f a) rest | (a,rest) <- pr st ])++instance Applicative (SParse a) where+ pure = return+ (<*>) = ap++instance Functor (SParse a) where+ fmap = liftM sparse :: SParse a b -> Parse a b
ParsingBasics.hs view
@@ -1,12 +1,12 @@ ------------------------------------------------------------------------- -- --- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- Case study: Parsing expressions +-- Case study: Parsing expressions -- --- Note that this is not a monadic approach to parsing. +-- Note that this is not a monadic approach to parsing. -- --------------------------------------------------------------------------- @@ -16,101 +16,101 @@ infixr 5 >*> -- --- Syntactic types +-- Syntactic types -- type Var = Char data Expr = Lit Int | Var Var | Op Op Expr Expr data Op = Add | Sub | Mul | Div | Mod -- --- The type of parsers. +-- The type of parsers. -- type Parse a b = [a] -> [(b,[a])] -- --- Some basic parsers +-- Some basic parsers -- -- --- Fail on any input. +-- Fail on any input. -- none :: Parse a b none inp = [] -- --- Succeed, returning the value supplied. +-- Succeed, returning the value supplied. -- succeed :: b -> Parse a b succeed val inp = [(val,inp)] -- --- token t recognises t as the first value in the input. +-- token t recognises t as the first value in the input. -- token :: Eq a => a -> Parse a a token t (x:xs) - | t==x = [(t,xs)]- | otherwise = []+ | t==x = [(t,xs)]+ | otherwise = [] token t [] = [] -- --- spot whether an element with a particular property is the --- first element of input. +-- spot whether an element with a particular property is the +-- first element of input. -- spot :: (a -> Bool) -> Parse a a spot p (x:xs) - | p x = [(x,xs)]- | otherwise = []+ | p x = [(x,xs)]+ | otherwise = [] spot p [] = [] -- --- Examples. +-- Examples. -- bracket = token '(' dig = spot isDigit -- --- Combining parsers +-- Combining parsers -- -- --- alt p1 p2 recognises anything recogniseed by p1 or by p2. +-- alt p1 p2 recognises anything recogniseed by p1 or by p2. -- alt :: Parse a b -> Parse a b -> Parse a b alt p1 p2 inp = p1 inp ++ p2 inp exam1 = (bracket `alt` dig) "234" -- --- Apply one parser then the second to the result(s) of the first. +-- Apply one parser then the second to the result(s) of the first. -- (>*>) :: Parse a b -> Parse a c -> Parse a (b,c)--- +-- (>*>) p1 p2 inp = [((y,z),rem2) | (y,rem1) <- p1 inp , (z,rem2) <- p2 rem1 ] -- --- Transform the results of the parses according to the function. +-- Transform the results of the parses according to the function. -- build :: Parse a b -> (b -> c) -> Parse a c build p f inp = [ (f x,rem) | (x,rem) <- p inp ] -- --- Recognise a list of objects. +-- Recognise a list of objects. -- --- +-- list :: Parse a b -> Parse a [b] list p = (succeed []) `alt` ((p >*> list p) `build` convert) where convert = uncurry (:) -- --- From the exercises... +-- From the exercises... -- neList :: Parse a b -> Parse a [b]-neList = neList -- dummy definition+neList = neList -- dummy definition optional :: Parse a b -> Parse a [b]-optional = optional -- dummy definition+optional = optional -- dummy definition nTimes :: Int -> Parse a b -> Parse a [b]-nTimes = nTimes -- dummy definition+nTimes = nTimes -- dummy definition -- --- A parser for expressions +-- A parser for expressions -- -- --- The parser has three components, corresponding to the three --- clauses in the definition of the syntactic type. +-- The parser has three components, corresponding to the three +-- clauses in the definition of the syntactic type. -- parser :: Parse Char Expr parser = (litParse `alt` varParse) `alt` opExpParse -- --- Spotting variables. +-- Spotting variables. -- varParse :: Parse Char Expr varParse = spot isVar `build` Var@@ -118,7 +118,7 @@ isVar :: Char -> Bool isVar x = ('a' <= x && x <= 'z') -- --- Parsing (fully bracketed) operator applications. +-- Parsing (fully bracketed) operator applications. -- opExpParse = (token '(' >*>@@ -131,10 +131,10 @@ makeExpr (_,(e1,(bop,(e2,_)))) = Op (charToOp bop) e1 e2 isOp :: Char -> Bool-isOp = isOp -- dummy definition+isOp = isOp -- dummy definition charToOp :: Char -> Op-charToOp = charToOp -- dummy definition+charToOp = charToOp -- dummy definition -- -- A number is a list of digits with an optional ~ at the front. @@ -146,22 +146,22 @@ where join = uncurry (++) -- --- From the exercises... +-- From the exercises... -- charlistToExpr :: [Char] -> Expr-charlistToExpr = charlistToExpr -- dummy definition+charlistToExpr = charlistToExpr -- dummy definition -- --- A grammar for unbracketed expressions. --- --- eXpr ::= Int | Var | (eXpr Op eXpr) | --- lexpr mop mexpr | mexpr aop eXpr --- lexpr ::= Int | Var | (eXpr Op eXpr) --- mexpr ::= Int | Var | (eXpr Op eXpr) | lexpr mop mexpr --- mop ::= 'a' | '/' | '\%' --- aop ::= '+' | '-' +-- A grammar for unbracketed expressions. +-- +-- eXpr ::= Int | Var | (eXpr Op eXpr) | +-- lexpr mop mexpr | mexpr aop eXpr +-- lexpr ::= Int | Var | (eXpr Op eXpr) +-- mexpr ::= Int | Var | (eXpr Op eXpr) | lexpr mop mexpr +-- mop ::= 'a' | '/' | '\%' +-- aop ::= '+' | '-' -- -- --- The top-level parser +-- The top-level parser -- topLevel :: Parse a b -> [a] -> b topLevel p inp@@ -171,13 +171,13 @@ where results = [ found | (found,[]) <- p inp ] -- --- The type of commands. +-- The type of commands. -- data Command = Eval Expr | Assign Var Expr | Null commandParse :: Parse Char Command-commandParse = commandParse -- dummy definition+commandParse = commandParse -- dummy definition -- --- From the exercises. +-- From the exercises. -- -- tokenList :: [a] -> Parse a [a] -- spotWhile :: (a -> Bool) -> Parse a [a]
Pic.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- Pic.hs+-- Pic.hs -- -- A deep embedding of pictures --
Pictures.hs view
@@ -1,9 +1,9 @@ -------------------------------------------------------------------------- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2010.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2010. ----- Pictures.hs+-- Pictures.hs -- -- An implementation of a type of rectangular pictures -- using lists of lists of characters.
PicturesSVG.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. -- --- PicturesSVG+-- PicturesSVG -- -- The Pictures functionality implemented by translation -- SVG (Scalable Vector Graphics)
QCfuns.hs view
@@ -1,10 +1,10 @@ ------------------------------------------------------------------------- ----- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- QCfuns+-- QCfuns -- -------------------------------------------------------------------------
RPS.hs view
@@ -1,15 +1,15 @@ -------------------------------------------------------------------------- Haskell: The Craft of Functional Programming--- Simon Thompson--- (c) Addison-Wesley, 1996-2010.+-- Haskell: The Craft of Functional Programming+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2010. -- --- RPS: Rock - Paper - Scissors+-- RPS: Rock - Paper - Scissors ----------------------------------------------------------------------- module RPS where import Data.Time-import System.Locale+import System.Locale hiding (defaultTimeLocale) import System.IO.Unsafe import System.IO import Test.QuickCheck
Relation.hs view
@@ -1,52 +1,52 @@ ------------------------------------------------------------------------- -- --- Relation.hs +-- Relation.hs ----- Building Relations and Graphs on top of the Set ADT. +-- Building Relations and Graphs on top of the Set ADT. -- --- (c) Addison-Welsey, 1996-2011. +-- (c) Addison-Welsey, 1996-2011. -- ---------------------------------------------------------------------------- + module Relation where import Set import Data.List hiding ( union ) -- --- A relation is a set of pairs. +-- A relation is a set of pairs. type Relation a = Set (a,a) -- --- Operations over relations. +-- Operations over relations. -- ^^^^^^^^^^^^^^^^^^^^^^^^^^ -- --- The image of an element under a relation. +-- The image of an element under a relation. image :: Ord a => Relation a -> a -> Set a image rel val = mapSet snd (filterSet ((==val).fst) rel) -- --- The image of a set of elements under a relation. +-- The image of a set of elements under a relation. -- setImage :: Ord a => Relation a -> Set a -> Set a setImage rel = unionSet . mapSet (image rel) --- The union of a set of sets. +-- The union of a set of sets. -- unionSet :: Ord a => Set (Set a) -> Set a unionSet = foldSet union empty -- --- Add to a set its image under a relation. +-- Add to a set its image under a relation. addImage :: Ord a => Relation a -> Set a -> Set a addImage rel st = st `union` setImage rel st -- --- Add the children (under the relation isParent) to a set. +-- Add the children (under the relation isParent) to a set. -- type People = String @@ -59,7 +59,7 @@ addChildren = addImage isParent -- --- Compose two relations. +-- Compose two relations. -- compose :: Ord a => Relation a -> Relation a -> Relation a @@ -69,7 +69,7 @@ equals ((a,b),(c,d)) = (b==c) outer ((a,b),(c,d)) = (a,d) --- The product of two sets. +-- The product of two sets. -- setProduct :: (Ord a,Ord b) => Set a -> Set b -> Set (a,b) @@ -83,7 +83,7 @@ where addEl el el' = (el',el) -- --- The transitive closure of a relation. +-- The transitive closure of a relation. tClosure :: Ord a => Relation a -> Relation a @@ -95,15 +95,15 @@ limit :: Eq a => (a -> a) -> a -> a limit f xs - | xs == next = xs- | otherwise = limit f next+ | xs == next = xs+ | otherwise = limit f next where next = f xs --- Graphs +-- Graphs -- ^^^^^^ -- --- The connected components of a graph. +-- The connected components of a graph. connect :: Ord a => Relation a -> Relation a @@ -112,7 +112,7 @@ clos = tClosure rel solc = inverse clos -- --- The inverse of a relation swap all pairs. +-- The inverse of a relation swap all pairs. inverse :: Ord a => Relation a -> Relation a @@ -120,7 +120,7 @@ where swap (x,y) = (y,x) -- --- The equivalence classes of a(n equivalence) relation. +-- The equivalence classes of a(n equivalence) relation. -- classes :: Ord a => Relation a -> Set (Set a) @@ -129,7 +129,7 @@ where start = mapSet sing (eles rel) --- The auxiliary functions used in classes. +-- The auxiliary functions used in classes. -- eles :: Ord a => Relation a -> Set a @@ -140,43 +140,43 @@ addImages rel = mapSet (addImage rel) --- Searching in graphs +-- Searching in graphs -- ^^^^^^^^^^^^^^^^^^^ -- --- The descendants v under rel which lie outside st. +-- The descendants v under rel which lie outside st. -- newDescs :: Ord a => Relation a -> Set a -> a -> Set a newDescs rel st v = image rel v `diff` st -- --- Breaking the abstraction barrier for sets. +-- Breaking the abstraction barrier for sets. -- defined in Sets.hs -- flatten :: Ord a => Set a -> [a] --- Under the list implementation, we can use --- flatten = id- +-- Under the list implementation, we can use +-- flatten = id+ -- --- A list of new descendants. +-- A list of new descendants. -- findDescs :: Ord a => Relation a -> [a] -> a -> [a] findDescs rel xs v = flatten (newDescs rel (makeSet xs) v) -- --- Breadth first search. +-- Breadth first search. -- ^^^^^^^^^^^^^^^^^^^^^ breadthFirst :: Ord a => Relation a -> a -> [a] breadthFirst rel val- = limit step start- where- start = [val]- step xs = xs ++ nub (concat (map (findDescs rel xs) xs))+ = limit step start+ where+ start = [val]+ step xs = xs ++ nub (concat (map (findDescs rel xs) xs)) -- --- Depth first search. +-- Depth first search. -- ^^^^^^^^^^^^^^^^^^^^^ depthFirst :: Ord a => Relation a -> a -> [a]@@ -186,9 +186,9 @@ depthFirst rel v = depthSearch rel v [] depthSearch rel v used- = v : depthList rel (findDescs rel used' v) used'- where- used' = v:used+ = v : depthList rel (findDescs rel used' v) used'+ where+ used' = v:used depthList :: Ord a => Relation a -> [a] -> [a] -> [a] @@ -198,11 +198,11 @@ = next ++ depthList rel rest (used++next) where next - | elem val used = []- | otherwise = depthSearch rel val used+ | elem val used = []+ | otherwise = depthSearch rel val used -- --- From the exercises... +-- From the exercises... -- -- distance :: Eq a => Relation a -> a -> a -> Int
Set.hs view
@@ -1,10 +1,10 @@ ------------------------------------------------------------------------- -- --- Set.hs +-- Set.hs ----- ADT of sets, implemented as ordered lists without repetitions. +-- ADT of sets, implemented as ordered lists without repetitions. -- --- (c) Addison-Welsey, 1996-2011. +-- (c) Addison-Welsey, 1996-2011. -- --------------------------------------------------------------------------- @@ -26,7 +26,7 @@ import Data.List hiding ( union ) -- --- Instance declarations for Eq and Ord +-- Instance declarations for Eq and Ord instance Eq a => Eq (Set a) where (==) = eqSet@@ -34,8 +34,8 @@ instance Ord a => Ord (Set a) where (<=) = leqSet --- The implementation. --- +-- The implementation. +-- newtype Set a = Set [a] empty :: Set a@@ -47,9 +47,9 @@ memSet :: Ord a => Set a -> a -> Bool memSet (Set []) y = False memSet (Set (x:xs)) y - | x<y = memSet (Set xs) y- | x==y = True- | otherwise = False+ | x<y = memSet (Set xs) y+ | x==y = True+ | otherwise = False union :: Ord a => Set a -> Set a -> Set a union (Set xs) (Set ys) = Set (uni xs ys)@@ -58,9 +58,9 @@ uni [] ys = ys uni xs [] = xs uni (x:xs) (y:ys) - | x<y = x : uni xs (y:ys)- | x==y = x : uni xs ys- | otherwise = y : uni (x:xs) ys+ | x<y = x : uni xs (y:ys)+ | x==y = x : uni xs ys+ | otherwise = y : uni (x:xs) ys inter :: Ord a => Set a -> Set a -> Set a inter (Set xs) (Set ys) = Set (int xs ys)@@ -69,9 +69,9 @@ int [] ys = [] int xs [] = [] int (x:xs) (y:ys) - | x<y = int xs (y:ys)- | x==y = x : int xs ys- | otherwise = int (x:xs) ys+ | x<y = int xs (y:ys)+ | x==y = x : int xs ys+ | otherwise = int (x:xs) ys diff :: Ord a => Set a -> Set a -> Set a diff (Set xs) (Set ys) = Set (dif xs ys)@@ -80,9 +80,9 @@ dif [] ys = [] dif xs [] = xs dif (x:xs) (y:ys) - | x<y = x : dif xs (y:ys)- | x==y = dif xs ys- | otherwise = dif (x:xs) ys+ | x<y = x : dif xs (y:ys)+ | x==y = dif xs ys+ | otherwise = dif (x:xs) ys subSet :: Ord a => Set a -> Set a -> Bool subSet (Set xs) (Set ys) = subS xs ys@@ -91,9 +91,9 @@ subS [] ys = True subS xs [] = False subS (x:xs) (y:ys) - | x<y = False- | x==y = subS xs ys- | x>y = subS (x:xs) ys+ | x<y = False+ | x==y = subS xs ys+ | x>y = subS (x:xs) ys eqSet :: Eq a => Set a -> Set a -> Bool eqSet (Set xs) (Set ys) = (xs == ys)@@ -101,14 +101,14 @@ leqSet :: Ord a => Set a -> Set a -> Bool leqSet (Set xs) (Set ys) = (xs <= ys) --- +-- makeSet :: Ord a => [a] -> Set a makeSet = Set . remDups . sort where remDups [] = [] remDups [x] = [x] remDups (x:y:xs) - | x < y = x : remDups (y:xs)+ | x < y = x : remDups (y:xs) | otherwise = remDups (y:xs) mapSet :: Ord b => (a -> b) -> Set a -> Set b
Simulation/Base.hs view
@@ -1,10 +1,10 @@ ------------------------------------------------------------------------- -- --- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- The basis of the simulation package.+-- The basis of the simulation package. -- ------------------------------------------------------------------------- @@ -14,7 +14,7 @@ -- The type of input messages. data Inmess = No | Yes Arrival Service- deriving (Eq,Show)+ deriving (Eq,Show) type Arrival = Int type Service = Int@@ -22,6 +22,6 @@ -- The type of output messages. data Outmess = None | Discharge Arrival Wait Service- deriving (Eq,Show)+ deriving (Eq,Show) type Wait = Int
Simulation/QueueState.hs view
@@ -1,11 +1,11 @@ ------------------------------------------------------------------------- -- --- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- The queue ADT: its signature is given in comments in the module--- header.+-- The queue ADT: its signature is given in comments in the module+-- header. -- ------------------------------------------------------------------------- module QueueState @@ -18,7 +18,7 @@ queueEmpty -- QueueState -> Bool ) where -import Base -- for the base types of the system+import Base -- for the base types of the system type Time = Int @@ -34,8 +34,8 @@ addMessage :: Inmess -> QueueState -> QueueState addMessage im (QS time serv ml) - | isYes im = QS time serv (ml++[im])- | otherwise = QS time serv ml+ | isYes im = QS time serv (ml++[im])+ | otherwise = QS time serv ml where isYes (Yes _ _) = True isYes _ = False
Simulation/RandomGen.hs view
@@ -1,10 +1,10 @@ ------------------------------------------------------------------------- -- --- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- Random number generation.+-- Random number generation. -- -------------------------------------------------------------------------
Simulation/ServerState.hs view
@@ -1,11 +1,11 @@ ------------------------------------------------------------------------- -- --- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- The server ADT: its signature is given in comments in the module--- header.+-- The server ADT: its signature is given in comments in the module+-- header. -- ------------------------------------------------------------------------- @@ -20,8 +20,8 @@ shortestQueue -- ServerState -> Int ) where -import Base -- for the base types of the system-import QueueState -- for the queue type+import Base -- for the base types of the system+import QueueState -- for the queue type -- The server consists of a collection of queues, accessed by integers from 0.
Simulation/TopLevelServe.hs view
@@ -1,19 +1,19 @@ ------------------------------------------------------------------------- -- --- Haskell: The Craft of Functional Programming, 3e--- Simon Thompson--- (c) Addison-Wesley, 1996-2011.+-- Haskell: The Craft of Functional Programming, 3e+-- Simon Thompson+-- (c) Addison-Wesley, 1996-2011. ----- The top level of the server simulation.+-- The top level of the server simulation. -- ------------------------------------------------------------------------- module TopLevelServe where -import Base -- for the base types of the system-import QueueState -- for the queue type-import ServerState -- for the server type-import RandomGen -- for the random inputs+import Base -- for the base types of the system+import QueueState -- for the queue type+import ServerState -- for the server type+import RandomGen -- for the random inputs -- The top-level simulation is a function from a series of input @@ -39,9 +39,9 @@ simEx = doSimulation serverStart simulationInput --- = [Discharge 1 0 2, Discharge 3 0 1, Discharge 6 0 1, --- Discharge 2 0 5, Discharge 5 0 3, Discharge 4 0 4,--- Discharge 7 2 2,...+-- = [Discharge 1 0 2, Discharge 3 0 1, Discharge 6 0 1, +-- Discharge 2 0 5, Discharge 5 0 3, Discharge 4 0 4,+-- Discharge 7 2 2,... -- A `finite' input: infinite list with only a finite number of `interesting' -- inputs.
UseMonads.hs view
@@ -2,9 +2,6 @@ import Control.Monad.Identity -instance Show a => Show (Identity a) where- show (Identity x) = show x- example1 = do { x <- [1,2]; y<-[3,4]; return (x+y)} example2 = do { x <- Just 1; y<- Just 2; return (x+y)}