{-# 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 Control.Monad
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import qualified Data.Set as Set

--------------------------------------------------------------------
-- The API
--------------------------------------------------------------------

-- | Linearizes given expression as string in the language
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)

-- | The same as 'linearizeAllLang' but does not return
-- the language.
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

-- | Linearizes given expression as string in all languages
-- available in the grammar.
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)]

-- | Linearizes given expression as a bracketed string in the language
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

-- | Linearizes given expression as a bracketed string in the language
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 []]

-- | Creates a table from feature name to linearization. 
-- The outher list encodes the variations
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"

--------------------------------------------------------------------
-- Implementation
--------------------------------------------------------------------

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
"]")  -- fun without lin
      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 = []

--amapWithIndex :: (IArray a e1, IArray a e2, Ix i) => (i -> e1 -> e2) -> a i e1 -> a i e2
--amapWithIndex f arr = listArray (bounds arr) (map (uncurry f) (assocs arr))