home *** CD-ROM | disk | FTP | other *** search
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
- -- __________ __________ __________ __________ ________
- -- / _______/ / ____ / / _______/ / _______/ / ____ \
- -- / / _____ / / / / / /______ / /______ / /___/ /
- -- / / /_ / / / / / / _______/ / _______/ / __ __/
- -- / /___/ / / /___/ / / / / /______ / / \ \
- -- /_________/ /_________/ /__/ /_________/ /__/ \__\
- --
- -- Functional programming environment, Version 2.20 (beta-release)
- -- Copyright Mark P Jones 1991.
- --
- -- Standard prelude for use of overloaded values using type classes.
- -- Based on the Haskell standard prelude version 1.1.
-
- help = "press :? for a list of commands"
-
- -- Operator precedence table: -----------------------------------------------
-
- infixl 9 !!
- infixr 9 .
- infixr 8 ^
- infixl 7 *
- infix 7 /, `div`, `rem`, `mod`
- infixl 6 +, -
- infix 5 \\
- infixr 5 ++, :
- infix 4 ==, /=, <, <=, >=, >
- infix 4 `elem`, `notElem`
- infixr 3 &&
- infixr 2 ||
-
- -- Standard combinators: ----------------------------------------------------
-
- primitive strict "primStrict" :: (a -> b) -> a -> b
-
- const :: a -> b -> a
- const k x = k
-
- id :: a -> a
- id x = x
-
- curry :: ((a,b) -> c) -> a -> b -> c
- curry f a b = f (a,b)
-
- uncurry :: (a -> b -> c) -> (a,b) -> c
- uncurry f (a,b) = f a b
-
- fst :: (a,b) -> a
- fst (x,_) = x
-
- snd :: (a,b) -> b
- snd (_,y) = y
-
- fst3 :: (a,b,c) -> a
- fst3 (x,_,_) = x
-
-
- 97
-
-
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- snd3 :: (a,b,c) -> b
- snd3 (_,x,_) = x
-
- thd3 :: (a,b,c) -> c
- thd3 (_,_,x) = x
-
- (.) :: (b -> c) -> (a -> b) -> (a -> c)
- (f . g) x = f (g x)
-
- flip :: (a -> b -> c) -> b -> a -> c
- flip f x y = f y x
-
- -- Boolean functions: -------------------------------------------------------
-
- (&&), (||) :: Bool -> Bool -> Bool
- False && x = False
- True && x = x
-
- False || x = x
- True || x = True
-
- not :: Bool -> Bool
- not True = False
- not False = True
-
- and, or :: [Bool] -> Bool
- and = foldr (&&) True
- or = foldr (||) False
-
- any, all :: (a -> Bool) -> [a] -> Bool
- any p = or . map p
- all p = and . map p
-
- otherwise :: Bool
- otherwise = True
-
- -- Character functions: -----------------------------------------------------
-
- primitive ord "primCharToInt" :: Char -> Int
- primitive chr "primIntToChar" :: Int -> Char
-
-
- isAscii, isControl, isPrint, isSpace :: Char -> Bool
- isUpper, isLower, isAlpha, isDigit, isAlphanum :: Char -> Bool
-
- isAscii c = ord c < 128
-
- isControl c = c < ' ' || c == '\DEL'
-
- isPrint c = c >= ' ' && c <= '~'
-
- isSpace c = c == ' ' || c == '\t' || c == '\n' || c == '\r' ||
- c == '\f' || c == '\v'
-
- isUpper c = c >= 'A' && c <= 'Z'
- isLower c = c >= 'a' && c <= 'z'
-
-
- 98
-
-
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- isAlpha c = isUpper c || isLower c
- isDigit c = c >= '0' && c <= '9'
- isAlphanum c = isAlpha c || isDigit c
-
-
- toUpper, toLower :: Char -> Char
-
- toUpper c | isLower c = chr (ord c - ord 'a' + ord 'A')
- | otherwise = c
-
- toLower c | isUpper c = chr (ord c - ord 'A' + ord 'a')
- | otherwise = c
-
- -- Standard type classes: ---------------------------------------------------
-
- class Eq a where
- (==), (/=) :: a -> a -> Bool
- x /= y = not (x == y)
-
- class Eq a => Ord a where
- (<), (<=), (>), (>=) :: a -> a -> Bool
- max, min :: a -> a -> a
-
- x < y = x <= y && x /= y
- x >= y = y <= x
- x > y = y < x
-
- max x y | x >= y = x
- | y >= x = y
- min x y | x <= y = x
- | y <= x = y
-
- class Ord a => Ix a where
- range :: (a,a) -> [a]
- index :: (a,a) -> a -> Int
- inRange :: (a,a) -> a -> Bool
-
- class Ord a => Enum a where
- enumFrom :: a -> [a] -- [n..]
- enumFromThen :: a -> a -> [a] -- [n,m..]
- enumFromTo :: a -> a -> [a] -- [n..m]
- enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m]
-
- enumFromTo n m = takeWhile (m>=) (enumFrom n)
- enumFromThenTo n n' m = takeWhile ((if n'>=n then (>=) else (<=)) m)
- (enumFromThen n n')
-
- class Eq a => Num a where -- simplified numeric class
- (+), (-), (*), (/) :: a -> a -> a
- negate :: a -> a
- fromInteger :: Int -> a
-
- -- Type class instances: ----------------------------------------------------
-
- primitive primEqInt "primEqInt",
- primLeInt "primLeInt" :: Int -> Int -> Bool
-
-
- 99
-
-
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- primitive primPlusInt "primPlusInt",
- primMinusInt "primMinusInt",
- primDivInt "primDivInt",
- primMulInt "primMulInt" :: Int -> Int -> Int
- primitive primNegInt "primNegInt" :: Int -> Int
-
- instance Eq Int where (==) = primEqInt
-
- instance Ord Int where (<=) = primLeInt
-
- instance Ix Int where
- range (m,n) = [m..n]
- index (m,n) i = i - m
- inRange (m,n) i = m <= i && i <= n
-
- instance Enum Int where
- enumFrom n = iterate (1+) n
- enumFromThen n m = iterate ((m-n)+) n
-
- instance Num Int where
- (+) = primPlusInt
- (-) = primMinusInt
- (*) = primMulInt
- (/) = primDivInt
- negate = primNegInt
- fromInteger x = x
-
- primitive primEqFloat "primEqFloat",
- primLeFloat "primLeFloat" :: Float -> Float -> Bool
- primitive primPlusFloat "primPlusFloat",
- primMinusFloat "primMinusFloat",
- primDivFloat "primDivFloat",
- primMulFloat "primMulFloat" :: Float -> Float -> Float
- primitive primNegFloat "primNegFloat" :: Float -> Float
- primitive primIntToFloat "primIntToFloat" :: Int -> Float
-
- instance Eq Float where (==) = primEqFloat
-
- instance Ord Float where (<=) = primLeFloat
-
- instance Enum Float where
- enumFrom n = iterate (1.0+) n
- enumFromThen n m = iterate ((m-n)+) n
-
- instance Num Float where
- (+) = primPlusFloat
- (-) = primMinusFloat
- (*) = primMulFloat
- (/) = primDivFloat
- negate = primNegFloat
- fromInteger = primIntToFloat
-
- instance Eq Char where c == d = ord c == ord d
-
- instance Ord Char where c <= d = ord c <= ord d
-
-
-
- 100
-
-
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- instance Ix Char where
- range (c,c') = [c..c']
- index (c,c') ci = ord ci - ord c
- inRange (c,c') ci = ord c <= i && i <= ord c' where i = ord ci
-
- instance Enum Char where
- enumFrom c = map chr [ord c ..]
- enumFromThen c c' = map chr [ord c, ord c' ..]
-
- instance Eq a => Eq [a] where
- [] == [] = True
- [] == (y:ys) = False
- (x:xs) == [] = False
- (x:xs) == (y:ys) = x==y && xs==ys
-
- instance Ord a => Ord [a] where
- [] <= _ = True
- (_:_) <= [] = False
- (x:xs) <= (y:ys) = x<y || (x==y && xs<=ys)
-
- instance (Eq a, Eq b) => Eq (a,b) where
- (x,y) == (u,v) = x==u && y==v
-
- instance Eq Bool where
- True == True = True
- False == False = True
- _ == _ = False
-
- -- Standard numerical functions: --------------------------------------------
-
- primitive div "primDivInt",
- rem "primRemInt",
- mod "primModInt" :: Int -> Int -> Int
-
- subtract :: Num a => a -> a -> a
- subtract = flip (-)
-
- even, odd :: Int -> Bool
- even x = x `rem` 2 == 0
- odd = not . even
-
- gcd :: Int -> Int -> Int
- gcd x y = gcd' (abs x) (abs y)
- where gcd' x 0 = x
- gcd' x y = gcd' y (x `rem` y)
-
- lcm :: Int -> Int -> Int
- lcm _ 0 = 0
- lcm 0 _ = 0
- lcm x y = abs ((x `div` gcd x y) * y)
-
- (^) :: Int -> Int -> Int
- x ^ 0 = 1
- x ^ (n+1) = f x n x
- where f _ 0 y = y
- f x n y = g x n where
-
-
- 101
-
-
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- g x n | even n = g (x*x) (n`div`2)
- | otherwise = f x (n-1) (x*y)
-
- abs :: Int -> Int
- abs x | x >= 0 = x
- | x < 0 = - x
-
- signum :: Int -> Int
- signum x | x == 0 = 0
- | x > 0 = 1
- | x < 0 = -1
-
- sum, product :: [Int] -> Int
- sum = foldl' (+) 0
- product = foldl' (*) 1
-
- sums, products :: [Int] -> [Int]
- sums = scanl (+) 0
- products = scanl (*) 1
-
- -- Standard list processing functions: --------------------------------------
-
- head :: [a] -> a
- head (x:_) = x
-
- last :: [a] -> a
- last [x] = x
- last (_:xs) = last xs
-
- tail :: [a] -> [a]
- tail (_:xs) = xs
-
- init :: [a] -> [a]
- init [x] = [x]
- init (x:xs) = x : init xs
-
- (++) :: [a] -> [a] -> [a] -- append lists. Associative with
- [] ++ ys = ys -- left and right identity [].
- (x:xs) ++ ys = x:(xs++ys)
-
- length :: [a] -> Int -- calculate length of list
- length = foldl' (\n _ -> n+1) 0
-
- (!!) :: [a] -> Int -> a -- xs!!n selects the nth element of
- (x:_) !! 0 = x -- the list xs (first element xs!!0)
- (_:xs) !! (n+1) = xs !! n -- for any n < length xs.
-
- iterate :: (a -> a) -> a -> [a] -- generate the infinite list
- iterate f x = x : iterate f (f x) -- [x, f x, f (f x), ...
-
- repeat :: a -> [a] -- generate the infinite list
- repeat x = xs where xs = x:xs -- [x, x, x, x, ...
-
- cycle :: [a] -> [a] -- generate the infinite list
- cycle xs = xs' where xs'=xs++xs'-- xs ++ xs ++ xs ++ ...
-
-
-
- 102
-
-
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- copy :: Int -> a -> [a] -- make list of n copies of x
- copy n x = take n xs where xs = x:xs
-
- nub :: Eq a => [a] -> [a] -- remove duplicates from list
- nub [] = []
- nub (x:xs) = x : nub (filter (x/=) xs)
-
- reverse :: [a] -> [a] -- reverse elements of list
- reverse = foldl (flip (:)) []
-
- elem, notElem :: Eq a => a -> [a] -> Bool
- elem = any . (==) -- test for membership in list
- notElem = all . (/=) -- test for non-membership
-
- maximum, minimum :: Ord a => [a] -> a
- maximum = foldl1 max -- max element in non-empty list
- minimum = foldl1 min -- min element in non-empty list
-
- concat :: [[a]] -> [a] -- concatenate list of lists
- concat = foldr (++) []
-
- transpose :: [[a]] -> [[a]] -- transpose list of lists
- transpose = foldr
- (\xs xss -> zipWith (:) xs (xss ++ repeat []))
- []
-
- -- null provides a simple and efficient way of determining whether a given
- -- list is empty, without using (==) and hence avoiding a constraint of the
- -- form Eq [a].
-
- null :: [a] -> Bool
- null [] = True
- null (_:_) = False
-
- -- (\\) is used to remove the first occurrence of each element in the second
- -- list from the first list. It is a kind of inverse of (++) in the sense
- -- that (xs ++ ys) \\ xs = ys for any finite list xs of proper values xs.
-
- (\\) :: Eq a => [a] -> [a] -> [a]
- (\\) = foldl del
- where [] `del` _ = []
- (x:xs) `del` y
- | x == y = xs
- | otherwise = x : xs `del` y
-
-
- -- map f xs applies the function f to each element of the list xs returning
- -- the corresponding list of results. filter p xs returns the sublist of xs
- -- containing those elements which satisfy the predicate p.
-
- map :: (a -> b) -> [a] -> [b]
- map f [] = []
- map f (x:xs) = f x : map f xs
-
- filter :: (a -> Bool) -> [a] -> [a]
- filter _ [] = []
-
-
- 103
-
-
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- filter p (x:xs)
- | p x = x : xs'
- | otherwise = xs'
- where xs' = filter p xs
-
- -- Fold primitives: The foldl and scanl functions, variants foldl1 and
- -- scanl1 for non-empty lists, and strict variants foldl' scanl' describe
- -- common patterns of recursion over lists. Informally:
- --
- -- foldl f a [x1, x2, ..., xn] = f (...(f (f a x1) x2)...) xn
- -- = (...((a `f` x1) `f` x2)...) `f` xn
- -- etc...
- --
- -- The functions foldr, scanr and variants foldr1, scanr1 are duals of these
- -- functions:
- -- e.g. foldr f a xs = foldl (flip f) a (reverse xs) for finite lists xs.
-
- foldl :: (a -> b -> a) -> a -> [b] -> a
- foldl f z [] = z
- foldl f z (x:xs) = foldl f (f z x) xs
-
- foldl1 :: (a -> a -> a) -> [a] -> a
- foldl1 f (x:xs) = foldl f x xs
-
- foldl' :: (a -> b -> a) -> a -> [b] -> a
- foldl' f a [] = a
- foldl' f a (x:xs) = strict (foldl' f) (f a x) xs
-
- scanl :: (a -> b -> a) -> a -> [b] -> [a]
- scanl f q xs = q : (case xs of
- [] -> []
- x:xs -> scanl f (f q x) xs)
-
- scanl1 :: (a -> a -> a) -> [a] -> [a]
- scanl1 f (x:xs) = scanl f x xs
-
- scanl' :: (a -> b -> a) -> a -> [b] -> [a]
- scanl' f q xs = q : (case xs of
- [] -> []
- x:xs -> strict (scanl' f) (f q x) xs)
-
- foldr :: (a -> b -> b) -> b -> [a] -> b
- foldr f z [] = z
- foldr f z (x:xs) = f x (foldr f z xs)
-
- foldr1 :: (a -> a -> a) -> [a] -> a
- foldr1 f [x] = x
- foldr1 f (x:xs) = f x (foldr1 f xs)
-
- scanr :: (a -> b -> b) -> b -> [a] -> [b]
- scanr f q0 [] = [q0]
- scanr f q0 (x:xs) = f x q : qs
- where qs@(q:_) = scanr f q0 xs
-
- scanr1 :: (a -> a -> a) -> [a] -> [a]
- scanr1 f [x] = [x]
-
-
- 104
-
-
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- scanr1 f (x:xs) = f x q : qs
- where qs@(q:_) = scanr1 f xs
-
- -- List breaking functions:
- --
- -- take n xs returns the first n elements of xs
- -- drop n xs returns the remaining elements of xs
- -- splitAt n xs = (take n xs, drop n xs)
- --
- -- takeWhile p xs returns the longest initial segment of xs whose
- -- elements satisfy p
- -- dropWhile p xs returns the remaining portion of the list
- -- span p xs = (takeWhile p xs, dropWhile p xs)
- --
- -- takeUntil p xs returns the list of elements upto and including the
- -- first element of xs which satisfies p
-
- take :: Int -> [a] -> [a]
- take 0 _ = []
- take _ [] = []
- take (n+1) (x:xs) = x : take n xs
-
- drop :: Int -> [a] -> [a]
- drop 0 xs = xs
- drop _ [] = []
- drop (n+1) (_:xs) = drop n xs
-
- splitAt :: Int -> [a] -> ([a], [a])
- splitAt 0 xs = ([],xs)
- splitAt _ [] = ([],[])
- splitAt (n+1) (x:xs) = (x:xs',xs'') where (xs',xs'') = splitAt n xs
-
- takeWhile :: (a -> Bool) -> [a] -> [a]
- takeWhile p [] = []
- takeWhile p (x:xs)
- | p x = x : takeWhile p xs
- | otherwise = []
-
- takeUntil :: (a -> Bool) -> [a] -> [a]
- takeUntil p [] = []
- takeUntil p (x:xs)
- | p x = [x]
- | otherwise = x : takeUntil p xs
-
- dropWhile :: (a -> Bool) -> [a] -> [a]
- dropWhile p [] = []
- dropWhile p xs@(x:xs')
- | p x = dropWhile p xs'
- | otherwise = xs
-
- span, break :: (a -> Bool) -> [a] -> ([a],[a])
- span p [] = ([],[])
- span p xs@(x:xs')
- | p x = let (ys,zs) = span p xs' in (x:ys,zs)
- | otherwise = ([],xs)
- break p = span (not . p)
-
-
- 105
-
-
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- -- Text processing:
- -- lines s returns the list of lines in the string s.
- -- words s returns the list of words in the string s.
- -- unlines ls joins the list of lines ls into a single string
- -- with lines separated by newline characters.
- -- unwords ws joins the list of words ws into a single string
- -- with words separated by spaces.
-
- lines :: String -> [String]
- lines "" = []
- lines s = l : (if null s' then [] else lines (tail s'))
- where (l, s') = break ('\n'==) s
-
- words :: String -> [String]
- words s = case dropWhile isSpace s of
- "" -> []
- s' -> w : words s''
- where (w,s'') = break isSpace s'
-
- unlines :: [String] -> String
- unlines = concat . map (\l -> l ++ "\n")
-
- unwords :: [String] -> String
- unwords [] = []
- unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
-
- -- Merging and sorting lists:
-
- merge :: Ord a => [a] -> [a] -> [a]
- merge [] ys = ys
- merge xs [] = xs
- merge (x:xs) (y:ys)
- | x <= y = x : merge xs (y:ys)
- | otherwise = y : merge (x:xs) ys
-
- sort :: Ord a => [a] -> [a]
- sort = foldr insert []
-
- insert :: Ord a => a -> [a] -> [a]
- insert x [] = [x]
- insert x (y:ys)
- | x <= y = x:y:ys
- | otherwise = y:insert x ys
-
- qsort :: Ord a => [a] -> [a]
- qsort [] = []
- qsort (x:xs) = qsort [ u | u<-xs, u<x ] ++
- [ x ] ++
- qsort [ u | u<-xs, u>=x ]
-
- -- zip and zipWith families of functions:
-
- zip :: [a] -> [b] -> [(a,b)]
- zip = zipWith (\a b -> (a,b))
-
- zip3 :: [a] -> [b] -> [c] -> [(a,b,c)]
-
-
- 106
-
-
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- zip3 = zipWith3 (\a b c -> (a,b,c))
-
- zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
- zip4 = zipWith4 (\a b c d -> (a,b,c,d))
-
- zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
- zip5 = zipWith5 (\a b c d e -> (a,b,c,d,e))
-
- zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a,b,c,d,e,f)]
- zip6 = zipWith6 (\a b c d e f -> (a,b,c,d,e,f))
-
- zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a,b,c,d,e,f,g)]
- zip7 = zipWith7 (\a b c d e f g -> (a,b,c,d,e,f,g))
-
-
- zipWith :: (a->b->c) -> [a]->[b]->[c]
- zipWith z (a:as) (b:bs) = z a b : zipWith z as bs
- zipWith _ _ _ = []
-
- zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d]
- zipWith3 z (a:as) (b:bs) (c:cs)
- = z a b c : zipWith3 z as bs cs
- zipWith3 _ _ _ _ = []
-
- zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
- zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
- = z a b c d : zipWith4 z as bs cs ds
- zipWith4 _ _ _ _ _ = []
-
- zipWith5 :: (a->b->c->d->e->f) -> [a]->[b]->[c]->[d]->[e]->[f]
- zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
- = z a b c d e : zipWith5 z as bs cs ds es
- zipWith5 _ _ _ _ _ _ = []
-
- zipWith6 :: (a->b->c->d->e->f->g)
- -> [a]->[b]->[c]->[d]->[e]->[f]->[g]
- zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
- = z a b c d e f : zipWith6 z as bs cs ds es fs
- zipWith6 _ _ _ _ _ _ _ = []
-
- zipWith7 :: (a->b->c->d->e->f->g->h)
- -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
- zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
- = z a b c d e f g : zipWith7 z as bs cs ds es fs gs
- zipWith7 _ _ _ _ _ _ _ _ = []
-
- -- Formatted output: --------------------------------------------------------
-
- primitive primPrint "primPrint" :: Int -> a -> String -> String
-
- show' :: a -> String
- show' x = primPrint 0 x []
-
- cjustify, ljustify, rjustify :: Int -> String -> String
-
- cjustify n s = space halfm ++ s ++ space (m - halfm)
-
-
- 107
-
-
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- where m = n - length s
- halfm = m `div` 2
- ljustify n s = s ++ space (n - length s)
- rjustify n s = space (n - length s) ++ s
-
- space :: Int -> String
- space n = copy n ' '
-
- layn :: [String] -> String
- layn = lay 1 where lay _ [] = []
- lay n (x:xs) = rjustify 4 (show n) ++ ") "
- ++ x ++ "\n" ++ lay (n+1) xs
-
- -- Miscellaneous: -----------------------------------------------------------
-
- until :: (a -> Bool) -> (a -> a) -> a -> a
- until p f x | p x = x
- | otherwise = until p f (f x)
-
- until' :: (a -> Bool) -> (a -> a) -> a -> [a]
- until' p f = takeUntil p . iterate f
-
- error :: String -> a
- error msg | False = error msg
-
- undefined :: a
- undefined | False = undefined
-
- asTypeOf :: a -> a -> a
- x `asTypeOf` _ = x
-
- -- A trimmed down version of the Haskell Text class: ------------------------
-
- type ShowS = String -> String
-
- class Text a where
- showsPrec :: Int -> a -> ShowS
- showList :: [a] -> ShowS
-
- showsPrec = primPrint
- showList [] = showString "[]"
- showList (x:xs) = showChar '[' . shows x . showl xs
- where showl [] = showChar ']'
- showl (x:xs) = showChar ',' . shows x . showl xs
-
- shows :: Text a => a -> ShowS
- shows = showsPrec 0
-
- show :: Text a => a -> String
- show x = shows x ""
-
- showChar :: Char -> ShowS
- showChar = (:)
-
- showString :: String -> ShowS
- showString = (++)
-
-
- 108
-
-
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- instance Text ()
-
- instance Text Int
-
- instance Text Char where
- showList cs = showChar '"' . showl cs
- where showl "" = showChar '"'
- showl ('"':cs) = showString "\\\"" . showl cs
- showl (c:cs) = showChar c . showl cs
- -- Haskell has showLitChar c . showl cs
-
- instance Text a => Text [a] where
- showsPrec p = showList
-
- instance (Text a, Text b) => Text (a,b) where
- showsPrec p (x,y) = showChar '(' . shows x . showChar ',' .
- shows y . showChar ')'
-
- -- I/O functions and definitions: -------------------------------------------
-
- stdin = "stdin"
- stdout = "stdout"
- stderr = "stderr"
- stdecho = "stdecho"
-
- data Request = -- file system requests:
- ReadFile String
- | WriteFile String String
- | AppendFile String String
- -- channel system requests:
- | ReadChan String
- | AppendChan String String
- -- environment requests:
- | Echo Bool
-
- data Response = Success
- | Str String
- | Failure IOError
-
- data IOError = WriteError String
- | ReadError String
- | SearchError String
- | FormatError String
- | OtherError String
-
- type Dialogue = [Response] -> [Request]
- type SuccCont = Dialogue
- type StrCont = String -> Dialogue
- type FailCont = IOError -> Dialogue
-
- done :: Dialogue
- readFile :: String -> FailCont -> StrCont -> Dialogue
- writeFile :: String -> String -> FailCont -> SuccCont -> Dialogue
- appendFile :: String -> String -> FailCont -> SuccCont -> Dialogue
- readChan :: String -> FailCont -> StrCont -> Dialogue
- appendChan :: String -> String -> FailCont -> SuccCont -> Dialogue
-
-
- 109
-
-
-
-
- Introduction to Gofer APPENDIX B: CONTENTS OF STANDARD PRELUDE
-
-
- echo :: Bool -> FailCont -> SuccCont -> Dialogue
-
- done resps = []
- readFile name fail succ resps =
- (ReadFile name) : strDispatch fail succ resps
- writeFile name contents fail succ resps =
- (WriteFile name contents) : succDispatch fail succ resps
- appendFile name contents fail succ resps =
- (AppendFile name contents) : succDispatch fail succ resps
- readChan name fail succ resps =
- (ReadChan name) : strDispatch fail succ resps
- appendChan name contents fail succ resps =
- (AppendChan name contents) : succDispatch fail succ resps
- echo bool fail succ resps =
- (Echo bool) : succDispatch fail succ resps
-
- strDispatch fail succ (resp:resps) =
- case resp of Str val -> succ val resps
- Failure msg -> fail msg resps
-
- succDispatch fail succ (resp:resps) =
- case resp of Success -> succ resps
- Failure msg -> fail msg resps
-
- abort :: FailCont
- abort err = done
-
- exit :: FailCont
- exit err = appendChan stdout msg abort done
- where msg = case err of ReadError s -> s
- WriteError s -> s
- SearchError s -> s
- FormatError s -> s
- OtherError s -> s
-
- print :: Text a => a -> Dialogue
- print x = appendChan stdout (show x) abort done
-
- prints :: Text a => a -> String -> Dialogue
- prints x s = appendChan stdout (shows x s) abort done
-
- interact :: (String -> String) -> Dialogue
- interact f = readChan stdin abort
- (\x -> appendChan stdout (f x) abort done)
-
- run :: (String -> String) -> Dialogue
- run f = echo False abort (interact f)
-
- -- End of Gofer standard prelude: --------------------------------------------
-
-
-
-
-
-
-
-
-
- 110
-
-
-