module PGF(
PGF,
readPGF,
CId, mkCId, wildCId,
showCId, readCId,
ppCId, pIdent, utf8CId,
Language,
showLanguage, readLanguage,
languages, abstractName, languageCode,
Type, Hypo,
showType, readType,
mkType, mkHypo, mkDepHypo, mkImplHypo,
unType,
categories, categoryContext, startCat,
functions, functionsByCat, functionType, missingLins,
Tree,
Expr,
showExpr, readExpr,
mkAbs, unAbs,
mkApp, unApp,
mkStr, unStr,
mkInt, unInt,
mkDouble, unDouble,
mkMeta, unMeta,
pExpr,
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,
Parse.getContinuationInfo,
generateAll, generateAllDepth,
generateFrom, generateFromDepth,
generateRandom, generateRandomDepth,
generateRandomFrom, generateRandomFromDepth,
Lemma, Analysis, Morpho,
lookupMorpho, buildMorpho, fullFormLexicon,
morphoMissing,
morphoKnown, isInMorpho,
graphvizAbstractTree,
graphvizParseTree,
graphvizDependencyTree,
graphvizBracketedString,
graphvizAlignment,
gizaAlignment,
GraphvizOptions(..),
graphvizDefaults,
getDepLabels,
Probabilities,
mkProbabilities,
defaultProbabilities,
showProbabilities,
readProbabilitiesFromFile,
probTree, setProbabilities, rankTreesByProbs,
browse,
ATree(..),Trie(..),toATree,toTrie
) 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 qualified PGF.Forest as Forest
import qualified PGF.Parse as Parse
import PGF.Utilities(replace)
import qualified Data.Map as Map
import Data.Binary
import Data.List(mapAccumL)
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]
categoryContext :: PGF -> CId -> Maybe [Hypo]
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))]
categoryContext pgf cat =
case Map.lookup cat (cats (abstract pgf)) of
Just (hypos,_,_) -> Just hypos
Nothing -> Nothing
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
data ATree t = Other t | App CId [ATree t] deriving Show
data Trie = Oth Tree | Ap CId [[Trie ]] deriving Show
toATree :: Tree -> ATree Tree
toATree e = maybe (Other e) app (unApp e)
where
app (f,es) = App f (map toATree es)
toTrie = combines . map ((:[]) . singleton)
where
singleton t = case t of
Other e -> Oth e
App f ts -> Ap f [map singleton ts]
combines [] = []
combines (ts:tss) = ts1:combines tss2
where
(ts1,tss2) = combines2 [] tss ts
combines2 ots [] ts1 = (ts1,reverse ots)
combines2 ots (ts2:tss) ts1 =
maybe (combines2 (ts2:ots) tss ts1) (combines2 ots tss) (combine ts1 ts2)
combine ts us = mapM combine2 (zip ts us)
where
combine2 (Ap f ts,Ap g us) | f==g = Just (Ap f (combines (ts++us)))
combine2 _ = Nothing