home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / gofer230.zip / Progs / Gofer / Demos / Utils / array.gs next >
Text File  |  1994-06-23  |  3KB  |  74 lines
  1. -- An inefficient implementation of Haskell arrays based on the
  2. -- functional specification in the Haskell report version 1.2
  3. --
  4. -- To save you some typing, just in case you wanted to use this
  5. -- stuff ... but don't expect constant time lookup!
  6.  
  7. infixl 9  !
  8. infixl 9  //
  9. infix  1  :=
  10.  
  11. data Assoc a b =  a := b  
  12. data Array a b = MkArray (a,a) (a -> b) 
  13.  
  14. array       :: (Ix a) => (a,a) -> [Assoc a b] -> Array a b
  15. listArray  :: (Ix a) => (a,a) -> [b] -> Array a b
  16. (!)       :: (Ix a) => Array a b -> a -> b
  17. bounds       :: (Ix a) => Array a b -> (a,a)
  18. indices       :: (Ix a) => Array a b -> [a]
  19. elems       :: (Ix a) => Array a b -> [b]
  20. assocs       :: (Ix a) => Array a b -> [Assoc a b]
  21. accumArray :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [Assoc a c] -> Array a b
  22. (//)       :: (Ix a) => Array a b -> [Assoc a b] -> Array a b
  23. accum       :: (Ix a) => (b -> c -> b) -> Array a b -> [Assoc a c] -> Array a b
  24. amap       :: (Ix a) => (b -> c) -> Array a b -> Array a c
  25. ixmap       :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a c
  26.  
  27. array b ivs           = MkArray b
  28.              (\j -> case [v | (i := v) <- ivs, i == j] of
  29.                  [v] -> v
  30.                 []  -> error "(!){PreludeArray}: \
  31.                      \undefined array element"
  32.                 _   -> error "(!){PreludeArray}: \
  33.                      \multiply defined array element")
  34. listArray b vs          = array b (zipWith (:=) (range b) vs)
  35.  
  36. (!) (MkArray _ f)     = f
  37. bounds (MkArray b _)  = b
  38. indices              = range . bounds
  39. elems a               = [a!i | i <- indices a]
  40. assocs a              = [i := a!i | i <- indices a]
  41. a // us              = array (bounds a)
  42.                 ([i := a!i | i <- indices a \\ [i | i:=_ <- us]]
  43.                  ++ us)
  44.  
  45. accum f               = foldl (\a (i := v) -> a // [i := f (a!i) v])
  46.  
  47. accumArray f z b      = accum f (array b [i := z | i <- range b])
  48. amap f a              = array b [i := f (a!i) | i <- range b]
  49.                         where b = bounds a
  50. ixmap b f a           = array b [i := a ! f i | i <- range b]
  51.  
  52. instance (Ix a, Text a, Text b) => Text (Assoc a b)  where
  53.     showsPrec _ (a := b) = shows a . showString " := " . shows b
  54.  
  55. instance (Ix a) => Ix (a,a) where
  56.     range ((ma,mb),(na,nb)) = [(a,b) | a <- range (ma,na), b <- range (mb,nb)]
  57.  
  58. -- Some applications, taken from the Gentle Introduction ...
  59.  
  60. fibs n = a where a = array (0,n) ([ 0 := 1, 1 := 1 ] ++
  61.                                   [ i := a!(i-2) + a!(i-1) | i <- [2..n] ])
  62.  
  63. fibs10 = fibs 10
  64.  
  65. wavefront n = a where a = array ((1,1),(n,n))
  66.                              ([ (1,j) := 1 | j <- [1..n] ] ++
  67.                               [ (i,1) := 1 | i <- [2..n] ] ++
  68.                               [ (i,j) := a!(i,j-1) + a!(i-1,j-1) + a!(i-1,j)
  69.                                            | i <- [2..n], j <- [2..n] ])
  70.  
  71. listwave n = [ [wf!(i,j) | j <- [1..n]] | i <- [1..n] ]
  72.              where wf = wavefront n
  73.  
  74.