@@ -55,12 +55,14 @@ module Data.MemoTrie
5555 , memo, memo2, memo3, mup
5656 , inTrie, inTrie2, inTrie3
5757 -- , untrieBits
58− , trieGeneric, untrieGeneric, enumerateGeneric, Reg
58+ , trieGeneric, untrieGeneric, enumerateGeneric, Reg
59+ , memoFix
5960 ) where
6061
6162-- Export the parts of HasTrie separately in order to get the associated data
6263-- type constructors, so I can define instances of other classes on them.
6364
65+import Data.Function (fix)
6466import Data.Bits
6567import Data.Word
6668import Data.Int
@@ -168,6 +170,42 @@ mup mem f = memo (mem . f)
168170memo2 = mup memo
169171memo3 = mup memo2
170172
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+
171209-- | Apply a unary function inside of a trie
172210inTrie :: (HasTrie a, HasTrie c) =>
173211 ((a -> b) -> (c -> d))
@@ -685,4 +723,3 @@ dropSum s = case s of
685723liftSum :: Either (f a) (g a) -> (f :+: g) a
686724liftSum = either L1 R1
687725{-# INLINEABLE liftSum #-}
688−