<commit_before>{-# LANGUAGE Trustworthy          #-}
------------------------------------------------------------------------
-- |
-- Module      : AI.Rete.Net
-- Copyright   : (c) 2015 <NAME>
-- License     : BSD-style (see the file LICENSE)
-- Created     : 2015-03-05
-- Maintainer  : <EMAIL>
-- Stability   : experimental
------------------------------------------------------------------------
module AI.Rete.Net where

import AI.Rete.Data
import AI.Rete.Flow<commit_msg>Implemented building or sharing Amems.<commit_after>{-# LANGUAGE Trustworthy          #-}
------------------------------------------------------------------------
-- |
-- Module      : AI.Rete.Net
-- Copyright   : (c) 2015 <NAME>
-- License     : BSD-style (see the file LICENSE)
-- Created     : 2015-03-05
-- Maintainer  : <EMAIL>
-- Stability   : experimental
------------------------------------------------------------------------
module AI.Rete.Net where

import           AI.Rete.Data
import           AI.Rete.Flow
import           Control.Monad (liftM)
import           Control.Monad.Trans.State.Strict (get, put)
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set

-- CREATING ALPHA MEMORY AND FEEDING IN INITIAL Wmes.

-- | Searches for an existing alpha memory for the given symbols or
-- creates a new one.
buildOrShareAmem :: Obj   ConstantOrVariable
                 -> Attr  ConstantOrVariable
                 -> Val   ConstantOrVariable
                 -> ReteM Amem
buildOrShareAmem (Obj o) (Attr a) (Val v) = do
  let f s = case s of { JustConstant c' -> c'; _ -> wildcardConstant }
      o'  = Obj  (f o)
      a'  = Attr (f a)
      v'  = Val  (f v)

  amems <- liftM reteAmems get
  let k = Wme o' a' v'

  case Map.lookup k amems of
    Just amem -> return amem -- Happily found.
    Nothing   -> do
      -- Let's create new Amem.
      amem <- liftM Amem genid
      rete <- get
      let amemState = createAmemState rete o' a' v'
      put
        rete { reteAmems      = Map.insert k amem (reteAmems rete)
             , reteAmemStates = Map.insert amem amemState (reteAmemStates rete )}
      return amem
{-# INLINE buildOrShareAmem #-}

createAmemState :: Rete
                -> Obj Constant -> Attr Constant -> Val Constant
                -> AmemState
createAmemState rete o a v = loop wmes Map.empty Map.empty Map.empty
  where
    (Obj  o') = o
    (Attr a') = a
    (Val  v') = v
    isWild  s = s == wildcardConstant
    wmes      = Set.toList (wmesForAmemFeed (isWild o') (isWild a') (isWild v')
                                            (reteWorkingMemory rete) o a v)

    loop []        i1 i2 i3 = AmemState wmes i1 i2 i3 []
    loop (w:wmes') i1 i2 i3 =
      let (Wme wo wa wv) = w in
      loop wmes' (wmesIndexInsert wo w i1)
                 (wmesIndexInsert wa w i2)
                 (wmesIndexInsert wv w i3)
{-# INLINE createAmemState #-}

wmesForAmemFeed :: Bool -> Bool -> Bool
                -> WorkingMemory
                -> Obj Constant -> Attr Constant -> Val Constant
                -> Set.HashSet Wme
wmesForAmemFeed False False False workingMemory o a v =
  -- o a v
  s1 `Set.intersection` s2 `Set.intersection` s3
  where
    s1 = Map.lookupDefault Set.empty o (reteWmesByObj  workingMemory)
    s2 = Map.lookupDefault Set.empty a (reteWmesByAttr workingMemory)
    s3 = Map.lookupDefault Set.empty v (reteWmesByVal  workingMemory)

wmesForAmemFeed False False True workingMemory o a _ =
  -- o a *
  s1 `Set.intersection` s2
  where
    s1 = Map.lookupDefault Set.empty o (reteWmesByObj  workingMemory)
    s2 = Map.lookupDefault Set.empty a (reteWmesByAttr workingMemory)

wmesForAmemFeed False True False workingMemory o _ v =
  -- o * v
  s1 `Set.intersection` s2
  where
    s1 = Map.lookupDefault Set.empty o (reteWmesByObj workingMemory)
    s2 = Map.lookupDefault Set.empty v (reteWmesByVal workingMemory)

wmesForAmemFeed False True True workingMemory o _ _ =
  -- o * *
  Map.lookupDefault Set.empty o (reteWmesByObj workingMemory)

wmesForAmemFeed True False False workingMemory _ a v =
  -- * a v
  s1 `Set.intersection` s2
  where
    s1 = Map.lookupDefault Set.empty a (reteWmesByAttr workingMemory)
    s2 = Map.lookupDefault Set.empty v (reteWmesByVal  workingMemory)

wmesForAmemFeed True False True workingMemory _ a _ =
  -- * a *
  Map.lookupDefault Set.empty a (reteWmesByAttr workingMemory)

wmesForAmemFeed True True False workingMemory _ _ v =
  -- * * v
  Map.lookupDefault Set.empty v (reteWmesByVal workingMemory)

wmesForAmemFeed True True True workingMemory _ _ _ =
  -- * * *
  reteWmes workingMemory
{-# INLINE wmesForAmemFeed #-}
{'fraction_non_alphanumeric': 0.14893157781135333, 'fraction_numerical': 0.011655514785236349, 'mean_word_length': 1.8908296943231442, 'pattern_counts': {'":': 0, '<': 10, '<?xml version=': 0, '>': 25, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2917081', 'n_tokens_mistral': 1509, 'n_tokens_neox': 1459, 'n_words': 448}