+
+-- import Debug.Trace
+
+import Data.List
+import qualified Data.Map.Strict as M
+import Data.Map.Strict ((!))
+-- import Data.Maybe
+
+import Control.Monad.State.Strict
+-- import Control.Monad.Reader
+-- import Control.Monad.Writer
+-- import Control.Monad.RWS.Strict
+
+import Control.Parallel.Strategies
+
+
+type Memo = M.Map (Int, Int) Int
+
+type MemoF = State Memo
+
+main :: IO ()
+main =
+ do let resultPairs = fmap evalAck [0 .. (2 ^ 15 - 1)] `using` parList rdeepseq
+ let result = filter ((== 6) . snd) resultPairs
+ print result
+
+r7Gives6 :: Int -> Bool
+r7Gives6 r7 = result == 6
+ where result = evalState (ackermann 4 1 r7) M.empty
+
+evalAck :: Int -> (Int, Int)
+evalAck r7 = (r7, evalState (ackermann 4 1 r7) M.empty)
+
+
+ackermann :: Int -> Int -> Int -> MemoF Int
+ackermann r0 r1 r7 = do
+ memoResult <- memoLookup r0 r1
+ case memoResult of
+ Just r -> return r
+ Nothing ->
+ do if r0 == 0
+ then do let res = ((r1 + 1) `mod` (2 ^ 15))
+ memoStore r0 r1 res
+ return res
+ else if r1 == 0
+ then do res <- ackermann (r0 - 1) r7 r7
+ memoStore r0 r1 res
+ return res
+ else do subResult <- ackermann r0 (r1 - 1) r7
+ res <- ackermann (r0 - 1) subResult r7
+ memoStore r0 r1 res
+ return res
+
+memoLookup :: Int -> Int -> MemoF (Maybe Int)
+memoLookup r0 r1 =
+ do table <- get
+ return $ M.lookup (r0, r1) table
+
+memoStore :: Int -> Int -> Int -> MemoF ()
+memoStore r0 r1 result =
+ do table <- get
+ let table' = M.insert (r0, r1) result table
+ put table'
+