module Utils where
--import ListSet(union)
--import HbcWord
import HbcUtils

infixr 1 `thenC`
infixl 1 `ifC`

aboth :: (t -> b) -> (t, t) -> (b, b)
aboth t -> b
f (t
x, t
y) = (t -> b
f t
x, t -> b
f t
y)
mapPair :: (t -> a, t -> b) -> (t, t) -> (a, b)
mapPair (t -> a
f, t -> b
g) (t
x, t
y) = (t -> a
f t
x, t -> b
g t
y)
pairwith :: (t -> b) -> t -> (t, b)
pairwith t -> b
f t
x = (t
x, t -> b
f t
x)
swap :: (b, a) -> (a, b)
swap (b
x, a
y) = (a
y, b
x)
pair :: a -> b -> (a, b)
pair = (,)

setFst :: (a, b) -> a -> (a, b)
setFst (a
_,b
y) a
x = (a
x,b
y)
setSnd :: (a, b) -> b -> (a, b)
setSnd (a
x,b
_) b
y = (a
x,b
y)

oo :: (t -> t) -> (t -> t -> t) -> t -> t -> t
oo t -> t
f t -> t -> t
g t
x t
y = t -> t
f (t -> t -> t
g t
x t
y)

-- | Apply a function to the nth element of a list
anth :: Int -> (a->a) -> [a] -> [a]
anth :: Int -> (a -> a) -> [a] -> [a]
anth Int
_ a -> a
_ [] = []
anth Int
1 a -> a
f (a
x : [a]
xs) = a -> a
f a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
anth Int
n a -> a
f (a
x : [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> (a -> a) -> [a] -> [a]
forall a. Int -> (a -> a) -> [a] -> [a]
anth (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a -> a
f [a]
xs

--dropto p = while (\l -> l /= [] && (not . p . head) l) tail

number :: Int -> [a] -> [(Int,a)]
number :: Int -> [a] -> [(Int, a)]
number Int
_ [] = []
number Int
i (a
x : [a]
xs) = (Int
i, a
x) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: Int -> [a] -> [(Int, a)]
forall a. Int -> [a] -> [(Int, a)]
number (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs

loop :: (t -> t) -> t
loop t -> t
f =
    let yf :: t
yf = t -> t
f t
yf
    in  t
yf

ifC :: (a -> a) -> Bool -> a -> a
ifC a -> a
c Bool
b = if Bool
b then a -> a
c else a -> a
forall a. a -> a
id
thenC :: Bool -> (a -> a) -> a -> a
thenC = ((a -> a) -> Bool -> a -> a) -> Bool -> (a -> a) -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a) -> Bool -> a -> a
forall a. (a -> a) -> Bool -> a -> a
ifC

gmap :: (t -> [a] -> [a]) -> (t -> t) -> t t -> [a]
gmap t -> [a] -> [a]
g t -> t
f = (t -> [a] -> [a]) -> [a] -> t t -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\t
x -> \[a]
ys -> t -> [a] -> [a]
g (t -> t
f t
x) [a]
ys) []

unionmap :: (t -> [a]) -> t t -> [a]
unionmap t -> [a]
f = ([a] -> [a] -> [a]) -> (t -> [a]) -> t t -> [a]
forall (t :: * -> *) t a t.
Foldable t =>
(t -> [a] -> [a]) -> (t -> t) -> t t -> [a]
gmap [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
union t -> [a]
f

-- | Remove the first occurence
remove :: t -> [t] -> [t]
remove t
a (t
b : [t]
bs) | t
a t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
b = [t]
bs
remove t
a (t
b : [t]
bs) = t
b t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t] -> [t]
remove t
a [t]
bs
remove t
a [] = []

-- | Replace the first occurence
replace :: (a, b) -> [(a, b)] -> [(a, b)]
replace (a, b)
p [] = [(a, b)
p]
replace (a
t, b
v) ((a
t', b
v') : [(a, b)]
ls') | a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t' = (a
t, b
v) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
ls'
replace (a, b)
p ((a, b)
l : [(a, b)]
ls') = (a, b)
l (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: (a, b) -> [(a, b)] -> [(a, b)]
replace (a, b)
p [(a, b)]
ls'

unconcat :: [Int] -> [a] -> [[a]]
unconcat [] [a]
_ = []
unconcat (Int
n : [Int]
ns) [a]
xs = [a]
xs1[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[Int] -> [a] -> [[a]]
unconcat [Int]
ns [a]
xs2
  where ([a]
xs1,[a]
xs2) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs

-- | lunconcat xss ys = unconcat (map length xss) ys
lunconcat :: [[a]] -> [a] -> [[a]]
lunconcat [] [a]
_ = []
lunconcat ([a]
n : [[a]]
ns) [a]
xs = [a]
xs1[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]] -> [a] -> [[a]]
lunconcat [[a]]
ns [a]
xs2
  where ([a]
xs1,[a]
xs2) = [a] -> [a] -> ([a], [a])
forall a a. [a] -> [a] -> ([a], [a])
lsplit [a]
n [a]
xs


-- | lhead xs ys = take (length xs) ys, but the rhs is stricter
lhead :: [a] -> [a] -> [a]
lhead (a
x : [a]
xs) (a
y : [a]
ys) = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
lhead [a]
xs [a]
ys
lhead [a]
_ [a]
_ = []

-- | ltail xs ys = drop (length xs) ys, but the rhs is stricter
ltail :: [a] -> [a] -> [a]
ltail [] [a]
ys = [a]
ys
ltail [a]
_ [] = []
ltail (a
x : [a]
xs) (a
y : [a]
ys) = [a] -> [a] -> [a]
ltail [a]
xs [a]
ys

-- | lsplit xs ys = (lhead xs ys,ltail xs ys), but without the space leak, -fpbu
lsplit :: [a] -> [a] -> ([a], [a])
lsplit [] [a]
ys = ([], [a]
ys)
lsplit [a]
_ [] = ([], [])
lsplit (a
x : [a]
xs) (a
y : [a]
ys) =
    let ([a]
yhs, [a]
yts) = [a] -> [a] -> ([a], [a])
lsplit [a]
xs [a]
ys
    in  (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
yhs, [a]
yts)

-- | JSP 920928
part :: (a -> Bool) -> [a] -> ([a], [a])
part a -> Bool
p [] = ([], [])
part a -> Bool
p (a
x : [a]
xs) =
    let ([a]
ys, [a]
zs) = (a -> Bool) -> [a] -> ([a], [a])
part a -> Bool
p [a]
xs
    in  if a -> Bool
p a
x then (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys, [a]
zs) else ([a]
ys, a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
zs)

issubset :: t a -> t a -> Bool
issubset t a
a t a
b = (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
b) t a
a

-- | To avoid problems caused by poor type inference for constructor classes in
-- Haskell 1.3:
mapList :: (a -> b) -> [a] -> [b]
mapList = forall a b. (a -> b) -> [a] -> [b]
map :: ((a->b)->[a]->[b])

-- From Compat.hs:
--bitxor,bitand::Int->Int->Int
--bitxor x y = wordToInt (bitXor (fromIntegral x) (fromIntegral y))
--bitand x y = wordToInt (bitAnd (fromIntegral x) (fromIntegral y))


-- | @chopList (breakAt c) == segments (/=c)@
segments :: (a -> Bool) -> [a] -> [[a]]
segments a -> Bool
p [] = []
segments a -> Bool
p [a]
xs = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span a -> Bool
p [a]
xs of
                  ([a]
xs1,a
_:[a]
xs2) -> [a]
xs1[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:(a -> Bool) -> [a] -> [[a]]
segments a -> Bool
p [a]
xs2
                  ([a]
xs1,[a]
_) -> [[a]
xs1]