-reverseP :: [:a:] -> [:a:]
-reverseP a = permuteP (enumFromThenToP (len - 1) (len - 2) 0) a
- -- we can't use the [:x, y..z:] form here for tedious
- -- reasons to do with the typechecker and the fact that
- -- `enumFromThenToP' is defined in the same module
- where
- len = lengthP a
-
-andP :: [:Bool:] -> Bool
-andP = foldP (&&) True
-
-orP :: [:Bool:] -> Bool
-orP = foldP (||) True
-
-anyP :: (a -> Bool) -> [:a:] -> Bool
-anyP p = orP . mapP p
-
-allP :: (a -> Bool) -> [:a:] -> Bool
-allP p = andP . mapP p
-
-elemP :: (Eq a) => a -> [:a:] -> Bool
-elemP x = anyP (== x)
-
-notElemP :: (Eq a) => a -> [:a:] -> Bool
-notElemP x = allP (/= x)
-
-lookupP :: (Eq a) => a -> [:(a, b):] -> Maybe b
-lookupP = error "Prelude.lookupP: not implemented yet" -- FIXME
-
-sumP :: (Num a) => [:a:] -> a
-sumP = foldP (+) 0
-
-productP :: (Num a) => [:a:] -> a
-productP = foldP (*) 0
-
-maximumP :: (Ord a) => [:a:] -> a
-maximumP [::] = error "Prelude.maximumP: empty parallel array"
-maximumP xs = fold1P max xs
-
-minimumP :: (Ord a) => [:a:] -> a
-minimumP [::] = error "Prelude.minimumP: empty parallel array"
-minimumP xs = fold1P min xs
-
-zipP :: [:a:] -> [:b:] -> [:(a, b):]
-zipP = zipWithP (,)
-
-zip3P :: [:a:] -> [:b:] -> [:c:] -> [:(a, b, c):]
-zip3P = zipWith3P (,,)
-
-zipWithP :: (a -> b -> c) -> [:a:] -> [:b:] -> [:c:]
-zipWithP f a1 a2 = let
- len1 = lengthP a1
- len2 = lengthP a2
- len = len1 `min` len2
- in
- fst $ loopFromTo 0 (len - 1) combine 0 a1
- where
- combine e1 i = (Just $ f e1 (a2!:i), i + 1)
-
-zipWith3P :: (a -> b -> c -> d) -> [:a:]->[:b:]->[:c:]->[:d:]
-zipWith3P f a1 a2 a3 = let
- len1 = lengthP a1
- len2 = lengthP a2
- len3 = lengthP a3
- len = len1 `min` len2 `min` len3
- in
- fst $ loopFromTo 0 (len - 1) combine 0 a1
- where
- combine e1 i = (Just $ f e1 (a2!:i) (a3!:i), i + 1)
-
-unzipP :: [:(a, b):] -> ([:a:], [:b:])
-unzipP a = (fst $ loop (mapEFL fst) noAL a, fst $ loop (mapEFL snd) noAL a)
--- FIXME: these two functions should be optimised using a tupled custom loop
-unzip3P :: [:(a, b, c):] -> ([:a:], [:b:], [:c:])
-unzip3P a = (fst $ loop (mapEFL fst3) noAL a,
- fst $ loop (mapEFL snd3) noAL a,
- fst $ loop (mapEFL trd3) noAL a)
- where
- fst3 (a, _, _) = a
- snd3 (_, b, _) = b
- trd3 (_, _, c) = c
-
--- instances
---
-
-instance Eq a => Eq [:a:] where
- a1 == a2 | lengthP a1 == lengthP a2 = andP (zipWithP (==) a1 a2)
- | otherwise = False
-
-instance Ord a => Ord [:a:] where
- compare a1 a2 = case foldlP combineOrdering EQ (zipWithP compare a1 a2) of
- EQ | lengthP a1 == lengthP a2 -> EQ
- | lengthP a1 < lengthP a2 -> LT
- | otherwise -> GT
- where
- combineOrdering EQ EQ = EQ
- combineOrdering EQ other = other
- combineOrdering other _ = other
-
-instance Functor [::] where
- fmap = mapP
-
-instance Monad [::] where
- m >>= k = foldrP ((+:+) . k ) [::] m
- m >> k = foldrP ((+:+) . const k) [::] m
- return x = [:x:]
- fail _ = [::]
-
-instance Show a => Show [:a:] where
- showsPrec _ = showPArr . fromP
- where
- showPArr [] s = "[::]" ++ s
- showPArr (x:xs) s = "[:" ++ shows x (showPArr' xs s)
-
- showPArr' [] s = ":]" ++ s
- showPArr' (y:ys) s = ',' : shows y (showPArr' ys s)
-
-instance Read a => Read [:a:] where
- readsPrec _ a = [(toP v, rest) | (v, rest) <- readPArr a]
- where
- readPArr = readParen False (\r -> do
- ("[:",s) <- lex r
- readPArr1 s)
- readPArr1 s =
- (do { (":]", t) <- lex s; return ([], t) }) ++
- (do { (x, t) <- reads s; (xs, u) <- readPArr2 t; return (x:xs, u) })
-
- readPArr2 s =
- (do { (":]", t) <- lex s; return ([], t) }) ++
- (do { (",", t) <- lex s; (x, u) <- reads t; (xs, v) <- readPArr2 u;
- return (x:xs, v) })
-
--- overloaded functions
---
-
--- Ideally, we would like `enumFromToP' and `enumFromThenToP' to be members of
--- `Enum'. On the other hand, we really do not want to change `Enum'. Thus,
--- for the moment, we hope that the compiler is sufficiently clever to
--- properly fuse the following definition.
-
-enumFromToP :: Enum a => a -> a -> [:a:]
-enumFromToP x y = mapP toEnum (eftInt (fromEnum x) (fromEnum y))
- where
- eftInt x y = scanlP (+) x $ replicateP (y - x + 1) 1
-
-enumFromThenToP :: Enum a => a -> a -> a -> [:a:]
-enumFromThenToP x y z =
- mapP toEnum (efttInt (fromEnum x) (fromEnum y) (fromEnum z))
- where
- efttInt x y z = scanlP (+) x $
- replicateP ((z - x + 1) `div` delta - 1) delta
- where
- delta = y - x
-
--- the following functions are not available on lists
---
-
--- create an array from a list (EXPORTED)
---
-toP :: [a] -> [:a:]
-toP l = fst $ loop store l (replicateP (length l) ())
- where
- store _ (x:xs) = (Just x, xs)
-
--- convert an array to a list (EXPORTED)
---
-fromP :: [:a:] -> [a]
-fromP a = [a!:i | i <- [0..lengthP a - 1]]
-
--- cut a subarray out of an array (EXPORTED)
---
-sliceP :: Int -> Int -> [:e:] -> [:e:]
-sliceP from to a =
- fst $ loopFromTo (0 `max` from) (to `min` (lengthP a - 1)) (mapEFL id) noAL a
-
--- parallel folding (EXPORTED)
---
--- * the first argument must be associative; otherwise, the result is undefined
---
-foldP :: (e -> e -> e) -> e -> [:e:] -> e
-foldP = foldlP
-
--- parallel folding without explicit neutral (EXPORTED)
---
--- * the first argument must be associative; otherwise, the result is undefined
---
-fold1P :: (e -> e -> e) -> [:e:] -> e
-fold1P = foldl1P
-
--- permute an array according to the permutation vector in the first argument
--- (EXPORTED)
---
-permuteP :: [:Int:] -> [:e:] -> [:e:]
-permuteP is es = fst $ loop (mapEFL (es!:)) noAL is
-
--- permute an array according to the back-permutation vector in the first
--- argument (EXPORTED)
---
--- * the permutation vector must represent a surjective function; otherwise,
--- the result is undefined
---
-bpermuteP :: [:Int:] -> [:e:] -> [:e:]
-bpermuteP is es = error "Prelude.bpermuteP: not implemented yet" -- FIXME
-
--- permute an array according to the back-permutation vector in the first
--- argument, which need not be surjective (EXPORTED)
---
--- * any elements in the result that are not covered by the back-permutation
--- vector assume the value of the corresponding position of the third
--- argument
---
-bpermuteDftP :: [:Int:] -> [:e:] -> [:e:] -> [:e:]
-bpermuteDftP is es = error "Prelude.bpermuteDftP: not implemented yet"-- FIXME
-
--- computes the cross combination of two arrays (EXPORTED)
---
-crossP :: [:a:] -> [:b:] -> [:(a, b):]
-crossP a1 a2 = fst $ loop combine (0, 0) $ replicateP len ()
- where
- len1 = lengthP a1
- len2 = lengthP a2
- len = len1 * len2
- --
- combine _ (i, j) = (Just $ (a1!:i, a2!:j), next)
- where
- next | (i + 1) == len1 = (0 , j + 1)
- | otherwise = (i + 1, j)
-
-{- An alternative implementation
- * The one above is certainly better for flattened code, but here where we
- are handling boxed arrays, the trade off is less clear. However, I
- think, the above one is still better.
-
-crossP a1 a2 = let
- len1 = lengthP a1
- len2 = lengthP a2
- x1 = concatP $ mapP (replicateP len2) a1
- x2 = concatP $ replicateP len1 a2
- in
- zipP x1 x2
- -}
-
--- computes an index array for all elements of the second argument for which
--- the predicate yields `True' (EXPORTED)
---
-indexOfP :: (a -> Bool) -> [:a:] -> [:Int:]
-indexOfP p a = fst $ loop calcIdx 0 a
- where
- calcIdx e idx | p e = (Just idx, idx + 1)
- | otherwise = (Nothing , idx )