3524599..master · MemoTrie

git.iko.soy/MemoTrie

on master help sign in

.gitignorenew file+15

since splitsnapshots

unifiedsplit

@@ -0,0 +1,15 @@

1+*~

2+Junk*

3+Old*

4+dist

5+Stuff

6+TAGS

7+tags

8+tarballs

10+# Mac OS generates

11+.DS_Store

12+

13+# Where do these files come from? They're not readable.

14+# For instance, .#Help.page

15+.#*

Makefile−8

@@ -1,9 +1 @@

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

2−

3−server = code.haskell.org

4−server-dir = /srv/code

5−server-url-dir =

6−

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

8−

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

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

MemoTrie.cabal+33−9

@@ -1,30 +1,54 @@

1Name: MemoTrie

2−Version: 0.4.13

2+Version: 0.6.10

3−Cabal-Version: >= 1.2

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.

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

14Author: Conal Elliott

15Author: Conal Elliott

15Maintainer: conal@conal.net

16Maintainer: conal@conal.net

16−Homepage: http://haskell.org/haskellwiki/MemoTrie

17−Package-Url: http://code.haskell.org/MemoTrie

19License: BSD3

18License: BSD3

20License-File: COPYING

19License-File: COPYING

21Stability: experimental

20Stability: experimental

22build-type: Simple

21build-type: Simple

23+source-repository head

24+ type: git

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

26+

27+Flag examples

28+ Description: "examples"

29+ Default: False

30+ Manual: True

31+

24Library

32Library

25 hs-Source-Dirs: src

33 hs-Source-Dirs: src

26− Extensions:

34+

35+ if impl(ghc >= 7.10.0)

27− 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+

28 Exposed-Modules:

40 Exposed-Modules:

29 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

30 ghc-options: -Wall

50 ghc-options: -Wall

51+ hs-source-dirs: examples

52+ default-language: Haskell2010

53+ build-depends: base, MemoTrie

54+

README.mdnew file+9

@@ -0,0 +1,9 @@

1+*MemoTrie* is functional library for creating efficient memo functions, using [tries](http://en.wikipedia.org/wiki/Trie "http://en.wikipedia.org/wiki/Trie").

2+It's based on some code from Spencer Janssen (originally put on hpaste.org, now expired), which I assume was based on Ralf Hinze's paper [*Memo functions, polytypically!*](http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.43.3272 "http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.43.3272").

4+Install with `cabal install Memotrie`.

6+See also

8+* Library documentation [on Hackage](http://hackage.haskell.org/package/MemoTrie).

9+* Related [blog posts](http://conal.net/blog/tag/trie/ "http://conal.net/blog/tag/trie/").

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+264−57

@@ -1,12 +1,15 @@

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

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

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

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

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

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

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

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

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

6----------------------------------------------------------------------

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

7-- |

10-- |

8-- Module : Data.MemoTrie

11-- Module : Data.MemoTrie

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

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

10-- License : BSD3

13-- License : BSD3

11--

14--

12-- Maintainer : conal@conal.net

15-- Maintainer : conal@conal.net

@@ -14,33 +17,69 @@

14--

17--

15-- Trie-based memoizer

18-- Trie-based memoizer

16--

19--

17−-- 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\">,

18-- 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,

19-- Polytypically!".

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

20----------------------------------------------------------------------

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

22module Data.MemoTrie

51module Data.MemoTrie

23− ( HasTrie, (:->:)(..), trie, untrie, enumerate

52+ ( HasTrie(..), (:->:)(..)

24 , domain, idTrie, (@.@)

53 , domain, idTrie, (@.@)

25 -- , trie2, trie3, untrie2, untrie3

54 -- , trie2, trie3, untrie2, untrie3

26 , memo, memo2, memo3, mup

55 , memo, memo2, memo3, mup

27 , inTrie, inTrie2, inTrie3

56 , inTrie, inTrie2, inTrie3

28 -- , untrieBits

57 -- , untrieBits

58+ , trieGeneric, untrieGeneric, enumerateGeneric, Reg

59+ , memoFix

29 ) where

60 ) where

31-- 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

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

34import Data.Bits

66import Data.Bits

35import Data.Word

67import Data.Word

36import Data.Int

68import Data.Int

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

37import Control.Applicative

70import Control.Applicative

71+#endif

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

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

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

39import Data.Monoid

74import Data.Monoid

75+#endif

40import Data.Function (on)

76import Data.Function (on)

77+import GHC.Generics

42−import Data.Void

79+import Control.Newtype.Generics

81+import Data.Void (Void)

82+

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

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

45-- import Control.Category

84-- import Control.Category

46-- import Control.Arrow

85-- import Control.Arrow

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

97-}

136-}

137

138

100−{-# RULES

101−"trie/untrie" forall t. trie (untrie t) = t

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

102− #-}

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+

103

146

104-- Don't include the dual rule:

147-- Don't include the dual rule:

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

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

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

127memo2 = mup memo

170memo2 = mup memo

128memo3 = mup memo2

171memo3 = mup memo2

129

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+

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

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

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

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

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

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

@@ -149,17 +228,28 @@ inTrie3 = untrie ~> inTrie2

149---- Instances

228---- Instances

150

229

151instance HasTrie Void where

230instance HasTrie Void where

152− -- As suggested by Audun

231+ -- As suggested by Audun Skaugen

153− data Void :->: a = VoidTrie

232+ data Void :->: a = VoidTrie

154 trie _ = VoidTrie

233 trie _ = VoidTrie

155− untrie VoidTrie = absurd

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

235+ -- \case -- needs EmptyCase

156 enumerate VoidTrie = []

236 enumerate VoidTrie = []

157

237

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

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

240+ pack () = VoidTrie

241+ unpack VoidTrie = ()

242+

158instance HasTrie () where

243instance HasTrie () where

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

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

160− trie f = UnitTrie (f ())

245+ trie f = UnitTrie (f ())

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

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

162− 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

163

253

164-- Proofs of inverse properties:

254-- Proofs of inverse properties:

165

255

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

191

281

192

282

193instance HasTrie Bool where

283instance HasTrie Bool where

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

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

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

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

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

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

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

198

293

199-- | Conditional with boolean last.

294-- | Conditional with boolean last.

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

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

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

220 BoolTrie f t

315 BoolTrie f t

221-}

316-}

222

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)

223

328

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

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

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

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

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

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

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

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

228− 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)

229

339

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

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

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

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

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

260

370

261

371

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

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

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

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

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

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

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

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

266− enumerate (PairTrie tt) =

376+ enumerate (PairTrie tt) =

267− [ ((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

268

383

269{-

384{-

270 untrie (trie f)

385 untrie (trie f)

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

293-}

408-}

294

409

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

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

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

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

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

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

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

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

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

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

300

415

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

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

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

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

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

306

421

307

422

308instance HasTrie x => HasTrie [x] where

423instance HasTrie x => HasTrie [x] where

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

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

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

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

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

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

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

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

313

428

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

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

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

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

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

320

435

321#define WordInstance(Type,TrieType)\

436#define WordInstance(Type,TrieType)\

322instance HasTrie Type where \

437instance HasTrie Type where \

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

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

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

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

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

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

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

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

327

442

328WordInstance(Word,WordTrie)

443WordInstance(Word,WordTrie)

329WordInstance(Word8,Word8Trie)

444WordInstance(Word8,Word8Trie)

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

332WordInstance(Word64,Word64Trie)

447WordInstance(Word64,Word64Trie)

333

448

334-- instance HasTrie Word where

449-- instance HasTrie Word where

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

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

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

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

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

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

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

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

339

454

340

455

341-- | Extract bits in little-endian order

456-- | Extract bits in little-endian order

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

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

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

355

470

356instance HasTrie Char where

471instance HasTrie Char where

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

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

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

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

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

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

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

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

361

476

362-- 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

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

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

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

366

481

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

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

368instance HasTrie IntType where \

483instance HasTrie IntType where \

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

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

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

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

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

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

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

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

373

488

374IntInstance(Int,Word,IntTrie)

489IntInstance(Int,Word,IntTrie)

375IntInstance(Int8,Word8,Int8Trie)

490IntInstance(Int8,Word8,Int8Trie)

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

381-- extract the sign bit.

496-- extract the sign bit.

382

497

383instance HasTrie Integer where

498instance HasTrie Integer where

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

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

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

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

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

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

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

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

388

503

389

504

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

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

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

472

587

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

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

474 mempty = trie mempty

589 mempty = trie mempty

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

475 mappend = inTrie2 mappend

591 mappend = inTrie2 mappend

592+#else

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

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

595+#endif

476

596

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

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

478 fmap f = inTrie (fmap f)

598 fmap f = inTrie (fmap f)

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

496(@.@) = inTrie2 (.)

616(@.@) = inTrie2 (.)

497

617

498

618

499−

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

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

501-- id = idTrie

620-- id = idTrie

502-- (.) = (.:)

621-- (.) = (.:)

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

515

634

516-}

635-}

517

636

518−

519---- To go elsewhere

637---- To go elsewhere

520

638

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

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

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

531

649

532f1' = memo f1

650f1' = memo f1

533-}

651-}

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.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

wikipage.twdeleted−21

@@ -1,21 +0,0 @@

1−[[Category:Packages]]

2−

3−== Abstract ==

4−

5−'''MemoTrie''' is functional library for creating efficient memo functions, using [http://en.wikipedia.org/wiki/Trie trie]s. It's based on [http://hpaste.org/3839 some code] from Spencer Janssen and uses type families.

6−

7−Besides this wiki page, here are more ways to find out about MemoTrie:

8−* Visit the [http://hackage.haskell.org/cgi-bin/hackage-scripts/package/MemoTrie Hackage page] for library documentation and to download & install.

9−* Or install with <tt>cabal install MemoTrie</tt>.

10−* Get the code repository: <tt>darcs get http://code.haskell.org/MemoTrie</tt>.

11−

12−

13−Please leave comments at the [[Talk:MemoTrie|Talk page]].

14−

15−== See also ==

16−

17−* [http://www.haskell.org/haskellwiki/GHC/Indexed_types#An_associated_data_type_example An associated data type example]

18−* Ralf Hinze's ''[http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.46.223 Generalizing Generalized Tries]''

19−* Related [http://conal.net/blog/tag/tries/ blog posts].

20−* Use of MemoTrie in [[vector-space]].

21−