home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / languages / gofer / !Gofer / preludes / gcwmin < prev    next >
Text File  |  1994-05-20  |  19KB  |  628 lines
  1. --         __________   __________   __________   __________   ________
  2. --        /  _______/  /  ____   /  /  _______/  /  _______/  /  ____  \
  3. --       /  / _____   /  /   /  /  /  /______   /  /______   /  /___/  /
  4. --      /  / /_   /  /  /   /  /  /  _______/  /  _______/  /  __   __/
  5. --     /  /___/  /  /  /___/  /  /  /         /  /______   /  /  \  \ 
  6. --    /_________/  /_________/  /__/         /_________/  /__/    \__\
  7. --
  8. --    Functional programming environment, Version 2.28
  9. --    Copyright Mark P Jones 1991-1993.
  10. --
  11. --    Minimal Gofer prelude for experimentation with different approaches
  12. --    to standard operations.
  13. --
  14. --   Any Gofer prelude file should typically include at least the following
  15. --   definitions:
  16.  
  17. infixr 5 :
  18. infixr 3 &&
  19. infixr 2 ||
  20.  
  21. (&&), (||)     :: Bool -> Bool -> Bool
  22. False && _      = False     -- (&&) and (||) names predefined in Gofer
  23. True  && x      = x
  24. False || x      = x
  25. True  || _      = True
  26.  
  27. flip           :: (a -> b -> c) -> b -> a -> c
  28. flip  f x y     =  f y x
  29.  
  30. -- Primitives -----------------------------------------------------------
  31.  
  32. primitive error "primError" :: String -> a
  33.  
  34. -- End of minimal prelude ----------------------------------------------
  35.  
  36. primitive strict "primStrict" :: (a -> b) -> a -> b
  37.  
  38. -- Format primitives ----------------------------------------------------
  39.  
  40. primitive primPrint "primPrint"  :: Int -> a -> String -> String
  41. primitive primShowsInt "primShowsInt" :: Int -> Int -> String -> String
  42. primitive primShowsFloat "primShowsFloat" :: 
  43.                      Int -> Float -> String -> String
  44.  
  45. -- Character primitives -------------------------------------------------
  46.  
  47. primitive primEqChar   "primEqChar",
  48.           primLeChar   "primLeChar"  :: Char -> Char -> Bool
  49. primitive ord "primCharToInt" :: Char -> Int
  50. primitive chr "primIntToChar" :: Int -> Char
  51.  
  52. -- Integer primitives --------------------------------------------------
  53.  
  54. primitive primEqInt    "primEqInt",
  55.           primLeInt    "primLeInt"   :: Int -> Int -> Bool
  56. primitive primPlusInt  "primPlusInt",
  57.           primMinusInt "primMinusInt",
  58.           primDivInt   "primDivInt",
  59.           primMulInt   "primMulInt"  :: Int -> Int -> Int
  60. primitive primNegInt   "primNegInt"  :: Int -> Int
  61. primitive quot   "primQuotInt",
  62.           rem    "primRemInt",
  63.           mod    "primModInt"    :: Int -> Int -> Int
  64.  
  65.  
  66. -- Float primitives ---------------------------------------------------
  67.  
  68. primitive primEqFloat    "primEqFloat",
  69.           primLeFloat    "primLeFloat"    :: Float -> Float -> Bool
  70. primitive primPlusFloat  "primPlusFloat", 
  71.           primMinusFloat "primMinusFloat", 
  72.           primDivFloat   "primDivFloat",
  73.           primMulFloat   "primMulFloat"   :: Float -> Float -> Float 
  74. primitive primNegFloat   "primNegFloat"   :: Float -> Float
  75. primitive primIntToFloat "primIntToFloat" :: Int -> Float
  76. primitive truncate "primFloatToInt" :: Float -> Int
  77.  
  78. -- Trigonometric primitives ------------------------------------
  79.  
  80. primitive sin  "primSinFloat",  asin  "primAsinFloat",
  81.           cos  "primCosFloat",  acos  "primAcosFloat",
  82.           tan "primTanFloat",  atan  "primAtanFloat",
  83.           primLogFloat  "primLogFloat",  log10 "primLog10Float",
  84.           primExpFloat  "primExpFloat",  sqrt  "primSqrtFloat" 
  85.                             :: Float -> Float
  86. primitive atan2    "primAtan2Float" :: Float -> Float -> Float
  87.  
  88. -- IO ------------------------------------------------------------
  89.  
  90. stdin         =  "stdin"
  91. stdout        =  "stdout"
  92. stderr        =  "stderr"
  93. stdecho       =  "stdecho"
  94.  
  95. {- The Dialogue, Request, Response and IOError datatypes are now built-in:
  96. data Request  =  -- file system requests:
  97.                 ReadFile      String         
  98.               | WriteFile     String String
  99.               | AppendFile    String String
  100.                  -- channel system requests:
  101.               | ReadChan      String 
  102.               | AppendChan    String String
  103.                  -- environment requests:
  104.               | Echo          Bool
  105.               | GetArgs
  106.               | GetProgName
  107.               | GetEnv        String
  108.  
  109. data Response = Success
  110.               | Str     String 
  111.               | Failure IOError
  112.               | StrList [String]
  113.  
  114. data IOError  = WriteError   String
  115.               | ReadError    String
  116.               | SearchError  String
  117.               | FormatError  String
  118.               | OtherError   String
  119.  
  120. type Dialogue    =  [Response] -> [Request]
  121. -}
  122.  
  123. run             :: (String -> String) -> Dialogue
  124. run f ~(Success : ~(Str kbd : _))
  125.              = [Echo False, ReadChan "stdin", AppendChan "stdout" (f kbd)]
  126.  
  127. primitive primFopen "primFopen" :: String -> a -> (String -> a) -> a
  128.  
  129. openfile        :: String -> String
  130. openfile f       = primFopen f (error ("can't open file "++f)) id
  131.  
  132. --- Fixities ------------------------------------------------------------
  133.  
  134. infixl 9 !!
  135. infixr 9 .
  136. infixr 8 ^
  137. infixl 7 *, :/, /
  138. infix  7  `quot`, `rem`, `mod`
  139. infixl 6 +, -, :+!
  140. infixr 5 ++
  141. infix  4 ==, /=, <, <=, >=, >
  142. infixl 2 `bind`, `hcf`
  143.  
  144. -- Standard synonyms --------------------
  145.  
  146. type Rel a = a -> a -> Bool
  147. type BinOp a = a -> a -> a
  148.  
  149. -- Standard type classes: -----------------------------------------------
  150.  
  151. class Eq a where
  152.     (==), (/=) :: Rel a
  153.     x /= y      = not (x == y)
  154. -- (x == x) === True
  155. -- (x == y) === (y == x)
  156. -- (x == y) && (y == z) ==> (x == z) 
  157.  
  158. class Eq a => Ord a where
  159.     (<), (<=), (>), (>=) :: Rel a
  160.     max, min             :: BinOp a
  161.  
  162.     x <  y            = x <= y && x /= y
  163.     x >= y            = y <= x
  164.     x >  y            = y < x
  165.  
  166.     max x y | x >= y  = x
  167.             | y >= x  = y
  168.     min x y | x <= y  = x
  169.             | y <= x  = y
  170.  
  171. -- x <= x === True
  172. -- (x <= y) && (y <= z) ==> (x <= z)
  173.  
  174. class Ord a => Ix a where
  175.     range   :: (a,a) -> [a]
  176.     index   :: (a,a) -> a -> Int
  177.     inRange :: (a,a) -> a -> Bool
  178.  
  179. class Ord a => Enum a where
  180.     enumFrom       :: a -> [a]              -- [n..]
  181.     enumFromThen   :: a -> a -> [a]         -- [n,m..]
  182.     enumFromTo     :: a -> a -> [a]         -- [n..m]
  183.     enumFromThenTo :: a -> a -> a -> [a]    -- [n,n'..m]
  184.  
  185.     enumFromTo n m        = takeWhile (m>=) (enumFrom n)
  186.     enumFromThenTo n n' m = takeWhile ((if n'>=n then (>=) else (<=)) m)
  187.                                       (enumFromThen n n')
  188.  
  189. class LeftMul a b where
  190.     (*) :: a -> b -> b
  191.  
  192. class Add a where
  193.      (+),(-) :: BinOp a
  194.      negate  :: a -> a
  195.      zero    :: a
  196.      negate x = zero - x
  197. -- x + (y + z) === (x + y) + z
  198. -- x + y === y + x
  199. -- zero + x === x
  200. -- x + zero === x
  201. -- x - x === zero
  202.  
  203. class LeftMul a a => Mult a where
  204.      unit     :: a
  205.      (^)      :: a -> Int -> a
  206.      x ^ 0     = unit
  207.      x ^ 1     = x
  208.      x ^ (2*n) = (x*x)^n
  209.      x ^ (2*n+1) = x*(x*x)^n
  210. -- x*(y*z) === (x*y)*z
  211. -- unit*x === x
  212.  
  213. class Div a b where
  214.      (/) :: a -> b -> a
  215.  
  216. class (Div a a, Add a, Mult a, Div a Int, LeftMul Int a) => Exp a where
  217.      exp, log, cosh, sinh, tanh :: a -> a
  218.      cosh x = (exp(x) + exp(-x))/2
  219.      sinh x = (exp(x) - exp(-x))/2
  220.      tanh x = (a-unit)/(a+unit) where a = exp(2*x)
  221.  
  222. class Functor f where
  223.     map :: (a -> b) -> (f a -> f b)
  224. -- map (u.v) === (map u).(map v)
  225. -- map id === id
  226.  
  227. class Functor m => Monad m where
  228.     result    :: a -> m a
  229.     join      :: m (m a) -> m a
  230.     bind      :: m a -> (a -> m b) -> m b
  231.     join x     = bind x (\y->y)
  232.     x `bind` f = join (map f x)
  233. -- (map u).result === result.(map u)
  234. -- (map u).join === join.(map (map u))
  235. -- join.(map result) === id
  236. -- join.result === id
  237. -- join.join === join.(map join)
  238.  
  239. class Monad m => Monad0 m where
  240.     nil   :: m a
  241. -- map _ nil === nil
  242. -- join nil === nil
  243.  
  244. class Monad0 c => MonadPlus c where
  245.     (++) :: c a -> c a -> c a
  246. -- nil ++ x === x
  247. -- x ++ (y ++ z) === (x ++ y) ++ z
  248.  
  249. -- A trimmed down version of the Haskell Text class: ---------------------
  250.  
  251. type  ShowS   = String -> String
  252.  
  253. class Text a where 
  254.     showsPrec      :: Int -> a -> ShowS
  255.     showList       :: [a] -> ShowS
  256.     showsPrec       = primPrint
  257.     showList []     = showString "[]"
  258.     showList (x:xs) = showChar '[' . shows x . showl xs
  259.                     where showl []     = showChar ']'
  260.                           showl (x:xs) = showChar ',' . shows x . showl xs
  261.  
  262. shows      :: Text a => a