<commit_before>{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}

--------------------------------------------------------------------
-- |
-- Copyright :  (c) <NAME>
-- License   :  BSD3
-- Maintainer:  <NAME> <<EMAIL>>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Ermine.Syntax.Pattern.Compiler
  ( Guard(..)
  , PMatrix(..)
  , PCompEnv(..)
  , MonadPComp(..)
  , CompileInfo(..)
  , pathMap
  , colCores
  , colPaths
  , cols
  , guards
  , bodies
  , defaultOn
  , splitOn
  , compile
  ) where

import Prelude hiding (all)

import Bound
import Control.Applicative
import Control.Lens
import Data.Foldable
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HM
import qualified Data.Map as M
import Data.List (transpose)
import Data.Monoid
import Data.Ord
import Data.Set (Set)
import qualified Data.Set as S
import Data.Set.Lens
import Data.Traversable
import Ermine.Syntax.Core
import Ermine.Syntax.Global
import Ermine.Syntax.Pattern

newtype PCompEnv = PCompEnv { signatures :: HashMap Global (HashMap Global Int) }
  deriving (Eq, Show)

class (Applicative m, Monad m) => MonadPComp m where
  askPComp :: m PCompEnv

instance MonadPComp ((->) PCompEnv) where
  askPComp = id

isSignature :: MonadPComp m => Set PatHead -> m Bool
isSignature ps = case preview folded ps of
  Nothing         -> pure False
  Just (TupH _)   -> pure True
  Just (ConH _ g) -> askPComp <&> \env -> case HM.lookup g $ signatures env of
    Nothing -> error $ "PANIC: isSignature: unknown constructor"
    Just hm -> iall (\g' i -> S.member (ConH i g') ps) hm

constructorTag :: MonadPComp m => PatHead -> m Int
constructorTag (TupH _) = pure 0
constructorTag (ConH _ g) = askPComp <&> \env ->
  case HM.lookup g (signatures env) >>= HM.lookup g of
    Nothing -> error $ "PANIC: constructorTag: unknown constructor"
    Just i  -> i

-- | Guard representation. Every row of a pattern matrix must have an
-- assocated guard, but if no guard was specified, then it will simply be
-- the trivial guard which allows everything.
data Guard a = Trivial | Explicit (Scope PatPath Core a)
  deriving (Eq, Show, Functor, Foldable, Traversable)

makePrisms ''Guard

data CompileInfo a = CInfo { _pathMap  :: HashMap PatPath (Core a)
                           , _colCores :: [Core a]
                           , _colPaths :: [PatPaths]
                           }

makeLenses ''CompileInfo

remove :: Int -> CompileInfo a -> CompileInfo (Var () (Core a))
remove i (CInfo m ccs cps) = case (splitAt i ccs, splitAt i cps) of
  ((cl, _:cr), (pl, p:pr)) ->
    CInfo (HM.insert (leafPP p) (pure $ B ()) $ fmap (pure . F) m)
          (map (pure . F) $ cl ++ cr)
          (pl ++ pr)
  _ -> error "PANIC: remove: bad column reference"
<commit_msg>Fixed isSignature implementation<commit_after>{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}

--------------------------------------------------------------------
-- |
-- Copyright :  (c) <NAME>
-- License   :  BSD3
-- Maintainer:  <NAME> <<EMAIL>>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Ermine.Syntax.Pattern.Compiler
  ( Guard(..)
  , PMatrix(..)
  , PCompEnv(..)
  , MonadPComp(..)
  , isSignature
  , constructorTag
  , CompileInfo(..)
  , pathMap
  , colCores
  , colPaths
  , cols
  , guards
  , bodies
  , defaultOn
  , splitOn
  , compile
  ) where

import Prelude hiding (all)

import Bound
import Control.Applicative
import Control.Lens
import Data.Foldable
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HM
import qualified Data.Map as M
import Data.List (transpose)
import Data.Monoid
import Data.Ord
import Data.Set (Set)
import qualified Data.Set as S
import Data.Set.Lens
import Data.Traversable
import Ermine.Syntax.Core
import Ermine.Syntax.Global
import Ermine.Syntax.Pattern

newtype PCompEnv = PCompEnv { signatures :: HashMap Global (HashMap Global Int) }
  deriving (Eq, Show)

class (Applicative m, Monad m) => MonadPComp m where
  askPComp :: m PCompEnv

instance MonadPComp ((->) PCompEnv) where
  askPComp = id

isSignature :: MonadPComp m => Set PatHead -> m Bool
isSignature ps = case preview folded ps of
  Nothing         -> pure False
  Just (TupH _)   -> pure True
  Just (ConH _ g) -> askPComp <&> \env -> case HM.lookup g $ signatures env of
    Nothing -> error $ "PANIC: isSignature: unknown constructor"
    Just hm -> iall (\g' i -> S.member g' ns) hm
 where ns = S.map _name ps

constructorTag :: MonadPComp m => PatHead -> m Int
constructorTag (TupH _) = pure 0
constructorTag (ConH _ g) = askPComp <&> \env ->
  case HM.lookup g (signatures env) >>= HM.lookup g of
    Nothing -> error $ "PANIC: constructorTag: unknown constructor"
    Just i  -> i

-- | Guard representation. Every row of a pattern matrix must have an
-- assocated guard, but if no guard was specified, then it will simply be
-- the trivial guard which allows everything.
data Guard a = Trivial | Explicit (Scope PatPath Core a)
  deriving (Eq, Show, Functor, Foldable, Traversable)

makePrisms ''Guard

data CompileInfo a = CInfo { _pathMap  :: HashMap PatPath (Core a)
                           , _colCores :: [Core a]
                           , _colPaths :: [PatPaths]
                           }

makeLenses ''CompileInfo

remove :: Int -> CompileInfo a -> CompileInfo (Var () (Core a))
remove i (CInfo m ccs cps) = case (splitAt i ccs, splitAt i cps) of
  ((cl, _:cr), (pl, p:pr)) ->
    CInfo (HM.insert (leafPP p) (pure $ B ()) $ fmap (pure . F) m)
          (map (pure . F) $ cl ++ cr)
          (pl ++ pr)
  _ -> error "PANIC: remove: bad column reference"

{'fraction_non_alphanumeric': 0.1610305958132045, 'fraction_numerical': 0.0006441223832528181, 'mean_word_length': 2.5229722064662505, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 59, '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': '3614148', 'n_tokens_mistral': 2064, 'n_tokens_neox': 2037, 'n_words': 647}