{-# LANGUAGE BangPatterns #-}
-------------------------------------------------
-- |
-- Module      : PGF
-- Maintainer  : Krasimir Angelov
-- Stability   : stable
-- Portability : portable
--
-- This module is an Application Programming Interface to 
-- load and interpret grammars compiled in Portable Grammar Format (PGF).
-- The PGF format is produced as a final output from the GF compiler.
-- The API is meant to be used for embedding GF grammars in Haskell 
-- programs
-------------------------------------------------

module PGF(
           -- * PGF
           PGF,
           readPGF,
           parsePGF,

           -- * Identifiers
           CId, mkCId, wildCId,
           showCId, readCId,
           -- extra
           ppCId, pIdent, utf8CId,

           -- * Languages
           Language, 
           showLanguage, readLanguage,
           languages, abstractName, languageCode,

           -- * Types
           Type, Hypo,
           showType, readType,
           mkType, mkHypo, mkDepHypo, mkImplHypo,
           unType,
           categories, categoryContext, startCat,

           -- * Functions
           functions, functionsByCat, functionType, missingLins,

           -- * Expressions & Trees
           -- ** Tree
           Tree,

           -- ** Expr
           Expr,
           showExpr, readExpr,
           mkAbs,    unAbs,
           mkApp,    unApp, unapply,
           mkStr,    unStr,
           mkInt,    unInt,
           mkDouble, unDouble,
           mkFloat,  unFloat,
           mkMeta,   unMeta,
           -- extra
           pExpr, exprSize, exprFunctions,

           -- * Operations
           -- ** Linearization
           linearize, linearizeAllLang, linearizeAll, bracketedLinearize, bracketedLinearizeAll, tabularLinearizes,
           groupResults, -- lins of trees by language, removing duplicates
           showPrintName,
           
           BracketedString(..), FId, LIndex, Token,
           Forest.showBracketedString,flattenBracketedString,

           -- ** Parsing
           parse, parseAllLang, parseAll, parse_, parseWithRecovery, complete,

           -- ** Evaluation
           PGF.compute, paraphrase,

           -- ** Type Checking
           -- | The type checker in PGF does both type checking and renaming
           -- i.e. it verifies that all identifiers are declared and it
           -- distinguishes between global function or type indentifiers and
           -- variable names. The type checker should always be applied on
           -- expressions entered by the user i.e. those produced via functions
           -- like 'readType' and 'readExpr' because otherwise unexpected results
           -- could appear. All typechecking functions returns updated versions
           -- of the input types or expressions because the typechecking could
           -- also lead to metavariables instantiations.
           checkType, checkExpr, inferExpr,
           TcError(..), ppTcError,

           -- ** Low level parsing API
           Parse.ParseState,
           Parse.initState, Parse.nextState, Parse.getCompletions, Parse.recoveryStates, 
           Parse.ParseInput(..),  Parse.simpleParseInput, Parse.mkParseInput,
           Parse.ParseOutput(..), Parse.getParseOutput,
           Parse.getContinuationInfo,

           -- ** Generation
           -- | The PGF interpreter allows automatic generation of
           -- abstract syntax expressions of a given type. Since the
           -- type system of GF allows dependent types, the generation
           -- is in general undecidable. In fact, the set of all type
           -- signatures in the grammar is equivalent to a Turing-complete language (Prolog).
           --
           -- There are several generation methods which mainly differ in:
           --
           --     * whether the expressions are sequentially or randomly generated?
           --
           --     * are they generated from a template? The template is an expression
           --     containing meta variables which the generator will fill in.
           --
           --     * is there a limit of the depth of the expression?
           --     The depth can be used to limit the search space, which 
           --     in some cases is the only way to make the search decidable.
           generateAll,         generateAllDepth,
           generateFrom,        generateFromDepth,
           generateRandom,      generateRandomDepth,
           generateRandomFrom,  generateRandomFromDepth,

           -- ** Morphological Analysis
           Lemma, Analysis, Morpho,
           lookupMorpho, buildMorpho, fullFormLexicon,
           morphoMissing,
           -- extra:
           morphoKnown, isInMorpho,

           -- ** Visualizations
           graphvizAbstractTree,
           graphvizParseTree,
           graphvizParseTreeDep,
           graphvizDependencyTree,
           graphvizBracketedString,
           graphvizAlignment,
           gizaAlignment,
           GraphvizOptions(..),
           graphvizDefaults,
           conlls2latexDoc,
           -- extra:
           Labels, getDepLabels,
           CncLabels, getCncDepLabels,
 
           -- * Probabilities
           Probabilities,
           mkProbabilities,
           defaultProbabilities,
           showProbabilities,
           readProbabilitiesFromFile,
           -- extra:
           probTree, setProbabilities, rankTreesByProbs,
           
           -- -- ** SortTop
--         forExample,

           -- * Browsing
           browse,
           -- * Tries
           ATree(..),Trie(..),toATree,toTrie
          ) where

import PGF.CId
import PGF.Linearize
--import PGF.SortTop
import PGF.Generate
import PGF.TypeCheck
import PGF.Paraphrase
import PGF.VisualizeTree
import PGF.Probabilistic
import PGF.Macros
import PGF.Expr (Tree)
import PGF.Morphology
import PGF.Data
import PGF.Binary ()
import qualified PGF.Forest as Forest
import qualified PGF.Parse as Parse
import PGF.Utilities(replace)

--import Data.Char
import qualified Data.Map as Map
--import qualified Data.IntMap as IntMap
--import Data.Maybe
import Data.Binary
import Data.ByteString.Lazy (ByteString)
import Data.List(mapAccumL)
--import System.Random (newStdGen)
--import Control.Monad
import Text.PrettyPrint

---------------------------------------------------
-- Interface
---------------------------------------------------

-- | Reads file in Portable Grammar Format and produces
-- 'PGF' structure. The file is usually produced with:
--
-- > $ gf -make <grammar file name>
readPGF  :: FilePath -> IO PGF

-- | Like @readPGF@ but you have the manage file-handling.
--
-- @since 3.9.1
parsePGF :: ByteString -> PGF

-- | Tries to parse the given string in the specified language
-- and to produce abstract syntax expression.
parse        :: PGF -> Language -> Type -> String -> [Tree]

-- | The same as 'parseAllLang' but does not return
-- the language.
parseAll     :: PGF -> Type -> String -> [[Tree]]

-- | Tries to parse the given string with all available languages.
-- The returned list contains pairs of language
-- and list of abstract syntax expressions 
-- (this is a list, since grammars can be ambiguous). 
-- Only those languages
-- for which at least one parsing is possible are listed.
parseAllLang :: PGF -> Type -> String -> [(Language,[Tree])]

-- | The same as 'parse' but returns more detailed information
parse_       :: PGF -> Language -> Type -> Maybe Int -> String -> (Parse.ParseOutput,BracketedString)

-- | This is an experimental function. Use it on your own risk
parseWithRecovery :: PGF -> Language -> Type -> [Type] -> Maybe Int -> String -> (Parse.ParseOutput,BracketedString)

-- | List of all languages available in the given grammar.
languages    :: PGF -> [Language]

-- | Gets the RFC 4646 language tag 
-- of the language which the given concrete syntax implements,
-- if this is listed in the source grammar.
-- Example language tags include @\"en\"@ for English,
-- and @\"en-UK\"@ for British English.
languageCode :: PGF -> Language -> Maybe String

-- | The abstract language name is the name of the top-level
-- abstract module
abstractName :: PGF -> Language

-- | List of all categories defined in the given grammar.
-- The categories are defined in the abstract syntax
-- with the \'cat\' keyword.
categories :: PGF -> [CId]

categoryContext :: PGF -> CId -> Maybe [Hypo]

-- | The start category is defined in the grammar with
-- the \'startcat\' flag. This is usually the sentence category
-- but it is not necessary. Despite that there is a start category
-- defined you can parse with any category. The start category
-- definition is just for convenience.
startCat   :: PGF -> Type

-- | List of all functions defined in the abstract syntax
functions :: PGF -> [CId]

-- | List of all functions defined for a given category
functionsByCat :: PGF -> CId -> [CId]

-- | The type of a given function
functionType :: PGF -> CId -> Maybe Type


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

readPGF :: FilePath -> IO PGF
readPGF = FilePath -> IO PGF
forall a. Binary a => FilePath -> IO a
decodeFile

parsePGF :: ByteString -> PGF
parsePGF = ByteString -> PGF
forall a. Binary a => ByteString -> a
decode

parse :: PGF -> Language -> Type -> FilePath -> [Tree]
parse PGF
pgf Language
lang Type
typ FilePath
s =
  case PGF
-> Language
-> Type
-> Maybe Int
-> FilePath
-> (ParseOutput, BracketedString)
parse_ PGF
pgf Language
lang Type
typ (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) FilePath
s of
    (Parse.ParseOk [Tree]
ts,BracketedString
_) -> [Tree]
ts
    (ParseOutput, BracketedString)
_                    -> []

parseAll :: PGF -> Type -> FilePath -> [[Tree]]
parseAll PGF
mgr Type
typ = ((Language, [Tree]) -> [Tree]) -> [(Language, [Tree])] -> [[Tree]]
forall a b. (a -> b) -> [a] -> [b]
map (Language, [Tree]) -> [Tree]
forall a b. (a, b) -> b
snd ([(Language, [Tree])] -> [[Tree]])
-> (FilePath -> [(Language, [Tree])]) -> FilePath -> [[Tree]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> Type -> FilePath -> [(Language, [Tree])]
parseAllLang PGF
mgr Type
typ

parseAllLang :: PGF -> Type -> FilePath -> [(Language, [Tree])]
parseAllLang PGF
mgr Type
typ FilePath
s = 
  [(Language
lang,[Tree]
ts) | Language
lang <- PGF -> [Language]
languages PGF
mgr, (Parse.ParseOk [Tree]
ts,BracketedString
_) <- [PGF
-> Language
-> Type
-> Maybe Int
-> FilePath
-> (ParseOutput, BracketedString)
parse_ PGF
mgr Language
lang Type
typ (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) FilePath
s]]

parse_ :: PGF
-> Language
-> Type
-> Maybe Int
-> FilePath
-> (ParseOutput, BracketedString)
parse_ PGF
pgf Language
lang Type
typ Maybe Int
dp FilePath
s = 
  case Language -> Map Language Concr -> Maybe Concr
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
lang (PGF -> Map Language Concr
concretes PGF
pgf) of
    Just Concr
cnc -> PGF
-> Language
-> Type
-> Maybe Int
-> [FilePath]
-> (ParseOutput, BracketedString)
Parse.parse PGF
pgf Language
lang Type
typ Maybe Int
dp (FilePath -> [FilePath]
words FilePath
s)
    Maybe Concr
Nothing  -> FilePath -> (ParseOutput, BracketedString)
forall a. HasCallStack => FilePath -> a
error (FilePath
"Unknown language: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Language -> FilePath
showCId Language
lang)

parseWithRecovery :: PGF
-> Language
-> Type
-> [Type]
-> Maybe Int
-> FilePath
-> (ParseOutput, BracketedString)
parseWithRecovery PGF
pgf Language
lang Type
typ [Type]
open_typs Maybe Int
dp FilePath
s = PGF
-> Language
-> Type
-> [Type]
-> Maybe Int
-> [FilePath]
-> (ParseOutput, BracketedString)
Parse.parseWithRecovery PGF
pgf Language
lang Type
typ [Type]
open_typs Maybe Int
dp (FilePath -> [FilePath]
words FilePath
s)

complete :: PGF -> Language -> Type -> String -> String -> (BracketedString,String,Map.Map Token [CId])
complete :: PGF
-> Language
-> Type
-> FilePath
-> FilePath
-> (BracketedString, FilePath, Map FilePath [Language])
complete PGF
pgf Language
from Type
typ FilePath
input FilePath
prefix =
  let ws :: [FilePath]
ws  = FilePath -> [FilePath]
words FilePath
input
      ps0 :: ParseState
ps0 = PGF -> Language -> Type -> ParseState
Parse.initState PGF
pgf Language
from Type
typ
      (ParseState
ps,[FilePath]
ws') = ParseState -> [FilePath] -> (ParseState, [FilePath])
loop ParseState
ps0 [FilePath]
ws
      bs :: BracketedString
bs       = (ParseOutput, BracketedString) -> BracketedString
forall a b. (a, b) -> b
snd (ParseState -> Type -> Maybe Int -> (ParseOutput, BracketedString)
Parse.getParseOutput ParseState
ps Type
typ Maybe Int
forall a. Maybe a
Nothing)
  in if Bool -> Bool
not ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
ws')
       then (BracketedString
bs, [FilePath] -> FilePath
unwords (if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
prefix then [FilePath]
ws' else [FilePath]
ws'[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++[FilePath
prefix]), Map FilePath [Language]
forall k a. Map k a
Map.empty)
       else (BracketedString
bs, FilePath
prefix, (ParseState -> [Language])
-> Map FilePath ParseState -> Map FilePath [Language]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseState -> [Language]
getFuns (ParseState -> FilePath -> Map FilePath ParseState
Parse.getCompletions ParseState
ps FilePath
prefix))
  where
    loop :: ParseState -> [FilePath] -> (ParseState, [FilePath])
loop ParseState
ps []     = (ParseState
ps,[])
    loop ParseState
ps (FilePath
w:[FilePath]
ws) = case ParseState -> ParseInput -> Either ErrorState ParseState
Parse.nextState ParseState
ps (FilePath -> ParseInput
Parse.simpleParseInput FilePath
w) of
                       Left  ErrorState
es -> (ParseState
ps,FilePath
wFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
ws)
                       Right ParseState
ps -> ParseState -> [FilePath] -> (ParseState, [FilePath])
loop ParseState
ps [FilePath]
ws

    getFuns :: ParseState -> [Language]
getFuns ParseState
ps = [Language
cid | (Int
funid,Language
cid,FilePath
seq) <- ([FilePath], [(Int, Language, FilePath)])
-> [(Int, Language, FilePath)]
forall a b. (a, b) -> b
snd (([FilePath], [(Int, Language, FilePath)])
 -> [(Int, Language, FilePath)])
-> ([([FilePath], [(Int, Language, FilePath)])]
    -> ([FilePath], [(Int, Language, FilePath)]))
-> [([FilePath], [(Int, Language, FilePath)])]
-> [(Int, Language, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([FilePath], [(Int, Language, FilePath)])]
-> ([FilePath], [(Int, Language, FilePath)])
forall a. [a] -> a
head ([([FilePath], [(Int, Language, FilePath)])]
 -> [(Int, Language, FilePath)])
-> [([FilePath], [(Int, Language, FilePath)])]
-> [(Int, Language, FilePath)]
forall a b. (a -> b) -> a -> b
$ Map [FilePath] [(Int, Language, FilePath)]
-> [([FilePath], [(Int, Language, FilePath)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map [FilePath] [(Int, Language, FilePath)]
contInfo]
      where
        contInfo :: Map [FilePath] [(Int, Language, FilePath)]
contInfo = ParseState -> Map [FilePath] [(Int, Language, FilePath)]
Parse.getContinuationInfo ParseState
ps

groupResults :: [[(Language,String)]] -> [(Language,[String])]
groupResults :: [[(Language, FilePath)]] -> [(Language, [FilePath])]
groupResults = Map Language [FilePath] -> [(Language, [FilePath])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Language [FilePath] -> [(Language, [FilePath])])
-> ([[(Language, FilePath)]] -> Map Language [FilePath])
-> [[(Language, FilePath)]]
-> [(Language, [FilePath])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Language, [FilePath])
 -> Map Language [FilePath] -> Map Language [FilePath])
-> Map Language [FilePath]
-> [(Language, [FilePath])]
-> Map Language [FilePath]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Language, [FilePath])
-> Map Language [FilePath] -> Map Language [FilePath]
forall k a. (Ord k, Eq a) => (k, [a]) -> Map k [a] -> Map k [a]
more Map Language [FilePath]
forall k a. Map k a
Map.empty ([(Language, [FilePath])] -> Map Language [FilePath])
-> ([[(Language, FilePath)]] -> [(Language, [FilePath])])
-> [[(Language, FilePath)]]
-> Map Language [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Language, FilePath)] -> [(Language, [FilePath])]
forall a a. [(a, a)] -> [(a, [a])]
start ([(Language, FilePath)] -> [(Language, [FilePath])])
-> ([[(Language, FilePath)]] -> [(Language, FilePath)])
-> [[(Language, FilePath)]]
-> [(Language, [FilePath])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Language, FilePath)]] -> [(Language, FilePath)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
 where
  start :: [(a, a)] -> [(a, [a])]
start [(a, a)]
ls = [(a
l,[a
s]) | (a
l,a
s) <- [(a, a)]
ls]
  more :: (k, [a]) -> Map k [a] -> Map k [a]
more (k
l,[a]
s) = 
    ([a] -> [a] -> [a]) -> k -> [a] -> Map k [a] -> Map k [a]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\ [a
x] [a]
xs -> if a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x [a]
xs then [a]
xs else (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)) k
l [a]
s

abstractName :: PGF -> Language
abstractName PGF
pgf = PGF -> Language
absname PGF
pgf

languages :: PGF -> [Language]
languages PGF
pgf = Map Language Concr -> [Language]
forall k a. Map k a -> [k]
Map.keys (PGF -> Map Language Concr
concretes PGF
pgf)

languageCode :: PGF -> Language -> Maybe FilePath
languageCode PGF
pgf Language
lang = 
    case PGF -> Language -> Language -> Maybe Literal
lookConcrFlag PGF
pgf Language
lang (FilePath -> Language
mkCId FilePath
"language") of
      Just (LStr FilePath
s) -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Char -> Char -> FilePath -> FilePath
forall a. Eq a => a -> a -> [a] -> [a]
replace Char
'_' Char
'-' FilePath
s)
      Maybe Literal
_             -> Maybe FilePath
forall a. Maybe a
Nothing

categories :: PGF -> [Language]
categories PGF
pgf = [Language
c | (Language
c,([Hypo], [(Double, Language)], Double)
hs) <- Map Language ([Hypo], [(Double, Language)], Double)
-> [(Language, ([Hypo], [(Double, Language)], Double))]
forall k a. Map k a -> [(k, a)]
Map.toList (Abstr -> Map Language ([Hypo], [(Double, Language)], Double)
cats (PGF -> Abstr
abstract PGF
pgf))]

categoryContext :: PGF -> Language -> Maybe [Hypo]
categoryContext PGF
pgf Language
cat =
  case Language
-> Map Language ([Hypo], [(Double, Language)], Double)
-> Maybe ([Hypo], [(Double, Language)], Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
cat (Abstr -> Map Language ([Hypo], [(Double, Language)], Double)
cats (PGF -> Abstr
abstract PGF
pgf)) of
    Just ([Hypo]
hypos,[(Double, Language)]
_,Double
_) -> [Hypo] -> Maybe [Hypo]
forall a. a -> Maybe a
Just [Hypo]
hypos
    Maybe ([Hypo], [(Double, Language)], Double)
Nothing          -> Maybe [Hypo]
forall a. Maybe a
Nothing

startCat :: PGF -> Type
startCat PGF
pgf = [Hypo] -> Language -> [Tree] -> Type
DTyp [] (PGF -> Language
lookStartCat PGF
pgf) []

functions :: PGF -> [Language]
functions PGF
pgf = Map Language (Type, Int, Maybe ([Equation], [[Instr]]), Double)
-> [Language]
forall k a. Map k a -> [k]
Map.keys (Abstr
-> Map Language (Type, Int, Maybe ([Equation], [[Instr]]), Double)
funs (PGF -> Abstr
abstract PGF
pgf))

functionsByCat :: PGF -> Language -> [Language]
functionsByCat PGF
pgf Language
cat =
  case Language
-> Map Language ([Hypo], [(Double, Language)], Double)
-> Maybe ([Hypo], [(Double, Language)], Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
cat (Abstr -> Map Language ([Hypo], [(Double, Language)], Double)
cats (PGF -> Abstr
abstract PGF
pgf)) of
    Just ([Hypo]
_,[(Double, Language)]
fns,Double
_) -> ((Double, Language) -> Language)
-> [(Double, Language)] -> [Language]
forall a b. (a -> b) -> [a] -> [b]
map (Double, Language) -> Language
forall a b. (a, b) -> b
snd [(Double, Language)]
fns
    Maybe ([Hypo], [(Double, Language)], Double)
Nothing        -> []

functionType :: PGF -> Language -> Maybe Type
functionType PGF
pgf Language
fun =
  case 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
fun (Abstr
-> Map Language (Type, Int, Maybe ([Equation], [[Instr]]), Double)
funs (PGF -> Abstr
abstract PGF
pgf)) of
    Just (Type
ty,Int
_,Maybe ([Equation], [[Instr]])
_,Double
_) -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
ty
    Maybe (Type, Int, Maybe ([Equation], [[Instr]]), Double)
Nothing         -> Maybe Type
forall a. Maybe a
Nothing

-- | Converts an expression to normal form
compute :: PGF -> Expr -> Expr
compute :: PGF -> Tree -> Tree
compute PGF
pgf = Sig -> Int -> Env -> Tree -> Tree
PGF.Data.normalForm (Abstr
-> Map Language (Type, Int, Maybe ([Equation], [[Instr]]), Double)
funs (PGF -> Abstr
abstract PGF
pgf),Maybe Tree -> Int -> Maybe Tree
forall a b. a -> b -> a
const Maybe Tree
forall a. Maybe a
Nothing) Int
0 []

exprSize :: Expr -> Int
exprSize :: Tree -> Int
exprSize (EAbs BindType
_ Language
_ Tree
e) = Tree -> Int
exprSize Tree
e
exprSize (EApp Tree
e1 Tree
e2) = Tree -> Int
exprSize Tree
e1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tree -> Int
exprSize Tree
e2
exprSize (ETyped Tree
e Type
ty)= Tree -> Int
exprSize Tree
e
exprSize (EImplArg Tree
e) = Tree -> Int
exprSize Tree
e
exprSize Tree
_            = Int
1

exprFunctions :: Expr -> [CId]
exprFunctions :: Tree -> [Language]
exprFunctions (EAbs BindType
_ Language
_ Tree
e) = Tree -> [Language]
exprFunctions Tree
e
exprFunctions (EApp Tree
e1 Tree
e2) = Tree -> [Language]
exprFunctions Tree
e1 [Language] -> [Language] -> [Language]
forall a. [a] -> [a] -> [a]
++ Tree -> [Language]
exprFunctions Tree
e2
exprFunctions (ETyped Tree
e Type
ty)= Tree -> [Language]
exprFunctions Tree
e
exprFunctions (EImplArg Tree
e) = Tree -> [Language]
exprFunctions Tree
e
exprFunctions (EFun Language
f)     = [Language
f]
exprFunctions Tree
_            = []

--exprFunctions :: Expr -> [Fun]

browse :: PGF -> CId -> Maybe (String,[CId],[CId])
browse :: PGF -> Language -> Maybe (FilePath, [Language], [Language])
browse PGF
pgf Language
id = (FilePath -> (FilePath, [Language], [Language]))
-> Maybe FilePath -> Maybe (FilePath, [Language], [Language])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FilePath
def -> (FilePath
def,[Language]
producers,[Language]
consumers)) Maybe FilePath
definition
  where
    definition :: Maybe FilePath
definition = case 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
id (Abstr
-> Map Language (Type, Int, Maybe ([Equation], [[Instr]]), Double)
funs (PGF -> Abstr
abstract PGF
pgf)) of
                   Just (Type
ty,Int
_,Just ([Equation]
eqs,[[Instr]]
_),Double
_) -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ Doc -> FilePath
render (FilePath -> Doc
text FilePath
"fun" Doc -> Doc -> Doc
<+> Language -> Doc
ppCId Language
id Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Int -> [Language] -> Type -> Doc
ppType Int
0 [] Type
ty Doc -> Doc -> Doc
$$
                                                                if [Equation] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Equation]
eqs
                                                                  then Doc
empty
                                                                  else FilePath -> Doc
text FilePath
"def" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat [let scope :: [Language]
scope = ([Language] -> Patt -> [Language])
-> [Language] -> [Patt] -> [Language]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Language] -> Patt -> [Language]
pattScope [] [Patt]
patts
                                                                                                ds :: [Doc]
ds    = (Patt -> Doc) -> [Patt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Language] -> Patt -> Doc
ppPatt Int
9 [Language]
scope) [Patt]
patts
                                                                                            in Language -> Doc
ppCId Language
id Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep [Doc]
ds Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> Int -> [Language] -> Tree -> Doc
ppExpr Int
0 [Language]
scope Tree
res | Equ [Patt]
patts Tree
res <- [Equation]
eqs])
                   Just (Type
ty,Int
_,Maybe ([Equation], [[Instr]])
Nothing,Double
_)      -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ Doc -> FilePath
render (FilePath -> Doc
text FilePath
"data" Doc -> Doc -> Doc
<+> Language -> Doc
ppCId Language
id Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Int -> [Language] -> Type -> Doc
ppType Int
0 [] Type
ty)
                   Maybe (Type, Int, Maybe ([Equation], [[Instr]]), Double)
Nothing   -> case Language
-> Map Language ([Hypo], [(Double, Language)], Double)
-> Maybe ([Hypo], [(Double, Language)], Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
id (Abstr -> Map Language ([Hypo], [(Double, Language)], Double)
cats (PGF -> Abstr
abstract PGF
pgf)) of
                                  Just ([Hypo]
hyps,[(Double, Language)]
_,Double
_) -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ Doc -> FilePath
render (FilePath -> Doc
text FilePath
"cat" Doc -> Doc -> Doc
<+> Language -> Doc
ppCId Language
id Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (([Language], [Doc]) -> [Doc]
forall a b. (a, b) -> b
snd (([Language] -> Hypo -> ([Language], Doc))
-> [Language] -> [Hypo] -> ([Language], [Doc])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (Int -> [Language] -> Hypo -> ([Language], Doc)
ppHypo Int
4) [] [Hypo]
hyps)))
                                  Maybe ([Hypo], [(Double, Language)], Double)
Nothing         -> Maybe FilePath
forall a. Maybe a
Nothing

    ([Language]
producers,[Language]
consumers) = (Language
 -> (Type, Int, Maybe ([Equation], [[Instr]]), Double)
 -> ([Language], [Language])
 -> ([Language], [Language]))
-> ([Language], [Language])
-> Map Language (Type, Int, Maybe ([Equation], [[Instr]]), Double)
-> ([Language], [Language])
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Language
-> (Type, Int, Maybe ([Equation], [[Instr]]), Double)
-> ([Language], [Language])
-> ([Language], [Language])
forall a b c d. a -> (Type, b, c, d) -> ([a], [a]) -> ([a], [a])
accum ([],[]) (Abstr
-> Map Language (Type, Int, Maybe ([Equation], [[Instr]]), Double)
funs (PGF -> Abstr
abstract PGF
pgf))
      where
        accum :: a -> (Type, b, c, d) -> ([a], [a]) -> ([a], [a])
accum a
f (Type
ty,b
_,c
_,d
_) ([a]
plist,[a]
clist) = 
          let !plist' :: [a]
plist' = if Language
id Language -> [Language] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Language]
ps then a
f a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
plist else [a]
plist
              !clist' :: [a]
clist' = if Language
id Language -> [Language] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Language]
cs then a
f a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
clist else [a]
clist
          in ([a]
plist',[a]
clist')
          where
            ([Language]
ps,[Language]
cs) = Type -> ([Language], [Language])
tyIds Type
ty

    tyIds :: Type -> ([Language], [Language])
tyIds (DTyp [Hypo]
hyps Language
cat [Tree]
es) = ((Tree -> [Language] -> [Language])
-> [Language] -> [Tree] -> [Language]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tree -> [Language] -> [Language]
expIds (Language
catLanguage -> [Language] -> [Language]
forall a. a -> [a] -> [a]
:[[Language]] -> [Language]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Language]]
css) [Tree]
es,[[Language]] -> [Language]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Language]]
pss)
      where
        ([[Language]]
pss,[[Language]]
css) = [([Language], [Language])] -> ([[Language]], [[Language]])
forall a b. [(a, b)] -> ([a], [b])
unzip [Type -> ([Language], [Language])
tyIds Type
ty | (BindType
_,Language
_,Type
ty) <- [Hypo]
hyps]

    expIds :: Tree -> [Language] -> [Language]
expIds (EAbs BindType
_ Language
_ Tree
e) [Language]
ids = Tree -> [Language] -> [Language]
expIds Tree
e [Language]
ids
    expIds (EApp Tree
e1 Tree
e2) [Language]
ids = Tree -> [Language] -> [Language]
expIds Tree
e1 (Tree -> [Language] -> [Language]
expIds Tree
e2 [Language]
ids)
    expIds (EFun Language
id)    [Language]
ids = Language
id Language -> [Language] -> [Language]
forall a. a -> [a] -> [a]
: [Language]
ids
    expIds (ETyped Tree
e Type
_) [Language]
ids = Tree -> [Language] -> [Language]
expIds Tree
e [Language]
ids
    expIds Tree
_            [Language]
ids = [Language]
ids

-- | A type for plain applicative trees
data ATree t = Other t    | App CId  [ATree t]  deriving Int -> ATree t -> FilePath -> FilePath
[ATree t] -> FilePath -> FilePath
ATree t -> FilePath
(Int -> ATree t -> FilePath -> FilePath)
-> (ATree t -> FilePath)
-> ([ATree t] -> FilePath -> FilePath)
-> Show (ATree t)
forall t. Show t => Int -> ATree t -> FilePath -> FilePath
forall t. Show t => [ATree t] -> FilePath -> FilePath
forall t. Show t => ATree t -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ATree t] -> FilePath -> FilePath
$cshowList :: forall t. Show t => [ATree t] -> FilePath -> FilePath
show :: ATree t -> FilePath
$cshow :: forall t. Show t => ATree t -> FilePath
showsPrec :: Int -> ATree t -> FilePath -> FilePath
$cshowsPrec :: forall t. Show t => Int -> ATree t -> FilePath -> FilePath
Show
data Trie    = Oth   Tree | Ap  CId [[Trie   ]] deriving Int -> Trie -> FilePath -> FilePath
[Trie] -> FilePath -> FilePath
Trie -> FilePath
(Int -> Trie -> FilePath -> FilePath)
-> (Trie -> FilePath)
-> ([Trie] -> FilePath -> FilePath)
-> Show Trie
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Trie] -> FilePath -> FilePath
$cshowList :: [Trie] -> FilePath -> FilePath
show :: Trie -> FilePath
$cshow :: Trie -> FilePath
showsPrec :: Int -> Trie -> FilePath -> FilePath
$cshowsPrec :: Int -> Trie -> FilePath -> FilePath
Show
-- ^ A type for tries of plain applicative trees

-- | Convert a 'Tree' to an 'ATree'
toATree :: Tree -> ATree Tree
toATree :: Tree -> ATree Tree
toATree Tree
e = ATree Tree
-> ((Language, [Tree]) -> ATree Tree)
-> Maybe (Language, [Tree])
-> ATree Tree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Tree -> ATree Tree
forall t. t -> ATree t
Other Tree
e) (Language, [Tree]) -> ATree Tree
app (Tree -> Maybe (Language, [Tree])
unApp Tree
e)
  where
    app :: (Language, [Tree]) -> ATree Tree
app (Language
f,[Tree]
es) = Language -> [ATree Tree] -> ATree Tree
forall t. Language -> [ATree t] -> ATree t
App Language
f ((Tree -> ATree Tree) -> [Tree] -> [ATree Tree]
forall a b. (a -> b) -> [a] -> [b]
map Tree -> ATree Tree
toATree [Tree]
es)

-- | Combine a list of trees into a trie
toTrie :: [ATree Tree] -> [[Trie]]
toTrie = [[Trie]] -> [[Trie]]
combines ([[Trie]] -> [[Trie]])
-> ([ATree Tree] -> [[Trie]]) -> [ATree Tree] -> [[Trie]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ATree Tree -> [Trie]) -> [ATree Tree] -> [[Trie]]
forall a b. (a -> b) -> [a] -> [b]
map ((Trie -> [Trie] -> [Trie]
forall a. a -> [a] -> [a]
:[]) (Trie -> [Trie]) -> (ATree Tree -> Trie) -> ATree Tree -> [Trie]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATree Tree -> Trie
singleton)
  where
    singleton :: ATree Tree -> Trie
singleton ATree Tree
t = case ATree Tree
t of
                    Other Tree
e -> Tree -> Trie
Oth Tree
e
                    App Language
f [ATree Tree]
ts -> Language -> [[Trie]] -> Trie
Ap Language
f [(ATree Tree -> Trie) -> [ATree Tree] -> [Trie]
forall a b. (a -> b) -> [a] -> [b]
map ATree Tree -> Trie
singleton [ATree Tree]
ts]

    combines :: [[Trie]] -> [[Trie]]
combines [] = []
    combines ([Trie]
ts:[[Trie]]
tss) = [Trie]
ts1[Trie] -> [[Trie]] -> [[Trie]]
forall a. a -> [a] -> [a]
:[[Trie]] -> [[Trie]]
combines [[Trie]]
tss2
      where
        ([Trie]
ts1,[[Trie]]
tss2) = [[Trie]] -> [[Trie]] -> [Trie] -> ([Trie], [[Trie]])
combines2 [] [[Trie]]
tss [Trie]
ts
        combines2 :: [[Trie]] -> [[Trie]] -> [Trie] -> ([Trie], [[Trie]])
combines2 [[Trie]]
ots []        [Trie]
ts1 = ([Trie]
ts1,[[Trie]] -> [[Trie]]
forall a. [a] -> [a]
reverse [[Trie]]
ots)
        combines2 [[Trie]]
ots ([Trie]
ts2:[[Trie]]
tss) [Trie]
ts1 =
          ([Trie], [[Trie]])
-> ([Trie] -> ([Trie], [[Trie]]))
-> Maybe [Trie]
-> ([Trie], [[Trie]])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([[Trie]] -> [[Trie]] -> [Trie] -> ([Trie], [[Trie]])
combines2 ([Trie]
ts2[Trie] -> [[Trie]] -> [[Trie]]
forall a. a -> [a] -> [a]
:[[Trie]]
ots) [[Trie]]
tss [Trie]
ts1) ([[Trie]] -> [[Trie]] -> [Trie] -> ([Trie], [[Trie]])
combines2 [[Trie]]
ots [[Trie]]
tss) ([Trie] -> [Trie] -> Maybe [Trie]
combine [Trie]
ts1 [Trie]
ts2)

        combine :: [Trie] -> [Trie] -> Maybe [Trie]
combine [Trie]
ts [Trie]
us = ((Trie, Trie) -> Maybe Trie) -> [(Trie, Trie)] -> Maybe [Trie]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Trie, Trie) -> Maybe Trie
combine2 ([Trie] -> [Trie] -> [(Trie, Trie)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Trie]
ts [Trie]
us)
          where
            combine2 :: (Trie, Trie) -> Maybe Trie
combine2 (Ap Language
f [[Trie]]
ts,Ap Language
g [[Trie]]
us) | Language
fLanguage -> Language -> Bool
forall a. Eq a => a -> a -> Bool
==Language
g = Trie -> Maybe Trie
forall a. a -> Maybe a
Just (Language -> [[Trie]] -> Trie
Ap Language
f ([[Trie]] -> [[Trie]]
combines ([[Trie]]
ts[[Trie]] -> [[Trie]] -> [[Trie]]
forall a. [a] -> [a] -> [a]
++[[Trie]]
us)))
            combine2 (Trie, Trie)
_ = Maybe Trie
forall a. Maybe a
Nothing