{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable,DeriveAnyClass,DerivingVia #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExplicitForAll, RankNTypes #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PatternSynonyms,ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
{-# LANGUAGE DeriveFoldable , DeriveTraversable,DeriveGeneric#-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses#-}
{-# LANGUAGE MonadComprehensions,RoleAnnotations #-}
{-# LANGUAGE Trustworthy#-}

-- |
-- A random-access list implementation based on Chris Okasaki's approach
-- on his book \"Purely Functional Data Structures\", Cambridge University
-- Press, 1998, chapter 9.3.
--
-- 'RAList' is a replacement for ordinary finite lists.
-- 'RAList' provides the same complexity as ordinary for most the list operations.
-- Some operations take /O(log n)/ for 'RAList' where the list operation is /O(n)/,
-- notably indexing, '(!!)'.
--
module Data.RAList
   (
     RAList(Nil,Cons,(:|))

   -- * Basic functions
   --, empty
   , cons
   , uncons
--   , singleton
   , (++)
   , head
   , last
   , tail
   , init
   , null
   , length

   -- * Indexing lists
   -- | These functions treat a list @xs@ as a indexed collection,
   -- with indices ranging from 0 to @'length' xs - 1@.

   , (!!)
   ,lookupWithDefault
   ,lookupM
   ,lookup
   ,lookupCC

   --- * KV indexing
   --- | This function treats a RAList as an association list
   ,lookupL


   -- * List transformations
   , map
   , reverse
{-RA
   , intersperse
   , intercalate
   , transpose

   , subsequences
   , permutations
-}

  -- * indexed operations
  ,imap
  ,itraverse
  ,ifoldMap
  ,ifoldl'
  ,ifoldr



   -- * Reducing lists (folds)

   , foldl
   , foldl'
   , foldl1
   , foldl1'
   , foldr
   , foldr1


   -- ** Special folds

   , concat
   , concatMap
   , and
   , or
   , any
   , all
   , sum
   , product
   , maximum
   , minimum

   -- * Building lists
{-RA
   -- ** Scans
   , scanl
   , scanl1
   , scanr
   , scanr1

   -- ** Accumulating maps
   , mapAccumL
   , mapAccumR
-}
   -- ** Repetition
   , replicate


   -- ** Unfolding
   , unfoldr


   -- * Sublists

   -- ** Extracting sublists
   , take
   , drop
   , simpleDrop
   , splitAt
{-RA

   , takeWhile
   , dropWhile
   , dropWhileEnd
   , span
   , break

   , stripPrefix

   , group

   , inits
   , tails

   -- ** Predicates
   , isPrefixOf
   , isSuffixOf
   , isInfixOf
-}
   -- * Searching lists

   -- ** Searching by equality
   , elem
   , notElem

{-RA
   -- ** Searching with a predicate
   , find
-}
   , filter
   , partition
   , mapMaybe
   , catMaybes
   , wither

{-RA
   , elemIndex
   , elemIndices

   , findIndex
   , findIndices
-}
   -- * Zipping and unzipping lists

   , zip
{-RA
   , zip3
   , zip4, zip5, zip6, zip7
-}
   , zipWith
{-RA
   , zipWith3
   , zipWith4, zipWith5, zipWith6, zipWith7
-}
   , unzip
{-RA
   , unzip3
   , unzip4, unzip5, unzip6, unzip7

   -- * Special lists

   -- ** Functions on strings
   , lines
   , words
   , unlines
   , unwords

   -- ** \"Set\" operations

   , nub

   , delete
   , (\\)

   , union
   , intersect

   -- ** Ordered lists
   , sort
   , insert

   -- * Generalized functions

   -- ** The \"@By@\" operations

   -- *** User-supplied equality (replacing an @Eq@ context)
   -- | The predicate is assumed to define an equivalence.
   , nubBy
   , deleteBy
   , deleteFirstsBy
   , unionBy
   , intersectBy
   , groupBy

   -- *** User-supplied comparison (replacing an @Ord@ context)
   -- | The function is assumed to define a total ordering.
   , sortBy
   , insertBy
   , maximumBy
   , minimumBy
-}
   -- ** The \"@generic@\" operations
   -- | The prefix \`@generic@\' indicates an overloaded function that
   -- is a generalized version of a "Prelude" function.

   , genericLength
   , genericTake
   , genericDrop
   , genericSplitAt
   , genericIndex
   , genericReplicate

   -- * Update
   , update
   , adjust
   -- * List conversion
   , toList
   , fromList
   -- * List style fusion tools
   , build
   , augment

   , wLength
   ) where
import qualified Prelude
import Prelude hiding(
    (++), head, last, tail, init, null, length, map, reverse,
    foldl, foldl1, foldr, foldr1, concat, concatMap,
    and, or, any, all, sum, product, maximum, minimum, take,
    drop, elem, splitAt, notElem, lookup, replicate, (!!), filter,
    zip, zipWith, unzip
    )
import qualified Data.List as List

-- this should be a cabal flag for debugging data structure bugs :)
#define DEBUG 0

#if MIN_VERSION_base(4,11,0)
#else
import Data.Semigroup(Semigroup,(<>))
#endif
import Data.Data(Data,Typeable)
--import Data.Functor.Identity(runIdentity)
import Data.Word

import  Data.Foldable as F hiding (concat, concatMap)
import qualified Control.Monad.Fail as MF

import Control.Monad.Zip
import Numeric.Natural

--import GHC.Exts (oneShot)

import qualified GHC.Exts as GE (IsList(..))

import Data.Foldable.WithIndex
import Data.Functor.WithIndex
import Data.Traversable.WithIndex

import Data.RAList.Internal
import Control.Applicative(Applicative(liftA2))

import GHC.Generics(Generic,Generic1)


import Control.DeepSeq

infixl 9  !!
infixr 5  `cons`, ++
infixr 5 `Cons`
infixr 5 :|

-- | our '[]' by another name
pattern Nil :: forall a. RAList a
pattern $bNil :: RAList a
$mNil :: forall r a. RAList a -> (Void# -> r) -> (Void# -> r) -> r
Nil = RNil

-- | Constructor notation ':'
pattern Cons :: forall a. a -> RAList a -> RAList a
pattern $bCons :: a -> RAList a -> RAList a
$mCons :: forall r a. RAList a -> (a -> RAList a -> r) -> (Void# -> r) -> r
Cons x xs <-( uncons -> Just(x,xs) )
 where Cons a
x RAList a
xs = a -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
cons a
x RAList a
xs
{-# COMPLETE Nil,Cons #-}


-- | like ':' but for RAList
pattern (:|) :: forall a. a -> RAList a -> RAList a
pattern x $b:| :: a -> RAList a -> RAList a
$m:| :: forall r a. RAList a -> (a -> RAList a -> r) -> (Void# -> r) -> r
:| xs = Cons x xs
{-# COMPLETE (:|), Nil #-}



-- A RAList is stored as a list of trees.  Each tree is a full binary tree.
-- The sizes of the trees are monotonically increasing, except that the two
-- first trees may have the same size.
-- The first few tree sizes:
-- [ [], [1], [1,1], [3], [1,3], [1,1,3], [3,3], [7], [1,7], [1,1,7],
--   [3,7], [1,3,7], [1,1,3,7], [3,3,7], [7,7], [15], ...
-- (I.e., skew binary numbers.)


type role RAList representational

-- Special list type for (Word64, Tree a), i.e., Top a ~= [(Word64, Tree a)]
data RAList a = RNil
                | RCons {-# UNPACK #-}  !Word64 -- total number of elements, aka sum of subtrees
                        {-# UNPACK #-}  !Word64 --  size of this subtree
                                        (Tree a)
                                        (RAList a)
    deriving (RAList a -> RAList a -> Bool
(RAList a -> RAList a -> Bool)
-> (RAList a -> RAList a -> Bool) -> Eq (RAList a)
forall a. Eq a => RAList a -> RAList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RAList a -> RAList a -> Bool
$c/= :: forall a. Eq a => RAList a -> RAList a -> Bool
== :: RAList a -> RAList a -> Bool
$c== :: forall a. Eq a => RAList a -> RAList a -> Bool
Eq
              ,Typeable (RAList a)
DataType
Constr
Typeable (RAList a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RAList a -> c (RAList a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (RAList a))
-> (RAList a -> Constr)
-> (RAList a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (RAList a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (RAList a)))
-> ((forall b. Data b => b -> b) -> RAList a -> RAList a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RAList a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RAList a -> r)
-> (forall u. (forall d. Data d => d -> u) -> RAList a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RAList a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RAList a -> m (RAList a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RAList a -> m (RAList a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RAList a -> m (RAList a))
-> Data (RAList a)
RAList a -> DataType
RAList a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (RAList a))
(forall b. Data b => b -> b) -> RAList a -> RAList a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RAList a -> c (RAList a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RAList a)
forall a. Data a => Typeable (RAList a)
forall a. Data a => RAList a -> DataType
forall a. Data a => RAList a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> RAList a -> RAList a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> RAList a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> RAList a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RAList a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RAList a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> RAList a -> m (RAList a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> RAList a -> m (RAList a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RAList a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RAList a -> c (RAList a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (RAList a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (RAList a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RAList a -> u
forall u. (forall d. Data d => d -> u) -> RAList a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RAList a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RAList a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RAList a -> m (RAList a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RAList a -> m (RAList a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RAList a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RAList a -> c (RAList a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (RAList a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (RAList a))
$cRCons :: Constr
$cRNil :: Constr
$tRAList :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RAList a -> m (RAList a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> RAList a -> m (RAList a)
gmapMp :: (forall d. Data d => d -> m d) -> RAList a -> m (RAList a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> RAList a -> m (RAList a)
gmapM :: (forall d. Data d => d -> m d) -> RAList a -> m (RAList a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> RAList a -> m (RAList a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> RAList a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> RAList a -> u
gmapQ :: (forall d. Data d => d -> u) -> RAList a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> RAList a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RAList a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RAList a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RAList a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RAList a -> r
gmapT :: (forall b. Data b => b -> b) -> RAList a -> RAList a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> RAList a -> RAList a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (RAList a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (RAList a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (RAList a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (RAList a))
dataTypeOf :: RAList a -> DataType
$cdataTypeOf :: forall a. Data a => RAList a -> DataType
toConstr :: RAList a -> Constr
$ctoConstr :: forall a. Data a => RAList a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RAList a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RAList a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RAList a -> c (RAList a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RAList a -> c (RAList a)
$cp1Data :: forall a. Data a => Typeable (RAList a)
Data
              ,Typeable
              ,a -> RAList b -> RAList a
(a -> b) -> RAList a -> RAList b
(forall a b. (a -> b) -> RAList a -> RAList b)
-> (forall a b. a -> RAList b -> RAList a) -> Functor RAList
forall a b. a -> RAList b -> RAList a
forall a b. (a -> b) -> RAList a -> RAList b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RAList b -> RAList a
$c<$ :: forall a b. a -> RAList b -> RAList a
fmap :: (a -> b) -> RAList a -> RAList b
$cfmap :: forall a b. (a -> b) -> RAList a -> RAList b
Functor
              ,Functor RAList
Foldable RAList
Functor RAList
-> Foldable RAList
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> RAList a -> f (RAList b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RAList (f a) -> f (RAList a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RAList a -> m (RAList b))
-> (forall (m :: * -> *) a.
    Monad m =>
    RAList (m a) -> m (RAList a))
-> Traversable RAList
(a -> f b) -> RAList a -> f (RAList b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => RAList (m a) -> m (RAList a)
forall (f :: * -> *) a.
Applicative f =>
RAList (f a) -> f (RAList a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RAList a -> m (RAList b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RAList a -> f (RAList b)
sequence :: RAList (m a) -> m (RAList a)
$csequence :: forall (m :: * -> *) a. Monad m => RAList (m a) -> m (RAList a)
mapM :: (a -> m b) -> RAList a -> m (RAList b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RAList a -> m (RAList b)
sequenceA :: RAList (f a) -> f (RAList a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
RAList (f a) -> f (RAList a)
traverse :: (a -> f b) -> RAList a -> f (RAList b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RAList a -> f (RAList b)
$cp2Traversable :: Foldable RAList
$cp1Traversable :: Functor RAList
Traversable
#if DEBUG
              , Show
#endif
              , (forall x. RAList a -> Rep (RAList a) x)
-> (forall x. Rep (RAList a) x -> RAList a) -> Generic (RAList a)
forall x. Rep (RAList a) x -> RAList a
forall x. RAList a -> Rep (RAList a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RAList a) x -> RAList a
forall a x. RAList a -> Rep (RAList a) x
$cto :: forall a x. Rep (RAList a) x -> RAList a
$cfrom :: forall a x. RAList a -> Rep (RAList a) x
Generic
              , (forall a. RAList a -> Rep1 RAList a)
-> (forall a. Rep1 RAList a -> RAList a) -> Generic1 RAList
forall a. Rep1 RAList a -> RAList a
forall a. RAList a -> Rep1 RAList a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 RAList a -> RAList a
$cfrom1 :: forall a. RAList a -> Rep1 RAList a
Generic1
              ,RAList a -> ()
(RAList a -> ()) -> NFData (RAList a)
forall a. NFData a => RAList a -> ()
forall a. (a -> ()) -> NFData a
rnf :: RAList a -> ()
$crnf :: forall a. NFData a => RAList a -> ()
NFData
              ,(forall a. (a -> ()) -> RAList a -> ()) -> NFData1 RAList
forall a. (a -> ()) -> RAList a -> ()
forall (f :: * -> *).
(forall a. (a -> ()) -> f a -> ()) -> NFData1 f
liftRnf :: (a -> ()) -> RAList a -> ()
$cliftRnf :: forall a. (a -> ()) -> RAList a -> ()
NFData1
              )


#if !DEBUG
instance (Show a) => Show (RAList a) where
    showsPrec :: Int -> RAList a -> ShowS
showsPrec Int
p RAList a
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 (RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList a
xs)
#endif

--instance (Read a) => Read (RAList a) where
--    readsPrec p = readParen (p > 10) $ \ r -> [(fromList xs, t) | ("fromList", s) <- lex r, (xs, t) <- reads s]

instance (Ord a) => Ord (RAList a) where
  --- this is kinda naive, but simple for now
    RAList a
xs < :: RAList a -> RAList a -> Bool
<  RAList a
ys        = RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList a
xs [a] -> [a] -> Bool
forall a. Ord a => a -> a -> Bool
<  RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList a
ys
    RAList a
xs <= :: RAList a -> RAList a -> Bool
<= RAList a
ys        = RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList a
xs [a] -> [a] -> Bool
forall a. Ord a => a -> a -> Bool
<= RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList a
ys
    RAList a
xs > :: RAList a -> RAList a -> Bool
>  RAList a
ys        = RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList a
xs [a] -> [a] -> Bool
forall a. Ord a => a -> a -> Bool
>  RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList a
ys
    RAList a
xs >= :: RAList a -> RAList a -> Bool
>= RAList a
ys        = RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList a
xs [a] -> [a] -> Bool
forall a. Ord a => a -> a -> Bool
>= RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList a
ys
    RAList a
xs compare :: RAList a -> RAList a -> Ordering
`compare` RAList a
ys = RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList a
xs [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList a
ys

instance Monoid (RAList a) where
    mempty :: RAList a
mempty  = RAList a
forall a. RAList a
Nil


instance Semigroup (RAList a) where
    {-# INLINE (<>) #-}
    <> :: RAList a -> RAList a -> RAList a
(<>) = RAList a -> RAList a -> RAList a
forall a. RAList a -> RAList a -> RAList a
(++)

--instance Functor RAList where
--    fmap f (RAList s skewlist) = RAList s (fmap f skewlist)

--- lets just use  MonadComprehensions to write out the applictives
instance Applicative RAList where
    {-# INLINE pure #-}
    pure :: a -> RAList a
pure = \a
x -> a -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
Cons a
x RAList a
forall a. RAList a
Nil
    {-# INLINE (<*>) #-}
    RAList (a -> b)
fs <*> :: RAList (a -> b) -> RAList a -> RAList b
<*> RAList a
xs = [a -> b
f a
x | a -> b
f <- RAList (a -> b)
fs, a
x <- RAList a
xs]
    {-# INLINE liftA2 #-}
    liftA2 :: (a -> b -> c) -> RAList a -> RAList b -> RAList c
liftA2 a -> b -> c
f RAList a
xs RAList b
ys = [a -> b -> c
f a
x b
y | a
x <- RAList a
xs, b
y <- RAList b
ys]
    {-# INLINE (*>) #-}
    RAList a
xs *> :: RAList a -> RAList b -> RAList b
*> RAList b
ys  = [b
y | a
_ <- RAList a
xs, b
y <- RAList b
ys]


instance Monad RAList where
    return :: a -> RAList a
return = a -> RAList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    >>= :: RAList a -> (a -> RAList b) -> RAList b
(>>=) = ((a -> RAList b) -> RAList a -> RAList b)
-> RAList a -> (a -> RAList b) -> RAList b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> RAList b) -> RAList a -> RAList b
forall a b. (a -> RAList b) -> RAList a -> RAList b
concatMap

instance GE.IsList (RAList a) where
  type Item (RAList a) = a
  toList :: RAList a -> [Item (RAList a)]
toList = RAList a -> [Item (RAList a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  fromList :: [Item (RAList a)] -> RAList a
fromList = [Item (RAList a)] -> RAList a
forall a. [a] -> RAList a
fromList

instance MonadZip RAList where
  mzipWith :: (a -> b -> c) -> RAList a -> RAList b -> RAList c
mzipWith = (a -> b -> c) -> RAList a -> RAList b -> RAList c
forall a b c. (a -> b -> c) -> RAList a -> RAList b -> RAList c
zipWith
  munzip :: RAList (a, b) -> (RAList a, RAList b)
munzip = RAList (a, b) -> (RAList a, RAList b)
forall a b. RAList (a, b) -> (RAList a, RAList b)
unzip

{-# INLINE unzip #-}
-- adapted from List definition in base
unzip :: RAList (a,b) -> (RAList a,RAList b)
unzip :: RAList (a, b) -> (RAList a, RAList b)
unzip    =  ((a, b) -> (RAList a, RAList b) -> (RAList a, RAList b))
-> (RAList a, RAList b) -> RAList (a, b) -> (RAList a, RAList b)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (\(a
a,b
b) (!RAList a
as,!RAList b
bs) -> (a
aa -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
:| RAList a
as,b
bb -> RAList b -> RAList b
forall a. a -> RAList a -> RAList a
:|RAList b
bs)) (RAList a
forall a. RAList a
Nil,RAList b
forall a. RAList a
Nil)
--unzip    =  foldr (\(a,b) ~(as,bs) -> (a:| as,b:|bs)) (Nil,Nil)

--instance Traversable RAList where
    --{-# INLINE traverse #-} -- so that traverse can fuse
    -- deriving might be nice too, need to compare later
    --traverse f = foldr cons_f (pure Nil)
      --where cons_f x ys = liftA2 (cons) (f x) ys


instance   TraversableWithIndex Word64 RAList where
  {-# INLINE itraverse #-}
  itraverse :: (Word64 -> a -> f b) -> RAList a -> f (RAList b)
itraverse = \ Word64 -> a -> f b
f RAList a
s -> (Word64, f (RAList b)) -> f (RAList b)
forall a b. (a, b) -> b
snd ((Word64, f (RAList b)) -> f (RAList b))
-> (Word64, f (RAList b)) -> f (RAList b)
forall a b. (a -> b) -> a -> b
$ Indexing f (RAList b) -> Word64 -> (Word64, f (RAList b))
forall (f :: * -> *) a. Indexing f a -> Word64 -> (Word64, f a)
runIndexing ((a -> Indexing f b) -> RAList a -> Indexing f (RAList b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\a
a -> (Word64 -> (Word64, f b)) -> Indexing f b
forall (f :: * -> *) a. (Word64 -> (Word64, f a)) -> Indexing f a
Indexing (\Word64
i -> Word64
i Word64 -> (Word64, f b) -> (Word64, f b)
`seq` (Word64
i Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1, Word64 -> a -> f b
f Word64
i a
a))) RAList a
s) Word64
0
instance   FoldableWithIndex Word64 RAList where
instance   FunctorWithIndex Word64 RAList where

-- TODO: look into ways to make the toList more efficient if needed

instance Foldable RAList  where
  {-# INLINE null#-}
  null :: RAList a -> Bool
null = \ RAList a
x -> case RAList a
x of RAList a
Nil -> Bool
True ; RAList a
_ -> Bool
False
  {-# INLINE length #-}
  length :: RAList a -> Int
length = RAList a -> Int
forall w a. Integral w => RAList a -> w
genericLength -- :)



    -- This INLINE allows more list functions to fuse. See #9848.
  --{-# INLINE foldMap #-}
  --foldMap f = foldr (mappend . f) mempty
  --foldMap _f RNil = mempty
  --foldMap f (RCons _stot _stre tree rest) = foldMap f tree <> foldMap f rest

  foldMap :: (a -> m) -> RAList a -> m
foldMap = \(a -> m
f:: a -> m) (RAList a
ra:: RAList a ) ->
    let
        go :: RAList a -> m
        go :: RAList a -> m
go  RAList a
ral =    case RAList a
ral of   RAList a
RNil -> m
forall a. Monoid a => a
mempty
                                   (RCons Word64
_stot Word64
_stre Tree a
tree RAList a
rest) -> (a -> m) -> Tree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Tree a
tree m -> m -> m
forall a. Semigroup a => a -> a -> a
<> RAList a -> m
go  RAList a
rest
       in RAList a -> m
go RAList a
ra

   --not sure if providing my own foldr is a good idea, but lets try for now : )
  --{-# INLINE [0] foldr #-}
  {-
  foldr f z = go
          where
            go Nil     = z
            go (Cons y ys) = y `f` go ys
  -- {-# INLINE toList #-}
  toList = foldr (:) []
  -}

  --{-# INLINE foldl' #-}
{-
 foldl' k z0 xs =
      foldr (\(v::a) (fn::b->b) -> oneShot (\(z::b) -> z `seq` fn (k z v))) (id :: b -> b) xs z0
      -}


--instance Functor Top where
--    fmap _ Nil = Nil
--    fmap f (Cons w t xs) = Cons w (fmap f t) (fmap f xs)

-- Complete binary tree.  The completeness of the trees is an invariant that must
-- be preserved for the implementation to work.

{-# specialize genericLength :: RAList a -> Word64  #-}
{-# specialize genericLength :: RAList a -> Integer  #-}
{-# specialize genericLength :: RAList a -> Int  #-}
{-# specialize genericLength :: RAList a -> Word  #-}
genericLength :: Integral w =>RAList a -> w
genericLength :: RAList a -> w
genericLength = \RAList a
ra -> case RAList a
ra of RAList a
RNil ->  w
0 ; (RCons Word64
tot Word64
_trtot Tree a
_tree RAList a
_rest) -> Word64 -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
tot

wLength :: RAList a -> Word64
wLength :: RAList a -> Word64
wLength = RAList a -> Word64
forall w a. Integral w => RAList a -> w
genericLength

type role Tree representational
data Tree a
     = Leaf a
     | Node a (Tree a) (Tree a)
     deriving
        (Tree a -> Tree a -> Bool
(Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool) -> Eq (Tree a)
forall a. Eq a => Tree a -> Tree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tree a -> Tree a -> Bool
$c/= :: forall a. Eq a => Tree a -> Tree a -> Bool
== :: Tree a -> Tree a -> Bool
$c== :: forall a. Eq a => Tree a -> Tree a -> Bool
Eq
        ,Typeable (Tree a)
DataType
Constr
Typeable (Tree a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Tree a -> c (Tree a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Tree a))
-> (Tree a -> Constr)
-> (Tree a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Tree a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree a)))
-> ((forall b. Data b => b -> b) -> Tree a -> Tree a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Tree a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Tree a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Tree a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Tree a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Tree a -> m (Tree a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Tree a -> m (Tree a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Tree a -> m (Tree a))
-> Data (Tree a)
Tree a -> DataType
Tree a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Tree a))
(forall b. Data b => b -> b) -> Tree a -> Tree a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree a -> c (Tree a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree a)
forall a. Data a => Typeable (Tree a)
forall a. Data a => Tree a -> DataType
forall a. Data a => Tree a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Tree a -> Tree a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Tree a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Tree a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree a -> c (Tree a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Tree a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Tree a -> u
forall u. (forall d. Data d => d -> u) -> Tree a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree a -> c (Tree a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Tree a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree a))
$cNode :: Constr
$cLeaf :: Constr
$tTree :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
gmapMp :: (forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
gmapM :: (forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Tree a -> m (Tree a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Tree a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Tree a -> u
gmapQ :: (forall d. Data d => d -> u) -> Tree a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Tree a -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tree a -> r
gmapT :: (forall b. Data b => b -> b) -> Tree a -> Tree a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Tree a -> Tree a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Tree a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Tree a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Tree a))
dataTypeOf :: Tree a -> DataType
$cdataTypeOf :: forall a. Data a => Tree a -> DataType
toConstr :: Tree a -> Constr
$ctoConstr :: forall a. Data a => Tree a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tree a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree a -> c (Tree a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tree a -> c (Tree a)
$cp1Data :: forall a. Data a => Typeable (Tree a)
Data
        ,Typeable
        ,a -> Tree b -> Tree a
(a -> b) -> Tree a -> Tree b
(forall a b. (a -> b) -> Tree a -> Tree b)
-> (forall a b. a -> Tree b -> Tree a) -> Functor Tree
forall a b. a -> Tree b -> Tree a
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Tree b -> Tree a
$c<$ :: forall a b. a -> Tree b -> Tree a
fmap :: (a -> b) -> Tree a -> Tree b
$cfmap :: forall a b. (a -> b) -> Tree a -> Tree b
Functor
        ,Tree a -> ()
(Tree a -> ()) -> NFData (Tree a)
forall a. NFData a => Tree a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Tree a -> ()
$crnf :: forall a. NFData a => Tree a -> ()
NFData
        ,(forall a. (a -> ()) -> Tree a -> ()) -> NFData1 Tree
forall a. (a -> ()) -> Tree a -> ()
forall (f :: * -> *).
(forall a. (a -> ()) -> f a -> ()) -> NFData1 f
liftRnf :: (a -> ()) -> Tree a -> ()
$cliftRnf :: forall a. (a -> ()) -> Tree a -> ()
NFData1
        ,(forall x. Tree a -> Rep (Tree a) x)
-> (forall x. Rep (Tree a) x -> Tree a) -> Generic (Tree a)
forall x. Rep (Tree a) x -> Tree a
forall x. Tree a -> Rep (Tree a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Tree a) x -> Tree a
forall a x. Tree a -> Rep (Tree a) x
$cto :: forall a x. Rep (Tree a) x -> Tree a
$cfrom :: forall a x. Tree a -> Rep (Tree a) x
Generic
        ,(forall a. Tree a -> Rep1 Tree a)
-> (forall a. Rep1 Tree a -> Tree a) -> Generic1 Tree
forall a. Rep1 Tree a -> Tree a
forall a. Tree a -> Rep1 Tree a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Tree a -> Tree a
$cfrom1 :: forall a. Tree a -> Rep1 Tree a
Generic1
        ,Functor Tree
Foldable Tree
Functor Tree
-> Foldable Tree
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Tree a -> f (Tree b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Tree (f a) -> f (Tree a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Tree a -> m (Tree b))
-> (forall (m :: * -> *) a. Monad m => Tree (m a) -> m (Tree a))
-> Traversable Tree
(a -> f b) -> Tree a -> f (Tree b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Tree (m a) -> m (Tree a)
forall (f :: * -> *) a. Applicative f => Tree (f a) -> f (Tree a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tree a -> m (Tree b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree a -> f (Tree b)
sequence :: Tree (m a) -> m (Tree a)
$csequence :: forall (m :: * -> *) a. Monad m => Tree (m a) -> m (Tree a)
mapM :: (a -> m b) -> Tree a -> m (Tree b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tree a -> m (Tree b)
sequenceA :: Tree (f a) -> f (Tree a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Tree (f a) -> f (Tree a)
traverse :: (a -> f b) -> Tree a -> f (Tree b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree a -> f (Tree b)
$cp2Traversable :: Foldable Tree
$cp1Traversable :: Functor Tree
Traversable
#if DEBUG
        , Show
#endif
         )

instance Foldable Tree  where
  -- Tree is a PREORDER sequence layout
  foldMap :: (a -> m) -> Tree a -> m
foldMap a -> m
f (Leaf a
a) = a -> m
f a
a
  foldMap a -> m
f (Node a
a Tree a
l Tree a
r) =  a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Tree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Tree a
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<>  (a -> m) -> Tree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Tree a
r


--instance Functor Tree where
--     fmap f (Leaf x)     = Leaf (f x)
--     fmap f (Node x l r) = Node (f x) (fmap f l) (fmap f r)

-- todo audit inline pragmas for `cons`
-- also, i think we can say that cons is whnf strict in its second argument, lazy in the first?
{-# INLINE CONLIKE [0]   cons #-}
-- | Complexity /O(1)/.
cons :: a -> RAList a -> RAList a
cons :: a -> RAList a -> RAList a
cons = \ a
x RAList a
ls -> case RAList a
ls of
    (RCons Word64
tots1 Word64
tsz1 Tree a
t1
       (RCons Word64
_tots2 Word64
tsz2 Tree a
t2 RAList a
rest))
              | Word64
tsz2 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
tsz1
          -> Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons (Word64
tots1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) (Word64
tsz1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1 ) (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
x Tree a
t1 Tree a
t2 ) RAList a
rest
    RAList a
rlist -> Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons (Word64
1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ RAList a -> Word64
forall a. RAList a -> Word64
wLength RAList a
rlist ) Word64
1 (a -> Tree a
forall a. a -> Tree a
Leaf a
x) RAList a
rlist
{-
cons x (RCons tots1 tsz1 t1
              (RCons _tots2 tsz2 t2 rest))
           | tsz2 == tsz1 = RCons (tots1 + 1) (tsz1 * 2 + 1 ) (Node x t1 t2 ) rest
cons x rlist  = RCons (1 + wLength rlist ) 1 (Leaf x) rlist
-}

--(++) :: RAList a -> RAList a -> RAList a
--xs  ++ Nil = xs
--Nil ++ ys = ys
--xs  ++ ys = foldr cons ys xs

(++) :: RAList a -> RAList a-> RAList a
--{-# NOINLINE  (++) #-}    -- We want the RULE to fire first.
                             -- It's recursive, so won't inline anyway,
                             -- but saying so is more explicit
++ :: RAList a -> RAList a -> RAList a
(++) RAList a
Nil     RAList a
ys = RAList a
ys
(++) RAList a
xs    RAList a
Nil = RAList a
xs
(++) (Cons a
x RAList a
xs) RAList a
ys = a -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
Cons a
x ( RAList a
xs RAList a -> RAList a -> RAList a
forall a. RAList a -> RAList a -> RAList a
++ RAList a
ys)

-- {-# RULES
-- "RALIST/++"    [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
--  #-}


{-

      (++) :: [a] -> [a] -> [a]
      {-# NOINLINE [1] (++) #-}    -- We want the RULE to fire first.
                                   -- It's recursive, so won't inline anyway,
                                   -- but saying so is more explicit
      (++) []     ys = ys
      (++) (x:xs) ys = x : xs ++ ys

      {-# RULES
      "++"    [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
        #-}


-}

uncons :: RAList a -> Maybe (a, RAList a)
uncons :: RAList a -> Maybe (a, RAList a)
uncons (RAList a
RNil) =  Maybe (a, RAList a)
forall a. Maybe a
Nothing
uncons (RCons Word64
_tot Word64
_treetot  (Leaf a
h)     RAList a
wts) =  (a, RAList a) -> Maybe (a, RAList a)
forall a. a -> Maybe a
Just (a
h,RAList a
wts)
uncons (RCons Word64
_tot Word64
w (Node a
x Tree a
l Tree a
r) RAList a
wts) = (a, RAList a) -> Maybe (a, RAList a)
forall a. a -> Maybe a
Just (a
x, (Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons (Word64
restsize Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
w2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
w2) Word64
w2 Tree a
l (Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons (Word64
restsize Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
w2) Word64
w2 Tree a
r RAList a
wts)))
      where
        w2 :: Word64
w2 = Word64
w Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` Word64
2
        restsize :: Word64
restsize = RAList a -> Word64
forall a. RAList a -> Word64
wLength RAList a
wts

-- | Complexity /O(1)/.
head :: RAList a -> Maybe a
head :: RAList a -> Maybe a
head = ((a, RAList a) -> a) -> Maybe (a, RAList a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, RAList a) -> a
forall a b. (a, b) -> a
fst  (Maybe (a, RAList a) -> Maybe a)
-> (RAList a -> Maybe (a, RAList a)) -> RAList a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RAList a -> Maybe (a, RAList a)
forall a. RAList a -> Maybe (a, RAList a)
uncons

-- | Complexity /O(log n)/.
last :: RAList a -> a
last :: RAList a -> a
last RAList a
xs= RAList a
xs RAList a -> Word64 -> a
forall a. RAList a -> Word64 -> a
!! (RAList a -> Word64
forall w a. Integral w => RAList a -> w
genericLength RAList a
xs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)

half :: Word64 -> Word64
half :: Word64 -> Word64
half = \ Word64
n ->  Word64
n Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` Word64
2

-- | Complexity /O(log n)/.
(!!) :: RAList a -> Word64 -> a
RAList a
r !! :: RAList a -> Word64 -> a
!! Word64
n | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<  Word64
0 = String -> a
forall a. HasCallStack => String -> a
error String
"Data.RAList.!!: negative index"
                    | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= RAList a -> Word64
forall w a. Integral w => RAList a -> w
genericLength RAList a
r  = String -> a
forall a. HasCallStack => String -> a
error String
"Data.RAList.!!: index too large"
                    | Bool
otherwise = RAList a -> Word64 -> (a -> a) -> (String -> a) -> a
forall a r. RAList a -> Word64 -> (a -> r) -> (String -> r) -> r
lookupCC  RAList a
r Word64
n  a -> a
forall a. a -> a
id String -> a
forall a. HasCallStack => String -> a
error


lookupCC :: forall a r.  RAList a ->  Word64 -> (a -> r) -> (String -> r) -> r
lookupCC :: RAList a -> Word64 -> (a -> r) -> (String -> r) -> r
lookupCC  =  \  RAList a
ralist  Word64
index  a -> r
retval String -> r
retfail ->
    let
                look :: RAList a -> Word64 -> r
look RAList a
RNil Word64
_ = String -> r
retfail String
"RAList.lookup bad subscript, something is corrupted"
                look (RCons Word64
_tots Word64
tsz Tree a
t RAList a
xs) Word64
ix
                    | Word64
ix Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
tsz     = Word64 -> Word64 -> Tree a -> r
lookTree Word64
tsz  Word64
ix Tree a
t
                    | Bool
otherwise = RAList a -> Word64 -> r
look RAList a
xs (Word64
ix Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
tsz)

                lookTree :: Word64 -> Word64 -> Tree a -> r
lookTree Word64
_  Word64
ix (Leaf a
x)
                    | Word64
ix Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0    = a -> r
retval a
x
                    | Bool
otherwise = String -> r
retfail String
"RAList.lookup: not found. somehow we reached a leaf but our index doesnt match, this is bad"
                lookTree Word64
jsz Word64
ix (Node a
x Tree a
l Tree a
r)
                    | Word64
ix Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> (Word64 -> Word64
half Word64
jsz)  = Word64 -> Word64 -> Tree a -> r
lookTree (Word64 -> Word64
half Word64
jsz) (Word64
ix Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- (Word64 -> Word64
half Word64
jsz)) Tree a
r
                    | Word64
ix Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0        = Word64 -> Word64 -> Tree a -> r
lookTree (Word64 -> Word64
half Word64
jsz) (Word64
ix Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) Tree a
l -- ix between zero and floor of size/2
                    | Bool
otherwise     = a -> r
retval a
x  -- when ix is zero
      in
        if  Word64
index Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= (RAList a -> Word64
forall w a. Integral w => RAList a -> w
genericLength  RAList a
ralist)
           then  String -> r
retfail (String -> r) -> String -> r
forall a b. (a -> b) -> a -> b
$   String
"provide index larger than Ralist max valid coord " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Word64 -> String
forall a. Show a => a -> String
show Word64
index) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int -> String
forall a. Show a => a -> String
show (RAList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length RAList a
ralist))
           else RAList a -> Word64 -> r
look RAList a
ralist Word64
index


lookup :: forall a. RAList a ->  Word64 -> Maybe a
lookup :: RAList a -> Word64 -> Maybe a
lookup  = \ RAList a
xs Word64
i ->    RAList a
-> Word64 -> (a -> Maybe a) -> (String -> Maybe a) -> Maybe a
forall a r. RAList a -> Word64 -> (a -> r) -> (String -> r) -> r
lookupCC RAList a
xs Word64
i a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> String -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing)


{-# SPECIALIZE genericIndex :: RAList a -> Integer -> a #-}
{-# SPECIALIZE genericIndex :: RAList a -> Word -> a #-}
{-# SPECIALIZE genericIndex :: RAList a -> Word64 -> a #-}
{-# SPECIALIZE genericIndex :: RAList a -> Int -> a #-}
{-# SPECIALIZE genericIndex :: RAList a -> Natural -> a #-}
genericIndex :: Integral n => RAList a -> n -> a
genericIndex :: RAList a -> n -> a
genericIndex RAList a
ls n
ix | n -> Bool
forall a. Integral a => a -> Bool
word64Representable n
ix =  RAList a
ls RAList a -> Word64 -> a
forall a. RAList a -> Word64 -> a
!! (n -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
ix)
                   | Bool
otherwise = String -> a
forall a. HasCallStack => String -> a
error String
"argument index for Data.RAList.genericIndex not representable in Word64"


{-# SPECIALIZE lookupM :: forall a . RAList a ->  Word64 -> Maybe a  #-}
{-# SPECIALIZE lookupM :: forall a . RAList a ->  Word64 ->  IO a  #-}
lookupM :: forall a m. MF.MonadFail m => RAList a ->   Word64 -> m  a
lookupM :: RAList a -> Word64 -> m a
lookupM = \ RAList a
ix Word64
lst  -> RAList a -> Word64 -> (a -> m a) -> (String -> m a) -> m a
forall a r. RAList a -> Word64 -> (a -> r) -> (String -> r) -> r
lookupCC RAList a
ix Word64
lst a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

lookupWithDefault :: forall t. t -> Word64 ->  RAList t ->   t
lookupWithDefault :: t -> Word64 -> RAList t -> t
lookupWithDefault = \  t
d Word64
tree RAList t
ix  -> RAList t -> Word64 -> (t -> t) -> (String -> t) -> t
forall a r. RAList a -> Word64 -> (a -> r) -> (String -> r) -> r
lookupCC  RAList t
ix Word64
tree t -> t
forall a. a -> a
id (t -> String -> t
forall a b. a -> b -> a
const t
d)


-- | Complexity /O(1)/.
tail :: RAList a -> Maybe (RAList a)
tail :: RAList a -> Maybe (RAList a)
tail = ((a, RAList a) -> RAList a)
-> Maybe (a, RAList a) -> Maybe (RAList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, RAList a) -> RAList a
forall a b. (a, b) -> b
snd (Maybe (a, RAList a) -> Maybe (RAList a))
-> (RAList a -> Maybe (a, RAList a))
-> RAList a
-> Maybe (RAList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RAList a -> Maybe (a, RAList a)
forall a. RAList a -> Maybe (a, RAList a)
uncons
-- XXX Is there some clever way to do this?
init :: RAList a -> RAList a
init :: RAList a -> RAList a
init = [a] -> RAList a
forall a. [a] -> RAList a
fromList ([a] -> RAList a) -> (RAList a -> [a]) -> RAList a -> RAList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
Prelude.init ([a] -> [a]) -> (RAList a -> [a]) -> RAList a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


-- -- | Complexity /O(1)/.
--length :: RAList a -> Word64
--length (RCons s  _treesize _tree  _rest) = s
--length RNil = 0

map :: (a->b) -> RAList a -> RAList b
map :: (a -> b) -> RAList a -> RAList b
map = (a -> b) -> RAList a -> RAList b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap


--- adapted from ghc base
-- | 'reverse' @xs@ returns the elements of @xs@ in reverse order.
-- @xs@ must be finite.
reverse                 :: RAList a -> RAList a
#if defined(USE_REPORT_PRELUDE)
reverse                 =  foldl (flip  cons) Nil
#else
reverse :: RAList a -> RAList a
reverse RAList a
l =  RAList a -> RAList a -> RAList a
forall a. RAList a -> RAList a -> RAList a
rev RAList a
l RAList a
forall a. RAList a
Nil
  where
    rev :: RAList a -> RAList a -> RAList a
rev RAList a
Nil    RAList a
a = RAList a
a
    rev (Cons a
x RAList a
xs) RAList a
a = RAList a -> RAList a -> RAList a
rev RAList a
xs (a -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
Cons a
x RAList a
a)
#endif



foldl1' :: (a -> a -> a) -> RAList a -> a
foldl1' :: (a -> a -> a) -> RAList a -> a
foldl1' a -> a -> a
f RAList a
xs | RAList a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null RAList a
xs = String -> a
forall a. String -> a
errorEmptyList String
"foldl1'"
             | Bool
otherwise = (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
List.foldl1' a -> a -> a
f (RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList a
xs)

---- XXX This could be deforested.
--foldr :: (a -> b -> b) -> b -> RAList a -> b
--foldr f z xs = Prelude.foldr f z (toList xs)

--foldr1 :: (a -> a -> a) -> RAList a -> a
--foldr1 f xs | null xs = errorEmptyList "foldr1"
--            | otherwise = Prelude.foldr1 f (toList xs)

concat :: RAList (RAList a) -> RAList a
concat :: RAList (RAList a) -> RAList a
concat = (RAList a -> RAList a -> RAList a)
-> RAList a -> RAList (RAList a) -> RAList a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RAList a -> RAList a -> RAList a
forall a. Semigroup a => a -> a -> a
(<>) RAList a
forall a. RAList a
Nil
{-# INLINE  concat #-}
-- {-# NOINLINE [1] concat #-}

-- {-# RULES
-- "concat" forall xs. concat xs =
--     build (\c n -> foldr (\x y -> foldr c y x) n xs)
-- -- We don't bother to turn non-fusible applications of concat back into concat
-- #-}



concatMap :: (a -> RAList b) -> RAList a -> RAList b
--concatMap f = concat . fmap f
-- TODO: should this and others be foldr' ?
concatMap :: (a -> RAList b) -> RAList a -> RAList b
concatMap a -> RAList b
f             =  (a -> RAList b -> RAList b) -> RAList b -> RAList a -> RAList b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (RAList b -> RAList b -> RAList b
forall a. RAList a -> RAList a -> RAList a
(++) (RAList b -> RAList b -> RAList b)
-> (a -> RAList b) -> a -> RAList b -> RAList b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RAList b
f) RAList b
forall a. RAList a
Nil
{-# INLINE concatMap #-}
--{-# NOINLINE [1] concatMap #-}

--{-# RULES
--"concatMap" forall f xs . concatMap f xs =
--    build (\c n -> foldr (\x b -> foldr c b (f x)) n xs)
 --  #-}

--and :: RAList Bool -> Bool
--and = foldr (&&) True

--or :: RAList Bool -> Bool
--or = foldr (||) False

--any :: (a -> Bool) -> RAList a -> Bool
--any p = or . map p

--all :: (a -> Bool) -> RAList a -> Bool
--all p = and . map p

--sum :: (Num a) => RAList a -> a
--sum = foldl (+) 0

--product :: (Num a) => RAList a -> a
--product = foldl (*) 1

--maximum :: (Ord a) => RAList a -> a
--maximum xs | null xs   = errorEmptyList "maximum"
--           | otherwise = foldl1 max xs

--minimum :: (Ord a) => RAList a -> a
--minimum xs | null xs   = errorEmptyList "minimum"
--           | otherwise = foldl1 min xs

replicate :: Word64 -> a -> RAList a
replicate :: Word64 -> a -> RAList a
replicate Word64
n a
v = [a] -> RAList a
forall a. [a] -> RAList a
fromList ([a] -> RAList a) -> [a] -> RAList a
forall a b. (a -> b) -> a -> b
$ Int -> a -> [a]
forall a. Int -> a -> [a]
Prelude.replicate (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)  a
v

{-# SPECIALIZE genericReplicate ::  Int  -> a -> RAList a #-}
{-# SPECIALIZE genericReplicate ::  Word -> a -> RAList a #-}
{-# SPECIALIZE genericReplicate ::  Word64 -> a -> RAList a #-}
{-# SPECIALIZE genericReplicate ::  Integer-> a -> RAList a #-}
{-# SPECIALIZE genericReplicate ::  Natural -> a -> RAList a #-}
genericReplicate :: Integral n => n -> a -> RAList a
genericReplicate :: n -> a -> RAList a
genericReplicate n
siz a
val
  |  n -> Bool
forall a. Integral a => a -> Bool
word64Representable n
siz    = Word64 -> a -> RAList a
forall a. Word64 -> a -> RAList a
replicate (n -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
siz) a
val
  |  n
siz n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0 = String -> RAList a
forall a. HasCallStack => String -> a
error String
"negative replicate size arg in Data.RAList.genericReplicate"
  | Bool
otherwise = String -> RAList a
forall a. HasCallStack => String -> a
error String
"too large integral arg to Data.Ralist.genericReplicate"

-- when converting from  a non Word64 integral type to Word64, we want to make sure either
-- that the source integral type is representable / embedded within word64
-- OR that if its a type which can represent a Word64 value exactly, the value does
-- not exceed the size of the largest positive Word64 value. At least with Replicate :)
word64Representable :: Integral a => a -> Bool
word64Representable :: a -> Bool
word64Representable a
siz = a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
siz Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= (Word64
forall a. Bounded a => a
maxBound :: Word64)   Bool -> Bool -> Bool
|| a
siz a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64)

-- unlike drop, i dont think we can do better than the list take in complexity
take :: Word64 -> RAList a -> RAList a
take :: Word64 -> RAList a -> RAList a
take Word64
n RAList a
ls | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<  (Word64
forall a. Bounded a => a
maxBound :: Word64) = [a] -> RAList a
forall a. [a] -> RAList a
fromList ([a] -> RAList a) -> [a] -> RAList a
forall a b. (a -> b) -> a -> b
$  Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ RAList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList a
ls
          | Bool
otherwise = RAList a
ls

genericTake :: Integral n => n -> RAList a -> RAList a
genericTake :: n -> RAList a -> RAList a
genericTake n
siz RAList a
ls |  n
siz n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
0 =  RAList a
forall a. RAList a
Nil
                   | n -> Bool
forall a. Integral a => a -> Bool
word64Representable n
siz =  Word64 -> RAList a -> RAList a
forall a. Word64 -> RAList a -> RAList a
take (n -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
siz) RAList a
ls
                   | Bool
otherwise = String -> RAList a
forall a. HasCallStack => String -> a
error String
"too large integral arg for Data.RAList.genericTake"

-- | @`drop` i l@ where l has length n has worst case complexity  Complexity /O(log n)/, Average case
-- complexity should be /O(min(log i, log n))/.
drop :: Word64 -> RAList a -> RAList a
drop :: Word64 -> RAList a -> RAList a
drop Word64
n RAList a
rlist   | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0 = RAList a
rlist
drop Word64
n RAList a
rlist  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>=( RAList a -> Word64
forall w a. Integral w => RAList a -> w
genericLength RAList a
rlist) = RAList a
forall a. RAList a
Nil
drop Word64
n RAList a
rlist  = (Word64 -> RAList a -> RAList a
forall a. Word64 -> RAList a -> RAList a
loop Word64
n RAList a
rlist)
  where loop :: Word64 -> RAList a -> RAList a
loop Word64
0 RAList a
xs = RAList a
xs
        loop Word64
m (RCons Word64
_tot Word64
treesize Tree a
_ RAList a
xs) | Word64
treesize Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
m = Word64 -> RAList a -> RAList a
loop (Word64
mWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
treesize) RAList a
xs -- drops full trees
        loop Word64
m (RCons Word64
_tot Word64
treesize  Tree a
tre RAList a
xs) = Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
splitTree Word64
m Word64
treesize Tree a
tre RAList a
xs -- splits tree
        loop Word64
_ RAList a
_ = String -> RAList a
forall a. HasCallStack => String -> a
error String
"Data.RAList.drop: impossible"


genericDrop :: Integral n => n -> RAList a -> RAList a
genericDrop :: n -> RAList a -> RAList a
genericDrop n
siz RAList a
ls | n
siz n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
0 = RAList a
ls
                   | n -> Bool
forall a. Integral a => a -> Bool
word64Representable n
siz = Word64 -> RAList a -> RAList a
forall a. Word64 -> RAList a -> RAList a
drop (n -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
siz) RAList a
ls
                   | Bool
otherwise = RAList a
forall a. RAList a
Nil -- because a list with more than putatively 2**64 elements :)

-- helper function for drop
-- drops the first n elements of the tree and adds them to the front
splitTree :: Word64 -> Word64 -> Tree a -> RAList a -> RAList a
splitTree :: Word64 -> Word64 -> Tree a -> RAList a -> RAList a
splitTree Word64
n Word64
treeSize tree :: Tree a
tree@(Node a
_ Tree a
l Tree a
r) RAList a
xs =
    case (Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
n  Word64
1, Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> Word64
half Word64
treeSize) of
      (Ordering
LT {- n==0 -}, Bool
_ )  -> Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons (Word64
suffixSize Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
treeSize)  Word64
treeSize Tree a
tree RAList a
xs
      (Ordering
EQ {- n==1 -}, Bool
_ )  -> Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons (Word64
suffixSize Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
2Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
halfTreeSize) Word64
halfTreeSize Tree a
l
                                (Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons (Word64
suffixSize Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
halfTreeSize) Word64
halfTreeSize Tree a
r RAList a
xs)
      (Ordering
_, Bool
True )           -> Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
splitTree (Word64
nWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
1) Word64
halfTreeSize Tree a
l (Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons (Word64
suffixSize Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
halfTreeSize) Word64
halfTreeSize Tree a
r RAList a
xs)
      (Ordering
_, Bool
False)           -> Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
splitTree (Word64
nWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
halfTreeSizeWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
1) Word64
halfTreeSize Tree a
r RAList a
xs
    where suffixSize :: Word64
suffixSize = RAList a -> Word64
forall w a. Integral w => RAList a -> w
genericLength RAList a
xs
          halfTreeSize :: Word64
halfTreeSize = Word64 -> Word64
half Word64
treeSize
splitTree Word64
n Word64
treeSize nd :: Tree a
nd@(Leaf a
_) RAList a
xs =
  case Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
n Word64
1 of
    Ordering
EQ {-1-} -> RAList a
xs
    Ordering
LT {-0-}-> Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons ((RAList a -> Word64
forall w a. Integral w => RAList a -> w
genericLength RAList a
xs) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
treeSize) Word64
treeSize Tree a
nd RAList a
xs
    Ordering
GT {- > 1-} -> String -> RAList a
forall a. HasCallStack => String -> a
error String
"drop invariant violated, must be smaller than current tree"



-- Old version of drop
-- worst case complexity /O(n)/
simpleDrop :: Word64 -> RAList a -> RAList a
simpleDrop :: Word64 -> RAList a -> RAList a
simpleDrop Word64
n RAList a
xs  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0 = RAList a
xs
                 | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= (RAList a -> Word64
forall w a. Integral w => RAList a -> w
genericLength RAList a
xs) = RAList a
forall a. RAList a
Nil
                 | Bool
otherwise =  (Word64 -> RAList a -> RAList a
loop Word64
n RAList a
xs)
    where loop :: Word64 -> RAList a -> RAList a
loop Word64
0 RAList a
rs = RAList a
rs
          loop Word64
m (RCons Word64
_tot Word64
w Tree a
_ RAList a
rs) | Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
m = Word64 -> RAList a -> RAList a
loop (Word64
mWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
w) RAList a
rs
          loop Word64
m (RCons Word64
_tot Word64
w (Node a
_ Tree a
l Tree a
r) RAList a
rs) = Word64 -> RAList a -> RAList a
loop (Word64
mWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
1) (Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons ((RAList a -> Word64
forall w a. Integral w => RAList a -> w
genericLength RAList a
xs) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
w2) Word64
w2 Tree a
l (Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons ((RAList a -> Word64
forall w a. Integral w => RAList a -> w
genericLength RAList a
xs) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
w2) Word64
w2 Tree a
r RAList a
rs))
            where w2 :: Word64
w2 = Word64 -> Word64
half Word64
w
          loop Word64
_ RAList a
_ = String -> RAList a
forall a. HasCallStack => String -> a
error String
"Data.RAList.drop: impossible"


-- we *could* try to do better here, but this is fine
splitAt :: Word64 -> RAList a -> (RAList a, RAList a)
splitAt :: Word64 -> RAList a -> (RAList a, RAList a)
splitAt Word64
n RAList a
xs = (Word64 -> RAList a -> RAList a
forall a. Word64 -> RAList a -> RAList a
take Word64
n RAList a
xs, Word64 -> RAList a -> RAList a
forall a. Word64 -> RAList a -> RAList a
drop Word64
n RAList a
xs)

genericSplitAt :: Integral n => n  -> RAList a -> (RAList a, RAList a)
genericSplitAt :: n -> RAList a -> (RAList a, RAList a)
genericSplitAt n
siz RAList a
ls | n
siz n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
0 = (RAList a
forall a. RAList a
Nil,RAList a
ls)
                      | n -> Bool
forall a. Integral a => a -> Bool
word64Representable n
siz = (Word64 -> RAList a -> RAList a
forall a. Word64 -> RAList a -> RAList a
take (n -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
siz) RAList a
ls, Word64 -> RAList a -> RAList a
forall a. Word64 -> RAList a -> RAList a
drop (n -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
siz) RAList a
ls)
                      | Bool
otherwise = (RAList a
ls, RAList a
forall a. RAList a
Nil)

--elem :: (Eq a) => a -> RAList a -> Bool
--elem x = any (== x)

--notElem :: (Eq a) => a -> RAList a -> Bool
--notElem x = not . elem x -- aka all (/=)

-- naive list based lookup
lookupL :: (Eq a) => a -> RAList (a, b) -> Maybe b
lookupL :: a -> RAList (a, b) -> Maybe b
lookupL a
x RAList (a, b)
xys = a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup a
x (RAList (a, b) -> [(a, b)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList RAList (a, b)
xys)

-- catMaybes ls = mapMaybe Just ls
catMaybes :: RAList (Maybe a) -> RAList a
catMaybes :: RAList (Maybe a) -> RAList a
catMaybes = \  RAList (Maybe a)
ls-> (Maybe a -> RAList a -> RAList a)
-> RAList a -> RAList (Maybe a) -> RAList a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (\ Maybe a
a RAList a
bs -> RAList a -> (a -> RAList a) -> Maybe a -> RAList a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RAList a
bs (a -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
:| RAList a
bs) Maybe a
a ) RAList a
forall a. RAList a
Nil  RAList (Maybe a)
ls

wither :: forall a b f . Applicative f => (a -> f (Maybe b)) -> RAList a -> f (RAList b)
wither :: (a -> f (Maybe b)) -> RAList a -> f (RAList b)
wither a -> f (Maybe b)
f RAList a
ls =  (a -> f (RAList b) -> f (RAList b))
-> f (RAList b) -> RAList a -> f (RAList b)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((\ a
a f (RAList b)
fbs -> (Maybe b -> RAList b -> RAList b)
-> f (Maybe b) -> f (RAList b) -> f (RAList b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((RAList b -> RAList b)
-> (b -> RAList b -> RAList b) -> Maybe b -> RAList b -> RAList b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RAList b -> RAList b
forall a. a -> a
id (b -> RAList b -> RAList b
forall a. a -> RAList a -> RAList a
cons)) (a -> f (Maybe b)
f a
a) f (RAList b)
fbs))  (RAList b -> f (RAList b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure RAList b
forall a. RAList a
Nil ) RAList a
ls


-- mapMaybe f ls ===  foldr' (\ a bs -> maybe bs (\b -> b :| bs ) $! f a) ls
mapMaybe :: forall a b .  (a -> Maybe b) -> RAList a -> RAList b
mapMaybe :: (a -> Maybe b) -> RAList a -> RAList b
mapMaybe = \ a -> Maybe b
fm RAList a
ls ->
    let
        go :: RAList a -> RAList b
        go :: RAList a -> RAList b
go RAList a
Nil = RAList b
forall a. RAList a
Nil
        go (a
a:| RAList a
as) | Just b
b <- a -> Maybe b
fm a
a =  b
b b -> RAList b -> RAList b
forall a. a -> RAList a -> RAList a
:| RAList a -> RAList b
go RAList a
as
                    | Bool
otherwise      = RAList a -> RAList b
go RAList a
as
        in
        RAList a -> RAList b
go RAList a
ls

-- wither f ls == foldr


{-# NOINLINE [1] filter #-}
filter :: forall a . (a -> Bool) -> RAList a -> RAList a
filter :: (a -> Bool) -> RAList a -> RAList a
filter = \ a -> Bool
f   RAList a
ls ->
  let go :: RAList a  -> RAList a
      go :: RAList a -> RAList a
go RAList a
Nil = RAList a
forall a. RAList a
Nil
      go (a
a :| RAList a
as) = if a -> Bool
f a
a
                       then a
a a -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
:| RAList a -> RAList a
go RAList a
as
                       else RAList a -> RAList a
go RAList a
as
    in
     RAList a -> RAList a
go RAList a
ls


--filter _p Nil    = Nil
--filter p  (Cons x xs)
--  | p x         = x `Cons` filter p xs
--  | otherwise      = filter p xs



{-# INLINE [0] filterFB #-} -- See Note [Inline FB functions] in ghc base
filterFB :: (a -> b -> b) -> (a -> Bool) -> a -> b -> b
filterFB :: (a -> b -> b) -> (a -> Bool) -> a -> b -> b
filterFB a -> b -> b
c a -> Bool
p a
x b
r | a -> Bool
p a
x       = a
x a -> b -> b
`c` b
r
                 | Bool
otherwise = b
r

--- ANY late rule is problematic that uses cons :(

{-# RULES
"RA/filter"     [~1] forall p xs.  filter p xs = build (\c n -> foldr (filterFB c p) n xs)
"RA/filterList" [1]  forall p.     foldr (filterFB (cons) p) RNil = filter p
"RA/filterFB"        forall c p q. filterFB (filterFB c p) q = filterFB c (\x -> q x && p x)
 #-}


partition :: (a->Bool) -> RAList a -> (RAList a, RAList a)
partition :: (a -> Bool) -> RAList a -> (RAList a, RAList a)
partition a -> Bool
p RAList a
xs = ((a -> Bool) -> RAList a -> RAList a
forall a. (a -> Bool) -> RAList a -> RAList a
filter a -> Bool
p RAList a
xs, (a -> Bool) -> RAList a -> RAList a
forall a. (a -> Bool) -> RAList a -> RAList a
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p) RAList a
xs)



zip :: RAList a -> RAList b -> RAList (a, b)
zip :: RAList a -> RAList b -> RAList (a, b)
zip = (a -> b -> (a, b)) -> RAList a -> RAList b -> RAList (a, b)
forall a b c. (a -> b -> c) -> RAList a -> RAList b -> RAList c
zipWith (,)

zipWith :: forall a b c .  (a->b->c) -> RAList a -> RAList b -> RAList c
zipWith :: (a -> b -> c) -> RAList a -> RAList b -> RAList c
zipWith a -> b -> c
f  = \ RAList a
xs1 RAList b
xs2 ->


                  case Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RAList a -> Word64
forall a. RAList a -> Word64
wLength RAList a
xs1) (RAList b -> Word64
forall a. RAList a -> Word64
wLength RAList b
xs2) of
                      Ordering
EQ -> RAList a -> RAList b -> RAList c
zipTop RAList a
xs1 RAList b
xs2

                      Ordering
LT -> RAList a -> RAList b -> RAList c
zipTop  RAList a
xs1
                                    (Word64 -> RAList b -> RAList b
forall a. Word64 -> RAList a -> RAList a
take (RAList a -> Word64
forall a. RAList a -> Word64
wLength RAList a
xs1) RAList b
xs2)

                      Ordering
GT -> RAList a -> RAList b -> RAList c
zipTop  (Word64 -> RAList a -> RAList a
forall a. Word64 -> RAList a -> RAList a
take (RAList b -> Word64
forall a. RAList a -> Word64
wLength RAList b
xs2) RAList a
xs1)
                                     RAList b
xs2

    --      | s1 == s2 = RAList s1 (zipTop wts1 wts2)
    --    | otherwise = fromList $ Prelude.zipWith f (toList xs1) (toList xs2)
  where zipTree :: Tree a -> Tree b -> Tree c
zipTree (Leaf a
x1) (Leaf b
x2) = c -> Tree c
forall a. a -> Tree a
Leaf (a -> b -> c
f a
x1 b
x2)
        zipTree (Node a
x1 Tree a
l1 Tree a
r1) (Node b
x2 Tree b
l2 Tree b
r2) = c -> Tree c -> Tree c -> Tree c
forall a. a -> Tree a -> Tree a -> Tree a
Node (a -> b -> c
f a
x1 b
x2) (Tree a -> Tree b -> Tree c
zipTree Tree a
l1 Tree b
l2) (Tree a -> Tree b -> Tree c
zipTree Tree a
r1 Tree b
r2)
        zipTree Tree a
_ Tree b
_ = String -> Tree c
forall a. HasCallStack => String -> a
error String
"Data.RAList.zipWith: impossible"
        zipTop :: RAList a -> RAList b -> RAList c
        zipTop :: RAList a -> RAList b -> RAList c
zipTop RAList a
RNil RAList b
RNil = RAList c
forall a. RAList a
RNil
        zipTop (RCons Word64
tot1 Word64
w Tree a
t1 RAList a
xss1) (RCons Word64
_tot2 Word64
_ Tree b
t2 RAList b
xss2) = Word64 -> Word64 -> Tree c -> RAList c -> RAList c
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons Word64
tot1 Word64
w (Tree a -> Tree b -> Tree c
zipTree Tree a
t1 Tree b
t2) (RAList a -> RAList b -> RAList c
zipTop RAList a
xss1 RAList b
xss2)
        zipTop RAList a
_ RAList b
_ = String -> RAList c
forall a. HasCallStack => String -> a
error String
"Data.RAList.zipWith: impossible"



-- | Change element at the given index.
-- Complexity /O(log n)/.
update :: Word64 -> a -> RAList a -> RAList a
update :: Word64 -> a -> RAList a -> RAList a
update Word64
i a
x = (a -> a) -> Word64 -> RAList a -> RAList a
forall a. (a -> a) -> Word64 -> RAList a -> RAList a
adjust (a -> a -> a
forall a b. a -> b -> a
const a
x) Word64
i

-- | Apply a function to the value at the given index.
-- Complexity /O(log n)/.
adjust :: forall a . (a->a) -> Word64 -> RAList a -> RAList a
adjust :: (a -> a) -> Word64 -> RAList a -> RAList a
adjust a -> a
f Word64
n RAList a
s | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<  Word64
0 = String -> RAList a
forall a. HasCallStack => String -> a
error String
"Data.RAList.adjust: negative index"
                          | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= (RAList a -> Word64
forall w a. Integral w => RAList a -> w
genericLength RAList a
s) = String -> RAList a
forall a. HasCallStack => String -> a
error String
"Data.RAList.adjust: index too large"
                          | Bool
otherwise = (Word64 -> RAList a -> RAList a
adj Word64
n RAList a
s )
  where adj  :: Word64 -> RAList a -> RAList a
        adj :: Word64 -> RAList a -> RAList a
adj Word64
j (RCons Word64
tot  Word64
w Tree a
t RAList a
wts') | Word64
j Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
w     = Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons Word64
tot Word64
w (Word64 -> Word64 -> Tree a -> Tree a
adjt Word64
j (Word64
w Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` Word64
2) Tree a
t) RAList a
wts'
                                    | Bool
otherwise = Word64 -> Word64 -> Tree a -> RAList a -> RAList a
forall a. Word64 -> Word64 -> Tree a -> RAList a -> RAList a
RCons Word64
tot Word64
w Tree a
t (Word64 -> RAList a -> RAList a
adj (Word64
jWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
w) RAList a
wts')
        adj Word64
j RAList a
_ = String -> RAList a
forall a. HasCallStack => String -> a
error (String
"Data.RAList.adjust: impossible Nil element: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show Word64
j)

        adjt :: Word64 -> Word64 -> Tree a -> Tree a
        adjt :: Word64 -> Word64 -> Tree a -> Tree a
adjt Word64
0 Word64
0 (Leaf a
x)     = a -> Tree a
forall a. a -> Tree a
Leaf (a -> a
f a
x)
        adjt Word64
0 Word64
_ (Node a
x Tree a
l Tree a
r) = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node (a -> a
f a
x) Tree a
l Tree a
r
        adjt Word64
j Word64
w (Node a
x Tree a
l Tree a
r) | Word64
j Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
w    = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
x (Word64 -> Word64 -> Tree a -> Tree a
adjt (Word64
jWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
1) (Word64
w Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` Word64
2) Tree a
l) Tree a
r
                              | Bool
otherwise = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
x Tree a
l (Word64 -> Word64 -> Tree a -> Tree a
adjt (Word64
jWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
1Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
w) (Word64
w Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` Word64
2) Tree a
r)
        adjt Word64
_ Word64
_ Tree a
_ = String -> Tree a
forall a. HasCallStack => String -> a
error String
"Data.RAList.adjust: impossible"



-- | Complexity /O(n)/.
fromList :: [a] -> RAList a
fromList :: [a] -> RAList a
fromList = (a -> RAList a -> RAList a) -> RAList a -> [a] -> RAList a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr a -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
Cons RAList a
forall a. RAList a
Nil

errorEmptyList :: String -> a
errorEmptyList :: String -> a
errorEmptyList String
fun =
  String -> a
forall a. HasCallStack => String -> a
error (String
"Data.RAList." String -> ShowS
forall a. [a] -> [a] -> [a]
Prelude.++ String
fun String -> ShowS
forall a. [a] -> [a] -> [a]
Prelude.++ String
": empty list")


--- copy fusion codes of your own :) perhaps?
--- for now these fusion rules are shamelessly copied from the ghc base library

{-# INLINE [1] build #-}
--- a
build   :: forall a. (forall b. (a -> b -> b) -> b -> b) -> RAList a
build :: (forall b. (a -> b -> b) -> b -> b) -> RAList a
build = \ forall b. (a -> b -> b) -> b -> b
g -> (a -> RAList a -> RAList a) -> RAList a -> RAList a
forall b. (a -> b -> b) -> b -> b
g  a -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
cons RAList a
forall a. RAList a
Nil

unfoldr :: (b -> Maybe (a, b)) -> b -> RAList a
{-# INLINE unfoldr #-} -- See Note [INLINE unfoldr  in ghc base library original source]
unfoldr :: (b -> Maybe (a, b)) -> b -> RAList a
unfoldr b -> Maybe (a, b)
f b
b0 = (forall b. (a -> b -> b) -> b -> b) -> RAList a
forall a. (forall b. (a -> b -> b) -> b -> b) -> RAList a
build (\a -> b -> b
c b
n ->
  let go :: b -> b
go b
b = case b -> Maybe (a, b)
f b
b of
               Just (a
a, b
new_b) -> a
a a -> b -> b
`c` b -> b
go b
new_b
               Maybe (a, b)
Nothing         -> b
n
  in b -> b
go b
b0)


augment :: forall a. (forall b. (a->b->b) -> b -> b) -> RAList a -> RAList a
-- {-# INLINE [1] augment #-}
augment :: (forall b. (a -> b -> b) -> b -> b) -> RAList a -> RAList a
augment forall b. (a -> b -> b) -> b -> b
g RAList a
xs = (a -> RAList a -> RAList a) -> RAList a -> RAList a
forall b. (a -> b -> b) -> b -> b
g a -> RAList a -> RAList a
forall a. a -> RAList a -> RAList a
cons RAList a
xs



--{-# RULES
--"RALIST/fold/build"    forall k z (g::forall b. (a->b->b) -> b -> b) .
--                foldr k z (build g) = g k z
--
--"RALIST/foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .
--                foldr k z (augment g xs) = g k (foldr k z xs)
--
--
--"RALIST/augment/build" forall (g::forall b. (a->b->b) -> b -> b)
--                       (h::forall b. (a->b->b) -> b -> b) .
--                       augment g (build h) = build (\c n -> g c (h c n))
--
----- not sure if these latter rules will be useful for RALIST
--
--"RALIST/foldr/cons/build" forall k z x (g::forall b. (a->b->b) -> b -> b) .
--                           foldr k z (cons x (build g)) = k x (g k z)
--
--
--"RALIST/foldr/single"  forall k z x. foldr k z (cons x RNil) = k x z
--"RALIST/foldr/nil"     forall k z.   foldr k z RNil  = z
--
--
--"RALIST/foldr/cons/build" forall k z x (g::forall b. (a->b->b) -> b -> b) .
--                           foldr k z (cons x (build g)) = k x (g k z)
--
--"RALIST/augment/build" forall (g::forall b. (a->b->b) -> b -> b)
--                       (h::forall b. (a->b->b) -> b -> b) .
--                       augment g (build h) = build (\c n -> g c (h c n))
--"RALIST/augment/nil"   forall (g::forall b. (a->b->b) -> b -> b) .
--                        augment g RNil = build g
--
--"RALIST/foldr/id"                        foldr (cons) RNil = \x  -> x
--"RALIST/foldr/app"     [1] forall ys. foldr (cons) ys = \xs -> xs ++ ys
--        -- Only activate this from phase 1, because that's
--        -- when we disable the rule that expands (++) into foldr
-- #-}

-- {-# RULES
-- "RALIST/++"    [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
--   #-}



{-
additional ru

"foldr/id"                        foldr (:) [] = \x  -> x
        -- Only activate this from phase 1, because that's
        -- when we disable the rule that expands (++) into foldr

-- The foldr/cons rule looks nice, but it can give disastrously
-- bloated code when compiling
--      array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]
-- i.e. when there are very very long literal lists
-- So I've disabled it for now. We could have special cases
-- for short lists, I suppose.
-- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)

"foldr/single"  forall k z x. foldr k z [x] = k x z
"foldr/nil"     forall k z.   foldr k z []  = z

"foldr/cons/build" forall k z x (g::forall b. (a->b->b) -> b -> b) .
                           foldr k z (x:build g) = k x (g k z)

-}