<commit_before>{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}

-- |An efficient implementation of 'Data.Graph.Inductive.Graph.Graph'
-- using big-endian patricia tree (i.e. "Data.IntMap").
--
-- This module provides the following specialised functions to gain
-- more performance, using GHC's RULES pragma:
--
-- * 'Data.Graph.Inductive.Graph.insNode'
--
-- * 'Data.Graph.Inductive.Graph.insEdge'
--
-- * 'Data.Graph.Inductive.Graph.gmap'
--
-- * 'Data.Graph.Inductive.Graph.nmap'
--
-- * 'Data.Graph.Inductive.Graph.emap'

module Data.LLVM.Internal.PatriciaTree (
  Gr,
  UGr
  ) where

import           Data.Graph.Inductive.Graph
import           Data.IntMap ( IntMap )
import qualified Data.IntMap as IM
import           Data.List ( foldl' )
import           Data.Maybe
import           Control.Arrow ( second )


newtype Gr a b = Gr (GraphRep a b)

type GraphRep a b = IntMap (Context' a b)
type Context' a b = (IntMap [b], a, IntMap [b])
-- data Context' a b = Context' !(IntMap [b]) !a !(IntMap [b])

type UGr = Gr () ()


instance Graph Gr where
    -- required members
    empty           = Gr IM.empty
    isEmpty (Gr g)  = IM.null g
    match           = matchGr

    mkGraph vs es =
      let g0 = insNodes vs empty
      in foldl' (flip insEdge) g0 es
    labNodes (Gr g) = [ (node, label) | (node, (_, label, _)) <- IM.toList g ]

    -- overriding members for efficiency
    noNodes   (Gr g) = IM.size g
    nodeRange (Gr g)
        | IM.null g = (0, 0)
        | otherwise = (ix (IM.minViewWithKey g), ix (IM.maxViewWithKey g))
                  where
                    ix = fst . fst . fromJust

    labEdges (Gr g) = do (node, (_, _, s)) <- IM.toList g
                         (next, labels)    <- IM.toList s
                         label             <- labels
                         return (node, next, label)


instance DynGraph Gr where
    (p, v, l, s) & (Gr g)
        = let !g1 = IM.insert v (fromAdj p, l, fromAdj s) g
              !g2 = addSucc g1 v p
              !g3 = addPred g2 v s
          in
            Gr g3


matchGr :: Node -> Gr a b -> Decomp Gr a b
matchGr node (Gr g)
    = case IM.lookup node g of
        Nothing
            -> (Nothing, Gr g)

        Just (p, label, s)
            -> let !g1 = IM.delete node g<commit_msg>Formatting in the forked PatriciaTree<commit_after>{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}

-- |An efficient implementation of 'Data.Graph.Inductive.Graph.Graph'
-- using big-endian patricia tree (i.e. "Data.IntMap").
--
-- This module provides the following specialised functions to gain
-- more performance, using GHC's RULES pragma:
--
-- * 'Data.Graph.Inductive.Graph.insNode'
--
-- * 'Data.Graph.Inductive.Graph.insEdge'
--
-- * 'Data.Graph.Inductive.Graph.gmap'
--
-- * 'Data.Graph.Inductive.Graph.nmap'
--
-- * 'Data.Graph.Inductive.Graph.emap'

module Data.LLVM.Internal.PatriciaTree (
  Gr,
  UGr
  ) where

import           Data.Graph.Inductive.Graph
import           Data.IntMap ( IntMap )
import qualified Data.IntMap as IM
import           Data.List ( foldl' )
import           Data.Maybe
import           Control.Arrow ( second )


newtype Gr a b = Gr (GraphRep a b)

type GraphRep a b = IntMap (Context' a b)
type Context' a b = (IntMap [b], a, IntMap [b])
-- data Context' a b = Context' !(IntMap [b]) !a !(IntMap [b])

type UGr = Gr () ()


instance Graph Gr where
    -- required members
  empty = Gr IM.empty
  isEmpty (Gr g) = IM.null g
  match = matchGr

  mkGraph vs es =
    let g0 = insNodes vs empty
    in foldl' (flip insEdge) g0 es
  labNodes (Gr g) = [ (node, label) | (node, (_, label, _)) <- IM.toList g ]

    -- overriding members for efficiency
  noNodes (Gr g) = IM.size g
  nodeRange (Gr g) = nr g

  labEdges (Gr g) = do
    (node, (_, _, s)) <- IM.toList g
    (next, labels) <- IM.toList s
    label <- labels
    return (node, next, label)

nr g | IM.null g = (0, 0)
     | otherwise = (ix (IM.minViewWithKey g), ix (IM.maxViewWithKey g))
  where
    ix = fst . fst . fromJust


instance DynGraph Gr where
    (p, v, l, s) & (Gr g)
        = let !g1 = IM.insert v (fromAdj p, l, fromAdj s) g
              !g2 = addSucc g1 v p
              !g3 = addPred g2 v s
          in
            Gr g3


matchGr :: Node -> Gr a b -> Decomp Gr a b
matchGr node (Gr g)
    = case IM.lookup node g of
        Nothing
            -> (Nothing, Gr g)

        Just (p, label, s)
            -> let !g1 = IM.delete node g
{'fraction_non_alphanumeric': 0.1278466741826381, 'fraction_numerical': 0.00496054114994363, 'mean_word_length': 1.9791806581598388, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4611471', 'n_tokens_mistral': 1566, 'n_tokens_neox': 1504, 'n_words': 497}