summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorchessai <>2018-12-05 20:32:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-12-05 20:32:00 (GMT)
commitb4f730f9c8c7afa1fae7dfc1512499e181b3943a (patch)
treea43b7322f5ff20b96622238bafd66d4d794158fc
version 0.1.0.0HEAD0.1.0.0master
-rwxr-xr-xCHANGELOG.md5
-rw-r--r--LICENSE30
-rw-r--r--Setup.hs2
-rw-r--r--src/Data/List/Unlifted.hs209
-rw-r--r--unlifted-list.cabal22
5 files changed, 268 insertions, 0 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100755
index 0000000..dca436b
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for unlifted-list
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..8f3f232
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2018, chessai
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of chessai nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/src/Data/List/Unlifted.hs b/src/Data/List/Unlifted.hs
new file mode 100644
index 0000000..d92b7cd
--- /dev/null
+++ b/src/Data/List/Unlifted.hs
@@ -0,0 +1,209 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE GADTSyntax #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | This module defines an API centred around linked lists of unlifted values.
+module Data.List.Unlifted
+ ( UList(UNil,UCons)
+ , map
+ , foldr
+ , foldl
+ , foldl'
+ , null
+ , scanl
+ , filter
+ , length
+ , (.)
+ ) where
+
+import GHC.Prim
+import GHC.Types
+import GHC.Magic (oneShot)
+import Data.Function (id)
+import Data.Semigroup (Semigroup((<>)))
+#if MIN_VERSION_base(4,9,0)
+import Data.Monoid (Monoid(mempty, mappend))
+#endif
+import GHC.Num ((+))
+
+-- | Function composition.
+(.) :: forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep) (c :: TYPE 'UnliftedRep). (b -> c) -> (a -> b) -> a -> c
+{-# INLINE (.) #-}
+(.) f g = \x -> f (g x)
+
+-- | A linked list of unlifted values. The values stored in the list
+-- are guaranteed to not be thunks.
+data UList (a :: TYPE 'UnliftedRep) where
+ UNil :: UList a
+ UCons :: a -> UList a -> UList a
+
+instance Semigroup (UList a) where
+ (<>) = (++)
+
+#if MIN_VERSION_base(4,9,0)
+instance Monoid (UList a) where
+ mempty = UNil
+#if !MIN_VERSION_base(4,11,0)
+ mappend = (<>)
+#endif
+#endif
+
+-- | '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, ...]
+map :: (a -> b) -> UList a -> UList b
+{-# NOINLINE [0] map #-}
+map _ UNil = UNil
+map f (UCons x xs) = UCons (f x) (map f xs)
+
+mapFB :: forall (a :: TYPE 'UnliftedRep)
+ (elt :: TYPE 'UnliftedRep)
+ (lst :: Type).
+ (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
+{-# INLINE [0] mapFB #-}
+mapFB c f = \x ys -> c (f x) ys
+
+build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> UList a
+{-# INLINE [1] build #-}
+build g = g UCons UNil
+
+augment :: forall a. (forall b. (a -> b -> b) -> b -> b) -> UList a -> UList a
+{-# INLINE [1] augment #-}
+augment g xs = g UCons xs
+
+-- | '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)...)
+foldr :: (a -> b -> b) -> b -> UList a -> b
+{-# INLINE [0] foldr #-}
+foldr k z = go
+ where
+ go UNil = z
+ go (UCons y ys) = y `k` go ys
+
+-- | '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.
+foldl :: forall a b. (b -> a -> b) -> b -> UList a -> b
+{-# INLINE foldl #-}
+foldl k z0 xs = foldr
+ (\(v :: a) (fn :: b -> b) -> oneShot (\(z :: b) -> fn (k z v)))
+ (id :: b -> b)
+ xs
+ z0
+
+-- | A strict version of 'foldl'.
+foldl' :: forall a b. (b -> a -> b) -> b -> UList a -> b
+{-# 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
+
+-- | Test whether a list is empty.
+null :: UList a -> Bool
+null UNil = True
+null _ = False
+
+-- | '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, ...]
+--
+-- Note that
+--
+-- > last (scanl f z xs) == foldl f z xs.
+
+-- This peculiar arrangement is necessary to prevent scanl being rewritten in
+-- its own right-hand side.
+scanl :: (b -> a -> b) -> b -> UList a -> UList b
+{-# NOINLINE [1] scanl #-}
+scanl = scanlGo
+ where
+ scanlGo f q ls = UCons q
+ (case ls of
+ UNil -> UNil
+ UCons x xs -> scanlGo f (f q x) xs
+ )
+
+{-# RULES
+"scanl" [~1] forall f a bs. scanl f a bs =
+ build (\c n -> a `c` foldr (scanlFB f c) (\_ -> n) bs a)
+"scanList" [1] forall f (a::a) bs.
+ foldr (scanlFB f UCons) (\_ -> UNil) bs a = tail (scanl f a bs)
+ #-}
+
+tail :: UList a -> UList a
+tail UNil = UNil
+tail (UCons x xs) = xs
+
+{-# INLINE [0] scanlFB #-}
+scanlFB :: forall (a :: TYPE 'UnliftedRep)
+ (b :: TYPE 'UnliftedRep)
+ (c :: Type).
+ (b -> a -> b) -> (b -> c -> c) -> a -> (b -> c) -> b -> c
+scanlFB f c = \b g -> oneShot (\x -> let b' = f x b in b' `c` g b')
+
+-- | 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.
+(++) :: UList a -> UList a -> UList a
+{-# NOINLINE [1] (++) #-}
+(++) UNil ys = ys
+(++) (UCons x xs) ys = UCons x (xs ++ ys)
+
+{-# RULES
+"++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
+ #-}
+
+-- | '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]
+filter :: (a -> Bool) -> UList a -> UList a
+{-# NOINLINE [1] filter #-}
+filter _ UNil = UNil
+filter pred (UCons x xs) = if pred x
+ then UCons x (filter pred xs)
+ else filter pred xs
+
+-- | /O(n)/. 'length' returns the length of a finite list as an 'Int'.
+length :: UList a -> Int
+{-# NOINLINE [1] length #-}
+length xs = lenAcc xs 0
+
+lenAcc :: UList a -> Int -> Int
+lenAcc UNil n = n
+lenAcc (UCons _ ys) n = lenAcc ys (n + 1)
+
+{-# RULES
+"map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs)
+"mapList" [1] forall f. foldr (mapFB UCons f) UNil = map f
+"mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f . g)
+"mapFB/id" forall c. mapFB c (\x -> x) = c
+ #-}
+
+-- Coercible (a :: Type) (b :: Type)
+-- {-# RULES "map/coerce" [1] map coerce = coerce #-}
+
+-- This needs something like `class Eq (a :: TYPE 'UnliftedRep)`
+--elem :: a -> UList a -> Bool
+--elem _ UNil = False
+--elem x (y:ys) = x == y || elem x ys
+
diff --git a/unlifted-list.cabal b/unlifted-list.cabal
new file mode 100644
index 0000000..17146ab
--- /dev/null
+++ b/unlifted-list.cabal
@@ -0,0 +1,22 @@
+name: unlifted-list
+version: 0.1.0.0
+synopsis: GHC Haskell lists of non-thunks (things of kind TYPE 'UnliftedRep)
+description: The type provided by this library is a linked list that guarantees
+ the values it stores are not thunks. It could certainly be useful
+ for something stack-like, where the values are unlifted.
+homepage: https://github.com/chessai/unlifted-list.git
+license: BSD3
+license-file: LICENSE
+author: chessai
+maintainer: chessai1996@gmail.com
+copyright: 2018 (c) chessai
+category: Data
+build-type: Simple
+extra-source-files: CHANGELOG.md
+cabal-version: >=1.10
+
+library
+ exposed-modules: Data.List.Unlifted
+ build-depends: base >=4.10 && <4.13, ghc-prim, semigroups >= 0.18 && < 0.19
+ hs-source-dirs: src
+ default-language: Haskell2010