Commits

Alessandro Vermeulen committed adf3a87

* I think I have the algorithm now as it was meant to be. So without the various(!)
mistakes in which variables were used.
* It still doesn't work because I can't find the real SNMap together with it's
interface.

Comments (0)

Files changed (3)

+module Main where
+  
+import Memo.SNMap.SNMap
+
+main = print "Hello :)"

code/Memo/Main.hs

-module Main where
-  
-import Memo.SNMap.SNMap
-
-main = print "Hello :)"

code/Memo/SNMap/SNMap.hs

-module Memo.SNMap.SNMap where
+{-# LANGUAGE StandaloneDeriving #-}
+module Memo.SNMap.SNMap ( memo ) where
+
+import Data.HashMap as M
 
 import System.Mem.Weak
 import System.Mem.StableName
 
-applyWeak :: (a -> b) -> SNMap a (Weak b) -> a -> b
-applyWeak f table arg =
-  unsafePerformIO (do
-    { sn  <- mkStableName arg
-    ; lkp <- lookupSNMap tbl sn
-    ; case lkp of
-        Nothing    -> not_found tbl sn
-        Just weak  -> do { val <- deRefWeak weak
-                         ; case val of 
-                             Just result  -> return result
-                             Nothing      -> return not_found tbl sn
-                         }
-    })
-  where
-    not_found tbl sn = do { let res = f arg
-                          ; weak <- mkSimpleWeak arg res
-                          ; insertSNMap tbl sn weak
-                          ; return res
-                          }
+import System.IO.Unsafe ( unsafePerformIO )
+
+
+
+
+-------------------------------------------------------------------------------- 
+-- SNMap Implementation
+type SNMap k v = HashMap (StableName k) v
+
+deriving instance Ord (StableName k)
+
+newSNMap :: IO (SNMap k v)
+newSNMap = return empty
+
+lookupSNMap :: SNMap k v -> StableName k -> IO (Maybe v)
+lookupSNMap map sn = return (M.lookup sn map)
+
+insertSNMap :: SNMap k v -> StableName k -> v -> IO ()
+insertSNMap = undefined
+
+removeSNMap :: SNMap k v -> StableName k -> IO ()
+removeSNMap = undefined
+
+snMapElems :: SNMap k v -> IO [(k,v)]
+snMapElems = undefined
+
+-------------------------------------------------------------------------------- 
+-- Memoisation with finalisers
+
+type MemoTable a b = SNMap a (Weak b)
+
+memo :: (a -> b) -> a -> b
+memo f =
+  let (table, weak) = unsafePerformIO (do { table  <- newSNMap
+                                          ; weak   <- mkWeak table table (Just (table_finalizer table))
+                                          ; return (table , weak)
+                                          })
+   in memo' f table weak
+  
+table_finalizer :: MemoTable a b -> IO ()
+table_finalizer table =
+  do { pairs <- snMapElems table; sequence_ [ finalize w | (_ , w)  <- pairs] }
+
+memo' :: (a -> b) -> MemoTable a b -> Weak (MemoTable a b) -> a -> b
+memo' f table weak_table arg = unsafePerformIO (
+  do {  sn   <- makeStableName arg
+     ;  lkp  <- lookupSNMap table sn
+     ;  case lkp of 
+          Nothing  -> not_found sn
+          Just v   -> do  { maybe_val <- deRefWeak v
+                          ; case maybe_val of
+                              Nothing   -> not_found sn
+                              Just val  -> return val
+                          }
+     })
+  where val = f arg
+        not_found sn = do  {  weak <- mkWeak arg val (Just (finalizer sn weak_table))
+                           ;  insertSNMap table sn weak
+                           ;  return val
+                           }
+                       
+finalizer :: StableName a -> Weak (MemoTable a b) -> IO ()
+finalizer sn weak_table = do  {  r <- deRefWeak weak_table
+                              ;  case r of
+                                   Nothing    -> return ()
+                                   Just mvar  -> removeSNMap mvar sn
+                              }