{-# LANGUAGE FlexibleContexts #-}
module PGF.Linearize
( linearize
, linearizeAll
, linearizeAllLang
, bracketedLinearize
, bracketedLinearizeAll
, tabularLinearizes
) where
import PGF.CId
import PGF.Data
import PGF.Macros
import PGF.Expr
import Data.Array.IArray
import Data.List
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import qualified Data.Set as Set
linearize :: PGF -> Language -> Tree -> String
linearize :: PGF -> Language -> Tree -> String
linearize PGF
pgf Language
lang = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (Tree -> [String]) -> Tree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String]) -> (Tree -> [String]) -> Tree -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> String)
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
-> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unwords ([String] -> String)
-> (((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [String])
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BracketedString -> [String]) -> [BracketedString] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BracketedString -> [String]
flattenBracketedString ([BracketedString] -> [String])
-> (((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [BracketedString])
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String, [BracketedString]) -> [BracketedString]
forall a b. (a, b) -> b
snd ((Maybe String, [BracketedString]) -> [BracketedString])
-> (((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> (Maybe String, [BracketedString]))
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [BracketedString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String
-> [BracketedTokn] -> (Maybe String, [BracketedString])
untokn Maybe String
forall a. Maybe a
Nothing ([BracketedTokn] -> (Maybe String, [BracketedString]))
-> (((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [BracketedTokn])
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> (Maybe String, [BracketedString])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Concr
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [BracketedTokn]
firstLin Concr
cnc) ([((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
-> [String])
-> (Tree
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))])
-> Tree
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF
-> Concr
-> Tree
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
linTree PGF
pgf Concr
cnc
where
cnc :: Concr
cnc = Concr -> Language -> Map Language Concr -> Concr
forall i a. Ord i => a -> i -> Map i a -> a
lookMap (String -> Concr
forall a. HasCallStack => String -> a
error String
"no lang") Language
lang (PGF -> Map Language Concr
concretes PGF
pgf)
linearizeAll :: PGF -> Tree -> [String]
linearizeAll :: PGF -> Tree -> [String]
linearizeAll PGF
pgf = ((Language, String) -> String) -> [(Language, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Language, String) -> String
forall a b. (a, b) -> b
snd ([(Language, String)] -> [String])
-> (Tree -> [(Language, String)]) -> Tree -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> Tree -> [(Language, String)]
linearizeAllLang PGF
pgf
linearizeAllLang :: PGF -> Tree -> [(Language,String)]
linearizeAllLang :: PGF -> Tree -> [(Language, String)]
linearizeAllLang PGF
pgf Tree
t = [(Language
lang,PGF -> Language -> Tree -> String
linearize PGF
pgf Language
lang Tree
t) | Language
lang <- Map Language Concr -> [Language]
forall k a. Map k a -> [k]
Map.keys (PGF -> Map Language Concr
concretes PGF
pgf)]
bracketedLinearize :: PGF -> Language -> Tree -> [BracketedString]
bracketedLinearize :: PGF -> Language -> Tree -> [BracketedString]
bracketedLinearize PGF
pgf Language
lang = [[BracketedString]] -> [BracketedString]
forall a. [[a]] -> [a]
head ([[BracketedString]] -> [BracketedString])
-> (Tree -> [[BracketedString]]) -> Tree -> [BracketedString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [BracketedString])
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
-> [[BracketedString]]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe String, [BracketedString]) -> [BracketedString]
forall a b. (a, b) -> b
snd ((Maybe String, [BracketedString]) -> [BracketedString])
-> (((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> (Maybe String, [BracketedString]))
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [BracketedString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String
-> [BracketedTokn] -> (Maybe String, [BracketedString])
untokn Maybe String
forall a. Maybe a
Nothing ([BracketedTokn] -> (Maybe String, [BracketedString]))
-> (((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [BracketedTokn])
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> (Maybe String, [BracketedString])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Concr
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [BracketedTokn]
firstLin Concr
cnc) ([((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
-> [[BracketedString]])
-> (Tree
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))])
-> Tree
-> [[BracketedString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF
-> Concr
-> Tree
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
linTree PGF
pgf Concr
cnc
where
cnc :: Concr
cnc = Concr -> Language -> Map Language Concr -> Concr
forall i a. Ord i => a -> i -> Map i a -> a
lookMap (String -> Concr
forall a. HasCallStack => String -> a
error String
"no lang") Language
lang (PGF -> Map Language Concr
concretes PGF
pgf)
head :: [[a]] -> [a]
head [] = []
head ([a]
bs:[[a]]
bss) = [a]
bs
bracketedLinearizeAll :: PGF -> Language -> Tree -> [[BracketedString]]
bracketedLinearizeAll :: PGF -> Language -> Tree -> [[BracketedString]]
bracketedLinearizeAll PGF
pgf Language
lang = (((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [BracketedString])
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
-> [[BracketedString]]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe String, [BracketedString]) -> [BracketedString]
forall a b. (a, b) -> b
snd ((Maybe String, [BracketedString]) -> [BracketedString])
-> (((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> (Maybe String, [BracketedString]))
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [BracketedString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String
-> [BracketedTokn] -> (Maybe String, [BracketedString])
untokn Maybe String
forall a. Maybe a
Nothing ([BracketedTokn] -> (Maybe String, [BracketedString]))
-> (((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [BracketedTokn])
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> (Maybe String, [BracketedString])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Concr
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [BracketedTokn]
firstLin Concr
cnc) ([((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
-> [[BracketedString]])
-> (Tree
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))])
-> Tree
-> [[BracketedString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF
-> Concr
-> Tree
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
linTree PGF
pgf Concr
cnc
where
cnc :: Concr
cnc = Concr -> Language -> Map Language Concr -> Concr
forall i a. Ord i => a -> i -> Map i a -> a
lookMap (String -> Concr
forall a. HasCallStack => String -> a
error String
"no lang") Language
lang (PGF -> Map Language Concr
concretes PGF
pgf)
firstLin :: Concr
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [BracketedTokn]
firstLin Concr
cnc arg :: ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
arg@(ct :: (Language, Int)
ct@(Language
cat,Int
n_fid),Int
fid,Language
fun,[Tree]
es,([Language]
xs,Array Int [BracketedTokn]
lin)) =
case Int -> IntMap [Int] -> Maybe [Int]
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
fid (Concr -> IntMap [Int]
linrefs Concr
cnc) of
Just (Int
funid:[Int]
_) -> ([Language], Array Int [BracketedTokn])
-> Array Int [BracketedTokn]
forall a b. (a, b) -> b
snd (Concr
-> ((Language, Int) -> Bool)
-> [Language]
-> Int
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
-> ([Language], Array Int [BracketedTokn])
mkLinTable Concr
cnc (Bool -> (Language, Int) -> Bool
forall a b. a -> b -> a
const Bool
True) [] Int
funid [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
arg]) Array Int [BracketedTokn] -> Int -> [BracketedTokn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
0
Maybe [Int]
_ -> [String -> BracketedTokn
LeafKS []]
tabularLinearizes :: PGF -> Language -> Expr -> [[(String,String)]]
tabularLinearizes :: PGF -> Language -> Tree -> [[(String, String)]]
tabularLinearizes PGF
pgf Language
lang Tree
e = (((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [(String, String)])
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
-> [[(String, String)]]
forall a b. (a -> b) -> [a] -> [b]
map ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [(String, String)]
forall (a :: * -> * -> *) i b b c d a.
(IArray a [BracketedTokn], Ix i) =>
((Language, b), b, c, d, (a, a i [BracketedTokn]))
-> [(String, String)]
cnv (PGF
-> Concr
-> Tree
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
linTree PGF
pgf Concr
cnc Tree
e)
where
cnc :: Concr
cnc = Concr -> Language -> Map Language Concr -> Concr
forall i a. Ord i => a -> i -> Map i a -> a
lookMap (String -> Concr
forall a. HasCallStack => String -> a
error String
"no lang") Language
lang (PGF -> Map Language Concr
concretes PGF
pgf)
cnv :: ((Language, b), b, c, d, (a, a i [BracketedTokn]))
-> [(String, String)]
cnv (ct :: (Language, b)
ct@(Language
cat,b
_),b
_,c
_,d
_,(a
_,a i [BracketedTokn]
lin)) = [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Language -> [String]
lbls Language
cat) ([String] -> [(String, String)]) -> [String] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ ([BracketedTokn] -> String) -> [[BracketedTokn]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unwords ([String] -> String)
-> ([BracketedTokn] -> [String]) -> [BracketedTokn] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BracketedString -> [String]) -> [BracketedString] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BracketedString -> [String]
flattenBracketedString ([BracketedString] -> [String])
-> ([BracketedTokn] -> [BracketedString])
-> [BracketedTokn]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String, [BracketedString]) -> [BracketedString]
forall a b. (a, b) -> b
snd ((Maybe String, [BracketedString]) -> [BracketedString])
-> ([BracketedTokn] -> (Maybe String, [BracketedString]))
-> [BracketedTokn]
-> [BracketedString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String
-> [BracketedTokn] -> (Maybe String, [BracketedString])
untokn Maybe String
forall a. Maybe a
Nothing) (a i [BracketedTokn] -> [[BracketedTokn]]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems a i [BracketedTokn]
lin)
lbls :: Language -> [String]
lbls Language
cat = case Language -> Map Language CncCat -> Maybe CncCat
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
cat (Concr -> Map Language CncCat
cnccats (PGF -> Language -> Concr
lookConcr PGF
pgf Language
lang)) of
Just (CncCat Int
_ Int
_ Array Int String
lbls) -> Array Int String -> [String]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems Array Int String
lbls
Maybe CncCat
Nothing -> String -> [String]
forall a. HasCallStack => String -> a
error String
"No labels"
linTree :: PGF -> Concr -> Expr -> [(CncType, FId, CId, [Expr], LinTable)]
linTree :: PGF
-> Concr
-> Tree
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
linTree PGF
pgf Concr
cnc Tree
e = [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
forall a. Eq a => [a] -> [a]
nub (((Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
forall a b. (a -> b) -> [a] -> [b]
map (Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))
-> ((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
forall a b. (a, b) -> b
snd (Maybe (Language, Int)
-> Int
-> Tree
-> [Language]
-> [Language]
-> Tree
-> [Tree]
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
lin Maybe (Language, Int)
forall a. Maybe a
Nothing Int
0 Tree
e [] [] Tree
e []))
where
lp :: Map Language (IntMap (Set Production))
lp = Concr -> Map Language (IntMap (Set Production))
lproductions Concr
cnc
lin :: Maybe (Language, Int)
-> Int
-> Tree
-> [Language]
-> [Language]
-> Tree
-> [Tree]
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
lin Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs (EAbs BindType
_ Language
x Tree
e) [Tree]
es = Maybe (Language, Int)
-> Int
-> Tree
-> [Language]
-> [Language]
-> Tree
-> [Tree]
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
lin Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys (Language
xLanguage -> [Language] -> [Language]
forall a. a -> [a] -> [a]
:[Language]
xs) Tree
e [Tree]
es
lin Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs (EApp Tree
e1 Tree
e2) [Tree]
es = Maybe (Language, Int)
-> Int
-> Tree
-> [Language]
-> [Language]
-> Tree
-> [Tree]
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
lin Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs Tree
e1 (Tree
e2Tree -> [Tree] -> [Tree]
forall a. a -> [a] -> [a]
:[Tree]
es)
lin Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs (EImplArg Tree
e) [Tree]
es = Maybe (Language, Int)
-> Int
-> Tree
-> [Language]
-> [Language]
-> Tree
-> [Tree]
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
lin Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs Tree
e [Tree]
es
lin Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs (ETyped Tree
e Type
_) [Tree]
es = Maybe (Language, Int)
-> Int
-> Tree
-> [Language]
-> [Language]
-> Tree
-> [Tree]
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
lin Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs Tree
e [Tree]
es
lin Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs (EFun Language
f) [Tree]
es = Maybe (Language, Int)
-> Int
-> Tree
-> [Language]
-> [Language]
-> Language
-> [Tree]
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
apply Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs Language
f [Tree]
es
lin Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs (EMeta Int
i) [Tree]
es = Maybe (Language, Int)
-> Int
-> Tree
-> [Language]
-> [Language]
-> String
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
forall a t.
Maybe (a, Int)
-> Int
-> Tree
-> t
-> [Language]
-> String
-> [(Int,
((a, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
def Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs (Char
'?'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show Int
i)
lin Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs (EVar Int
i) [Tree]
_ = Maybe (Language, Int)
-> Int
-> Tree
-> [Language]
-> [Language]
-> String
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
forall a t.
Maybe (a, Int)
-> Int
-> Tree
-> t
-> [Language]
-> String
-> [(Int,
((a, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
def Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs (Language -> String
showCId (([Language]
xs[Language] -> [Language] -> [Language]
forall a. [a] -> [a] -> [a]
++[Language]
ys) [Language] -> Int -> Language
forall a. [a] -> Int -> a
!! Int
i))
lin Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs (ELit Literal
l) [] = case Literal
l of
LStr String
s -> (Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n_fidInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,((Language
cidString,Int
n_fid),Int
fidString,Language
wildCId,[Tree
e0],([],String -> Array Int [BracketedTokn]
forall (a :: * -> * -> *) i.
(IArray a [BracketedTokn], Ix i, Num i) =>
String -> a i [BracketedTokn]
ss String
s)))
LInt Int
n -> (Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n_fidInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,((Language
cidInt, Int
n_fid),Int
fidInt, Language
wildCId,[Tree
e0],([],String -> Array Int [BracketedTokn]
forall (a :: * -> * -> *) i.
(IArray a [BracketedTokn], Ix i, Num i) =>
String -> a i [BracketedTokn]
ss (Int -> String
forall a. Show a => a -> String
show Int
n))))
LFlt Double
f -> (Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n_fidInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,((Language
cidFloat, Int
n_fid),Int
fidFloat, Language
wildCId,[Tree
e0],([],String -> Array Int [BracketedTokn]
forall (a :: * -> * -> *) i.
(IArray a [BracketedTokn], Ix i, Num i) =>
String -> a i [BracketedTokn]
ss (Double -> String
forall a. Show a => a -> String
show Double
f))))
ss :: String -> a i [BracketedTokn]
ss String
s = (i, i) -> [[BracketedTokn]] -> a i [BracketedTokn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i
0,i
0) [[String -> BracketedTokn
LeafKS String
s]]
apply :: Maybe CncType -> FId -> Expr -> [CId] -> [CId] -> CId -> [Expr] -> [(FId,(CncType, FId, CId, [Expr], LinTable))]
apply :: Maybe (Language, Int)
-> Int
-> Tree
-> [Language]
-> [Language]
-> Language
-> [Tree]
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
apply Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs Language
f [Tree]
es =
case Language
-> Map Language (IntMap (Set Production))
-> Maybe (IntMap (Set Production))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
f Map Language (IntMap (Set Production))
lp of
Just IntMap (Set Production)
prods -> do (Int
funid,(Language
cat,Int
fid),[(Language, Int)]
ctys) <- IntMap (Set Production)
-> [(Int, (Language, Int), [(Language, Int)])]
getApps IntMap (Set Production)
prods
(Int
n_fid,[((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
args) <- Int
-> [((Language, Int), Tree)]
-> [(Int,
[((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))])]
descend Int
n_fid ([(Language, Int)] -> [Tree] -> [((Language, Int), Tree)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Language, Int)]
ctys [Tree]
es)
(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n_fidInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,((Language
cat,Int
n_fid),Int
fid,Language
f,[Tree
e0],Concr
-> ((Language, Int) -> Bool)
-> [Language]
-> Int
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
-> ([Language], Array Int [BracketedTokn])
mkLinTable Concr
cnc (Bool -> (Language, Int) -> Bool
forall a b. a -> b -> a
const Bool
True) [Language]
xs Int
funid [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
args))
Maybe (IntMap (Set Production))
Nothing -> Maybe (Language, Int)
-> Int
-> Tree
-> [Language]
-> [Language]
-> String
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
forall a t.
Maybe (a, Int)
-> Int
-> Tree
-> t
-> [Language]
-> String
-> [(Int,
((a, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
def Maybe (Language, Int)
mb_cty Int
n_fid Tree
e0 [Language]
ys [Language]
xs (String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Language -> String
showCId Language
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]")
where
getApps :: IntMap (Set Production)
-> [(Int, (Language, Int), [(Language, Int)])]
getApps IntMap (Set Production)
prods =
case Maybe (Language, Int)
mb_cty of
Just (Language
cat,Int
fid) -> [(Int, (Language, Int), [(Language, Int)])]
-> (Set Production -> [(Int, (Language, Int), [(Language, Int)])])
-> Maybe (Set Production)
-> [(Int, (Language, Int), [(Language, Int)])]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Production -> [(Int, (Language, Int), [(Language, Int)])])
-> [Production] -> [(Int, (Language, Int), [(Language, Int)])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Production -> [(Int, (Language, Int), [(Language, Int)])]
toApp Int
fid) ([Production] -> [(Int, (Language, Int), [(Language, Int)])])
-> (Set Production -> [Production])
-> Set Production
-> [(Int, (Language, Int), [(Language, Int)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Production -> [Production]
forall a. Set a -> [a]
Set.toList) (Int -> IntMap (Set Production) -> Maybe (Set Production)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
fid IntMap (Set Production)
prods)
Maybe (Language, Int)
Nothing -> [[(Int, (Language, Int), [(Language, Int)])]]
-> [(Int, (Language, Int), [(Language, Int)])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> Production -> [(Int, (Language, Int), [(Language, Int)])]
toApp Int
fid Production
prod | (Int
fid,Set Production
set) <- IntMap (Set Production) -> [(Int, Set Production)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap (Set Production)
prods, Production
prod <- Set Production -> [Production]
forall a. Set a -> [a]
Set.toList Set Production
set]
where
toApp :: Int -> Production -> [(Int, (Language, Int), [(Language, Int)])]
toApp Int
fid (PApply Int
funid [PArg]
pargs) =
let Just (Type
ty,Int
_,Maybe ([Equation], [[Instr]])
_,Double
_) = Language
-> Map Language (Type, Int, Maybe ([Equation], [[Instr]]), Double)
-> Maybe (Type, Int, Maybe ([Equation], [[Instr]]), Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
f (Abstr
-> Map Language (Type, Int, Maybe ([Equation], [[Instr]]), Double)
funs (PGF -> Abstr
abstract PGF
pgf))
([Language]
args,Language
res) = Type -> ([Language], Language)
catSkeleton Type
ty
in [(Int
funid,(Language
res,Int
fid),[Language] -> [Int] -> [(Language, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Language]
args [Int
fid | PArg [(Int, Int)]
_ Int
fid <- [PArg]
pargs])]
toApp Int
_ (PCoerce Int
fid) =
[(Int, (Language, Int), [(Language, Int)])]
-> (Set Production -> [(Int, (Language, Int), [(Language, Int)])])
-> Maybe (Set Production)
-> [(Int, (Language, Int), [(Language, Int)])]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Production -> [(Int, (Language, Int), [(Language, Int)])])
-> [Production] -> [(Int, (Language, Int), [(Language, Int)])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Production -> [(Int, (Language, Int), [(Language, Int)])]
toApp Int
fid) ([Production] -> [(Int, (Language, Int), [(Language, Int)])])
-> (Set Production -> [Production])
-> Set Production
-> [(Int, (Language, Int), [(Language, Int)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Production -> [Production]
forall a. Set a -> [a]
Set.toList) (Int -> IntMap (Set Production) -> Maybe (Set Production)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
fid IntMap (Set Production)
prods)
descend :: Int
-> [((Language, Int), Tree)]
-> [(Int,
[((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))])]
descend Int
n_fid [] = (Int,
[((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))])
-> [(Int,
[((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))])]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n_fid,[])
descend Int
n_fid (((Language, Int)
cty,Tree
e):[((Language, Int), Tree)]
fes) = do (Int
n_fid,((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
arg) <- Maybe (Language, Int)
-> Int
-> Tree
-> [Language]
-> [Language]
-> Tree
-> [Tree]
-> [(Int,
((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
lin ((Language, Int) -> Maybe (Language, Int)
forall a. a -> Maybe a
Just (Language, Int)
cty) Int
n_fid Tree
e ([Language]
xs[Language] -> [Language] -> [Language]
forall a. [a] -> [a] -> [a]
++[Language]
ys) [] Tree
e []
(Int
n_fid,[((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
args) <- Int
-> [((Language, Int), Tree)]
-> [(Int,
[((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))])]
descend Int
n_fid [((Language, Int), Tree)]
fes
(Int,
[((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))])
-> [(Int,
[((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))])]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n_fid,((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
arg((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
forall a. a -> [a] -> [a]
:[((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
args)
def :: Maybe (a, Int)
-> Int
-> Tree
-> t
-> [Language]
-> String
-> [(Int,
((a, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
def (Just (a
cat,Int
fid)) Int
n_fid Tree
e0 t
ys [Language]
xs String
s =
case Int -> IntMap [Int] -> Maybe [Int]
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
fid (Concr -> IntMap [Int]
lindefs Concr
cnc) of
Just [Int]
funs -> do Int
funid <- [Int]
funs
let args :: [((Language, Int), Int, Language, [Tree],
([a], Array Int [BracketedTokn]))]
args = [((Language
wildCId, Int
n_fid),Int
fidString,Language
wildCId,[Tree
e0],([],String -> Array Int [BracketedTokn]
forall (a :: * -> * -> *) i.
(IArray a [BracketedTokn], Ix i, Num i) =>
String -> a i [BracketedTokn]
ss String
s))]
(Int,
((a, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))
-> [(Int,
((a, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n_fidInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2,((a
cat,Int
n_fidInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1),Int
fid,Language
wildCId,[Tree
e0],Concr
-> ((Language, Int) -> Bool)
-> [Language]
-> Int
-> [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
-> ([Language], Array Int [BracketedTokn])
mkLinTable Concr
cnc (Bool -> (Language, Int) -> Bool
forall a b. a -> b -> a
const Bool
True) [Language]
xs Int
funid [((Language, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn]))]
forall a.
[((Language, Int), Int, Language, [Tree],
([a], Array Int [BracketedTokn]))]
args))
Maybe [Int]
Nothing
| Int -> Bool
isPredefFId Int
fid -> (Int,
((a, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))
-> [(Int,
((a, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n_fidInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2,((a
cat,Int
n_fidInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1),Int
fid,Language
wildCId,[Tree
e0],([Language]
xs,(Int, Int) -> [[BracketedTokn]] -> Array Int [BracketedTokn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
0) [[String -> BracketedTokn
LeafKS String
s]])))
| Bool
otherwise -> do PCoerce Int
fid <- [Production]
-> (Set Production -> [Production])
-> Maybe (Set Production)
-> [Production]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Set Production -> [Production]
forall a. Set a -> [a]
Set.toList (Int -> IntMap (Set Production) -> Maybe (Set Production)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
fid (Concr -> IntMap (Set Production)
pproductions Concr
cnc))
Maybe (a, Int)
-> Int
-> Tree
-> t
-> [Language]
-> String
-> [(Int,
((a, Int), Int, Language, [Tree],
([Language], Array Int [BracketedTokn])))]
def ((a, Int) -> Maybe (a, Int)
forall a. a -> Maybe a
Just (a
cat,Int
fid)) Int
n_fid Tree
e0 t
ys [Language]
xs String
s
def Maybe (a, Int)
Nothing Int
n_fid Tree
e0 t
ys [Language]
xs String
s = []