module PGF(
PGF,
readPGF,
CId, mkCId, wildCId,
showCId, readCId,
Language,
showLanguage, readLanguage,
languages, abstractName, languageCode,
Type, Hypo,
showType, readType,
mkType, mkHypo, mkDepHypo, mkImplHypo,
unType,
categories, startCat,
functions, functionsByCat, functionType, missingLins,
Tree,
Expr,
showExpr, readExpr,
mkAbs, unAbs,
mkApp, unApp,
mkStr, unStr,
mkInt, unInt,
mkDouble, unDouble,
mkMeta, unMeta,
linearize, linearizeAllLang, linearizeAll, bracketedLinearize, tabularLinearizes,
groupResults,
showPrintName,
BracketedString(..), FId, LIndex, Token,
Forest.showBracketedString,flattenBracketedString,
parse, parseAllLang, parseAll, parse_, parseWithRecovery,
PGF.compute, paraphrase,
checkType, checkExpr, inferExpr,
TcError(..), ppTcError,
Parse.ParseState,
Parse.initState, Parse.nextState, Parse.getCompletions, Parse.recoveryStates,
Parse.ParseInput(..), Parse.simpleParseInput, Parse.mkParseInput,
Parse.ParseOutput(..), Parse.getParseOutput,
generateAll, generateAllDepth,
generateFrom, generateFromDepth,
generateRandom, generateRandomDepth,
generateRandomFrom, generateRandomFromDepth,
Lemma, Analysis, Morpho,
lookupMorpho, buildMorpho, fullFormLexicon,
morphoMissing,
mkTokenizer,
graphvizAbstractTree,
graphvizParseTree,
graphvizDependencyTree,
graphvizBracketedString,
graphvizAlignment,
gizaAlignment,
GraphvizOptions(..),
graphvizDefaults,
Probabilities,
mkProbabilities,
defaultProbabilities,
showProbabilities,
readProbabilitiesFromFile,
browse
) where
import PGF.CId
import PGF.Linearize
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 PGF.Tokenizer
import qualified PGF.Forest as Forest
import qualified PGF.Parse as Parse
import GF.Data.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.List(mapAccumL)
import System.Random (newStdGen)
import Control.Monad
import Text.PrettyPrint
readPGF :: FilePath -> IO PGF
parse :: PGF -> Language -> Type -> String -> [Tree]
parseAll :: PGF -> Type -> String -> [[Tree]]
parseAllLang :: PGF -> Type -> String -> [(Language,[Tree])]
parse_ :: PGF -> Language -> Type -> Maybe Int -> String -> (Parse.ParseOutput,BracketedString)
parseWithRecovery :: PGF -> Language -> Type -> [Type] -> Maybe Int -> String -> (Parse.ParseOutput,BracketedString)
languages :: PGF -> [Language]
languageCode :: PGF -> Language -> Maybe String
abstractName :: PGF -> Language
categories :: PGF -> [CId]
startCat :: PGF -> Type
functions :: PGF -> [CId]
functionsByCat :: PGF -> CId -> [CId]
functionType :: PGF -> CId -> Maybe Type
readPGF f = decodeFile f
parse pgf lang typ s =
case parse_ pgf lang typ (Just 4) s of
(Parse.ParseOk ts,_) -> ts
_ -> []
parseAll mgr typ = map snd . parseAllLang mgr typ
parseAllLang mgr typ s =
[(lang,ts) | lang <- languages mgr, (Parse.ParseOk ts,_) <- [parse_ mgr lang typ (Just 4) s]]
parse_ pgf lang typ dp s =
case Map.lookup lang (concretes pgf) of
Just cnc -> Parse.parse pgf lang typ dp (words s)
Nothing -> error ("Unknown language: " ++ showCId lang)
parseWithRecovery pgf lang typ open_typs dp s = Parse.parseWithRecovery pgf lang typ open_typs dp (words s)
groupResults :: [[(Language,String)]] -> [(Language,[String])]
groupResults = Map.toList . foldr more Map.empty . start . concat
where
start ls = [(l,[s]) | (l,s) <- ls]
more (l,s) =
Map.insertWith (\ [x] xs -> if elem x xs then xs else (x : xs)) l s
abstractName pgf = absname pgf
languages pgf = Map.keys (concretes pgf)
languageCode pgf lang =
case lookConcrFlag pgf lang (mkCId "language") of
Just (LStr s) -> Just (replace '_' '-' s)
_ -> Nothing
categories pgf = [c | (c,hs) <- Map.toList (cats (abstract pgf))]
startCat pgf = DTyp [] (lookStartCat pgf) []
functions pgf = Map.keys (funs (abstract pgf))
functionsByCat pgf cat =
case Map.lookup cat (cats (abstract pgf)) of
Just (_,fns,_) -> map snd fns
Nothing -> []
functionType pgf fun =
case Map.lookup fun (funs (abstract pgf)) of
Just (ty,_,_,_,_) -> Just ty
Nothing -> Nothing
compute :: PGF -> Expr -> Expr
compute pgf = PGF.Data.normalForm (funs (abstract pgf),const Nothing) 0 []
browse :: PGF -> CId -> Maybe (String,[CId],[CId])
browse pgf id = fmap (\def -> (def,producers,consumers)) definition
where
definition = case Map.lookup id (funs (abstract pgf)) of
Just (ty,_,Just eqs,_,_) -> Just $ render (text "fun" <+> ppCId id <+> colon <+> ppType 0 [] ty $$
if null eqs
then empty
else text "def" <+> vcat [let scope = foldl pattScope [] patts
ds = map (ppPatt 9 scope) patts
in ppCId id <+> hsep ds <+> char '=' <+> ppExpr 0 scope res | Equ patts res <- eqs])
Just (ty,_,Nothing, _,_) -> Just $ render (text "data" <+> ppCId id <+> colon <+> ppType 0 [] ty)
Nothing -> case Map.lookup id (cats (abstract pgf)) of
Just (hyps,_,_) -> Just $ render (text "cat" <+> ppCId id <+> hsep (snd (mapAccumL (ppHypo 4) [] hyps)))
Nothing -> Nothing
(producers,consumers) = Map.foldWithKey accum ([],[]) (funs (abstract pgf))
where
accum f (ty,_,_,_,_) (plist,clist) =
let !plist' = if id `elem` ps then f : plist else plist
!clist' = if id `elem` cs then f : clist else clist
in (plist',clist')
where
(ps,cs) = tyIds ty
tyIds (DTyp hyps cat es) = (foldr expIds (cat:concat css) es,concat pss)
where
(pss,css) = unzip [tyIds ty | (_,_,ty) <- hyps]
expIds (EAbs _ _ e) ids = expIds e ids
expIds (EApp e1 e2) ids = expIds e1 (expIds e2 ids)
expIds (EFun id) ids = id : ids
expIds (ETyped e _) ids = expIds e ids
expIds _ ids = ids