adaptive-containers-0.3: Self optimizing container types

Stabilityexperimental
Maintainerdons@galois.com

Data.Adaptive.List

Contents

Description

Self adapting polymorphic lists.

This library statically specializes the polymorphic container representation of lists to specific, more efficient representations, when instantiated with particular monomorphic types. It does this via an associated more efficient data type for each pair of elements you wish to store in your container.

The resulting list structures use less space, and functions on them tend to be faster, than regular lists.

Instead of representing '[1..5] :: [Int]' as:

      (:) 
     /   \
    /     \
 I# 1#    (:)
         /   \
        /     \
     I# 2#    (:)
             /   \
            /     \
         I# 3#    []

The compiler will select an associated data type that packs better, via the class instances, resulting in:

   ConsInt 1#
    |
   ConsInt 2#
    |
   ConsInt 3#
    |
    []

The user however, still sees a polymorphic list type.

This list type currently doesn't fuse.

Synopsis

The adaptive list class-associated type

class AdaptList a whereSource

Representation-improving polymorphic lists.

Associated Types

data List a Source

Methods

empty :: List aSource

The empty list

cons :: a -> List a -> List aSource

Prepend a value onto a list

null :: List a -> BoolSource

Is the list empty?

head :: List a -> aSource

The first element of the list

tail :: List a -> List aSource

The tail of the list

Instances

AdaptList Bool

We can unpack bools!

AdaptList Char 
AdaptList Double 
AdaptList Float 
AdaptList Int 
AdaptList Int8 
AdaptList Int16 
AdaptList Int32 
AdaptList Int64 
AdaptList Integer 
AdaptList Word 
AdaptList Word8 
AdaptList Word16 
AdaptList Word32 
AdaptList Word64 
AdaptList (Pair Char Char) 
AdaptList (Pair Char Double) 
AdaptList (Pair Char Float) 
AdaptList (Pair Char Int) 
AdaptList (Pair Char Int8) 
AdaptList (Pair Char Int16) 
AdaptList (Pair Char Int32) 
AdaptList (Pair Char Int64) 
AdaptList (Pair Char Integer) 
AdaptList (Pair Char Word) 
AdaptList (Pair Char Word8) 
AdaptList (Pair Char Word16) 
AdaptList (Pair Char Word32) 
AdaptList (Pair Char Word64) 
AdaptList (Pair Double Char) 
AdaptList (Pair Double Double) 
AdaptList (Pair Double Float) 
AdaptList (Pair Double Int) 
AdaptList (Pair Double Int8) 
AdaptList (Pair Double Int16) 
AdaptList (Pair Double Int32) 
AdaptList (Pair Double Int64) 
AdaptList (Pair Double Integer) 
AdaptList (Pair Double Word) 
AdaptList (Pair Double Word8) 
AdaptList (Pair Double Word16) 
AdaptList (Pair Double Word32) 
AdaptList (Pair Double Word64) 
AdaptList (Pair Float Char) 
AdaptList (Pair Float Double) 
AdaptList (Pair Float Float) 
AdaptList (Pair Float Int) 
AdaptList (Pair Float Int8) 
AdaptList (Pair Float Int16) 
AdaptList (Pair Float Int32) 
AdaptList (Pair Float Int64) 
AdaptList (Pair Float Integer) 
AdaptList (Pair Float Word) 
AdaptList (Pair Float Word8) 
AdaptList (Pair Float Word16) 
AdaptList (Pair Float Word32) 
AdaptList (Pair Float Word64) 
AdaptList (Pair Int Char) 
AdaptList (Pair Int Double) 
AdaptList (Pair Int Float) 
AdaptList (Pair Int Int) 
AdaptList (Pair Int Int8) 
AdaptList (Pair Int Int16) 
AdaptList (Pair Int Int32) 
AdaptList (Pair Int Int64) 
AdaptList (Pair Int Integer) 
AdaptList (Pair Int Word) 
AdaptList (Pair Int Word8) 
AdaptList (Pair Int Word16) 
AdaptList (Pair Int Word32) 
AdaptList (Pair Int Word64) 
AdaptList (Pair Int8 Char) 
AdaptList (Pair Int8 Double) 
AdaptList (Pair Int8 Float) 
AdaptList (Pair Int8 Int) 
AdaptList (Pair Int8 Int8) 
AdaptList (Pair Int8 Int16) 
AdaptList (Pair Int8 Int32) 
AdaptList (Pair Int8 Int64) 
AdaptList (Pair Int8 Integer) 
AdaptList (Pair Int8 Word) 
AdaptList (Pair Int8 Word8) 
AdaptList (Pair Int8 Word16) 
AdaptList (Pair Int8 Word32) 
AdaptList (Pair Int8 Word64) 
AdaptList (Pair Int16 Char) 
AdaptList (Pair Int16 Double) 
AdaptList (Pair Int16 Float) 
AdaptList (Pair Int16 Int) 
AdaptList (Pair Int16 Int8) 
AdaptList (Pair Int16 Int16) 
AdaptList (Pair Int16 Int32) 
AdaptList (Pair Int16 Int64) 
AdaptList (Pair Int16 Integer) 
AdaptList (Pair Int16 Word) 
AdaptList (Pair Int16 Word8) 
AdaptList (Pair Int16 Word16) 
AdaptList (Pair Int16 Word32) 
AdaptList (Pair Int16 Word64) 
AdaptList (Pair Int32 Char) 
AdaptList (Pair Int32 Double) 
AdaptList (Pair Int32 Float) 
AdaptList (Pair Int32 Int) 
AdaptList (Pair Int32 Int8) 
AdaptList (Pair Int32 Int16) 
AdaptList (Pair Int32 Int32) 
AdaptList (Pair Int32 Int64) 
AdaptList (Pair Int32 Integer) 
AdaptList (Pair Int32 Word) 
AdaptList (Pair Int32 Word8) 
AdaptList (Pair Int32 Word16) 
AdaptList (Pair Int32 Word32) 
AdaptList (Pair Int32 Word64) 
AdaptList (Pair Int64 Char) 
AdaptList (Pair Int64 Double) 
AdaptList (Pair Int64 Float) 
AdaptList (Pair Int64 Int) 
AdaptList (Pair Int64 Int8) 
AdaptList (Pair Int64 Int16) 
AdaptList (Pair Int64 Int32) 
AdaptList (Pair Int64 Int64) 
AdaptList (Pair Int64 Integer) 
AdaptList (Pair Int64 Word) 
AdaptList (Pair Int64 Word8) 
AdaptList (Pair Int64 Word16) 
AdaptList (Pair Int64 Word32) 
AdaptList (Pair Int64 Word64) 
AdaptList (Pair Integer Char) 
AdaptList (Pair Integer Double) 
AdaptList (Pair Integer Float) 
AdaptList (Pair Integer Int) 
AdaptList (Pair Integer Int8) 
AdaptList (Pair Integer Int16) 
AdaptList (Pair Integer Int32) 
AdaptList (Pair Integer Int64) 
AdaptList (Pair Integer Integer) 
AdaptList (Pair Integer Word) 
AdaptList (Pair Integer Word8) 
AdaptList (Pair Integer Word16) 
AdaptList (Pair Integer Word32) 
AdaptList (Pair Integer Word64) 
AdaptList (Pair Word Char) 
AdaptList (Pair Word Double) 
AdaptList (Pair Word Float) 
AdaptList (Pair Word Int) 
AdaptList (Pair Word Int8) 
AdaptList (Pair Word Int16) 
AdaptList (Pair Word Int32) 
AdaptList (Pair Word Int64) 
AdaptList (Pair Word Integer) 
AdaptList (Pair Word Word) 
AdaptList (Pair Word Word8) 
AdaptList (Pair Word Word16) 
AdaptList (Pair Word Word32) 
AdaptList (Pair Word Word64) 
AdaptList (Pair Word8 Char) 
AdaptList (Pair Word8 Double) 
AdaptList (Pair Word8 Float) 
AdaptList (Pair Word8 Int) 
AdaptList (Pair Word8 Int8) 
AdaptList (Pair Word8 Int16) 
AdaptList (Pair Word8 Int32) 
AdaptList (Pair Word8 Int64) 
AdaptList (Pair Word8 Integer) 
AdaptList (Pair Word8 Word) 
AdaptList (Pair Word8 Word8) 
AdaptList (Pair Word8 Word16) 
AdaptList (Pair Word8 Word32) 
AdaptList (Pair Word8 Word64) 
AdaptList (Pair Word16 Char) 
AdaptList (Pair Word16 Double) 
AdaptList (Pair Word16 Float) 
AdaptList (Pair Word16 Int) 
AdaptList (Pair Word16 Int8) 
AdaptList (Pair Word16 Int16) 
AdaptList (Pair Word16 Int32) 
AdaptList (Pair Word16 Int64) 
AdaptList (Pair Word16 Integer) 
AdaptList (Pair Word16 Word) 
AdaptList (Pair Word16 Word8) 
AdaptList (Pair Word16 Word16) 
AdaptList (Pair Word16 Word32) 
AdaptList (Pair Word16 Word64) 
AdaptList (Pair Word32 Char) 
AdaptList (Pair Word32 Double) 
AdaptList (Pair Word32 Float) 
AdaptList (Pair Word32 Int) 
AdaptList (Pair Word32 Int8) 
AdaptList (Pair Word32 Int16) 
AdaptList (Pair Word32 Int32) 
AdaptList (Pair Word32 Int64) 
AdaptList (Pair Word32 Integer) 
AdaptList (Pair Word32 Word) 
AdaptList (Pair Word32 Word8) 
AdaptList (Pair Word32 Word16) 
AdaptList (Pair Word32 Word32) 
AdaptList (Pair Word32 Word64) 
AdaptList (Pair Word64 Char) 
AdaptList (Pair Word64 Double) 
AdaptList (Pair Word64 Float) 
AdaptList (Pair Word64 Int) 
AdaptList (Pair Word64 Int8) 
AdaptList (Pair Word64 Int16) 
AdaptList (Pair Word64 Int32) 
AdaptList (Pair Word64 Int64) 
AdaptList (Pair Word64 Integer) 
AdaptList (Pair Word64 Word) 
AdaptList (Pair Word64 Word8) 
AdaptList (Pair Word64 Word16) 
AdaptList (Pair Word64 Word32) 
AdaptList (Pair Word64 Word64) 

Basic Interface

toList :: AdaptList a => List a -> [a]Source

O(n), convert an adaptive list to a regular list

fromList :: AdaptList a => [a] -> List aSource

O(n), convert an adaptive list to a regular list

enumFromToList :: (AdaptList a, Ord a, Enum a) => a -> a -> List aSource

O(n), construct a list by enumerating a range

uncons :: AdaptList a => List a -> Maybe (a, List a)Source

O(1), uncons, take apart a list into the head and tail.

(++) :: AdaptList a => List a -> List a -> List aSource

O(n), Append two lists, i.e.,

 [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn]
 [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...]

If the first list is not finite, the result is the first list. The spine of the first list argument must be copied.

last :: AdaptList a => List a -> aSource

O(n), Extract the last element of a list, which must be finite and non-empty.

init :: AdaptList a => List a -> List aSource

O(n). Return all the elements of a list except the last one. The list must be finite and non-empty.

length :: AdaptList a => List a -> IntSource

O(n). length returns the length of a finite list as an Int. It is an instance of the more general Data.List.genericLength, the result type of which may be any kind of number.

List transformations

map :: (AdaptList a, AdaptList b) => (a -> b) -> List a -> List bSource

O(n). map f xs is the list obtained by applying f to each element of xs, i.e.,

 map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn]
 map f [x1, x2, ...] == [f x1, f x2, ...]

Properties:

 map f . map g         = map (f . g)
 map f (repeat x)      = repeat (f x)
 map f (replicate n x) = replicate n (f x)

reverse :: AdaptList a => List a -> List aSource

O(n). reverse xs returns the elements of xs in reverse order. xs must be finite. Will fuse as a consumer only.

intersperse :: AdaptList a => a -> List a -> List aSource

O(n). The intersperse function takes an element and a list and `intersperses' that element between the elements of the list. For example,

 intersperse ',' "abcde" == "a,b,c,d,e"

intercalate :: (AdaptList (List a), AdaptList a) => List a -> List (List a) -> List aSource

O(n). intercalate xs xss is equivalent to (concat (intersperse xs xss)). It inserts the list xs in between the lists in xss and concatenates the result.

 intercalate = concat . intersperse

Reducing lists (folds)

foldl :: AdaptList b => (a -> b -> a) -> a -> List b -> aSource

O(n). foldl, applied to a binary operator, a starting value (typically the left-identity of the operator), and a list, reduces the list using the binary operator, from left to right:

 foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn

The list must be finite. The accumulator is whnf strict.

foldl1 :: AdaptList a => (a -> a -> a) -> List a -> aSource

O(n). foldl1 is a variant of foldl that has no starting value argument, and thus must be applied to non-empty lists.

foldr :: AdaptList a => (a -> b -> b) -> b -> List a -> bSource

O(n). foldr, applied to a binary operator, a starting value (typically the right-identity of the operator), and a list, reduces the list using the binary operator, from right to left:

 foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)

foldr1 :: AdaptList a => (a -> a -> a) -> List a -> aSource

O(n). foldr1 is a variant of foldr that has no starting value argument, and thus must be applied to non-empty lists.

Special folds

concat :: (AdaptList (List a), AdaptList a) => List (List a) -> List aSource

O(n). Concatenate a list of lists. concat :: [[a]] -> [a]

concatMap :: (AdaptList a1, AdaptList a) => (a -> List a1) -> List a -> List a1Source

O(n), fusion. Map a function over a list and concatenate the results.

and :: List Bool -> BoolSource

O(n). and returns the conjunction of a Boolean list. For the result to be True, the list must be finite; False, however, results from a False value at a finite index of a finite or infinite list.

or :: List Bool -> BoolSource

O(n). or returns the disjunction of a Boolean list. For the result to be False, the list must be finite; True, however, results from a True value at a finite index of a finite or infinite list.

any :: AdaptList a => (a -> Bool) -> List a -> BoolSource

O(n). Applied to a predicate and a list, any determines if any element of the list satisfies the predicate.

all :: AdaptList a => (a -> Bool) -> List a -> BoolSource

Applied to a predicate and a list, all determines if all elements of the list satisfy the predicate.

sum :: (AdaptList a, Num a) => List a -> aSource

O(n), fusion. The sum function computes the sum of a finite list of numbers.

product :: (AdaptList a, Num a) => List a -> aSource

O(n),fusion. The product function computes the product of a finite list of numbers.

maximum :: (AdaptList a, Ord a) => List a -> aSource

O(n). maximum returns the maximum value from a list, which must be non-empty, finite, and of an ordered type. It is a special case of Data.List.maximumBy, which allows the programmer to supply their own comparison function.

minimum :: (AdaptList a, Ord a) => List a -> aSource

O(n). minimum returns the minimum value from a list, which must be non-empty, finite, and of an ordered type. It is a special case of Data.List.minimumBy, which allows the programmer to supply their own comparison function.

Building lists

Scans

scanl :: (AdaptList b, AdaptList a) => (a -> b -> a) -> a -> List b -> List aSource

O(n). scanl is similar to foldl, but returns a list of successive reduced values from the left:

 scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]

Properties:

 last (scanl f z xs) == foldl f z x

scanl1 :: AdaptList a => (a -> a -> a) -> List a -> List aSource

O(n). scanl1 is a variant of scanl that has no starting value argument:

 scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]

scanr :: (AdaptList a, AdaptList b) => (a -> b -> b) -> b -> List a -> List bSource

O(n). scanr is the right-to-left dual of scanl. Properties:

 head (scanr f z xs) == foldr f z xs

scanr1 :: AdaptList a => (a -> a -> a) -> List a -> List aSource

scanr1 is a variant of scanr that has no starting value argument.

Infinite lists

iterate :: AdaptList a => (a -> a) -> a -> List aSource

O(n), iterate f x returns an infinite list of repeated applications of f to x:

 iterate f x == [x, f x, f (f x), ...]

repeat :: AdaptList a => a -> List aSource

O(n). repeat x is an infinite list, with x the value of every element.

replicate :: AdaptList a => Int -> a -> List aSource

O(n). replicate n x is a list of length n with x the value of every element. It is an instance of the more general Data.List.genericReplicate, in which n may be of any integral type.

cycle :: AdaptList a => List a -> List aSource

fusion. cycle ties a finite list into a circular one, or equivalently, the infinite repetition of the original list. It is the identity on infinite lists.

Unfolding

unfoldr :: AdaptList a => (b -> Maybe (a, b)) -> b -> List aSource

The unfoldr function is a `dual' to foldr: while foldr reduces a list to a summary value, unfoldr builds a list from a seed value. The function takes the element and returns Nothing if it is done producing the list or returns Just (a,b), in which case, a is a prepended to the list and b is used as the next element in a recursive call. For example,

 iterate f == unfoldr (\x -> Just (x, f x))

In some cases, unfoldr can undo a foldr operation:

 unfoldr f' (foldr f z xs) == xs

if the following holds:

 f' (f x y) = Just (x,y)
 f' z       = Nothing

A simple use of unfoldr:

 unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
  [10,9,8,7,6,5,4,3,2,1]

TODO: AdaptPair state.

Sublists

Extracting sublists

take :: AdaptList a => Int -> List a -> List aSource

O(n). take n, applied to a list xs, returns the prefix of xs of length n, or xs itself if n > length xs:

 take 5 "Hello World!" == "Hello"
 take 3 [1,2,3,4,5] == [1,2,3]
 take 3 [1,2] == [1,2]
 take 3 [] == []
 take (-1) [1,2] == []
 take 0 [1,2] == []

It is an instance of the more general Data.List.genericTake, in which n may be of any integral type.

drop :: AdaptList a => Int -> List a -> List aSource

O(n). drop n xs returns the suffix of xs after the first n elements, or [] if n > length xs:

 drop 6 "Hello World!" == "World!"
 drop 3 [1,2,3,4,5] == [4,5]
 drop 3 [1,2] == []
 drop 3 [] == []
 drop (-1) [1,2] == [1,2]
 drop 0 [1,2] == [1,2]

It is an instance of the more general Data.List.genericDrop, in which n may be of any integral type.

splitAt :: AdaptList a => Int -> List a -> (List a, List a)Source

splitAt n xs returns a tuple where first element is xs prefix of length n and second element is the remainder of the list:

 splitAt 6 "Hello World!" == ("Hello ","World!")
 splitAt 3 [1,2,3,4,5] == ([1,2,3],[4,5])
 splitAt 1 [1,2,3] == ([1],[2,3])
 splitAt 3 [1,2,3] == ([1,2,3],[])
 splitAt 4 [1,2,3] == ([1,2,3],[])
 splitAt 0 [1,2,3] == ([],[1,2,3])
 splitAt (-1) [1,2,3] == ([],[1,2,3])

It is equivalent to (take n xs, drop n xs). splitAt is an instance of the more general Data.List.genericSplitAt, in which n may be of any integral type.

Searching lists

Searching by equality

elem :: (AdaptList a, Eq a) => a -> List a -> BoolSource

O(n). elem is the list membership predicate, usually written in infix form, e.g., x elem xs.

notElem :: (AdaptList a, Eq a) => a -> List a -> BoolSource

O(n). notElem is the negation of elem.

filter :: AdaptList a => (a -> Bool) -> List a -> List aSource

O(n). filter, applied to a predicate and a list, returns the list of those elements that satisfy the predicate; i.e.,

 filter p xs = [ x | x <- xs, p x]

Properties:

 filter p (filter q s) = filter (\x -> q x && p x) s

Zipping and unzipping lists

zip :: (AdaptPair a b, AdaptList a, AdaptList b, AdaptList (Pair a b)) => List a -> List b -> List (Pair a b)Source

O(n),fusion. zip takes two lists and returns a list of corresponding pairs. If one input list is short, excess elements of the longer list are discarded.

Properties:

 zip a b = zipWith (,) a b