Dictionary.hs

{-# LANGUAGE OverloadedStrings, BangPatterns #-}

module Megahaskhal.Dictionary (
  Dictionary,
  addWord,
  addAllWords,
  findWord,
  lookupIndex,
  replicateM,
  forM_,
  emptyDictionary,
  length ) where

import qualified Data.Foldable      as F
import qualified Data.Map.Strict    as M
import qualified Data.IntMap.Strict as I
import           Data.Text          (Text)
import           Prelude hiding     (length)
import           Control.DeepSeq    (NFData)

data Dictionary = Dictionary
  { dWordId :: !(M.Map Text Int)
  , dIdWord :: !(I.IntMap Text)
  } deriving (Show)

instance NFData Dictionary

forM_ :: Monad m => Dictionary -> (Text -> m a) -> m ()
forM_ d m = mapM_ (m . findWord d) [0 .. length d]

emptyDictionary :: Dictionary
emptyDictionary = addAllWords (Dictionary M.empty I.empty) defaultWords
  where defaultWords = ["<ERROR>", "<FIN>"]

findWord :: Dictionary -> Int -> Text
findWord = (I.!) . dIdWord

lookupIndex :: Text -> Dictionary -> Maybe Int
lookupIndex k = M.lookup k . dWordId

addWord :: Text -> Dictionary -> (Int, Dictionary)
addWord s (Dictionary wordId idWord) =
  case M.lookup s wordId of
    Just ident -> (ident, dict)
    Nothing    -> (len, dict)
  where
    len  = M.size wordId
    dict = Dictionary (M.insert s len wordId) (I.insert len s idWord)

-- |Add all words to a dictionary if they weren't already in it, and return
-- the new dictionary
addAllWords :: Dictionary -> [Text] -> Dictionary
addAllWords = F.foldl' go
  where go d w = snd $ addWord w d

replicateM :: Monad m => Int -> m Text -> m Dictionary
replicateM reps m = go reps emptyDictionary
  where
    go n !acc
      | n <= 0          = return acc
      | otherwise       = m >>= go (n - 1) . snd . (`addWord` acc)

length :: Dictionary -> Int
length = M.size . dWordId

Before

./dist/build/updatebrain/updatebrain megahal.brn marx_communist_manifesto.txt testes.brn +RTS -p -hc -sUpdate.summary 
  70,334,065,864 bytes allocated in the heap
  33,129,215,768 bytes copied during GC
     185,906,648 bytes maximum residency (296 sample(s))
       5,131,840 bytes maximum slop
             458 MB total memory in use (0 MB lost due to fragmentation)

                                    Tot time (elapsed)  Avg pause  Max pause
  Gen  0     114778 colls,     0 par   35.09s   35.97s     0.0003s    0.0061s
  Gen  1       296 colls,     0 par   29.28s   30.07s     0.1016s    0.2135s

  TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1)

  SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)

  INIT    time    0.00s  (  0.00s elapsed)
  MUT     time   20.79s  ( 29.71s elapsed)
  GC      time   56.28s  ( 57.76s elapsed)
  RP      time    0.00s  (  0.00s elapsed)
  PROF    time    8.10s  (  8.28s elapsed)
  EXIT    time    0.00s  (  0.03s elapsed)
  Total   time   85.17s  ( 87.49s elapsed)

  Alloc rate    3,382,679,664 bytes per MUT second

  Productivity  24.4% of total user, 23.8% of total elapsed

gc_alloc_block_sync: 0
whitehole_spin: 0
gen[0].sync: 0
gen[1].sync: 0

After

./dist/build/updatebrain/updatebrain megahal.brn marx_communist_manifesto.txt testes.brn +RTS -p -hc -sUpdate.summary 
  38,421,846,184 bytes allocated in the heap
  12,181,507,040 bytes copied during GC
     165,219,248 bytes maximum residency (111 sample(s))
       3,369,248 bytes maximum slop
             460 MB total memory in use (0 MB lost due to fragmentation)

                                    Tot time (elapsed)  Avg pause  Max pause
  Gen  0     64683 colls,     0 par   16.24s   16.64s     0.0003s    0.0063s
  Gen  1       111 colls,     0 par    9.73s   10.13s     0.0912s    0.1854s

  TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1)

  SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)

  INIT    time    0.00s  (  0.00s elapsed)
  MUT     time    9.46s  ( 13.11s elapsed)
  GC      time   22.71s  ( 23.42s elapsed)
  RP      time    0.00s  (  0.00s elapsed)
  PROF    time    3.26s  (  3.35s elapsed)
  EXIT    time    0.00s  (  0.02s elapsed)
  Total   time   35.43s  ( 36.55s elapsed)

  Alloc rate    4,062,176,670 bytes per MUT second

  Productivity  26.7% of total user, 25.9% of total elapsed

gc_alloc_block_sync: 0
whitehole_spin: 0
gen[0].sync: 0
gen[1].sync: 0