forked from GitHub/gf-core
84 lines
2.5 KiB
Haskell
84 lines
2.5 KiB
Haskell
module GF.Compile.ExampleBased (
|
|
parseExamplesInGrammar,
|
|
configureExBased
|
|
) where
|
|
|
|
import PGF
|
|
import PGF.Probabilistic
|
|
import PGF.Morphology
|
|
import PGF.ToAPI
|
|
|
|
import Data.List
|
|
|
|
parseExamplesInGrammar :: ExConfiguration -> FilePath -> IO (FilePath,[String])
|
|
parseExamplesInGrammar conf file = do
|
|
src <- readFile file -- .gfe
|
|
let file' = take (length file - 3) file ++ "gf" -- .gf
|
|
ws <- convertFile conf src file'
|
|
return (file',ws)
|
|
|
|
convertFile :: ExConfiguration -> String -> FilePath -> IO [String]
|
|
convertFile conf src file = do
|
|
writeFile file "" -- "-- created by example-based grammar writing in GF\n"
|
|
conv [] src
|
|
where
|
|
conv ws s = do
|
|
(cex,end) <- findExample s
|
|
if null end then return (nub (sort ws)) else do
|
|
ws2 <- convEx cex
|
|
conv (ws2 ++ ws) end
|
|
findExample s = case s of
|
|
'%':'e':'x':cs -> return $ getExample cs
|
|
c:cs -> appf [c] >> findExample cs
|
|
_ -> return (undefined,s)
|
|
getExample s =
|
|
let
|
|
(cat,exend) = break (=='"') s
|
|
(ex, end) = break (=='"') (tail exend)
|
|
in ((unwords (words cat),ex), tail end) -- quotes ignored
|
|
pgf = resource_pgf conf
|
|
morpho = resource_morpho conf
|
|
lang = language conf
|
|
convEx (cat,ex) = do
|
|
appn "("
|
|
let typ = maybe (error "no valid cat") id $ readType cat
|
|
ws <- case fst (parse_ pgf lang typ (Just 4) ex) of
|
|
ParseFailed _ -> do
|
|
let ws = morphoMissing morpho (words ex)
|
|
appv ("WARNING: cannot parse example " ++ ex)
|
|
case ws of
|
|
[] -> return ()
|
|
_ -> appv (" missing words: " ++ unwords ws)
|
|
return ws
|
|
TypeError _ ->
|
|
return []
|
|
ParseIncomplete ->
|
|
return []
|
|
ParseOk ts ->
|
|
case rank ts of
|
|
(t:tt) -> do
|
|
if null tt
|
|
then return ()
|
|
else appv ("WARNING: ambiguous example " ++ ex)
|
|
appn t
|
|
mapM_ (appn . (" --- " ++)) tt
|
|
appn ")"
|
|
return []
|
|
return ws
|
|
rank ts = [printExp conf t ++ " -- " ++ show p | (t,p) <- rankTreesByProbs pgf ts]
|
|
appf = appendFile file
|
|
appn s = appf s >> appf "\n"
|
|
appv s = appn ("--- " ++ s) >> putStrLn s
|
|
|
|
data ExConfiguration = ExConf {
|
|
resource_pgf :: PGF,
|
|
resource_morpho :: Morpho,
|
|
verbose :: Bool,
|
|
language :: Language,
|
|
printExp :: Tree -> String
|
|
}
|
|
|
|
configureExBased :: PGF -> Morpho -> Language -> (Tree -> String) -> ExConfiguration
|
|
configureExBased pgf morpho lang pr = ExConf pgf morpho False lang pr
|
|
|