home *** CD-ROM | disk | FTP | other *** search
/ PSION CD 2 / PsionCDVol2.iso / Programs / 876 / hugs.sis / Trex.hs < prev    next >
Encoding:
Text File  |  2000-09-21  |  1.8 KB  |  56 lines
  1. -----------------------------------------------------------------------------
  2. -- Trex utilities:  Functions to compare and show record values
  3. --
  4. -- Warning: This file is an integral part of the TREX implementation, and
  5. -- should not be modified without corresponding changes in the interpreter.
  6. --
  7. -- Suitable for use with Hugs 98, if compiled with TREX support.
  8. -----------------------------------------------------------------------------
  9.  
  10. module Trex( module Prelude, ShowRecRow(..), EqRecRow(..), insertField ) where
  11.  
  12. -- Code for equalities:
  13.  
  14. instance EqRecRow r => Eq (Rec r) where
  15.   r == s = eqFields (eqRecRow r s)
  16.            where eqFields = and . map snd
  17.  
  18. class EqRecRow r where
  19.   eqRecRow :: Rec r -> Rec r -> [(String,Bool)]
  20.  
  21. instance EqRecRow EmptyRow where
  22.   eqRecRow _ _ = []
  23.  
  24.  
  25. -- Code for showing values:
  26.  
  27. instance ShowRecRow r => Show (Rec r) where
  28.   showsPrec d = showFields . showRecRow
  29.    where
  30.     showFields   :: [(String, ShowS)] -> ShowS
  31.     showFields [] = showString "EmptyRec"
  32.     showFields xs = showChar '(' . foldr1 comma (map fld xs) . showChar ')'
  33.      where comma a b = a . showString ", " . b
  34.            fld (s,v) = showString s . showChar '=' . v
  35.  
  36. class ShowRecRow r where
  37.   showRecRow :: Rec r -> [(String, ShowS)]
  38.  
  39. instance ShowRecRow EmptyRow where
  40.   showRecRow _ = []
  41.  
  42.  
  43. -- General utility:
  44.  
  45. insertField       :: String -> v -> [(String, v)] -> [(String, v)]
  46. insertField n v fs = {- case fs of
  47.                        []     -> [(n,v)]
  48.                        (r:rs) -> if n <= fst r
  49.                                    then (n,v):fs
  50.                                    else r : insertField n v rs -}
  51.                      bef ++ [(n,v)] ++ aft
  52.  where (bef,aft) = span (\r -> n > fst r) fs
  53.  
  54. -----------------------------------------------------------------------------
  55.  
  56.