@@ -1,6 +1,6 @@
11{-# LANGUAGE GADTs, TypeFamilies, TypeOperators, ScopedTypeVariables, CPP #-}
22{-# LANGUAGE StandaloneDeriving, FlexibleInstances #-}
3−{-# LANGUAGE DefaultSignatures, FlexibleContexts, EmptyCase, LambdaCase #-}
3+{-# LANGUAGE DefaultSignatures, FlexibleContexts, LambdaCase #-}
44{-# OPTIONS_GHC -Wall -fenable-rewrite-rules #-}
55
66-- ScopedTypeVariables works around a 6.10 bug. The forall keyword is
@@ -64,12 +64,14 @@ module Data.MemoTrie
6464import Data.Bits
6565import Data.Word
6666import Data.Int
67−import Control.Applicative
67+-- import Control.Applicative
6868import Control.Arrow (first,(&&&))
69−import Data.Monoid
69+-- import Data.Monoid
7070import Data.Function (on)
7171import GHC.Generics
7272
73+import Control.Newtype
74+
7375import Data.Void (Void)
7476
7577-- import Prelude hiding (id,(.))
@@ -128,7 +130,13 @@ untrie3 tt = untrie2 . untrie tt
128130-}
129131
130132
131−{-# RULES "trie/untrie" forall t. trie (untrie t) = t #-}
133+-- {-# RULES "trie/untrie" forall t. trie (untrie t) = t #-}
134+
135+-- warning: [-Winline-rule-shadowing] …
136+-- Rule "trie/untrie" may never fire
137+-- because rule "Class op untrie" for ‘untrie’ might fire first
138+-- Probable fix: add phase [n] or [~n] to the competing rule
139+
132140
133141-- Don't include the dual rule:
134142-- "untrie/trie" forall f. untrie (trie f) = f
@@ -179,17 +187,28 @@ inTrie3 = untrie ~> inTrie2
179187
180188instance HasTrie Void where
181189 -- As suggested by Audun Skaugen
182− data Void :->: a = VoidTrie
190+ data Void :->: a = VoidTrie
183191 trie _ = VoidTrie
184− untrie VoidTrie = \case
192+ untrie VoidTrie = \ _ -> error "untrie VoidTrie"
193+ -- \case -- needs EmptyCase
185194 enumerate VoidTrie = []
186195
196+instance Newtype (Void :->: a) where
197+ type O (Void :->: a) = ()
198+ pack () = VoidTrie
199+ unpack VoidTrie = ()
200+
187201instance HasTrie () where
188202 newtype () :->: a = UnitTrie a
189203 trie f = UnitTrie (f ())
190204 untrie (UnitTrie a) = \ () -> a
191205 enumerate (UnitTrie a) = [((),a)]
192206
207+instance Newtype (() :->: a) where
208+ type O (() :->: a) = a
209+ pack a = UnitTrie a
210+ unpack (UnitTrie a) = a
211+
193212-- Proofs of inverse properties:
194213
195214{-
@@ -225,6 +244,11 @@ instance HasTrie Bool where
225244 untrie (BoolTrie f t) = if' f t
226245 enumerate (BoolTrie f t) = [(False,f),(True,t)]
227246
247+instance Newtype (Bool :->: a) where
248+ type O (Bool :->: a) = (a,a)
249+ pack (a,a') = BoolTrie a a'
250+ unpack (BoolTrie a a') = (a,a')
251+
228252-- | Conditional with boolean last.
229253-- Spec: @if' (f False) (f True) == f@
230254if' :: x -> x -> Bool -> x
@@ -256,6 +280,11 @@ instance (HasTrie a, HasTrie b) => HasTrie (Either a b) where
256280 untrie (EitherTrie s t) = either (untrie s) (untrie t)
257281 enumerate (EitherTrie s t) = enum' Left s `weave` enum' Right t
258282
283+instance Newtype (Either a b :->: x) where
284+ type O (Either a b :->: x) = (a :->: x, b :->: x)
285+ pack (f,g) = EitherTrie f g
286+ unpack (EitherTrie f g) = (f,g)
287+
259288enum' :: (HasTrie a) => (a -> a') -> (a :->: b) -> [(a', b)]
260289enum' f = (fmap.first) f . enumerate
261290
@@ -295,6 +324,11 @@ instance (HasTrie a, HasTrie b) => HasTrie (a,b) where
295324 enumerate (PairTrie tt) =
296325 [ ((a,b),x) | (a,t) <- enumerate tt , (b,x) <- enumerate t ]
297326
327+instance Newtype ((a,b) :->: x) where
328+ type O ((a,b) :->: x) = a :->: b :->: x
329+ pack abx = PairTrie abx
330+ unpack (PairTrie abx) = abx
331+
298332{-
299333 untrie (trie f)
300334 == { trie def }
@@ -563,7 +597,8 @@ f1' = memo f1
563597instance HasTrie (V1 x) where
564598 data (V1 x :->: b) = V1Trie
565599 trie _ = V1Trie
566− untrie V1Trie = \case
600+ untrie V1Trie = \ _ -> error "untrie V1Trie"
601+ -- \case -- needs EmptyCase
567602 enumerate V1Trie = []
568603
569604-- | just like @()@