{-# LANGUAGE FlexibleInstances #-}
module GLL.Combinators.Visit.Join where
import GLL.Types.Grammar
import GLL.Types.Input
import GLL.Types.TypeCompose
import GLL.Combinators.Visit.Sem
import GLL.Combinators.Visit.FUNGLL
import GLL.Combinators.Options
import Data.List (intercalate)
import Data.Text (pack)
data SymbExpr t a = SymbExpr (Symbol t, Parse_Symb t, Sem_Symb t a)
type BNF t a = SymbExpr t a
data AltExpr t a = AltExpr ([Symbol t], Parse_Alt t, Sem_Alt t a)
type AltExprs = OO [] AltExpr
mkNtRule :: (Show t, Ord t, HasAlts b) => Bool -> Bool -> String -> b t a -> SymbExpr t a
mkNtRule :: forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
Bool -> Bool -> String -> b t a -> SymbExpr t a
mkNtRule Bool
use_ctx Bool
left_biased String
x' b t a
altPs' =
let vas1 :: [[Symbol t]]
vas1 = forall a b. (a -> b) -> [a] -> [b]
map (\(AltExpr ([Symbol t]
f,Parse_Alt t
_,Sem_Alt t a
_)) -> [Symbol t]
f) [AltExpr t a]
altPs
vas2 :: [Parse_Alt t]
vas2 = forall a b. (a -> b) -> [a] -> [b]
map (\(AltExpr ([Symbol t]
_,Parse_Alt t
s,Sem_Alt t a
_)) -> Parse_Alt t
s) [AltExpr t a]
altPs
vas3 :: [Sem_Alt t a]
vas3 = forall a b. (a -> b) -> [a] -> [b]
map (\(AltExpr ([Symbol t]
_,Parse_Alt t
_,Sem_Alt t a
t)) -> Sem_Alt t a
t) [AltExpr t a]
altPs
alts :: [Prod t]
alts = forall a b. (a -> b) -> [a] -> [b]
map (forall t. Nt -> Symbols t -> Prod t
Prod Nt
x) [[Symbol t]]
vas1
altPs :: [AltExpr t a]
altPs = forall (a :: * -> * -> *) t b.
(HasAlts a, Show t, Ord t) =>
a t b -> [AltExpr t b]
altsOf b t a
altPs'
x :: Nt
x = String -> Nt
pack String
x'
in forall t a. (Symbol t, Parse_Symb t, Sem_Symb t a) -> SymbExpr t a
SymbExpr (forall t. Nt -> Symbol t
Nt Nt
x, forall t. Ord t => Nt -> [Parse_Seq t] -> Parse_Symb t
parse_nterm Nt
x [Parse_Alt t]
vas2, forall t a.
Bool -> Bool -> Nt -> [Prod t] -> [Sem_Alt t a] -> Sem_Symb t a
sem_nterm Bool
use_ctx Bool
left_biased Nt
x [Prod t]
alts [Sem_Alt t a]
vas3)
join_apply :: (Show t, Ord t, IsSymbExpr s, Foldable f) =>
(a -> f b) -> s t a -> AltExpr t b
join_apply :: forall t (s :: * -> * -> *) (f :: * -> *) a b.
(Show t, Ord t, IsSymbExpr s, Foldable f) =>
(a -> f b) -> s t a -> AltExpr t b
join_apply a -> f b
f s t a
p' =
let SymbExpr (Symbol t
vpa1,Parse_Symb t
vpa2,Sem_Symb t a
vpa3) = forall (a :: * -> * -> *) t b.
(IsSymbExpr a, Show t, Ord t) =>
a t b -> BNF t b
mkRule s t a
p' in forall t a. ([Symbol t], Parse_Alt t, Sem_Alt t a) -> AltExpr t a
AltExpr
([Symbol t
vpa1],forall t. Ord t => Parse_Symb t -> Parse_Seq t
parse_apply Parse_Symb t
vpa2, forall (f :: * -> *) t a b.
(Foldable f, Ord t) =>
(a -> f b) -> Sem_Symb t a -> Sem_Alt t b
sem_apply a -> f b
f Sem_Symb t a
vpa3)
join_seq :: (Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
CombinatorOptions -> i t (a -> b) -> s t a -> AltExpr t b
join_seq :: forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
CombinatorOptions -> i t (a -> b) -> s t a -> AltExpr t b
join_seq CombinatorOptions
local_opts i t (a -> b)
pl' s t a
pr' =
let AltExpr ([Symbol t]
vimp1,Parse_Alt t
vimp2,Sem_Alt t (a -> b)
vimp3) = forall (a :: * -> * -> *) t b.
(IsAltExpr a, Show t, Ord t) =>
a t b -> AltExpr t b
toAlt i t (a -> b)
pl'
SymbExpr (Symbol t
vpa1,Parse_Symb t
vpa2,Sem_Symb t a
vpa3) = forall (a :: * -> * -> *) t b.
(IsSymbExpr a, Show t, Ord t) =>
a t b -> BNF t b
mkRule s t a
pr' in forall t a. ([Symbol t], Parse_Alt t, Sem_Alt t a) -> AltExpr t a
AltExpr
([Symbol t]
vimp1forall a. [a] -> [a] -> [a]
++[Symbol t
vpa1], forall t. Ord t => Parse_Seq t -> Parse_Symb t -> Parse_Seq t
parse_seq Parse_Alt t
vimp2 Parse_Symb t
vpa2, forall t a b.
Ord t =>
CombinatorOptions
-> Sem_Alt t (a -> b) -> Sem_Symb t a -> Sem_Alt t b
sem_seq CombinatorOptions
local_opts Sem_Alt t (a -> b)
vimp3 Sem_Symb t a
vpa3)
join_lexical :: Nt -> RawParser t -> SymbExpr t [t]
join_lexical :: forall t. Nt -> RawParser t -> SymbExpr t [t]
join_lexical Nt
nt RawParser t
regex = forall t a. (Symbol t, Parse_Symb t, Sem_Symb t a) -> SymbExpr t a
SymbExpr (forall t. Nt -> Symbol t
Nt Nt
nt, forall t. Nt -> RawParser t -> Parse_Symb t
parse_lexical Nt
nt RawParser t
regex, forall t. RawParser t -> Sem_Symb t [t]
sem_slice RawParser t
regex)
join_andNot :: (Show t) => SymbExpr t a -> SymbExpr t b -> SymbExpr t a
join_andNot :: forall t a b.
Show t =>
SymbExpr t a -> SymbExpr t b -> SymbExpr t a
join_andNot (SymbExpr (Symbol t
_,Parse_Symb t
p_parser,Sem_Symb t a
p_sem)) (SymbExpr (Symbol t
_, Parse_Symb t
q_parser, Sem_Symb t b
q_sem)) =
forall t a. (Symbol t, Parse_Symb t, Sem_Symb t a) -> SymbExpr t a
SymbExpr (Symbol t
s, Parse_Symb t
parser, Sem_Symb t a
p_sem)
where parser :: Parse_Symb t
parser@(Symbol t
s, Input t -> Slot t -> Int -> Int -> ContF t -> Command t
_) = forall t. Show t => Parse_Symb t -> Parse_Symb t -> Parse_Symb t
andNot Parse_Symb t
p_parser Parse_Symb t
q_parser
class IsSymbExpr a where
toSymb :: (Show t, Ord t) => a t b -> SymbExpr t b
mkRule :: (Show t, Ord t) => a t b -> BNF t b
mkRule = forall (a :: * -> * -> *) t b.
(IsSymbExpr a, Show t, Ord t) =>
a t b -> BNF t b
toSymb
instance IsSymbExpr AltExpr where
toSymb :: forall t b. (Show t, Ord t) => AltExpr t b -> BNF t b
toSymb = forall (a :: * -> * -> *) t b.
(IsSymbExpr a, Show t, Ord t) =>
a t b -> BNF t b
toSymb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (j :: * -> * -> *) a b.
f (j a b) -> OO f j a b
OO forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])
instance IsSymbExpr SymbExpr where
toSymb :: forall t b. (Show t, Ord t) => BNF t b -> BNF t b
toSymb = forall a. a -> a
id
instance IsSymbExpr AltExprs where
toSymb :: forall t b. (Show t, Ord t) => AltExprs t b -> BNF t b
toSymb AltExprs t b
a = forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
Bool -> Bool -> String -> b t a -> SymbExpr t a
mkNtRule Bool
False Bool
False String
mkName AltExprs t b
a
where mkName :: String
mkName = String
"_" forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"|" (forall a b. (a -> b) -> [a] -> [b]
map forall {t} {a}. Show t => AltExpr t a -> String
op (forall (f :: * -> *) (j :: * -> * -> *) a b.
OO f j a b -> f (j a b)
unOO AltExprs t b
a)) forall a. [a] -> [a] -> [a]
++ String
")"
where op :: AltExpr t a -> String
op (AltExpr ([Symbol t]
rhs,Parse_Alt t
_,Sem_Alt t a
_)) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"*" (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Symbol t]
rhs) forall a. [a] -> [a] -> [a]
++ String
")"
class HasAlts a where
altsOf :: (Show t, Ord t) => a t b -> [AltExpr t b]
instance HasAlts AltExpr where
altsOf :: forall t b. (Show t, Ord t) => AltExpr t b -> [AltExpr t b]
altsOf = (forall a. a -> [a] -> [a]
:[])
instance HasAlts SymbExpr where
altsOf :: forall t b. (Show t, Ord t) => SymbExpr t b -> [AltExpr t b]
altsOf = forall (a :: * -> * -> *) t b.
(HasAlts a, Show t, Ord t) =>
a t b -> [AltExpr t b]
altsOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) t b.
(IsAltExpr a, Show t, Ord t) =>
a t b -> AltExpr t b
toAlt
instance HasAlts AltExprs where
altsOf :: forall t b. (Show t, Ord t) => AltExprs t b -> [AltExpr t b]
altsOf = forall (f :: * -> *) (j :: * -> * -> *) a b.
OO f j a b -> f (j a b)
unOO
class IsAltExpr a where
toAlt :: (Show t, Ord t) => a t b -> AltExpr t b
instance IsAltExpr AltExpr where
toAlt :: forall t b. (Show t, Ord t) => AltExpr t b -> AltExpr t b
toAlt = forall a. a -> a
id
instance IsAltExpr SymbExpr where
toAlt :: forall t b. (Show t, Ord t) => SymbExpr t b -> AltExpr t b
toAlt SymbExpr t b
p = forall t (s :: * -> * -> *) (f :: * -> *) a b.
(Show t, Ord t, IsSymbExpr s, Foldable f) =>
(a -> f b) -> s t a -> AltExpr t b
join_apply (forall a. a -> [a] -> [a]
:[]) SymbExpr t b
p
instance IsAltExpr AltExprs where
toAlt :: forall t b. (Show t, Ord t) => AltExprs t b -> AltExpr t b
toAlt = forall (a :: * -> * -> *) t b.
(IsAltExpr a, Show t, Ord t) =>
a t b -> AltExpr t b
toAlt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) t b.
(IsSymbExpr a, Show t, Ord t) =>
a t b -> BNF t b
mkRule