home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Misc / GOFER2,03aBugFix.LHA / Gofer230a / gs / array.gs next >
Encoding:
Text File  |  1994-06-23  |  4.2 KB  |  107 lines
  1. -------------------------------------------------------------------------------
  2. -- This file contains a Gofer implementation of the Haskell array datatype
  3. -- using new Gofer primitives added in Gofer 2.30.
  4. --
  5. -- This file requires the standard, or cc prelude.
  6. -- You will not be able to use this file unless the version of Gofer that
  7. -- is installed on your machine has been compiled with the HASKELL_ARRAYS
  8. -- flag set to 1.
  9. --
  10. -- Based on the standard prelude for Haskell 1.2.
  11. -- Mark P Jones, 1994
  12. -------------------------------------------------------------------------------
  13.  
  14. module PreludeArray( Array, Assoc((:=)), array, listArray, (!), bounds,
  15.                     indices, elems, assocs, accumArray, (//), accum, amap,
  16.                     ixmap
  17.                   ) where
  18.  
  19. infixl 9 !
  20. infixl 9 //
  21. infix  1 :=
  22.  
  23. -- Associations:  Frankly, any pair type would do just as well ... ------------
  24.  
  25. data Assoc a b =  a := b
  26.  
  27. instance (Eq a, Eq b) => Eq (Assoc a b) where
  28.     (x := y) == (u := v)  =  x==u && y==v
  29.  
  30. instance (Ord a, Ord b) => Ord (Assoc a b) where
  31.     (x := y) <= (u := v)  =  x<u  ||  (x==u && y<=v)
  32.  
  33. instance (Text a, Text b) => Text (Assoc a b) where
  34.     showsPrec d (x := y)
  35.        = if d > 1 then showChar '(' . s . showChar ')'
  36.                   else s
  37.          where s = showsPrec 2 x . showString " := " . showsPrec 2 y
  38.  
  39. -- Array primitives: ----------------------------------------------------------
  40.  
  41. array      :: Ix a => (a,a) -> [Assoc a b] -> Array a b
  42. listArray  :: Ix a => (a,a) -> [b] -> Array a b
  43. (!)       :: Ix a => Array a b -> a -> b
  44. bounds     :: Ix a => Array a b -> (a,a)
  45. indices       :: Ix a => Array a b -> [a]
  46. elems      :: Ix a => Array a b -> [b]
  47. assocs       :: Ix a => Array a b -> [Assoc a b]
  48. accumArray :: Ix a => (b -> c -> b) -> b -> (a,a) -> [Assoc a c] -> Array a b
  49. (//)       :: Ix a => Array a b -> [Assoc a b] -> Array a b
  50. accum      :: Ix a => (b -> c -> b) -> Array a b -> [Assoc a c] -> Array a b
  51. amap       :: Ix a => (b -> c) -> Array a b -> Array a c
  52. ixmap       :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a c
  53.  
  54. instance (Ix a, Eq [Assoc a b]) => Eq (Array a b) where
  55.     a == a'   =   assocs a == assocs a'
  56.  
  57. instance (Ix a, Ord [Assoc a b]) => Ord (Array a b) where
  58.     a <= a'   =   assocs a <= assocs a'
  59.  
  60. instance (Ix a, Text (a,a), Text [Assoc a b]) => Text (Array a b) where
  61.     showsPrec p a = if (p>9) then showChar '(' . s . showChar ')' else s
  62.      where s = showString "array " .
  63.            shows (bounds a)    .
  64.            showChar ' '        .
  65.            shows (assocs a)
  66.  
  67. -- Implementation: ------------------------------------------------------------
  68.  
  69. primitive primArray "primArray"
  70.     :: (a -> Int) -> (a,a) -> [Assoc a b] -> Array a b
  71. primitive primUpdate "primUpdate"
  72.     :: (a -> Int) -> Array a b -> [Assoc a b] -> Array a b
  73. primitive primAccum "primAccum"
  74.     :: (a -> Int) -> (b -> c -> b) -> Array a b -> [Assoc a c] -> Array a b
  75. primitive primAccumArray "primAccumArray"
  76.     :: (a -> Int) -> (b -> c -> b) -> b -> (a,a) -> [Assoc a c] -> Array a b
  77. primitive primBounds    "primBounds"    :: Array a b -> (a,a)
  78. primitive primElems     "primElems"     :: Array a b -> [b]
  79. primitive primSubscript "primSubscript" :: (a -> Int) -> Array a b -> a -> b
  80. primitive primAmap      "primAmap"    :: (b -> c) -> Array a b -> Array a c
  81.  
  82. array bounds assocs = primArray (index bounds) bounds assocs
  83. listArray b vs        = array b (zipWith (:=) (range b) vs)
  84. (!) a               = primSubscript (index (bounds a)) a 
  85. bounds              = primBounds
  86. indices            = range . bounds
  87. elems               = primElems
  88. assocs a            = zipWith (:=) (indices a) (elems a)
  89. accumArray f z b    = primAccumArray (index b) f z b
  90. a // as             = primUpdate (index (bounds a)) a as
  91. accum f a           = primAccum (index (bounds a)) f a
  92. amap                = primAmap
  93. ixmap b f a         = array b [ i := (a ! f i) | i <- range b ]
  94.  
  95. instance (Ix a, Ix b) => Ix (a,b) where
  96.     range ((l,l'),(u,u'))
  97.        = [ (i,i') | i <- range (l,u), i' <- range (l',u') ]
  98.     index ((l,l'),(u,u')) (i,i')
  99.        = index (l,u) i * rangeSize (l',u') + index (l',u') i'
  100.     inRange ((l,l'),(u,u')) (i,i')
  101.        = inRange (l,u) i && inRange (l',u') i'
  102.  
  103. rangeSize        :: (Ix a) => (a,a) -> Int
  104. rangeSize r@(l,u) = index r u + 1
  105.  
  106. -------------------------------------------------------------------------------
  107.