master..ec75702 · MemoTrie

git.iko.soy/MemoTrie

on ec75702 help sign in

MemoTrie.cabal+8−5

since splitsnapshots

unifiedsplit

@@ -1,5 +1,5 @@

1Name: MemoTrie

2−Version: 0.6.10

2+Version: 0.6.4

3Cabal-Version: >= 1.10

4Synopsis: Trie-based memo functions

5Category: Data

@@ -10,11 +10,11 @@ Description:

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

@@ -33,14 +33,16 @@ Library

33 hs-Source-Dirs: src

35 if impl(ghc >= 7.10.0)

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

36+ Build-Depends: base >=4.8.0.0 && <5

37 else

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

38+ Build-Depends: base <4.8.0.0, void

40 Exposed-Modules:

41 Data.MemoTrie

42 Other-Modules:

44+ ghc-prof-options: -prof -auto-all

45+

44 default-language: Haskell2010

46 default-language: Haskell2010

46executable generic

48executable generic

@@ -48,6 +50,7 @@ executable generic

48 buildable: False

50 buildable: False

49 main-is: Generic.hs

51 main-is: Generic.hs

50 ghc-options: -Wall

52 ghc-options: -Wall

53+ default-language: Haskell2010

51 hs-source-dirs: examples

54 hs-source-dirs: examples

52 default-language: Haskell2010

55 default-language: Haskell2010

53 build-depends: base, MemoTrie

56 build-depends: base, MemoTrie

examples/Generic.hs+14−13

@@ -2,24 +2,25 @@

2import Data.MemoTrie

3import GHC.Generics (Generic)

5+data Color

5−data Color = RGB Int Int Int

6+ = RGB Int Int Int

6− | NamedColor String

7+ | Color String

7− deriving (Generic)

8+ deriving (Generic)

9instance HasTrie Color where

10instance HasTrie Color where

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

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

11− trie = trieGeneric ColorTrie

12+ trie = trieGeneric ColorTrie

12− untrie = untrieGeneric unColorTrie

13+ untrie = untrieGeneric unColorTrie

13− enumerate = enumerateGeneric unColorTrie

14+ enumerate = enumerateGeneric unColorTrie

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

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

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

17+runColor (Color s) = length [1..10e7]

18runColorMemoized = memo runColor

19runColorMemoized = memo runColor

20−main =

21+main = do

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

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

22− print$ runColorMemoized (NamedColor "")

23+ print$ runColorMemoized (Color "")

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

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

24− print$ runColorMemoized (NamedColor "")

25+ print$ runColorMemoized (Color "")

src/Data/MemoTrie.hs+9−103

@@ -1,6 +1,6 @@

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

2{-# LANGUAGE StandaloneDeriving, FlexibleInstances #-}

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

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

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

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

@@ -9,7 +9,7 @@

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

10-- |

11-- Module : Data.MemoTrie

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

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

13-- License : BSD3

14--

15-- Maintainer : conal@conal.net

@@ -42,7 +42,7 @@

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

43--

44-- @

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

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

46-- @

47--

48--

@@ -55,29 +55,21 @@ module Data.MemoTrie

55 , memo, memo2, memo3, mup

56 , inTrie, inTrie2, inTrie3

57 -- , untrieBits

58− , trieGeneric, untrieGeneric, enumerateGeneric, Reg

58+ , trieGeneric, untrieGeneric, enumerateGeneric, Reg

59− , memoFix

60 ) where

59 ) where

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

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

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

65−import Data.Function (fix)

66import Data.Bits

64import Data.Bits

67import Data.Word

65import Data.Word

68import Data.Int

66import Data.Int

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

70import Control.Applicative

67import Control.Applicative

71−#endif

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

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

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

74import Data.Monoid

69import Data.Monoid

75−#endif

76import Data.Function (on)

70import Data.Function (on)

77import GHC.Generics

71import GHC.Generics

79−import Control.Newtype.Generics

80−

81import Data.Void (Void)

73import Data.Void (Void)

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

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

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

136-}

128-}

137

129

138

130

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

131+{-# 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−

146

132

147-- Don't include the dual rule:

133-- Don't include the dual rule:

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

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

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

170memo2 = mup memo

156memo2 = mup memo

171memo3 = mup memo2

157memo3 = mup memo2

172

158

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

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

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

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

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

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

@@ -229,28 +179,17 @@ inTrie3 = untrie ~> inTrie2

229

179

230instance HasTrie Void where

180instance HasTrie Void where

231 -- As suggested by Audun Skaugen

181 -- As suggested by Audun Skaugen

232− data Void :->: a = VoidTrie

182+ data Void :->: a = VoidTrie

233 trie _ = VoidTrie

183 trie _ = VoidTrie

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

184+ untrie VoidTrie = \case

235− -- \case -- needs EmptyCase

236 enumerate VoidTrie = []

185 enumerate VoidTrie = []

237

186

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

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

240− pack () = VoidTrie

241− unpack VoidTrie = ()

242−

243instance HasTrie () where

187instance HasTrie () where

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

188 newtype () :->: a = UnitTrie a

245 trie f = UnitTrie (f ())

189 trie f = UnitTrie (f ())

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

190 untrie (UnitTrie a) = \ () -> a

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

191 enumerate (UnitTrie a) = [((),a)]

248

192

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

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

251− pack a = UnitTrie a

252− unpack (UnitTrie a) = a

253−

254-- Proofs of inverse properties:

193-- Proofs of inverse properties:

255

194

256{-

195{-

@@ -286,11 +225,6 @@ instance HasTrie Bool where

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

225 untrie (BoolTrie f t) = if' f t

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

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

288

227

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−

294-- | Conditional with boolean last.

228-- | Conditional with boolean last.

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

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

296if' :: x -> x -> Bool -> x

230if' :: x -> x -> Bool -> x

@@ -315,16 +249,6 @@ if' _ e True = e

315 BoolTrie f t

249 BoolTrie f t

316-}

250-}

317

251

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

252

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

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

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

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

@@ -332,11 +256,6 @@ instance (HasTrie a, HasTrie b) => HasTrie (Either a b) where

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

256 untrie (EitherTrie s t) = either (untrie s) (untrie t)

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

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

334

258

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−

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

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

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

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

342

261

@@ -376,11 +295,6 @@ instance (HasTrie a, HasTrie b) => HasTrie (a,b) where

376 enumerate (PairTrie tt) =

295 enumerate (PairTrie tt) =

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

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

378

297

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−

384{-

298{-

385 untrie (trie f)

299 untrie (trie f)

386 == { trie def }

300 == { trie def }

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

587

501

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

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

589 mempty = trie mempty

503 mempty = trie mempty

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

591 mappend = inTrie2 mappend

504 mappend = inTrie2 mappend

592−#else

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

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

595−#endif

596

505

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

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

598 fmap f = inTrie (fmap f)

507 fmap f = inTrie (fmap f)

@@ -654,8 +563,7 @@ f1' = memo f1

654instance HasTrie (V1 x) where

563instance HasTrie (V1 x) where

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

564 data (V1 x :->: b) = V1Trie

656 trie _ = V1Trie

565 trie _ = V1Trie

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

566+ untrie V1Trie = \case

658− -- \case -- needs EmptyCase

659 enumerate V1Trie = []

567 enumerate V1Trie = []

660

568

661-- | just like @()@

569-- | just like @()@

@@ -697,7 +605,6 @@ instance (HasTrie (f x)) => HasTrie (M1 i t f x) where

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

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

698type Reg a = Rep a ()

606type Reg a = Rep a ()

699

607

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

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

608trieGeneric :: (Generic a, HasTrie (Reg a))

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

609 => ((Reg a :->: b) -> (a :->: b))

703 -> (a -> b)

610 -> (a -> b)

@@ -705,7 +612,6 @@ trieGeneric :: (Generic a, HasTrie (Reg a))

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

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

706{-# INLINEABLE trieGeneric #-}

613{-# INLINEABLE trieGeneric #-}

707

614

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

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

615untrieGeneric :: (Generic a, HasTrie (Reg a))

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

616 => ((a :->: b) -> (Reg a :->: b))

711 -> (a :->: b)

617 -> (a :->: b)

@@ -713,7 +619,6 @@ untrieGeneric :: (Generic a, HasTrie (Reg a))

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

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

714{-# INLINEABLE untrieGeneric #-}

620{-# INLINEABLE untrieGeneric #-}

715

621

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

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

622enumerateGeneric :: (Generic a, HasTrie (Reg a))

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

623 => ((a :->: b) -> (Reg a :->: b))

719 -> (a :->: b)

624 -> (a :->: b)

@@ -738,3 +643,4 @@ dropSum s = case s of

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

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

739liftSum = either L1 R1

644liftSum = either L1 R1

740{-# INLINEABLE liftSum #-}

645{-# INLINEABLE liftSum #-}

646+

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