<commit_before>{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
--------------------------------------------------------------------
-- |
-- Copyright :  (c) <NAME>, <NAME> 2012-2013
-- License   :  BSD3
-- Maintainer:  <NAME> <<EMAIL>>
-- Stability :  experimental
-- Portability: non-portable
--
-- Smart builders for convenient building of patterns.
--------------------------------------------------------------------
module Ermine.Builtin.Pattern
  ( Binder(..)
  , P
  , varp
  , sigp
  , _p
  , strictp
  , lazyp
  , asp
  , conp
  , litp
  , alt
  ) where

import Bound
import Control.Applicative
import Control.Comonad
import Control.Lens
import Control.Lens.Internal.Review
import Data.Foldable
import Data.Functor.Identity
import Data.Traversable
import Ermine.Syntax
import Ermine.Syntax.Global
import Ermine.Syntax.Kind
import Ermine.Syntax.Literal
import Ermine.Syntax.Pattern
import Ermine.Syntax.Type

data Binder v a = Binder { vars :: [v], item :: a }
  deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)

instance Applicative (Binder v) where
  pure = Binder []
  Binder ls f <*> Binder rs x = Binder (ls ++ rs) (f x)

instance Comonad (Binder v) where
  extract = item
  extend f b = b { item = f b }

instance (p ~ Reviewed, f ~ Identity, Tup Reviewed Identity t) => Tup p f (Binder v t) where
  tupled = unto (fmap tup . sequenceA)

-- | Smart pattern
type P t v = Binder v (Pattern t)

-- | A pattern that binds a variable with (effectively) no type annotation.
varp :: v -> P (Annot k t) v
varp v = sigp v (Annot [star] . Scope . pure . B $ 0)

-- | A pattern that binds a variable with a type annotation.
sigp :: v -> t -> P t v
sigp v t = Binder [v] $ SigP t

-- | A wildcard pattern that ignores its argument
_p :: P t v
_p = pure WildcardP

-- | A strict (bang) pattern
strictp :: P t v -> P t v
strictp = fmap StrictP

-- | A lazy (irrefutable) pattern
lazyp :: P t v -> P t v
lazyp = fmap LazyP

-- | An as @(\@)@ pattern.
asp :: v -> P t v -> P t v
asp v (Binder vs p) = Binder (v:vs) $ AsP p

-- | A pattern that matches a constructor expression.
conp :: Global -> [P t v] -> P t v
conp g ps = ConP g <$> sequenceA ps

-- | A pattern that matches a literal value
litp :: Literal -> P t v
litp = pure . LitP

-- | smart alt constructor
alt :: (Monad f, Eq v) => P t v -> f v -> Alt t f v
alt (Binder vs p) = Alt p . abstract (`lookup` zip vs (paths p))
<commit_msg>IsString for easier builtin patterns<commit_after>{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
--------------------------------------------------------------------
-- |
-- Copyright :  (c) <NAME>, <NAME> 2012-2013
-- License   :  BSD3
-- Maintainer:  <NAME> <<EMAIL>>
-- Stability :  experimental
-- Portability: non-portable
--
-- Smart builders for convenient building of patterns.
--------------------------------------------------------------------
module Ermine.Builtin.Pattern
  ( Binder(..)
  , P
  , varp
  , sigp
  , _p
  , strictp
  , lazyp
  , asp
  , conp
  , litp
  , alt
  ) where

import Bound
import Control.Applicative
import Control.Comonad
import Control.Lens
import Control.Lens.Internal.Review
import Data.Foldable
import Data.Functor.Identity
import Data.String
import Data.Traversable
import Ermine.Syntax
import Ermine.Syntax.Global
import Ermine.Syntax.Kind
import Ermine.Syntax.Literal
import Ermine.Syntax.Pattern
import Ermine.Syntax.Type

data Binder v a = Binder { vars :: [v], item :: a }
  deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)

instance Applicative (Binder v) where
  pure = Binder []
  Binder ls f <*> Binder rs x = Binder (ls ++ rs) (f x)

instance Comonad (Binder v) where
  extract = item
  extend f b = b { item = f b }

instance (p ~ Reviewed, f ~ Identity, Tup Reviewed Identity t) => Tup p f (Binder v t) where
  tupled = unto (fmap tup . sequenceA)

-- | Smart pattern
type P t v = Binder v (Pattern t)

instance IsString s => IsString (P (Annot k t) s) where
  fromString = varp . fromString

-- | A pattern that binds a variable with (effectively) no type annotation.
varp :: v -> P (Annot k t) v
varp v = sigp v (Annot [star] . Scope . pure . B $ 0)

-- | A pattern that binds a variable with a type annotation.
sigp :: v -> t -> P t v
sigp v t = Binder [v] $ SigP t

-- | A wildcard pattern that ignores its argument
_p :: P t v
_p = pure WildcardP

-- | A strict (bang) pattern
strictp :: P t v -> P t v
strictp = fmap StrictP

-- | A lazy (irrefutable) pattern
lazyp :: P t v -> P t v
lazyp = fmap LazyP

-- | An as @(\@)@ pattern.
asp :: v -> P t v -> P t v
asp v (Binder vs p) = Binder (v:vs) $ AsP p

-- | A pattern that matches a constructor expression.
conp :: Global -> [P t v] -> P t v
conp g ps = ConP g <$> sequenceA ps

-- | A pattern that matches a literal value
litp :: Literal -> P t v
litp = pure . LitP

-- | smart alt constructor
alt :: (Monad f, Eq v) => P t v -> f v -> Alt t f v
alt (Binder vs p) = Alt p . abstract (`lookup` zip vs (paths p))

{'fraction_non_alphanumeric': 0.1711762495302518, 'fraction_numerical': 0.003757985719654265, 'mean_word_length': 2.474543080939948, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 46, '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': '1183410', 'n_tokens_mistral': 1888, 'n_tokens_neox': 1839, 'n_words': 693}