home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / languages / gofer / !Gofer / preludes / simple < prev    next >
Text File  |  1993-02-18  |  20KB  |  612 lines
  1. --         __________   __________   __________   __________   ________
  2. --        /  _______/  /  ____   /  /  _______/  /  _______/  /  ____  \
  3. --       /  / _____   /  /   /  /  /  /______   /  /______   /  /___/  /
  4. --      /  / /_   /  /  /   /  /  /  _______/  /  _______/  /  __   __/
  5. --     /  /___/  /  /  /___/  /  /  /         /  /______   /  /  \  \ 
  6. --    /_________/  /_________/  /__/         /_________/  /__/    \__\
  7. --
  8. --    Functional programming environment, Version 2.28
  9. --    Copyright Mark P Jones 1991-1993.
  10. --
  11. --    Simplified prelude, without any type classes and overloaded values
  12. --    Based on the Haskell standard prelude version 1.2.
  13. --
  14. --    This prelude file shows one approach to using Gofer without the
  15. --    use of overloaded implementations of show, <=, == etc.
  16. --
  17. --    Needless to say, some (most) of the Gofer demonstration programs
  18. --    cannot be used in connection with this prelude ... but a wide
  19. --    family of programs can be used without needing to worry about
  20. --    type classes at all.
  21. --
  22.  
  23. help = "press :? for a list of commands"
  24. quit = help ++ ", :q to quit"
  25.  
  26. -- Operator precedence table: ---------------------------------------------
  27.  
  28. infixl 9 !!
  29. infixr 9 .
  30. infixr 8 ^
  31. infixl 7 *
  32. infix  7 /, `div`, `quot`, `rem`, `mod`
  33. infixl 6 +, -
  34. infix  5 \\
  35. infixr 5 ++, :
  36. infix  4 ==, /=, <, <=, >=, >
  37. infix  4 `elem`, `notElem`
  38. infixr 3 &&
  39. infixr 2 ||
  40. infixr 0 $
  41.  
  42. -- Standard combinators: --------------------------------------------------
  43.  
  44. primitive strict "primStrict" :: (a -> b) -> a -> b
  45.  
  46. const          :: a -> b -> a
  47. const k x       = k
  48.  
  49. id             :: a -> a
  50. id    x         = x
  51.  
  52. curry          :: ((a,b) -> c) -> a -> b -> c
  53. curry f a b     =  f (a,b)
  54.  
  55. uncurry        :: (a -> b -> c) -> (a,b) -> c
  56. uncurry f (a,b) = f a b
  57.  
  58. fst            :: (a,b) -> a
  59. fst (x,_)       = x
  60.  
  61. snd            :: (a,b) -> b
  62. snd (_,y)       = y
  63.  
  64. fst3           :: (a,b,c) -> a
  65. fst3 (x,_,_)    = x
  66.  
  67. snd3           :: (a,b,c) -> b
  68. snd3 (_,x,_)    = x
  69.  
  70. thd3           :: (a,b,c) -> c
  71. thd3 (_,_,x)    = x
  72.  
  73. (.)            :: (b -> c) -> (a -> b) -> (a -> c)
  74. (f . g) x       = f (g x)
  75.  
  76. flip           :: (a -> b -> c) -> b -> a -> c
  77. flip  f x y     = f y x
  78.  
  79. ($)            :: (a -> b) -> a -> b   -- pronounced as `apply' elsewhere
  80. f $ x           = f x
  81.  
  82. -- Boolean functions: -----------------------------------------------------
  83.  
  84. (&&), (||)     :: Bool -> Bool -> Bool
  85. False && x      = False
  86. True  && x      = x
  87.  
  88. False || x      = x
  89. True  || x      = True
  90.  
  91. not            :: Bool -> Bool
  92. not True        = False
  93. not False       = True
  94.  
  95. and, or        :: [Bool] -> Bool
  96. and             = foldr (&&) True
  97. or              = foldr (||) False
  98.  
  99. any, all       :: (a -> Bool) -> [a] -> Bool
  100. any p           = or  . map p
  101. all p           = and . map p
  102.  
  103. otherwise      :: Bool
  104. otherwise       = True
  105.  
  106. -- Essentials and builtin primitives: ------------------------------------
  107.  
  108. primitive (==) "primGenericEq",
  109.           (/=) "primGenericNe",
  110.           (<=) "primGenericLe",
  111.           (<)  "primGenericLt",
  112.           (>=) "primGenericGe",
  113.           (>)  "primGenericGt"   :: a -> a -> Bool
  114.  
  115. max x y | x >= y    = x
  116.         | otherwise = y
  117. min x y | x <= y    = x
  118.         | otherwise = y
  119.  
  120. enumFrom n           = iterate (1+) n                           -- [n..]
  121. enumFromThen n m     = iterate ((m-n)+) n                       -- [n,m..]
  122. enumFromTo n m       = takeWhile (m>=) (enumFrom n)             -- [n..m]
  123. enumFromThenTo n o m = takeWhile 
  124.                              ((if o>=n then (>=) else (<=)) m) -- [n,o..m]
  125.                                  (enumFromThen n o)
  126.  
  127. primitive (+)    "primPlusInt",
  128.           (-)    "primMinusInt",
  129.           (/)    "primDivInt",
  130.           div    "primDivInt",
  131.           quot   "primQuotInt",
  132.           rem    "primRemInt",
  133.           mod    "primModInt",
  134.           (*)    "primMulInt"    :: Int -> Int -> Int
  135. primitive negate "primNegInt"    :: Int -> Int
  136.  
  137. primitive primPrint "primPrint"  :: Int -> a -> String -> String
  138.  
  139. show                ::  a -> String
  140. show x               =  primPrint 0 x []
  141.  
  142. -- Character functions: ---------------------------------------------------
  143.  
  144. primitive ord "primCharToInt" :: Char -> Int
  145. primitive chr "primIntToChar" :: Int -> Char
  146.  
  147. isAscii, isControl, isPrint, isSpace            :: Char -> Bool
  148. isUpper, isLower, isAlpha, isDigit, isAlphanum  :: Char -> Bool
  149.  
  150. isAscii c     =  ord c < 128
  151.  
  152. isControl c   =  c < ' '    ||  c == '\DEL'
  153.  
  154. isPrint c     =  c >= ' '   &&  c <= '~'
  155.  
  156. isSpace c     =  c == ' '   || c == '\t'  || c == '\n'  || c == '\r'  ||
  157.                                c == '\f'  || c == '\v'
  158.  
  159. isUpper c     =  c >= 'A'   &&  c <= 'Z'
  160. isLower c     =  c >= 'a'   &&  c <= 'z'
  161.  
  162. isAlpha c     =  isUpper c  ||  isLower c
  163. isDigit c     =  c >= '0'   &&  c <= '9'
  164. isAlphanum c  =  isAlpha c  ||  isDigit c
  165.  
  166.  
  167. toUpper, toLower      :: Char -> Char
  168.  
  169. toUpper c | isLower c  = chr (ord c - ord 'a' + ord 'A')
  170.           | otherwise  = c
  171.  
  172. toLower c | isUpper c  = chr (ord c - ord 'A' + ord 'a')
  173.           | otherwise  = c
  174.  
  175. minChar, maxChar      :: Char
  176. minChar                = chr 0
  177. maxChar                = chr 255
  178.  
  179. -- Standard numerical functions: -----------------------------------------
  180.  
  181. subtract  :: Int -> Int -> Int
  182. subtract   = flip (-)
  183.  
  184. even, odd :: Int -> Bool
  185. even x     = x `rem` 2 == 0
  186. odd        = not . even
  187.  
  188. gcd       :: Int -> Int -> Int
  189. gcd x y    = gcd' (abs x) (abs y)
  190.              where gcd' x 0 = x
  191.                    gcd' x y = gcd' y (x `rem` y)
  192.  
  193. lcm       :: Int -> Int -> Int
  194. lcm _ 0    = 0
  195. lcm 0 _    = 0
  196. lcm x y    = abs ((x `quot` gcd x y) * y)
  197.  
  198. (^)       :: Int -> Int -> Int
  199. x ^ 0      = 1
  200. x ^ (n+1)  = f x n x
  201.              where f _ 0 y = y
  202.                    f x n y = g x n where
  203.                              g x n | even n    = g (x*x) (n`quot`2)
  204.                                    | otherwise = f x (n-1) (x*y)
  205.  
  206. abs :: Int -> Int
  207. abs x    | x >= 0  = x
  208.          | x <  0  = - x
  209.  
  210. signum :: Int -> Int
  211. signum x | x == 0  = 0
  212.          | x > 0   = 1
  213.          | x < 0   = -1
  214.  
  215. sum, product    :: [Int] -> Int
  216. sum              = foldl' (+) 0
  217. product          = foldl' (*) 1
  218.  
  219. sums, products  :: [Int] -> [Int]
  220. sums             = scanl (+) 0
  221. products         = scanl (*) 1
  222.  
  223. -- Standard list processing functions: -----------------------------------
  224.  
  225. head             :: [a] -> a
  226. head (x:_)        = x
  227.  
  228. last             :: [a] -> a
  229. last [x]          = x
  230. last (_:xs)       = last xs
  231.  
  232. tail             :: [a] -> [a]
  233. tail (_:xs)       = xs
  234.  
  235. init             :: [a] -> [a]
  236. init [x]          = []
  237. init (x:xs)       = x : init xs
  238.  
  239. (++)             :: [a] -> [a] -> [a]    -- append lists.  Associative with
  240. []     ++ ys      = ys                   -- left and right identity [].
  241. (x:xs) ++ ys      = x:(xs++ys)
  242.  
  243. length           :: [a] -> Int           -- calculate length of list
  244. length            = foldl' (\n _ -> n+1) 0
  245.  
  246. (!!)             :: [a] -> Int -> a    -- xs!!n selects the nth element of
  247. (x:_)  !! 0       = x                  -- the list xs (first element xs!!0)
  248. (_:xs) !! (n+1)   = xs !! n              -- for any n < length xs.
  249.  
  250. iterate          :: (a -> a) -> a -> [a] -- generate the infinite list
  251. iterate f x       = x : iterate f (f x)  -- [x, f x, f (f x), ...
  252.  
  253. repeat           :: a -> [a]             -- generate the infinite list
  254. repeat x          = xs where xs = x:xs   -- [x, x, x, x, ...
  255.  
  256. cycle            :: [a] -> [a]           -- generate the infinite list
  257. cycle xs          = xs' where xs'=xs++xs'-- xs ++ xs ++ xs ++ ...
  258.  
  259. copy             :: Int -> a -> [a]      -- make list of n copies of x
  260. copy n x          = take n xs where xs = x:xs
  261.  
  262. nub              :: [a] -> [a]           -- remove duplicates from list
  263. nub []            = []
  264. nub (x:xs)        = x : nub (filter (x/=) xs)
  265.  
  266. reverse          :: [a] -> [a]           -- reverse elements of list
  267. reverse           = foldl (flip (:)) []
  268.  
  269. elem, notElem    :: a -> [a] -> Bool
  270. elem              = any . (==)           -- test for membership in list
  271. notElem           = all . (/=)           -- test for non-membership
  272.  
  273. maximum, minimum :: [a] -> a
  274. maximum           = foldl1 max          -- max element in non-empty list
  275. minimum           = foldl1 min          -- min element in non-empty list