{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
module Parsley.Internal.Core.CharPred (
CharPred(..), pattern Item, pattern Specific,
apply, andPred, orPred, diffPred, optimisePredGiven,
members, nonMembers,
lamTerm
) where
import Prelude hiding (null)
import Data.RangeSet (RangeSet, elems, unelems, fromRanges, full, member, fold, null, union, extractSingle, singleton, intersection, difference, isSubsetOf, sizeRanges)
import Parsley.Internal.Core.Lam (Lam(Abs, App, Var, T, F, If))
data CharPred where
UserPred :: (Char -> Bool) -> Lam (Char -> Bool) -> CharPred
Ranges :: RangeSet Char -> CharPred
pattern Item :: CharPred
pattern $bItem :: CharPred
$mItem :: forall r. CharPred -> (Void# -> r) -> (Void# -> r) -> r
Item <- Ranges (full -> True)
where Item = RangeSet Char -> CharPred
Ranges ([(Char, Char)] -> RangeSet Char
forall a. Enum a => [(a, a)] -> RangeSet a
fromRanges [(Char
forall a. Bounded a => a
minBound, Char
forall a. Bounded a => a
maxBound)])
pattern Specific :: Char -> CharPred
pattern $bSpecific :: Char -> CharPred
$mSpecific :: forall r. CharPred -> (Char -> r) -> (Void# -> r) -> r
Specific c <- Ranges (extractSingle -> Just c)
where Specific Char
c = RangeSet Char -> CharPred
Ranges (Char -> RangeSet Char
forall a. Enum a => a -> RangeSet a
singleton Char
c)
apply :: CharPred -> Char -> Bool
apply :: CharPred -> Char -> Bool
apply (UserPred Char -> Bool
f Lam (Char -> Bool)
_) Char
c = Char -> Bool
f Char
c
apply (Ranges RangeSet Char
rngs) Char
c = Char -> RangeSet Char -> Bool
forall a. Enum a => a -> RangeSet a -> Bool
member Char
c RangeSet Char
rngs
andPred :: CharPred -> CharPred -> CharPred
andPred :: CharPred -> CharPred -> CharPred
andPred (UserPred Char -> Bool
f Lam (Char -> Bool)
lf) CharPred
p = (Char -> Bool) -> Lam (Char -> Bool) -> CharPred
UserPred (\Char
c -> Char -> Bool
f Char
c Bool -> Bool -> Bool
&& CharPred -> Char -> Bool
apply CharPred
p Char
c) ((Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a a. (Lam a -> Lam a) -> Lam (a -> a)
Abs ((Lam Char -> Lam Bool) -> Lam (Char -> Bool))
-> (Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a b. (a -> b) -> a -> b
$ \Lam Char
c -> Lam Bool -> Lam Bool -> Lam Bool
andLam (Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App Lam (Char -> Bool)
lf Lam Char
c) (Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (CharPred -> Lam (Char -> Bool)
lamTerm CharPred
p) Lam Char
c))
andPred CharPred
p (UserPred Char -> Bool
f Lam (Char -> Bool)
lf) = (Char -> Bool) -> Lam (Char -> Bool) -> CharPred
UserPred (\Char
c -> CharPred -> Char -> Bool
apply CharPred
p Char
c Bool -> Bool -> Bool
&& Char -> Bool
f Char
c) ((Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a a. (Lam a -> Lam a) -> Lam (a -> a)
Abs ((Lam Char -> Lam Bool) -> Lam (Char -> Bool))
-> (Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a b. (a -> b) -> a -> b
$ \Lam Char
c -> Lam Bool -> Lam Bool -> Lam Bool
andLam (Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (CharPred -> Lam (Char -> Bool)
lamTerm CharPred
p) Lam Char
c) (Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App Lam (Char -> Bool)
lf Lam Char
c))
andPred (Ranges RangeSet Char
rngs1) (Ranges RangeSet Char
rngs2) = RangeSet Char -> CharPred
Ranges (RangeSet Char
rngs1 RangeSet Char -> RangeSet Char -> RangeSet Char
forall a. Enum a => RangeSet a -> RangeSet a -> RangeSet a
`intersection` RangeSet Char
rngs2)
optimisePredGiven :: CharPred
-> CharPred
-> CharPred
optimisePredGiven :: CharPred -> CharPred -> CharPred
optimisePredGiven (Ranges RangeSet Char
pred) (Ranges RangeSet Char
given)
| RangeSet Char -> RangeSet Char -> Bool
forall a. RangeSet a -> RangeSet a -> Bool
isSubsetOf RangeSet Char
given RangeSet Char
pred = CharPred
Item
| RangeSet Char -> Int
forall a. Enum a => RangeSet a -> Int
sizeRanges RangeSet Char
inter Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= RangeSet Char -> Int
forall a. Enum a => RangeSet a -> Int
sizeRanges RangeSet Char
pred = RangeSet Char -> CharPred
Ranges RangeSet Char
inter
| Bool
otherwise = RangeSet Char -> CharPred
Ranges RangeSet Char
pred
where
inter :: RangeSet Char
inter = RangeSet Char -> RangeSet Char -> RangeSet Char
forall a. Enum a => RangeSet a -> RangeSet a -> RangeSet a
intersection RangeSet Char
given RangeSet Char
pred
optimisePredGiven CharPred
p CharPred
_ = CharPred
p
orPred :: CharPred -> CharPred -> CharPred
orPred :: CharPred -> CharPred -> CharPred
orPred (UserPred Char -> Bool
f Lam (Char -> Bool)
lf) CharPred
p = (Char -> Bool) -> Lam (Char -> Bool) -> CharPred
UserPred (\Char
c -> Char -> Bool
f Char
c Bool -> Bool -> Bool
|| CharPred -> Char -> Bool
apply CharPred
p Char
c) ((Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a a. (Lam a -> Lam a) -> Lam (a -> a)
Abs ((Lam Char -> Lam Bool) -> Lam (Char -> Bool))
-> (Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a b. (a -> b) -> a -> b
$ \Lam Char
c -> Lam Bool -> Lam Bool -> Lam Bool
orLam (Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App Lam (Char -> Bool)
lf Lam Char
c) (Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (CharPred -> Lam (Char -> Bool)
lamTerm CharPred
p) Lam Char
c))
orPred CharPred
p (UserPred Char -> Bool
f Lam (Char -> Bool)
lf) = (Char -> Bool) -> Lam (Char -> Bool) -> CharPred
UserPred (\Char
c -> CharPred -> Char -> Bool
apply CharPred
p Char
c Bool -> Bool -> Bool
|| Char -> Bool
f Char
c) ((Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a a. (Lam a -> Lam a) -> Lam (a -> a)
Abs ((Lam Char -> Lam Bool) -> Lam (Char -> Bool))
-> (Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a b. (a -> b) -> a -> b
$ \Lam Char
c -> Lam Bool -> Lam Bool -> Lam Bool
orLam (Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (CharPred -> Lam (Char -> Bool)
lamTerm CharPred
p) Lam Char
c) (Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App Lam (Char -> Bool)
lf Lam Char
c))
orPred (Ranges RangeSet Char
rngs1) (Ranges RangeSet Char
rngs2) = RangeSet Char -> CharPred
Ranges (RangeSet Char
rngs1 RangeSet Char -> RangeSet Char -> RangeSet Char
forall a. Enum a => RangeSet a -> RangeSet a -> RangeSet a
`union` RangeSet Char
rngs2)
diffPred :: CharPred -> CharPred -> CharPred
diffPred :: CharPred -> CharPred -> CharPred
diffPred (UserPred Char -> Bool
f Lam (Char -> Bool)
lf) CharPred
p = (Char -> Bool) -> Lam (Char -> Bool) -> CharPred
UserPred (\Char
c -> Char -> Bool
f Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (CharPred -> Char -> Bool
apply CharPred
p Char
c)) ((Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a a. (Lam a -> Lam a) -> Lam (a -> a)
Abs ((Lam Char -> Lam Bool) -> Lam (Char -> Bool))
-> (Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a b. (a -> b) -> a -> b
$ \Lam Char
c -> Lam Bool -> Lam Bool -> Lam Bool
andLam (Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App Lam (Char -> Bool)
lf Lam Char
c) (Lam Bool -> Lam Bool
notLam (Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (CharPred -> Lam (Char -> Bool)
lamTerm CharPred
p) Lam Char
c)))
diffPred CharPred
p (UserPred Char -> Bool
f Lam (Char -> Bool)
lf) = (Char -> Bool) -> Lam (Char -> Bool) -> CharPred
UserPred (\Char
c -> CharPred -> Char -> Bool
apply CharPred
p Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
f Char
c)) ((Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a a. (Lam a -> Lam a) -> Lam (a -> a)
Abs ((Lam Char -> Lam Bool) -> Lam (Char -> Bool))
-> (Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a b. (a -> b) -> a -> b
$ \Lam Char
c -> Lam Bool -> Lam Bool -> Lam Bool
andLam (Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (CharPred -> Lam (Char -> Bool)
lamTerm CharPred
p) Lam Char
c) (Lam Bool -> Lam Bool
notLam (Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App Lam (Char -> Bool)
lf Lam Char
c)))
diffPred (Ranges RangeSet Char
rngs1) (Ranges RangeSet Char
rngs2) = RangeSet Char -> CharPred
Ranges (RangeSet Char
rngs1 RangeSet Char -> RangeSet Char -> RangeSet Char
forall a. Enum a => RangeSet a -> RangeSet a -> RangeSet a
`difference` RangeSet Char
rngs2)
members :: CharPred -> [Char]
members :: CharPred -> [Char]
members (UserPred Char -> Bool
f Lam (Char -> Bool)
_) = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
f [Char
forall a. Bounded a => a
minBound..Char
forall a. Bounded a => a
maxBound]
members (Ranges RangeSet Char
rngs) = RangeSet Char -> [Char]
forall a. Enum a => RangeSet a -> [a]
elems RangeSet Char
rngs
nonMembers :: CharPred -> [Char]
nonMembers :: CharPred -> [Char]
nonMembers (UserPred Char -> Bool
f Lam (Char -> Bool)
_) = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f) [Char
forall a. Bounded a => a
minBound..Char
forall a. Bounded a => a
maxBound]
nonMembers (Ranges RangeSet Char
rngs) = RangeSet Char -> [Char]
forall a. (Bounded a, Enum a) => RangeSet a -> [a]
unelems RangeSet Char
rngs
lamTerm :: CharPred -> Lam (Char -> Bool)
lamTerm :: CharPred -> Lam (Char -> Bool)
lamTerm (UserPred Char -> Bool
_ Lam (Char -> Bool)
t) = Lam (Char -> Bool)
t
lamTerm CharPred
Item = (Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a a. (Lam a -> Lam a) -> Lam (a -> a)
Abs (Lam Bool -> Lam Char -> Lam Bool
forall a b. a -> b -> a
const Lam Bool
T)
lamTerm (Ranges (RangeSet Char -> Bool
forall a. RangeSet a -> Bool
null -> Bool
True)) = (Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a a. (Lam a -> Lam a) -> Lam (a -> a)
Abs (Lam Bool -> Lam Char -> Lam Bool
forall a b. a -> b -> a
const Lam Bool
F)
lamTerm (Ranges RangeSet Char
rngs) =
(Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a a. (Lam a -> Lam a) -> Lam (a -> a)
Abs ((Lam Char -> Lam Bool) -> Lam (Char -> Bool))
-> (Lam Char -> Lam Bool) -> Lam (Char -> Bool)
forall a b. (a -> b) -> a -> b
$ \Lam Char
c ->
(Char -> Char -> Lam Bool -> Lam Bool -> Lam Bool)
-> Lam Bool -> RangeSet Char -> Lam Bool
forall a b.
Enum a =>
(a -> a -> b -> b -> b) -> b -> RangeSet a -> b
fold (Lam Char -> Char -> Char -> Lam Bool -> Lam Bool -> Lam Bool
conv Lam Char
c) Lam Bool
F RangeSet Char
rngs
where
conv :: Lam Char -> Char -> Char -> Lam Bool -> Lam Bool -> Lam Bool
conv Lam Char
c Char
l Char
u Lam Bool
lb Lam Bool
rb
| Char
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
u = Lam Char -> Lam Char -> Lam Bool
eq Lam Char
c (Bool -> Code Char -> Lam Char
forall a. Bool -> Code a -> Lam a
Var Bool
True [||l||]) Lam Bool -> Lam Bool -> Lam Bool
`or` Lam Bool -> Lam Bool -> Lam Bool -> Lam Bool
forall a. Lam Bool -> Lam a -> Lam a -> Lam a
if' (Lam Char -> Lam Char -> Lam Bool
lt Lam Char
c (Bool -> Code Char -> Lam Char
forall a. Bool -> Code a -> Lam a
Var Bool
True [||l||])) Lam Bool
lb Lam Bool
rb
| Char
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
forall a. Bounded a => a
minBound = Lam Char -> Lam Char -> Lam Bool
lte Lam Char
c (Bool -> Code Char -> Lam Char
forall a. Bool -> Code a -> Lam a
Var Bool
True [||u||]) Lam Bool -> Lam Bool -> Lam Bool
`or` Lam Bool
rb
| Char
u Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
forall a. Bounded a => a
maxBound = Lam Char -> Lam Char -> Lam Bool
lte (Bool -> Code Char -> Lam Char
forall a. Bool -> Code a -> Lam a
Var Bool
True [||l||]) Lam Char
c Lam Bool -> Lam Bool -> Lam Bool
`or` Lam Bool
lb
| Bool
otherwise = Lam Bool -> Lam Bool -> Lam Bool -> Lam Bool
forall a. Lam Bool -> Lam a -> Lam a -> Lam a
if' (Lam Char -> Lam Char -> Lam Bool
lte (Bool -> Code Char -> Lam Char
forall a. Bool -> Code a -> Lam a
Var Bool
True [||l||]) Lam Char
c) (Lam Char -> Lam Char -> Lam Bool
lte Lam Char
c (Bool -> Code Char -> Lam Char
forall a. Bool -> Code a -> Lam a
Var Bool
True [||u||]) Lam Bool -> Lam Bool -> Lam Bool
`or` Lam Bool
rb) Lam Bool
lb
or :: Lam Bool -> Lam Bool -> Lam Bool
or = Lam Bool -> Lam Bool -> Lam Bool
orLam
and :: Lam Bool -> Lam Bool -> Lam Bool
and = Lam Bool -> Lam Bool -> Lam Bool
andLam
lte :: Lam Char -> Lam Char -> Lam Bool
lte :: Lam Char -> Lam Char -> Lam Bool
lte = Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (Lam (Char -> Bool) -> Lam Char -> Lam Bool)
-> (Lam Char -> Lam (Char -> Bool))
-> Lam Char
-> Lam Char
-> Lam Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lam (Char -> Char -> Bool) -> Lam Char -> Lam (Char -> Bool)
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (Bool -> Code (Char -> Char -> Bool) -> Lam (Char -> Char -> Bool)
forall a. Bool -> Code a -> Lam a
Var Bool
True [||(<=)||])
lt :: Lam Char -> Lam Char -> Lam Bool
lt :: Lam Char -> Lam Char -> Lam Bool
lt = Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (Lam (Char -> Bool) -> Lam Char -> Lam Bool)
-> (Lam Char -> Lam (Char -> Bool))
-> Lam Char
-> Lam Char
-> Lam Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lam (Char -> Char -> Bool) -> Lam Char -> Lam (Char -> Bool)
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (Bool -> Code (Char -> Char -> Bool) -> Lam (Char -> Char -> Bool)
forall a. Bool -> Code a -> Lam a
Var Bool
True [||(<)||])
eq :: Lam Char -> Lam Char -> Lam Bool
eq :: Lam Char -> Lam Char -> Lam Bool
eq = Lam (Char -> Bool) -> Lam Char -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (Lam (Char -> Bool) -> Lam Char -> Lam Bool)
-> (Lam Char -> Lam (Char -> Bool))
-> Lam Char
-> Lam Char
-> Lam Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lam (Char -> Char -> Bool) -> Lam Char -> Lam (Char -> Bool)
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (Bool -> Code (Char -> Char -> Bool) -> Lam (Char -> Char -> Bool)
forall a. Bool -> Code a -> Lam a
Var Bool
True [||(==)||])
if' :: Lam Bool -> Lam a -> Lam a -> Lam a
if' Lam Bool
x Lam a
y Lam a
F = Lam Bool -> Lam Bool -> Lam Bool
and Lam Bool
x Lam a
Lam Bool
y
if' Lam Bool
c Lam a
x Lam a
y = Lam Bool -> Lam a -> Lam a -> Lam a
forall a. Lam Bool -> Lam a -> Lam a -> Lam a
If Lam Bool
c Lam a
x Lam a
y
instance Show CharPred where
show :: CharPred -> [Char]
show (UserPred Char -> Bool
_ Lam (Char -> Bool)
f) = Lam (Char -> Bool) -> [Char]
forall a. Show a => a -> [Char]
show Lam (Char -> Bool)
f
show CharPred
Item = [Char]
"const True"
show (Specific Char
c) = [[Char]] -> [Char]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[Char]
"(== ", Char -> [Char]
forall a. Show a => a -> [Char]
show Char
c, [Char]
")"]
show (Ranges RangeSet Char
rngs) = [Char]
"elem " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ RangeSet Char -> [Char]
forall a. Show a => a -> [Char]
show RangeSet Char
rngs
andLam :: Lam Bool -> Lam Bool -> Lam Bool
andLam :: Lam Bool -> Lam Bool -> Lam Bool
andLam Lam Bool
T Lam Bool
y = Lam Bool
y
andLam Lam Bool
x Lam Bool
T = Lam Bool
x
andLam Lam Bool
F Lam Bool
_ = Lam Bool
F
andLam Lam Bool
_ Lam Bool
F = Lam Bool
F
andLam Lam Bool
x Lam Bool
y = Lam (Bool -> Bool) -> Lam Bool -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (Lam (Bool -> Bool -> Bool) -> Lam Bool -> Lam (Bool -> Bool)
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (Bool -> Code (Bool -> Bool -> Bool) -> Lam (Bool -> Bool -> Bool)
forall a. Bool -> Code a -> Lam a
Var Bool
True [||(&&)||]) Lam Bool
x) Lam Bool
y
orLam :: Lam Bool -> Lam Bool -> Lam Bool
orLam :: Lam Bool -> Lam Bool -> Lam Bool
orLam Lam Bool
T Lam Bool
_ = Lam Bool
T
orLam Lam Bool
_ Lam Bool
T = Lam Bool
T
orLam Lam Bool
F Lam Bool
y = Lam Bool
y
orLam Lam Bool
y Lam Bool
F = Lam Bool
y
orLam Lam Bool
x Lam Bool
y = Lam (Bool -> Bool) -> Lam Bool -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (Lam (Bool -> Bool -> Bool) -> Lam Bool -> Lam (Bool -> Bool)
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (Bool -> Code (Bool -> Bool -> Bool) -> Lam (Bool -> Bool -> Bool)
forall a. Bool -> Code a -> Lam a
Var Bool
True [||(||)||]) Lam Bool
x) Lam Bool
y
notLam :: Lam Bool -> Lam Bool
notLam :: Lam Bool -> Lam Bool
notLam Lam Bool
T = Lam Bool
F
notLam Lam Bool
F = Lam Bool
T
notLam Lam Bool
x = Lam (Bool -> Bool) -> Lam Bool -> Lam Bool
forall a b. Lam (a -> b) -> Lam a -> Lam b
App (Bool -> Code (Bool -> Bool) -> Lam (Bool -> Bool)
forall a. Bool -> Code a -> Lam a
Var Bool
True [||not||]) Lam Bool
x