home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / languages / gofer / !Gofer / preludes / standard < prev   
Text File  |  1993-02-18  |  28KB  |  862 lines
  1. --         __________   __________   __________   __________   ________
  2. --        /  _______/  /  ____   /  /  _______/  /  _______/  /  ____  \
  3. --       /  / _____   /  /   /  /  /  /______   /  /______   /  /___/  /
  4. --      /  / /_   /  /  /   /  /  /  _______/  /  _______/  /  __   __/
  5. --     /  /___/  /  /  /___/  /  /  /         /  /______   /  /  \  \ 
  6. --    /_________/  /_________/  /__/         /_________/  /__/    \__\
  7. --
  8. --    Functional programming environment, Version 2.28
  9. --    Copyright Mark P Jones 1991-1993.
  10. --
  11. --    Standard prelude for use of overloaded values using type classes.
  12. --    Based on the Haskell standard prelude version 1.2.
  13.  
  14. help = "press :? for a list of commands"
  15.  
  16. -- Operator precedence table: ---------------------------------------------
  17.  
  18. infixl 9 !!
  19. infixr 9 .
  20. infixr 8 ^
  21. infixl 7 *
  22. infix  7 /, `div`, `quot`, `rem`, `mod`
  23. infixl 6 +, -
  24. infix  5 \\
  25. infixr 5 ++, :
  26. infix  4 ==, /=, <, <=, >=, >
  27. infix  4 `elem`, `notElem`
  28. infixr 3 &&
  29. infixr 2 ||
  30. infixr 0 $
  31.  
  32. -- Standard combinators: --------------------------------------------------
  33.  
  34. primitive strict "primStrict" :: (a -> b) -> a -> b
  35.  
  36. const          :: a -> b -> a
  37. const k x       = k
  38.  
  39. id             :: a -> a
  40. id    x         = x
  41.  
  42. curry          :: ((a,b) -> c) -> a -> b -> c
  43. curry f a b     =  f (a,b)
  44.  
  45. uncurry        :: (a -> b -> c) -> (a,b) -> c
  46. uncurry f (a,b) = f a b
  47.  
  48. fst            :: (a,b) -> a
  49. fst (x,_)       = x
  50.  
  51. snd            :: (a,b) -> b
  52. snd (_,y)       = y
  53.  
  54. fst3           :: (a,b,c) -> a
  55. fst3 (x,_,_)    = x
  56.  
  57. snd3           :: (a,b,c) -> b
  58. snd3 (_,x,_)    = x
  59.  
  60. thd3           :: (a,b,c) -> c
  61. thd3 (_,_,x)    = x
  62.  
  63. (.)            :: (b -> c) -> (a -> b) -> (a -> c)
  64. (f . g) x       = f (g x)
  65.  
  66. flip           :: (a -> b -> c) -> b -> a -> c
  67. flip  f x y     = f y x
  68.  
  69. ($)            :: (a -> b) -> a -> b   -- pronounced as `apply' elsewhere
  70. f $ x           = f x
  71.  
  72. -- Boolean functions: -----------------------------------------------------
  73.  
  74. (&&), (||)     :: Bool -> Bool -> Bool
  75. False && x      = False
  76. True  && x      = x
  77.  
  78. False || x      = x
  79. True  || x      = True
  80.  
  81. not            :: Bool -> Bool
  82. not True        = False
  83. not False       = True
  84.  
  85. and, or        :: [Bool] -> Bool
  86. and             = foldr (&&) True
  87. or              = foldr (||) False
  88.  
  89. any, all       :: (a -> Bool) -> [a] -> Bool
  90. any p           = or  . map p
  91. all p           = and . map p
  92.  
  93. otherwise      :: Bool
  94. otherwise       = True
  95.  
  96. -- Character functions: ---------------------------------------------------
  97.  
  98. primitive ord "primCharToInt" :: Char -> Int
  99. primitive chr "primIntToChar" :: Int -> Char
  100.  
  101. isAscii, isControl, isPrint, isSpace            :: Char -> Bool
  102. isUpper, isLower, isAlpha, isDigit, isAlphanum  :: Char -> Bool
  103.  
  104. isAscii c     =  ord c < 128
  105.  
  106. isControl c   =  c < ' '    ||  c == '\DEL'
  107.  
  108. isPrint c     =  c >= ' '   &&  c <= '~'
  109.  
  110. isSpace c     =  c == ' '   || c == '\t'  || c == '\n'  || c == '\r'  ||
  111.                                c == '\f'  || c == '\v'
  112.  
  113. isUpper c     =  c >= 'A'   &&  c <= 'Z'
  114. isLower c     =  c >= 'a'   &&  c <= 'z'
  115.  
  116. isAlpha c     =  isUpper c  ||  isLower c
  117. isDigit c     =  c >= '0'   &&  c <= '9'
  118. isAlphanum c  =  isAlpha c  ||  isDigit c
  119.  
  120.  
  121. toUpper, toLower      :: Char -> Char
  122.  
  123. toUpper c | isLower c  = chr (ord c - ord 'a' + ord 'A')
  124.           | otherwise  = c
  125.  
  126. toLower c | isUpper c  = chr (ord c - ord 'A' + ord 'a')
  127.           | otherwise  = c
  128.  
  129. minChar, maxChar      :: Char
  130. minChar                = chr 0
  131. maxChar                = chr 255
  132.  
  133. -- Standard type classes: -------------------------------------------------
  134.  
  135. class Eq a where
  136.     (==), (/=) :: a -> a -> Bool
  137.     x /= y      = not (x == y)
  138.  
  139. class Eq a => Ord a where
  140.     (<), (<=), (>), (>=) :: a -> a -> Bool
  141.     max, min             :: a -> a -> a
  142.  
  143.     x <  y            = x <= y && x /= y
  144.     x >= y            = y <= x
  145.     x >  y            = y < x
  146.  
  147.     max x y | x >= y  = x
  148.             | y >= x  = y
  149.     min x y | x <= y  = x
  150.             | y <= x  = y
  151.  
  152. class Ord a => Ix a where
  153.     range   :: (a,a) -> [a]
  154.     index   :: (a,a) -> a -> Int
  155.     inRange :: (a,a) -> a -> Bool
  156.  
  157. class Ord a => Enum a where
  158.     enumFrom       :: a -> [a]              -- [n..]
  159.     enumFromThen   :: a -> a -> [a]         -- [n,m..]
  160.     enumFromTo     :: a -> a -> [a]         -- [n..m]
  161.     enumFromThenTo :: a -> a -> a -> [a]    -- [n,n'..m]
  162.  
  163.     enumFromTo n m        = takeWhile (m>=) (enumFrom n)
  164.     enumFromThenTo n n' m = takeWhile ((if n'>=n then (>=) else (<=)) m)
  165.                                       (enumFromThen n n')
  166.  
  167. class (Eq a, Text a) => Num a where         -- simplified numeric class
  168.     (+), (-), (*), (/) :: a -> a -> a
  169.     negate             :: a -> a
  170.     fromInteger        :: Int -> a
  171.  
  172. -- Type class instances: --------------------------------------------------
  173.  
  174. primitive primEqInt    "primEqInt",
  175.           primLeInt    "primLeInt"   :: Int -> Int -> Bool
  176. primitive primPlusInt  "primPlusInt",
  177.           primMinusInt "primMinusInt",
  178.           primDivInt   "primDivInt",
  179.           primMulInt   "primMulInt"  :: Int -> Int -> Int
  180. primitive primNegInt   "primNegInt"  :: Int -> Int
  181.  
  182. instance Eq ()  where () == () = True
  183. instance Ord () where () <= () = True
  184.  
  185. instance Eq Int  where (==) = primEqInt
  186.  
  187. instance Ord Int where (<=) = primLeInt
  188.  
  189. instance Ix Int where
  190.     range (m,n)      = [m..n]
  191.     index (m,n) i    = i - m
  192.     inRange (m,n) i  = m <= i && i <= n
  193.  
  194. instance Enum Int where
  195.     enumFrom n       = iterate (1+) n
  196.     enumFromThen n m = iterate ((m-n)+) n
  197.  
  198. instance Num Int where
  199.     (+)           = primPlusInt
  200.     (-)           = primMinusInt
  201.     (*)           = primMulInt
  202.     (/)           = primDivInt
  203.     negate        = primNegInt
  204.     fromInteger x = x
  205.  
  206. {- PC version off -}
  207. primitive primEqFloat    "primEqFloat",
  208.           primLeFloat    "primLeFloat"    :: Float -> Float -> Bool
  209. primitive primPlusFloat  "primPlusFloat", 
  210.           primMinusFloat "primMinusFloat", 
  211.           primDivFloat   "primDivFloat",
  212.           primMulFloat   "primMulFloat"   :: Float -> Float -> Float 
  213. primitive primNegFloat   "primNegFloat"   :: Float -> Float
  214. primitive primIntToFloat "primIntToFloat" :: Int -> Float
  215.  
  216. instance Eq Float where (==) = primEqFloat
  217.  
  218. instance Ord Float where (<=) = primLeFloat
  219.  
  220. instance Enum Float where
  221.     enumFrom n       = iterate (1.0+) n
  222.     enumFromThen n m = iterate ((m-n)+) n
  223.  
  224. instance Num Float where
  225.     (+)         = primPlusFloat
  226.     (-)         = primMinusFloat
  227.     (*)         = primMulFloat
  228.     (/)         = primDivFloat 
  229.     negate      = primNegFloat
  230.     fromInteger = primIntToFloat
  231.  
  232. primitive sin "primSinFloat",  asin  "primAsinFloat",
  233.           cos "primCosFloat",  acos  "primAcosFloat",
  234.           tan "primTanFloat",  atan  "primAtanFloat",
  235.           log "primLogFloat",  log10 "primLog10Float",
  236.           exp "primExpFloat",  sqrt  "primSqrtFloat" :: Float -> Float
  237. primitive atan2    "primAtan2Float" :: Float -> Float -> Float
  238. primitive truncate "primFloatToInt" :: Float -> Int
  239.  
  240. pi :: Float
  241. pi  = 3.1415926535
  242.  
  243. {- PC version on -}
  244.  
  245. primitive primEqChar   "primEqChar",
  246.           primLeChar   "primLeChar"  :: Char -> Char -> Bool
  247.  
  248. instance Eq Char  where (==) = primEqChar   -- c == d  =  ord c == ord d
  249.  
  250. instance Ord Char where (<=) = primLeChar   -- c <= d  =  ord c <= ord d
  251.  
  252. instance Ix Char where
  253.     range (c,c')      = [c..c']
  254.     index (c,c') ci   = ord ci - ord c
  255.     inRange (c,c') ci = ord c <= i && i <= ord c' where i = ord ci
  256.  
  257. instance Enum Char where
  258.     enumFrom c        = map chr [ord c .. ord maxChar]
  259.     enumFromThen c c' = map chr [ord c, ord c' .. ord lastChar]
  260.                       where lastChar = if c' < c then minChar else maxChar
  261.  
  262. instance Eq a => Eq [a] where
  263.     []     == []     =  True
  264.     []     == (y:ys) =  False
  265.     (x:xs) == []     =  False
  266.     (x:xs) == (y:ys) =  x==y && xs==ys
  267.  
  268. instance Ord a => Ord [a] where
  269.     []     <= _      =  True
  270.     (_:_)  <= []     =  False
  271.     (x:xs) <= (y:ys) =  x<y || (x==y && xs<=ys)
  272.  
  273. instance (Eq a, Eq b) => Eq (a,b) where
  274.     (x,y) == (u,v)  =  x==u && y==v
  275.  
  276. instance (Ord a, Ord b) => Ord (a,b) where
  277.     (x,y) <= (u,v)  = x<u  ||  (x==u && y<=v)
  278.  
  279. instance Eq Bool where
  280.     True  == True   =  True
  281.     False == False  =  True
  282.     _     == _      =  Fa