diff --git a/Calculator/CalcEval.hs b/Calculator/CalcEval.hs --- a/Calculator/CalcEval.hs +++ b/Calculator/CalcEval.hs @@ -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 -- ----------------------------------------------------------------------- diff --git a/Calculator/CalcParse.hs b/Calculator/CalcParse.hs --- a/Calculator/CalcParse.hs +++ b/Calculator/CalcParse.hs @@ -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 diff --git a/Calculator/CalcParseLib.hs b/Calculator/CalcParseLib.hs --- a/Calculator/CalcParseLib.hs +++ b/Calculator/CalcParseLib.hs @@ -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 diff --git a/Calculator/CalcStore.hs b/Calculator/CalcStore.hs --- a/Calculator/CalcStore.hs +++ b/Calculator/CalcStore.hs @@ -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 diff --git a/Calculator/CalcToplevel.hs b/Calculator/CalcToplevel.hs --- a/Calculator/CalcToplevel.hs +++ b/Calculator/CalcToplevel.hs @@ -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 -- ----------------------------------------------------------------------- diff --git a/Calculator/CalcTypes.hs b/Calculator/CalcTypes.hs --- a/Calculator/CalcTypes.hs +++ b/Calculator/CalcTypes.hs @@ -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) diff --git a/Chapter1.hs b/Chapter1.hs --- a/Chapter1.hs +++ b/Chapter1.hs @@ -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. -- ------------------------------------------------------------------------- diff --git a/Chapter10.hs b/Chapter10.hs --- a/Chapter10.hs +++ b/Chapter10.hs @@ -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 diff --git a/Chapter11.hs b/Chapter11.hs --- a/Chapter11.hs +++ b/Chapter11.hs @@ -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 diff --git a/Chapter12.hs b/Chapter12.hs --- a/Chapter12.hs +++ b/Chapter12.hs @@ -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 diff --git a/Chapter13.hs b/Chapter13.hs --- a/Chapter13.hs +++ b/Chapter13.hs @@ -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 diff --git a/Chapter14_1.hs b/Chapter14_1.hs --- a/Chapter14_1.hs +++ b/Chapter14_1.hs @@ -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 diff --git a/Chapter14_2.hs b/Chapter14_2.hs --- a/Chapter14_2.hs +++ b/Chapter14_2.hs @@ -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. -- -------------------------------------------------------------------- diff --git a/Chapter15/CodeTable.hs b/Chapter15/CodeTable.hs --- a/Chapter15/CodeTable.hs +++ b/Chapter15/CodeTable.hs @@ -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 diff --git a/Chapter15/Coding.hs b/Chapter15/Coding.hs --- a/Chapter15/Coding.hs +++ b/Chapter15/Coding.hs @@ -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 [] = [] diff --git a/Chapter15/Frequency.hs b/Chapter15/Frequency.hs --- a/Chapter15/Frequency.hs +++ b/Chapter15/Frequency.hs @@ -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 [(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 Tree diff --git a/Chapter15/MakeTree.hs b/Chapter15/MakeTree.hs --- a/Chapter15/MakeTree.hs +++ b/Chapter15/MakeTree.hs @@ -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 diff --git a/Chapter15/Test.hs b/Chapter15/Test.hs --- a/Chapter15/Test.hs +++ b/Chapter15/Test.hs @@ -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. -- ------------------------------------------------------------------------- diff --git a/Chapter15/Types.hs b/Chapter15/Types.hs --- a/Chapter15/Types.hs +++ b/Chapter15/Types.hs @@ -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) diff --git a/Chapter16/QCStoreTest.hs b/Chapter16/QCStoreTest.hs --- a/Chapter16/QCStoreTest.hs +++ b/Chapter16/QCStoreTest.hs @@ -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. -- ------------------------------------------------------------------------- diff --git a/Chapter16/Queues1.hs b/Chapter16/Queues1.hs --- a/Chapter16/Queues1.hs +++ b/Chapter16/Queues1.hs @@ -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. -- ------------------------------------------------------------------------- diff --git a/Chapter16/Queues2.hs b/Chapter16/Queues2.hs --- a/Chapter16/Queues2.hs +++ b/Chapter16/Queues2.hs @@ -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. -- ------------------------------------------------------------------------- diff --git a/Chapter16/Queues3.hs b/Chapter16/Queues3.hs --- a/Chapter16/Queues3.hs +++ b/Chapter16/Queues3.hs @@ -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. -- ------------------------------------------------------------------------- diff --git a/Chapter16/Store.hs b/Chapter16/Store.hs --- a/Chapter16/Store.hs +++ b/Chapter16/Store.hs @@ -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 diff --git a/Chapter16/StoreFun.hs b/Chapter16/StoreFun.hs --- a/Chapter16/StoreFun.hs +++ b/Chapter16/StoreFun.hs @@ -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 diff --git a/Chapter16/StoreTest.hs b/Chapter16/StoreTest.hs --- a/Chapter16/StoreTest.hs +++ b/Chapter16/StoreTest.hs @@ -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 diff --git a/Chapter16/Tree.hs b/Chapter16/Tree.hs --- a/Chapter16/Tree.hs +++ b/Chapter16/Tree.hs @@ -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 diff --git a/Chapter16/UseStore.hs b/Chapter16/UseStore.hs --- a/Chapter16/UseStore.hs +++ b/Chapter16/UseStore.hs @@ -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 diff --git a/Chapter16/UseStoreFun.hs b/Chapter16/UseStoreFun.hs --- a/Chapter16/UseStoreFun.hs +++ b/Chapter16/UseStoreFun.hs @@ -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 diff --git a/Chapter16/UseTree.hs b/Chapter16/UseTree.hs --- a/Chapter16/UseTree.hs +++ b/Chapter16/UseTree.hs @@ -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 diff --git a/Chapter17.hs b/Chapter17.hs --- a/Chapter17.hs +++ b/Chapter17.hs @@ -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] diff --git a/Chapter18.hs b/Chapter18.hs --- a/Chapter18.hs +++ b/Chapter18.hs @@ -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 diff --git a/Chapter19/ParseLib.hs b/Chapter19/ParseLib.hs new file mode 100644 --- /dev/null +++ b/Chapter19/ParseLib.hs @@ -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 + + diff --git a/Chapter19/Pic.hs b/Chapter19/Pic.hs new file mode 100644 --- /dev/null +++ b/Chapter19/Pic.hs @@ -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)) + diff --git a/Chapter19/Pictures.hs b/Chapter19/Pictures.hs new file mode 100644 --- /dev/null +++ b/Chapter19/Pictures.hs @@ -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 diff --git a/Chapter19/QC.hs b/Chapter19/QC.hs --- a/Chapter19/QC.hs +++ b/Chapter19/QC.hs @@ -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. -- diff --git a/Chapter19/QCfuns.hs b/Chapter19/QCfuns.hs new file mode 100644 --- /dev/null +++ b/Chapter19/QCfuns.hs @@ -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 diff --git a/Chapter19/RegExp.hs b/Chapter19/RegExp.hs --- a/Chapter19/RegExp.hs +++ b/Chapter19/RegExp.hs @@ -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 -- ----------------------------------------------------------------------- diff --git a/Chapter2.hs b/Chapter2.hs --- a/Chapter2.hs +++ b/Chapter2.hs @@ -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) diff --git a/Chapter20/Chapter20.hs b/Chapter20/Chapter20.hs --- a/Chapter20/Chapter20.hs +++ b/Chapter20/Chapter20.hs @@ -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 diff --git a/Chapter20/PerformanceI.hs b/Chapter20/PerformanceI.hs --- a/Chapter20/PerformanceI.hs +++ b/Chapter20/PerformanceI.hs @@ -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 -- ----------------------------------------------------------------------- diff --git a/Chapter20/PerformanceIA.hs b/Chapter20/PerformanceIA.hs --- a/Chapter20/PerformanceIA.hs +++ b/Chapter20/PerformanceIA.hs @@ -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 -- ----------------------------------------------------------------------- diff --git a/Chapter20/PerformanceIS.hs b/Chapter20/PerformanceIS.hs --- a/Chapter20/PerformanceIS.hs +++ b/Chapter20/PerformanceIS.hs @@ -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 -- ----------------------------------------------------------------------- diff --git a/Chapter3.hs b/Chapter3.hs --- a/Chapter3.hs +++ b/Chapter3.hs @@ -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 -- ------------------------------------------------------------------------------ diff --git a/Chapter4.hs b/Chapter4.hs --- a/Chapter4.hs +++ b/Chapter4.hs @@ -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" diff --git a/Chapter5.hs b/Chapter5.hs --- a/Chapter5.hs +++ b/Chapter5.hs @@ -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) diff --git a/Chapter6.hs b/Chapter6.hs --- a/Chapter6.hs +++ b/Chapter6.hs @@ -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 -- -------------------------------------------------------------------------- diff --git a/Chapter7.hs b/Chapter7.hs --- a/Chapter7.hs +++ b/Chapter7.hs @@ -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. diff --git a/Chapter8.hs b/Chapter8.hs --- a/Chapter8.hs +++ b/Chapter8.hs @@ -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. diff --git a/Chapter9.hs b/Chapter9.hs --- a/Chapter9.hs +++ b/Chapter9.hs @@ -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? diff --git a/Craft3e.cabal b/Craft3e.cabal --- a/Craft3e.cabal +++ b/Craft3e.cabal @@ -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: diff --git a/Index.hs b/Index.hs --- a/Index.hs +++ b/Index.hs @@ -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 diff --git a/ParseLib.hs b/ParseLib.hs --- a/ParseLib.hs +++ b/ParseLib.hs @@ -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 diff --git a/ParsingBasics.hs b/ParsingBasics.hs --- a/ParsingBasics.hs +++ b/ParsingBasics.hs @@ -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] diff --git a/Pic.hs b/Pic.hs --- a/Pic.hs +++ b/Pic.hs @@ -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 -- diff --git a/Pictures.hs b/Pictures.hs --- a/Pictures.hs +++ b/Pictures.hs @@ -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. diff --git a/PicturesSVG.hs b/PicturesSVG.hs --- a/PicturesSVG.hs +++ b/PicturesSVG.hs @@ -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) diff --git a/QCfuns.hs b/QCfuns.hs --- a/QCfuns.hs +++ b/QCfuns.hs @@ -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 -- ------------------------------------------------------------------------- diff --git a/RPS.hs b/RPS.hs --- a/RPS.hs +++ b/RPS.hs @@ -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 diff --git a/Relation.hs b/Relation.hs --- a/Relation.hs +++ b/Relation.hs @@ -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 diff --git a/Set.hs b/Set.hs --- a/Set.hs +++ b/Set.hs @@ -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 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 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 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 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) - | xy = subS (x:xs) ys + | xy = 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 diff --git a/Simulation/Base.hs b/Simulation/Base.hs --- a/Simulation/Base.hs +++ b/Simulation/Base.hs @@ -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 diff --git a/Simulation/QueueState.hs b/Simulation/QueueState.hs --- a/Simulation/QueueState.hs +++ b/Simulation/QueueState.hs @@ -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 diff --git a/Simulation/RandomGen.hs b/Simulation/RandomGen.hs --- a/Simulation/RandomGen.hs +++ b/Simulation/RandomGen.hs @@ -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. -- ------------------------------------------------------------------------- diff --git a/Simulation/ServerState.hs b/Simulation/ServerState.hs --- a/Simulation/ServerState.hs +++ b/Simulation/ServerState.hs @@ -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. diff --git a/Simulation/TopLevelServe.hs b/Simulation/TopLevelServe.hs --- a/Simulation/TopLevelServe.hs +++ b/Simulation/TopLevelServe.hs @@ -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. diff --git a/UseMonads.hs b/UseMonads.hs --- a/UseMonads.hs +++ b/UseMonads.hs @@ -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)}