6938796..master · MemoTrie

git.iko.soy/MemoTrie

on master help sign in

MemoTrie.cabal+28−8

since splitsnapshots

unifiedsplit

@@ -1,20 +1,20 @@

1Name: MemoTrie

2−Version: 0.6.3

2+Version: 0.6.10

3−Cabal-Version: >= 1.6

3+Cabal-Version: >= 1.10

4Synopsis: Trie-based memo functions

5Category: Data

6Description:

7 MemoTrie provides a basis for memoized functions over some domains,

8 using tries. It's based on ideas from Ralf Hinze and code from

9− Spencer Janssen.

9+ Spencer Janssen. Generic support thanks to Sam Boosalis.

10 .

11 Project wiki page: <http://haskell.org/haskellwiki/MemoTrie>

12 .

13+ Ç 2008-2019 by Conal Elliott; BSD3 license.

14Homepage: https://github.com/conal/MemoTrie

15Author: Conal Elliott

16Maintainer: conal@conal.net

18License: BSD3

19License-File: COPYING

20Stability: experimental

@@ -24,11 +24,31 @@ source-repository head

24 type: git

25 location: git://github.com/conal/MemoTrie.git

27+Flag examples

28+ Description: "examples"

29+ Default: False

30+ Manual: True

31+

27Library

32Library

28 hs-Source-Dirs: src

33 hs-Source-Dirs: src

29− Extensions:

34+

35+ if impl(ghc >= 7.10.0)

30− Build-Depends: base < 5, void

36+ Build-Depends: base >=4.8.0.0 && <5, newtype-generics >= 0.5.3

37+ else

38+ Build-Depends: base <4.8.0.0, void, newtype-generics >= 0.5.3

39+

31 Exposed-Modules:

40 Exposed-Modules:

32 Data.MemoTrie

41 Data.MemoTrie

42+ Other-Modules:

43+

44+ default-language: Haskell2010

45+

46+executable generic

47+ if !flag(examples)

48+ buildable: False

49+ main-is: Generic.hs

50+ ghc-options: -Wall

51+ hs-source-dirs: examples

52+ default-language: Haskell2010

53+ build-depends: base, MemoTrie

34− ghc-prof-options: -prof -auto-all

examples/Generic.hsnew file+25

@@ -0,0 +1,25 @@

1+{-# LANGUAGE DeriveGeneric, TypeOperators, TypeFamilies #-}

2+import Data.MemoTrie

3+import GHC.Generics (Generic)

5+data Color = RGB Int Int Int

6+ | NamedColor String

7+ deriving (Generic)

9+instance HasTrie Color where

10+ newtype (Color :->: b) = ColorTrie { unColorTrie :: Reg Color :->: b }

11+ trie = trieGeneric ColorTrie

12+ untrie = untrieGeneric unColorTrie

13+ enumerate = enumerateGeneric unColorTrie

14+

15+runColor (RGB r g b) = r + g + b

16+runColor (NamedColor s) = length [1..10e7]

17+

18+runColorMemoized = memo runColor

19+

20+main =

21+ do putStrLn "first call (should take a few seconds): "

22+ print$ runColorMemoized (NamedColor "")

23+ putStrLn "cached call (should be instantaneous): "

24+ print$ runColorMemoized (NamedColor "")

25+

src/Data/MemoTrie.hs+205−123

@@ -1,14 +1,15 @@

1{-# LANGUAGE GADTs, TypeFamilies, TypeOperators, ScopedTypeVariables, CPP #-}

2{-# LANGUAGE StandaloneDeriving, FlexibleInstances #-}

3−{-# LANGUAGE DefaultSignatures, FlexibleContexts, EmptyCase, LambdaCase #-}

3+{-# LANGUAGE DefaultSignatures, FlexibleContexts, LambdaCase #-}

4{-# OPTIONS_GHC -Wall -fenable-rewrite-rules #-}

5-- ScopedTypeVariables works around a 6.10 bug. The forall keyword is

6-- ScopedTypeVariables works around a 6.10 bug. The forall keyword is

6-- supposed to be recognized in a RULES pragma.

7-- supposed to be recognized in a RULES pragma.

8----------------------------------------------------------------------

9----------------------------------------------------------------------

9-- |

10-- |

10-- Module : Data.MemoTrie

11-- Module : Data.MemoTrie

11−-- Copyright : (c) Conal Elliott 2008-2012

12+-- Copyright : (c) Conal Elliott 2008-2016

12-- License : BSD3

13-- License : BSD3

13--

14--

14-- Maintainer : conal@conal.net

15-- Maintainer : conal@conal.net

@@ -16,26 +17,33 @@

16--

17--

17-- Trie-based memoizer

18-- Trie-based memoizer

18--

19--

19−-- Adapted from sjanssen's paste: \"a lazy trie\" <http://hpaste.org/3839>,

20+-- Adapted from sjanssen's paste: <http://hpaste.org/3839 \"a lazy trie\">,

20-- which I think is based on Ralf Hinze's paper "Memo Functions,

21-- which I think is based on Ralf Hinze's paper "Memo Functions,

21-- Polytypically!".

22-- Polytypically!".

22--

23--

23-- You can automatically derive generic instances. for example:

24-- You can automatically derive generic instances. for example:

24--

25--

25-- @

26-- @

26−-- -- LANGUAGE DeriveGeneric, TypeOperators

27+-- {-# LANGUAGE <https://ocharles.org.uk/blog/posts/2014-12-16-derive-generic.html DeriveGeneric>, TypeOperators, TypeFamilies #-}

28+-- import Data.MemoTrie

29+-- import GHC.Generics (Generic)

27--

30--

28−-- data Color

29−-- = RGB Int Int Int

31+-- data Color = RGB Int Int Int

30−-- | Color String

32+-- | NamedColor String

31−-- deriving (Generic)

33+-- deriving ('Generic')

32--

34--

33-- instance HasTrie Color where

35-- instance HasTrie Color where

34−-- newtype (Color :->: b) = ColorTrie { unColorTrie :: 'Reg' Color :->: b }

36+-- newtype (Color :->: b) = ColorTrie { unColorTrie :: 'Reg' Color :->: b }

35−-- trie = 'trieGeneric' ColorTrie

37+-- trie = 'trieGeneric' ColorTrie

36−-- untrie = 'untrieGeneric' unColorTrie

38+-- untrie = 'untrieGeneric' unColorTrie

37−-- enumerate = 'enumerateGeneric' unColorTrie

39+-- enumerate = 'enumerateGeneric' unColorTrie

40+-- @

41+--

42+-- see @examples/Generic.hs@, which can be run with:

43+--

38-- @

44-- @

45+-- cabal configure -fexamples && cabal run generic

46+-- @

39--

47--

40--

48--

41----------------------------------------------------------------------

49----------------------------------------------------------------------

@@ -47,23 +55,31 @@ module Data.MemoTrie

47 , memo, memo2, memo3, mup

55 , memo, memo2, memo3, mup

48 , inTrie, inTrie2, inTrie3

56 , inTrie, inTrie2, inTrie3

49 -- , untrieBits

57 -- , untrieBits

50− , trieGeneric, untrieGeneric, enumerateGeneric, Reg

58+ , trieGeneric, untrieGeneric, enumerateGeneric, Reg

59+ , memoFix

51 ) where

60 ) where

53-- Export the parts of HasTrie separately in order to get the associated data

62-- Export the parts of HasTrie separately in order to get the associated data

54-- type constructors, so I can define instances of other classes on them.

63-- type constructors, so I can define instances of other classes on them.

65+import Data.Function (fix)

56import Data.Bits

66import Data.Bits

57import Data.Word

67import Data.Word

58import Data.Int

68import Data.Int

69+#if !MIN_VERSION_base(4,8,0)

59import Control.Applicative

70import Control.Applicative

71+#endif

60import Control.Arrow (first,(&&&))

72import Control.Arrow (first,(&&&))

73+#if !MIN_VERSION_base(4,8,0)

61import Data.Monoid

74import Data.Monoid

75+#endif

62import Data.Function (on)

76import Data.Function (on)

63import GHC.Generics

77import GHC.Generics

65−import Data.Void

79+import Control.Newtype.Generics

81+import Data.Void (Void)

82+

67-- import Prelude hiding (id,(.))

83-- import Prelude hiding (id,(.))

68-- import Control.Category

84-- import Control.Category

69-- import Control.Arrow

85-- import Control.Arrow

@@ -120,7 +136,13 @@ untrie3 tt = untrie2 . untrie tt

120-}

136-}

121

137

122

138

123−{-# RULES "trie/untrie" forall t. trie (untrie t) = t #-}

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+

124

146

125-- Don't include the dual rule:

147-- Don't include the dual rule:

126-- "untrie/trie" forall f. untrie (trie f) = f

148-- "untrie/trie" forall f. untrie (trie f) = f

@@ -148,6 +170,42 @@ mup mem f = memo (mem . f)

148memo2 = mup memo

170memo2 = mup memo

149memo3 = mup memo2

171memo3 = mup memo2

150

172

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+

151-- | Apply a unary function inside of a trie

209-- | Apply a unary function inside of a trie

152inTrie :: (HasTrie a, HasTrie c) =>

210inTrie :: (HasTrie a, HasTrie c) =>

153 ((a -> b) -> (c -> d))

211 ((a -> b) -> (c -> d))

@@ -171,16 +229,27 @@ inTrie3 = untrie ~> inTrie2

171

229

172instance HasTrie Void where

230instance HasTrie Void where

173 -- As suggested by Audun Skaugen

231 -- As suggested by Audun Skaugen

174− data Void :->: a = VoidTrie

232+ data Void :->: a = VoidTrie

175 trie _ = VoidTrie

233 trie _ = VoidTrie

176− untrie VoidTrie = absurd

234+ untrie VoidTrie = \ _ -> error "untrie VoidTrie"

235+ -- \case -- needs EmptyCase

177 enumerate VoidTrie = []

236 enumerate VoidTrie = []

178

237

238+instance Newtype (Void :->: a) where

239+ type O (Void :->: a) = ()

240+ pack () = VoidTrie

241+ unpack VoidTrie = ()

242+

179instance HasTrie () where

243instance HasTrie () where

180− newtype () :->: a = UnitTrie a

244+ newtype () :->: a = UnitTrie a

181− trie f = UnitTrie (f ())

245+ trie f = UnitTrie (f ())

182− untrie (UnitTrie a) = \ () -> a

246+ untrie (UnitTrie a) = \ () -> a

183− enumerate (UnitTrie a) = [((),a)]

247+ enumerate (UnitTrie a) = [((),a)]

248+

249+instance Newtype (() :->: a) where

250+ type O (() :->: a) = a

251+ pack a = UnitTrie a

252+ unpack (UnitTrie a) = a

184

253

185-- Proofs of inverse properties:

254-- Proofs of inverse properties:

186

255

@@ -212,10 +281,15 @@ memoizing hyper-strict functions.

212

281

213

282

214instance HasTrie Bool where

283instance HasTrie Bool where

215− data Bool :->: x = BoolTrie x x

284+ data Bool :->: x = BoolTrie x x

216− trie f = BoolTrie (f False) (f True)

285+ trie f = BoolTrie (f False) (f True)

217− untrie (BoolTrie f t) = if' f t

286+ untrie (BoolTrie f t) = if' f t

218− enumerate (BoolTrie f t) = [(False,f),(True,t)]

287+ enumerate (BoolTrie f t) = [(False,f),(True,t)]

288+

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')

219

293

220-- | Conditional with boolean last.

294-- | Conditional with boolean last.

221-- Spec: @if' (f False) (f True) == f@

295-- Spec: @if' (f False) (f True) == f@

@@ -241,12 +315,27 @@ if' _ e True = e

241 BoolTrie f t

315 BoolTrie f t

242-}

316-}

243

317

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)

244

328

245instance (HasTrie a, HasTrie b) => HasTrie (Either a b) where

329instance (HasTrie a, HasTrie b) => HasTrie (Either a b) where

246− data (Either a b) :->: x = EitherTrie (a :->: x) (b :->: x)

330+ data (Either a b) :->: x = EitherTrie (a :->: x) (b :->: x)

247− trie f = EitherTrie (trie (f . Left)) (trie (f . Right))

331+ trie f = EitherTrie (trie (f . Left)) (trie (f . Right))

248− untrie (EitherTrie s t) = either (untrie s) (untrie t)

332+ untrie (EitherTrie s t) = either (untrie s) (untrie t)

249− enumerate (EitherTrie s t) = enum' Left s `weave` enum' Right t

333+ enumerate (EitherTrie s t) = enum' Left s `weave` enum' Right t

334+

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)

250

339

251enum' :: (HasTrie a) => (a -> a') -> (a :->: b) -> [(a', b)]

340enum' :: (HasTrie a) => (a -> a') -> (a :->: b) -> [(a', b)]

252enum' f = (fmap.first) f . enumerate

341enum' f = (fmap.first) f . enumerate

@@ -281,11 +370,16 @@ as `weave` [] = as

281

370

282

371

283instance (HasTrie a, HasTrie b) => HasTrie (a,b) where

372instance (HasTrie a, HasTrie b) => HasTrie (a,b) where

284− newtype (a,b) :->: x = PairTrie (a :->: (b :->: x))

373+ newtype (a,b) :->: x = PairTrie (a :->: (b :->: x))

285− trie f = PairTrie (trie (trie . curry f))

374+ trie f = PairTrie (trie (trie . curry f))

286− untrie (PairTrie t) = uncurry (untrie . untrie t)

375+ untrie (PairTrie t) = uncurry (untrie . untrie t)

287− enumerate (PairTrie tt) =

376+ enumerate (PairTrie tt) =

288− [ ((a,b),x) | (a,t) <- enumerate tt , (b,x) <- enumerate t ]

377+ [ ((a,b),x) | (a,t) <- enumerate tt , (b,x) <- enumerate t ]

378+

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

289

383

290{-

384{-

291 untrie (trie f)

385 untrie (trie f)

@@ -314,10 +408,10 @@ instance (HasTrie a, HasTrie b) => HasTrie (a,b) where

314-}

408-}

315

409

316instance (HasTrie a, HasTrie b, HasTrie c) => HasTrie (a,b,c) where

410instance (HasTrie a, HasTrie b, HasTrie c) => HasTrie (a,b,c) where

317− newtype (a,b,c) :->: x = TripleTrie (((a,b),c) :->: x)

411+ newtype (a,b,c) :->: x = TripleTrie (((a,b),c) :->: x)

318− trie f = TripleTrie (trie (f . trip))

412+ trie f = TripleTrie (trie (f . trip))

319− untrie (TripleTrie t) = untrie t . detrip

413+ untrie (TripleTrie t) = untrie t . detrip

320− enumerate (TripleTrie t) = enum' trip t

414+ enumerate (TripleTrie t) = enum' trip t

321

415

322trip :: ((a,b),c) -> (a,b,c)

416trip :: ((a,b),c) -> (a,b,c)

323trip ((a,b),c) = (a,b,c)

417trip ((a,b),c) = (a,b,c)

@@ -327,10 +421,10 @@ detrip (a,b,c) = ((a,b),c)

327

421

328

422

329instance HasTrie x => HasTrie [x] where

423instance HasTrie x => HasTrie [x] where

330− newtype [x] :->: a = ListTrie (Either () (x,[x]) :->: a)

424+ newtype [x] :->: a = ListTrie (Either () (x,[x]) :->: a)

331− trie f = ListTrie (trie (f . list))

425+ trie f = ListTrie (trie (f . list))

332− untrie (ListTrie t) = untrie t . delist

426+ untrie (ListTrie t) = untrie t . delist

333− enumerate (ListTrie t) = enum' list t

427+ enumerate (ListTrie t) = enum' list t

334

428

335list :: Either () (x,[x]) -> [x]

429list :: Either () (x,[x]) -> [x]

336list = either (const []) (uncurry (:))

430list = either (const []) (uncurry (:))

@@ -341,10 +435,10 @@ delist (x:xs) = Right (x,xs)

341

435

342#define WordInstance(Type,TrieType)\

436#define WordInstance(Type,TrieType)\

343instance HasTrie Type where \

437instance HasTrie Type where \

344− newtype Type :->: a = TrieType ([Bool] :->: a);\

438+ newtype Type :->: a = TrieType ([Bool] :->: a);\

345− trie f = TrieType (trie (f . unbits));\

439+ trie f = TrieType (trie (f . unbits));\

346− untrie (TrieType t) = untrie t . bits;\

440+ untrie (TrieType t) = untrie t . bits;\

347− enumerate (TrieType t) = enum' unbits t

441+ enumerate (TrieType t) = enum' unbits t

348

442

349WordInstance(Word,WordTrie)

443WordInstance(Word,WordTrie)

350WordInstance(Word8,Word8Trie)

444WordInstance(Word8,Word8Trie)

@@ -353,10 +447,10 @@ WordInstance(Word32,Word32Trie)

353WordInstance(Word64,Word64Trie)

447WordInstance(Word64,Word64Trie)

354

448

355-- instance HasTrie Word where

449-- instance HasTrie Word where

356−-- newtype Word :->: a = WordTrie ([Bool] :->: a)

450+-- newtype Word :->: a = WordTrie ([Bool] :->: a)

357−-- trie f = WordTrie (trie (f . unbits))

451+-- trie f = WordTrie (trie (f . unbits))

358−-- untrie (WordTrie t) = untrie t . bits

452+-- untrie (WordTrie t) = untrie t . bits

359−-- enumerate (WordTrie t) = enum' unbits t

453+-- enumerate (WordTrie t) = enum' unbits t

360

454

361

455

362-- | Extract bits in little-endian order

456-- | Extract bits in little-endian order

@@ -375,10 +469,10 @@ unbits [] = 0

375unbits (x:xs) = unbit x .|. shiftL (unbits xs) 1

469unbits (x:xs) = unbit x .|. shiftL (unbits xs) 1

376

470

377instance HasTrie Char where

471instance HasTrie Char where

378− newtype Char :->: a = CharTrie (Int :->: a)

472+ newtype Char :->: a = CharTrie (Int :->: a)

379− untrie (CharTrie t) n = untrie t (fromEnum n)

473+ untrie (CharTrie t) n = untrie t (fromEnum n)

380− trie f = CharTrie (trie (f . toEnum))

474+ trie f = CharTrie (trie (f . toEnum))

381− enumerate (CharTrie t) = enum' toEnum t

475+ enumerate (CharTrie t) = enum' toEnum t

382

476

383-- Although Int is a Bits instance, we can't use bits directly for

477-- Although Int is a Bits instance, we can't use bits directly for

384-- memoizing, because the "bits" function gives an infinite result, since

478-- memoizing, because the "bits" function gives an infinite result, since

@@ -387,10 +481,10 @@ instance HasTrie Char where

387

481

388#define IntInstance(IntType,WordType,TrieType) \

482#define IntInstance(IntType,WordType,TrieType) \

389instance HasTrie IntType where \

483instance HasTrie IntType where \

390− newtype IntType :->: a = TrieType (WordType :->: a); \

484+ newtype IntType :->: a = TrieType (WordType :->: a); \

391− untrie (TrieType t) n = untrie t (fromIntegral n); \

485+ untrie (TrieType t) n = untrie t (fromIntegral n); \

392− trie f = TrieType (trie (f . fromIntegral)); \

486+ trie f = TrieType (trie (f . fromIntegral)); \

393− enumerate (TrieType t) = enum' fromIntegral t

487+ enumerate (TrieType t) = enum' fromIntegral t

394

488

395IntInstance(Int,Word,IntTrie)

489IntInstance(Int,Word,IntTrie)

396IntInstance(Int8,Word8,Int8Trie)

490IntInstance(Int8,Word8,Int8Trie)

@@ -402,10 +496,10 @@ IntInstance(Int64,Word64,Int64Trie)

402-- extract the sign bit.

496-- extract the sign bit.

403

497

404instance HasTrie Integer where

498instance HasTrie Integer where

405− newtype Integer :->: a = IntegerTrie ((Bool,[Bool]) :->: a)

499+ newtype Integer :->: a = IntegerTrie ((Bool,[Bool]) :->: a)

406− trie f = IntegerTrie (trie (f . unbitsZ))

500+ trie f = IntegerTrie (trie (f . unbitsZ))

407− untrie (IntegerTrie t) = untrie t . bitsZ

501+ untrie (IntegerTrie t) = untrie t . bitsZ

408− enumerate (IntegerTrie t) = enum' unbitsZ t

502+ enumerate (IntegerTrie t) = enum' unbitsZ t

409

503

410

504

411unbitsZ :: (Num n, Bits n) => (Bool,[Bool]) -> n

505unbitsZ :: (Num n, Bits n) => (Bool,[Bool]) -> n

@@ -493,7 +587,12 @@ instance HasTrie a => Monad ((:->:) a) where

493

587

494instance (HasTrie a, Monoid b) => Monoid (a :->: b) where

588instance (HasTrie a, Monoid b) => Monoid (a :->: b) where

495 mempty = trie mempty

589 mempty = trie mempty

590+#if !MIN_VERSION_base(4,11,0)

496 mappend = inTrie2 mappend

591 mappend = inTrie2 mappend

592+#else

593+instance (HasTrie a, Semigroup b) => Semigroup (a :->: b) where

594+ (<>) = inTrie2 (<>)

595+#endif

497

596

498instance HasTrie a => Functor ((:->:) a) where

597instance HasTrie a => Functor ((:->:) a) where

499 fmap f = inTrie (fmap f)

598 fmap f = inTrie (fmap f)

@@ -517,7 +616,6 @@ infixr 9 @.@

517(@.@) = inTrie2 (.)

616(@.@) = inTrie2 (.)

518

617

519

618

520−

521-- instance Category (:->:) where

619-- instance Category (:->:) where

522-- id = idTrie

620-- id = idTrie

523-- (.) = (.:)

621-- (.) = (.:)

@@ -536,7 +634,6 @@ necessary but disallowed `HasTrie` constraints on the domain type.

536

634

537-}

635-}

538

636

539−

540---- To go elsewhere

637---- To go elsewhere

541

638

542-- Matt Hellige's notation for @argument f . result g@.

639-- Matt Hellige's notation for @argument f . result g@.

@@ -555,70 +652,72 @@ f1' = memo f1

555

652

556-- | just like @void@

653-- | just like @void@

557instance HasTrie (V1 x) where

654instance HasTrie (V1 x) where

558− data (V1 x :->: b) = V1Trie

655+ data (V1 x :->: b) = V1Trie

559− trie _ = V1Trie

656+ trie _ = V1Trie

560− untrie V1Trie = \case

657+ untrie V1Trie = \ _ -> error "untrie V1Trie"

658+ -- \case -- needs EmptyCase

561− enumerate V1Trie = []

659+ enumerate V1Trie = []

562

660

563-- | just like @()@

661-- | just like @()@

564instance HasTrie (U1 x) where

662instance HasTrie (U1 x) where

565− data (U1 x :->: b) = U1Trie b

663+ data (U1 x :->: b) = U1Trie b

566− trie f = U1Trie (f U1)

664+ trie f = U1Trie (f U1)

567− untrie (U1Trie b) = \U1 -> b

665+ untrie (U1Trie b) = \U1 -> b

568− enumerate (U1Trie b) = [(U1, b)]

666+ enumerate (U1Trie b) = [(U1, b)]

569

667

570-- | wraps @Either (f x) (g x)@

668-- | wraps @Either (f x) (g x)@

571instance (HasTrie (f x), HasTrie (g x)) => HasTrie ((f :+: g) x) where

669instance (HasTrie (f x), HasTrie (g x)) => HasTrie ((f :+: g) x) where

572− newtype ((f :+: g) x :->: b) = EitherTrie1 (Either (f x) (g x) :->: b)

670+ newtype ((f :+: g) x :->: b) = EitherTrie1 (Either (f x) (g x) :->: b)

573− trie f = EitherTrie1 (trie (f . liftSum))

671+ trie f = EitherTrie1 (trie (f . liftSum))

574− untrie (EitherTrie1 t) = (untrie t) . dropSum

672+ untrie (EitherTrie1 t) = (untrie t) . dropSum

575− enumerate (EitherTrie1 t) = enum' liftSum t

673+ enumerate (EitherTrie1 t) = enum' liftSum t

576

674

577-- | wraps @(f x, g x)@

675-- | wraps @(f x, g x)@

578instance (HasTrie (f x), HasTrie (g x)) => HasTrie ((f :*: g) x) where

676instance (HasTrie (f x), HasTrie (g x)) => HasTrie ((f :*: g) x) where

579− newtype ((f :*: g) x :->: b) = PairTrie1 ((f x, g x) :->: b)

677+ newtype ((f :*: g) x :->: b) = PairTrie1 ((f x, g x) :->: b)

580− trie f = PairTrie1 (trie (f . liftProduct))

678+ trie f = PairTrie1 (trie (f . liftProduct))

581− untrie (PairTrie1 t) = (untrie t) . dropProduct

679+ untrie (PairTrie1 t) = (untrie t) . dropProduct

582− enumerate (PairTrie1 t) = enum' liftProduct t

680+ enumerate (PairTrie1 t) = enum' liftProduct t

583

681

584-- | wraps @a@

682-- | wraps @a@

585instance (HasTrie a) => HasTrie (K1 i a x) where

683instance (HasTrie a) => HasTrie (K1 i a x) where

586− data (K1 i a x :->: b) = K1Trie (a :->: b)

684+ data (K1 i a x :->: b) = K1Trie (a :->: b)

587− trie f = K1Trie (trie (f . K1))

685+ trie f = K1Trie (trie (f . K1))

588− untrie (K1Trie t) = \(K1 a) -> (untrie t) a

686+ untrie (K1Trie t) = \(K1 a) -> (untrie t) a

589− enumerate (K1Trie t) = enum' K1 t

687+ enumerate (K1Trie t) = enum' K1 t

590

688

591-- | wraps @f x@

689-- | wraps @f x@

592instance (HasTrie (f x)) => HasTrie (M1 i t f x) where

690instance (HasTrie (f x)) => HasTrie (M1 i t f x) where

593− data (M1 i t f x :->: b) = M1Trie (f x :->: b)

691+ data (M1 i t f x :->: b) = M1Trie (f x :->: b)

594− trie f = M1Trie (trie (f . M1))

692+ trie f = M1Trie (trie (f . M1))

595− untrie (M1Trie t) = \(M1 a) -> (untrie t) a

693+ untrie (M1Trie t) = \(M1 a) -> (untrie t) a

596− enumerate (M1Trie t) = enum' M1 t

694+ enumerate (M1Trie t) = enum' M1 t

597

695

696+-- | the data type in a __reg__ular form.

598−-- | "unlifted" generic representation. (i.e. is a unary type constructor).

697+-- "unlifted" generic representation. (i.e. is a unary type constructor).

599type Reg a = Rep a ()

698type Reg a = Rep a ()

600

699

601−trieGeneric

700+-- | 'Generic'-friendly default for 'trie'

602− :: (Generic a, HasTrie (Reg a))

701+trieGeneric :: (Generic a, HasTrie (Reg a))

603− => ((Reg a :->: b) -> (a :->: b))

702+ => ((Reg a :->: b) -> (a :->: b))

604− -> (a -> b)

703+ -> (a -> b)

605− -> (a :->: b)

704+ -> (a :->: b)

606trieGeneric theConstructor f = theConstructor (trie (f . to))

705trieGeneric theConstructor f = theConstructor (trie (f . to))

607{-# INLINEABLE trieGeneric #-}

706{-# INLINEABLE trieGeneric #-}

608

707

609−untrieGeneric

708+-- | 'Generic'-friendly default for 'untrie'

610− :: (Generic a, HasTrie (Reg a))

709+untrieGeneric :: (Generic a, HasTrie (Reg a))

611− => ((a :->: b) -> (Reg a :->: b))

710+ => ((a :->: b) -> (Reg a :->: b))

612− -> (a :->: b)

711+ -> (a :->: b)

613− -> (a -> b)

712+ -> (a -> b)

614untrieGeneric theDestructor t = \a -> (untrie (theDestructor t)) (from a)

713untrieGeneric theDestructor t = \a -> (untrie (theDestructor t)) (from a)

615{-# INLINEABLE untrieGeneric #-}

714{-# INLINEABLE untrieGeneric #-}

616

715

617−enumerateGeneric

716+-- | 'Generic'-friendly default for 'enumerate'

618− :: (Generic a, HasTrie (Reg a))

717+enumerateGeneric :: (Generic a, HasTrie (Reg a))

619− => ((a :->: b) -> (Reg a :->: b))

718+ => ((a :->: b) -> (Reg a :->: b))

620− -> (a :->: b)

719+ -> (a :->: b)

621− -> [(a, b)]

720+ -> [(a, b)]

622enumerateGeneric theDestructor t = enum' to (theDestructor t)

721enumerateGeneric theDestructor t = enum' to (theDestructor t)

623{-# INLINEABLE enumerateGeneric #-}

722{-# INLINEABLE enumerateGeneric #-}

624

723

@@ -632,27 +731,10 @@ liftProduct (a, b) = (a :*: b)

632

731

633dropSum :: (f :+: g) a -> Either (f a) (g a)

732dropSum :: (f :+: g) a -> Either (f a) (g a)

634dropSum s = case s of

733dropSum s = case s of

635− L1 x -> Left x

734+ L1 x -> Left x

636− R1 x -> Right x

735+ R1 x -> Right x

637{-# INLINEABLE dropSum #-}

736{-# INLINEABLE dropSum #-}

638

737

639liftSum :: Either (f a) (g a) -> (f :+: g) a

738liftSum :: Either (f a) (g a) -> (f :+: g) a

640liftSum = either L1 R1

739liftSum = either L1 R1

641{-# INLINEABLE liftSum #-}

740{-# INLINEABLE liftSum #-}

642−

643−{- example:

644−

645−{-# LANGUAGE DeriveGeneric, TypeOperators #-}

646−

647−data Color

648− = RGB Int Int Int

649− | Color String

650− deriving (Generic)

651−

652−instance HasTrie Color where

653− newtype (Color :->: b) = ColorTrie { unColorTrie :: Reg Color :->: b }

654− trie = trieGeneric ColorTrie

655− untrie = untrieGeneric unColorTrie

656− enumerate = enumerateGeneric unColorTrie

657−

658−-}

stack.yamlnew file+7

@@ -0,0 +1,7 @@

1+# resolver: lts-9.21 # ghc-8.0.2

2+# resolver: lts-11.22 # ghc-8.2.2

3+# resolver: lts-12.14 # ghc-8.4.3

4+# resolver: lts-12.19 # ghc-8.4.4

5+# resolver: lts-13.0 # ghc-8.6.3

6+# resolver: lts-13.13 # ghc-8.6.4

7+resolver: lts-14.6 # ghc-8.6.5