2

Running into a space overflow when trying to run this code (I've commented out the changes I've already tried):

{-# LANGUAGE BangPatterns #-}

import System.IO (hFlush, stdout)
import System.Environment (getArgs)
-- import Data.List (foldl')
import qualified Data.Map as Map
-- import qualified Data.Map.Strict as Map
-- import qualified Data.ByteString.Char8 as B


data Trie = Trie { isWord :: Bool, children :: Map.Map Char Trie }


initial :: Trie
initial = Trie False Map.empty


insertWord :: String -> Trie -> Trie
insertWord [] trie     = trie { isWord = True }
insertWord (c:cs) trie = trie { children = Map.insert c child $ children trie }
    where
      child = maybe (insertWord cs initial) (insertWord cs)
              (Map.lookup c (children trie))

-- insertWord :: String -> Trie -> Trie
-- insertWord [] trie     = trie { isWord = True }
-- insertWord (!c:(!cs)) trie = trie { children = Map.insert c child $ children trie }
--     where
--       child = let a = maybe (insertWord cs initial) (insertWord cs)
--                       (Map.lookup c (children trie))
--               in seq a a


fromWords :: [String] -> Trie
fromWords = foldr insertWord initial

-- fromWords :: [String] -> Trie
-- fromWords = foldl' (flip insertWord) initial


toWords :: Trie -> [String]
toWords = concatMap results . Map.toList . children
    where
      results (c, t) = (if isWord t then ([c]:) else id)
                       . map (\str -> c:str) $ toWords t


completions :: String -> Trie -> [String]
completions [] trie     = toWords trie
completions (c:cs) trie = maybe [] (map (c:) . completions cs)
                          (Map.lookup c $ children trie)


main :: IO ()
main = do
  [prefix] <- getArgs
  dict <- readFile "/usr/share/dict/words"
  mapM_ putStrLn (completions prefix (fromWords $ lines dict))
--  dict <- B.readFile "/usr/share/dict/words"
--  mapM_ putStrLn (completions prefix (fromWords $ map (B.unpack) $ B.lines dict))

Output:

$ ./trie abba
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize -RTS' to increase it.

The output from "+RTS -h": https://i.sstatic.net/5BpU1.png

I can get the code to work if I specify "+RTS -K1G". I'd really appreciate if someone could point me in the right direction.

4
  • 6
    You had the right idea with the commented-out foldl' approach -- you just need to make sure children is forced when a Trie is; i.e. make the children field in Trie strict. Commented Aug 5, 2014 at 0:49
  • Thanks! That works perfectly. Changed the Trie definition to data Trie = Trie { isWord :: Bool, children :: !(Map.Map Char Trie) }. So, a load of Map.insert's were building up without getting evaluated? Commented Aug 5, 2014 at 1:08
  • 4
    By the way, child = seq a a is a code smell, since it is equivalent to child = a: it does not cause child to be more strict. This is because if child is evaluated, then a is forced in both cases. If child is not evaluated, then a is not forced in both cases: the extra seq does not even get a chance to run. Commented Aug 5, 2014 at 8:27
  • @luqui since your comment resolved this question, mind turning it into an answer? Commented Apr 6, 2015 at 17:51

1 Answer 1

1

You had the right idea with the commented-out foldl' approach -- you just need to make sure children is forced when a Trie is; i.e. make the children field in Trie strict.

data Trie = Trie { isWord :: Bool, children :: !(Map.Map Char Trie) }
Sign up to request clarification or add additional context in comments.

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.