@@ -1,6 +1,6 @@
11{-# LANGUAGE GADTs, TypeFamilies, TypeOperators, ScopedTypeVariables, CPP #-}
22{-# LANGUAGE StandaloneDeriving, FlexibleInstances #-}
3−{-# LANGUAGE DefaultSignatures, FlexibleContexts, LambdaCase #-}
3+{-# LANGUAGE DefaultSignatures, FlexibleContexts, EmptyCase, LambdaCase #-}
44{-# OPTIONS_GHC -Wall -fenable-rewrite-rules #-}
55
66-- ScopedTypeVariables works around a 6.10 bug. The forall keyword is
@@ -9,7 +9,7 @@
99----------------------------------------------------------------------
1010-- |
1111-- Module : Data.MemoTrie
12−-- Copyright : (c) Conal Elliott 2008-2016
12+-- Copyright : (c) Conal Elliott 2008-2012
1313-- License : BSD3
1414--
1515-- Maintainer : conal@conal.net
@@ -42,7 +42,7 @@
4242-- see @examples/Generic.hs@, which can be run with:
4343--
4444-- @
45−-- cabal configure -fexamples && cabal run generic
45+-- $ cabal configure -fexamples && cabal run generic
4646-- @
4747--
4848--
@@ -55,29 +55,21 @@ module Data.MemoTrie
5555 , memo, memo2, memo3, mup
5656 , inTrie, inTrie2, inTrie3
5757 -- , untrieBits
58− , trieGeneric, untrieGeneric, enumerateGeneric, Reg
59− , memoFix
58+ , trieGeneric, untrieGeneric, enumerateGeneric, Reg
6059 ) where
6160
6261-- Export the parts of HasTrie separately in order to get the associated data
6362-- type constructors, so I can define instances of other classes on them.
6463
65−import Data.Function (fix)
6664import Data.Bits
6765import Data.Word
6866import Data.Int
69−#if !MIN_VERSION_base(4,8,0)
7067import Control.Applicative
71−#endif
7268import Control.Arrow (first,(&&&))
73−#if !MIN_VERSION_base(4,8,0)
7469import Data.Monoid
75−#endif
7670import Data.Function (on)
7771import GHC.Generics
7872
79−import Control.Newtype.Generics
80−
8173import Data.Void (Void)
8274
8375-- import Prelude hiding (id,(.))
@@ -136,13 +128,7 @@ untrie3 tt = untrie2 . untrie tt
136128-}
137129
138130
139−-- {-# RULES "trie/untrie" forall t. trie (untrie t) = t #-}
140−
141−-- warning: [-Winline-rule-shadowing] …
142−-- Rule "trie/untrie" may never fire
143−-- because rule "Class op untrie" for ‘untrie’ might fire first
144−-- Probable fix: add phase [n] or [~n] to the competing rule
145−
131+{-# RULES "trie/untrie" forall t. trie (untrie t) = t #-}
146132
147133-- Don't include the dual rule:
148134-- "untrie/trie" forall f. untrie (trie f) = f
@@ -170,42 +156,6 @@ mup mem f = memo (mem . f)
170156memo2 = mup memo
171157memo3 = mup memo2
172158
173−-- | Memoizing recursion. Use like `fix`.
174−memoFix :: HasTrie a => ((a -> b) -> (a -> b)) -> (a -> b)
175−memoFix h = fix (memo . h)
176−
177−#if 0
178−-- Equivalently,
179−
180−memoFix h = fix (\ f' -> memo (h f'))
181−
182−memoFix h = f'
183− where f' = memo (h f')
184−
185−memoFix h = f'
186− where
187− f' = memo f
188− f = h f'
189−#endif
190−
191−#if 0
192−-- Example
193−
194−fibF :: (Integer -> Integer) -> (Integer -> Integer)
195−fibF _ 0 = 1
196−fibF _ 1 = 1
197−fibF f n = f (n-1) + f (n-2)
198−
199−fib :: Integer -> Integer
200−fib = fix fibF
201−
202−fib' :: Integer -> Integer
203−fib' = memoFix fibF
204−
205−-- Try fib 30 vs fib' 30
206−#endif
207−
208−
209159-- | Apply a unary function inside of a trie
210160inTrie :: (HasTrie a, HasTrie c) =>
211161 ((a -> b) -> (c -> d))
@@ -229,28 +179,17 @@ inTrie3 = untrie ~> inTrie2
229179
230180instance HasTrie Void where
231181 -- As suggested by Audun Skaugen
232− data Void :->: a = VoidTrie
182+ data Void :->: a = VoidTrie
233183 trie _ = VoidTrie
234− untrie VoidTrie = \ _ -> error "untrie VoidTrie"
235− -- \case -- needs EmptyCase
184+ untrie VoidTrie = \case
236185 enumerate VoidTrie = []
237186
238−instance Newtype (Void :->: a) where
239− type O (Void :->: a) = ()
240− pack () = VoidTrie
241− unpack VoidTrie = ()
242−
243187instance HasTrie () where
244188 newtype () :->: a = UnitTrie a
245189 trie f = UnitTrie (f ())
246190 untrie (UnitTrie a) = \ () -> a
247191 enumerate (UnitTrie a) = [((),a)]
248192
249−instance Newtype (() :->: a) where
250− type O (() :->: a) = a
251− pack a = UnitTrie a
252− unpack (UnitTrie a) = a
253−
254193-- Proofs of inverse properties:
255194
256195{-
@@ -286,11 +225,6 @@ instance HasTrie Bool where
286225 untrie (BoolTrie f t) = if' f t
287226 enumerate (BoolTrie f t) = [(False,f),(True,t)]
288227
289−instance Newtype (Bool :->: a) where
290− type O (Bool :->: a) = (a,a)
291− pack (a,a') = BoolTrie a a'
292− unpack (BoolTrie a a') = (a,a')
293−
294228-- | Conditional with boolean last.
295229-- Spec: @if' (f False) (f True) == f@
296230if' :: x -> x -> Bool -> x
@@ -315,16 +249,6 @@ if' _ e True = e
315249 BoolTrie f t
316250-}
317251
318−instance HasTrie a => HasTrie (Maybe a) where
319− data (:->:) (Maybe a) b = MaybeTrie b (a :->: b)
320− trie f = MaybeTrie (f Nothing) (trie (f . Just))
321− untrie (MaybeTrie nothing_val a_trie) = maybe nothing_val (untrie a_trie)
322− enumerate (MaybeTrie nothing_val a_trie) = (Nothing, nothing_val) : enum' Just a_trie
323−
324−instance Newtype (Maybe a :->: x) where
325− type O (Maybe a :->: x) = (x, a :->: x)
326− pack (a,f) = MaybeTrie a f
327− unpack (MaybeTrie a f) = (a,f)
328252
329253instance (HasTrie a, HasTrie b) => HasTrie (Either a b) where
330254 data (Either a b) :->: x = EitherTrie (a :->: x) (b :->: x)
@@ -332,11 +256,6 @@ instance (HasTrie a, HasTrie b) => HasTrie (Either a b) where
332256 untrie (EitherTrie s t) = either (untrie s) (untrie t)
333257 enumerate (EitherTrie s t) = enum' Left s `weave` enum' Right t
334258
335−instance Newtype (Either a b :->: x) where
336− type O (Either a b :->: x) = (a :->: x, b :->: x)
337− pack (f,g) = EitherTrie f g
338− unpack (EitherTrie f g) = (f,g)
339−
340259enum' :: (HasTrie a) => (a -> a') -> (a :->: b) -> [(a', b)]
341260enum' f = (fmap.first) f . enumerate
342261
@@ -376,11 +295,6 @@ instance (HasTrie a, HasTrie b) => HasTrie (a,b) where
376295 enumerate (PairTrie tt) =
377296 [ ((a,b),x) | (a,t) <- enumerate tt , (b,x) <- enumerate t ]
378297
379−instance Newtype ((a,b) :->: x) where
380− type O ((a,b) :->: x) = a :->: b :->: x
381− pack abx = PairTrie abx
382− unpack (PairTrie abx) = abx
383−
384298{-
385299 untrie (trie f)
386300 == { trie def }
@@ -587,12 +501,7 @@ instance HasTrie a => Monad ((:->:) a) where
587501
588502instance (HasTrie a, Monoid b) => Monoid (a :->: b) where
589503 mempty = trie mempty
590−#if !MIN_VERSION_base(4,11,0)
591504 mappend = inTrie2 mappend
592−#else
593−instance (HasTrie a, Semigroup b) => Semigroup (a :->: b) where
594− (<>) = inTrie2 (<>)
595−#endif
596505
597506instance HasTrie a => Functor ((:->:) a) where
598507 fmap f = inTrie (fmap f)
@@ -654,8 +563,7 @@ f1' = memo f1
654563instance HasTrie (V1 x) where
655564 data (V1 x :->: b) = V1Trie
656565 trie _ = V1Trie
657− untrie V1Trie = \ _ -> error "untrie V1Trie"
658− -- \case -- needs EmptyCase
566+ untrie V1Trie = \case
659567 enumerate V1Trie = []
660568
661569-- | just like @()@
@@ -697,7 +605,6 @@ instance (HasTrie (f x)) => HasTrie (M1 i t f x) where
697605-- "unlifted" generic representation. (i.e. is a unary type constructor).
698606type Reg a = Rep a ()
699607
700−-- | 'Generic'-friendly default for 'trie'
701608trieGeneric :: (Generic a, HasTrie (Reg a))
702609 => ((Reg a :->: b) -> (a :->: b))
703610 -> (a -> b)
@@ -705,7 +612,6 @@ trieGeneric :: (Generic a, HasTrie (Reg a))
705612trieGeneric theConstructor f = theConstructor (trie (f . to))
706613{-# INLINEABLE trieGeneric #-}
707614
708−-- | 'Generic'-friendly default for 'untrie'
709615untrieGeneric :: (Generic a, HasTrie (Reg a))
710616 => ((a :->: b) -> (Reg a :->: b))
711617 -> (a :->: b)
@@ -713,7 +619,6 @@ untrieGeneric :: (Generic a, HasTrie (Reg a))
713619untrieGeneric theDestructor t = \a -> (untrie (theDestructor t)) (from a)
714620{-# INLINEABLE untrieGeneric #-}
715621
716−-- | 'Generic'-friendly default for 'enumerate'
717622enumerateGeneric :: (Generic a, HasTrie (Reg a))
718623 => ((a :->: b) -> (Reg a :->: b))
719624 -> (a :->: b)
@@ -738,3 +643,4 @@ dropSum s = case s of
738643liftSum :: Either (f a) (g a) -> (f :+: g) a
739644liftSum = either L1 R1
740645{-# INLINEABLE liftSum #-}
646+