master..5e43dbc · MemoTrie

git.iko.soy/MemoTrie

on 5e43dbc help sign in

Makefile+8

since splitsnapshots

unifiedsplit

@@ -1 +1,9 @@

1+# For special configuration, especially for docs. Otherwise see README.

3+server = code.haskell.org

4+server-dir = /srv/code

5+server-url-dir =

7+# extra-configure-args += --enable-library-profiling --enable-executable-profiling

1include ../my-cabal-make.inc

9include ../my-cabal-make.inc

MemoTrie.cabal+8−29

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

1Name: MemoTrie

2−Version: 0.6.10

2+Version: 0.6

3−Cabal-Version: >= 1.10

3+Cabal-Version: >= 1.2

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. Generic support thanks to Sam Boosalis.

9+ Spencer Janssen.

10 .

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

12 .

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

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

14+Homepage: http://haskell.org/haskellwiki/MemoTrie

15Author: Conal Elliott

16Maintainer: conal@conal.net

18License: BSD3

19License-File: COPYING

20Stability: experimental

@@ -24,31 +24,10 @@ 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−

32Library

27Library

33 hs-Source-Dirs: src

28 hs-Source-Dirs: src

34−

29+ Extensions:

35− if impl(ghc >= 7.10.0)

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

30+ Build-Depends: base < 5, void

39−

40 Exposed-Modules:

31 Exposed-Modules:

41 Data.MemoTrie

32 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

examples/Generic.hsdeleted−25

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

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

2−import Data.MemoTrie

3−import GHC.Generics (Generic)

4−

5−data Color = RGB Int Int Int

6− | NamedColor String

7− deriving (Generic)

8−

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+56−262

@@ -1,15 +1,13 @@

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

2−{-# LANGUAGE StandaloneDeriving, FlexibleInstances #-}

2+{-# LANGUAGE StandaloneDeriving, FlexibleInstances #-}

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

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

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

5−

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

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

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

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

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

7----------------------------------------------------------------------

10-- |

8-- |

11-- Module : Data.MemoTrie

9-- Module : Data.MemoTrie

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

10+-- Copyright : (c) Conal Elliott 2008-2012

13-- License : BSD3

11-- License : BSD3

14--

12--

15-- Maintainer : conal@conal.net

13-- Maintainer : conal@conal.net

@@ -17,35 +15,9 @@

17--

15--

18-- Trie-based memoizer

16-- Trie-based memoizer

19--

17--

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

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

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

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

22-- Polytypically!".

20-- Polytypically!".

23−--

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

25−--

26−-- @

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)

30−--

31−-- data Color = RGB Int Int Int

32−-- | NamedColor String

33−-- deriving ('Generic')

34−--

35−-- instance HasTrie Color where

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

37−-- trie = 'trieGeneric' ColorTrie

38−-- untrie = 'untrieGeneric' unColorTrie

39−-- enumerate = 'enumerateGeneric' unColorTrie

40−-- @

41−--

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

43−--

44−-- @

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

46−-- @

47−--

48−--

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

21----------------------------------------------------------------------

51module Data.MemoTrie

23module Data.MemoTrie

@@ -55,31 +27,21 @@ module Data.MemoTrie

55 , memo, memo2, memo3, mup

27 , memo, memo2, memo3, mup

56 , inTrie, inTrie2, inTrie3

28 , inTrie, inTrie2, inTrie3

57 -- , untrieBits

29 -- , untrieBits

58− , trieGeneric, untrieGeneric, enumerateGeneric, Reg

59− , memoFix

60 ) where

30 ) where

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

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

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

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

65−import Data.Function (fix)

66import Data.Bits

35import Data.Bits

67import Data.Word

36import Data.Word

68import Data.Int

37import Data.Int

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

70import Control.Applicative

38import Control.Applicative

71−#endif

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

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

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

74import Data.Monoid

40import Data.Monoid

75−#endif

76import Data.Function (on)

41import Data.Function (on)

77−import GHC.Generics

79−import Control.Newtype.Generics

43+import Data.Void

81−import Data.Void (Void)

82−

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

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

84-- import Control.Category

46-- import Control.Category

85-- import Control.Arrow

47-- import Control.Arrow

@@ -136,13 +98,9 @@ untrie3 tt = untrie2 . untrie tt

136-}

98-}

137

138

100

101+{-# RULES

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

102+"trie/untrie" forall t. trie (untrie t) = t

140−

103+ #-}

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−

146

104

147-- Don't include the dual rule:

105-- Don't include the dual rule:

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

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

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

170memo2 = mup memo

128memo2 = mup memo

171memo3 = mup memo2

129memo3 = mup memo2

172

130

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−

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

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

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

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

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

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

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

229

151

230instance HasTrie Void where

152instance HasTrie Void where

231 -- As suggested by Audun Skaugen

153 -- As suggested by Audun Skaugen

232− data Void :->: a = VoidTrie

154+ data Void :->: a = VoidTrie

233 trie _ = VoidTrie

155 trie _ = VoidTrie

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

156+ untrie VoidTrie = absurd

235− -- \case -- needs EmptyCase

236 enumerate VoidTrie = []

157 enumerate VoidTrie = []

237

158

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

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

240− pack () = VoidTrie

241− unpack VoidTrie = ()

242−

243instance HasTrie () where

159instance HasTrie () where

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

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

245− trie f = UnitTrie (f ())

161+ trie f = UnitTrie (f ())

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

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

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

163+ 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

253

164

254-- Proofs of inverse properties:

165-- Proofs of inverse properties:

255

166

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

281

192

282

193

283instance HasTrie Bool where

194instance HasTrie Bool where

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

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

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

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

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

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

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

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

293

199

294-- | Conditional with boolean last.

200-- | Conditional with boolean last.

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

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

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

315 BoolTrie f t

221 BoolTrie f t

316-}

222-}

317

223

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)

328

224

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

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

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

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

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

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

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

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

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

229+ 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)

339

230

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

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

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

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

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

370

261

371

262

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

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

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

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

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

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

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

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

376− enumerate (PairTrie tt) =

267+ enumerate (PairTrie tt) =

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

268+ [ ((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

383

269

384{-

270{-

385 untrie (trie f)

271 untrie (trie f)

@@ -408,10 +294,10 @@ instance Newtype ((a,b) :->: x) where

408-}

294-}

409

295

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

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

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

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

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

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

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

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

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

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

415

301

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

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

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

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

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

421

307

422

308

423instance HasTrie x => HasTrie [x] where

309instance HasTrie x => HasTrie [x] where

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

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

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

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

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

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

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

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

428

314

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

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

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

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

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

435

321

436#define WordInstance(Type,TrieType)\

322#define WordInstance(Type,TrieType)\

437instance HasTrie Type where \

323instance HasTrie Type where \

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

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

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

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

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

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

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

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

442

328

443WordInstance(Word,WordTrie)

329WordInstance(Word,WordTrie)

444WordInstance(Word8,Word8Trie)

330WordInstance(Word8,Word8Trie)

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

447WordInstance(Word64,Word64Trie)

333WordInstance(Word64,Word64Trie)

448

334

449-- instance HasTrie Word where

335-- instance HasTrie Word where

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

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

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

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

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

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

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

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

454

340

455

341

456-- | Extract bits in little-endian order

342-- | Extract bits in little-endian order

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

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

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

470

356

471instance HasTrie Char where

357instance HasTrie Char where

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

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

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

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

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

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

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

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

476

362

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

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

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

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

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

481

367

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

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

483instance HasTrie IntType where \

369instance HasTrie IntType where \

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

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

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

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

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

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

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

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

488

374

489IntInstance(Int,Word,IntTrie)

375IntInstance(Int,Word,IntTrie)

490IntInstance(Int8,Word8,Int8Trie)

376IntInstance(Int8,Word8,Int8Trie)

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

496-- extract the sign bit.

382-- extract the sign bit.

497

383

498instance HasTrie Integer where

384instance HasTrie Integer where

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

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

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

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

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

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

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

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

503

389

504

390

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

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

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

587

473

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

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

589 mempty = trie mempty

475 mempty = trie mempty

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

591 mappend = inTrie2 mappend

476 mappend = inTrie2 mappend

592−#else

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

594− (<>) = inTrie2 (<>)

595−#endif

596

477

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

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

598 fmap f = inTrie (fmap f)

479 fmap f = inTrie (fmap f)

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

616(@.@) = inTrie2 (.)

497(@.@) = inTrie2 (.)

617

498

618

499

500+

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

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

620-- id = idTrie

502-- id = idTrie

621-- (.) = (.:)

503-- (.) = (.:)

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

634

516

635-}

517-}

636

518

519+

637---- To go elsewhere

520---- To go elsewhere

638

521

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

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

@@ -649,92 +532,3 @@ f1 n = n + n

649

532

650f1' = memo f1

533f1' = memo f1

651-}

534-}

652−

653−-- | just like @void@

654−instance HasTrie (V1 x) where

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

656− trie _ = V1Trie

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

658− -- \case -- needs EmptyCase

659− enumerate V1Trie = []

660−

661−-- | just like @()@

662−instance HasTrie (U1 x) where

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

664− trie f = U1Trie (f U1)

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

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

667−

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

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

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

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

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

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

674−

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

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

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

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

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

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

681−

682−-- | wraps @a@

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

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

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

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

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

688−

689−-- | wraps @f x@

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

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

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

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

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

695−

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

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

698−type Reg a = Rep a ()

699−

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

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

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

703− -> (a -> b)

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

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

706−{-# INLINEABLE trieGeneric #-}

707−

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

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

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

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

712− -> (a -> b)

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

714−{-# INLINEABLE untrieGeneric #-}

715−

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

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

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

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

720− -> [(a, b)]

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

722−{-# INLINEABLE enumerateGeneric #-}

723−

724−dropProduct :: (f :*: g) a -> (f a, g a)

725−dropProduct (a :*: b) = (a, b)

726−{-# INLINEABLE dropProduct #-}

727−

728−liftProduct :: (f a, g a) -> (f :*: g) a

729−liftProduct (a, b) = (a :*: b)

730−{-# INLINEABLE liftProduct #-}

731−

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

733−dropSum s = case s of

734− L1 x -> Left x

735− R1 x -> Right x

736−{-# INLINEABLE dropSum #-}

737−

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

739−liftSum = either L1 R1

740−{-# INLINEABLE liftSum #-}

stack.yamldeleted−7

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

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