diff --git a/examples/animals/Animals.gf b/examples/animals/Animals.gf new file mode 100644 index 000000000..33b56e740 --- /dev/null +++ b/examples/animals/Animals.gf @@ -0,0 +1,12 @@ +-- The Question grammar specialized to animals. + +abstract Animals = Questions ** { + + flags startcat=Phrase ; + + fun + -- a lexicon of animals and actions among them + Dog, Cat, Mouse, Lion, Zebra : Entity ; + Chase, Eat, See : Action ; +} + diff --git a/examples/animals/AnimalsEng.gf b/examples/animals/AnimalsEng.gf new file mode 100644 index 000000000..22942b735 --- /dev/null +++ b/examples/animals/AnimalsEng.gf @@ -0,0 +1,16 @@ +--# -path=.:present:prelude +--resource/english:resource/abstract:resource/../prelude + +concrete AnimalsEng of Animals = QuestionsEng ** + open LangEng, ParadigmsEng, IrregEng in { + + lin + Dog = regN "dog" ; + Cat = regN "cat" ; + Mouse = mk2N "mouse" "mice" ; + Lion = regN "lion" ; + Zebra = regN "zebra" ; + Chase = dirV2 (regV "chase") ; + Eat = dirV2 eat_V ; + See = dirV2 see_V ; +} diff --git a/examples/animals/AnimalsFre.gf b/examples/animals/AnimalsFre.gf new file mode 100644 index 000000000..198c84ad7 --- /dev/null +++ b/examples/animals/AnimalsFre.gf @@ -0,0 +1,15 @@ +--# -path=.:present:prelude + +concrete AnimalsFre of Animals = QuestionsFre ** + open LangFre, ParadigmsFre, IrregFre in { + + lin + Dog = regN "chien" ; + Cat = regN "chat" ; + Mouse = regGenN "souris" feminine ; + Lion = regN "lion" ; + Zebra = regGenN "zèbre" masculine ; + Chase = dirV2 (regV "chasser") ; + Eat = dirV2 (regV "manger") ; + See = voir_V2 ; +} diff --git a/examples/animals/AnimalsSwe.gf b/examples/animals/AnimalsSwe.gf new file mode 100644 index 000000000..8f256885a --- /dev/null +++ b/examples/animals/AnimalsSwe.gf @@ -0,0 +1,15 @@ +--# -path=.:present:prelude + +concrete AnimalsSwe of Animals = QuestionsSwe ** + open LangSwe, ParadigmsSwe, IrregSwe in { + + lin + Dog = regN "hund" ; + Cat = mk2N "katt" "katter" ; + Mouse = mkN "mus" "musen" "möss" "mössen" ; + Lion = mk2N "lejon" "lejon" ; + Zebra = regN "zebra" ; + Chase = dirV2 (regV "jaga") ; + Eat = dirV2 äta_V ; + See = dirV2 se_V ; +} diff --git a/examples/animals/Questions.gf b/examples/animals/Questions.gf new file mode 100644 index 000000000..bb25e785d --- /dev/null +++ b/examples/animals/Questions.gf @@ -0,0 +1,10 @@ +-- Simple questions and answers, in present tense. + +abstract Questions = { + cat + Phrase ; Entity ; Action ; + fun + Who : Action -> Entity -> Phrase ; -- who chases X + Whom : Entity -> Action -> Phrase ; -- whom does X chase + Answer : Entity -> Action -> Entity -> Phrase ; -- X chases Y +} diff --git a/examples/animals/QuestionsEng.gf b/examples/animals/QuestionsEng.gf new file mode 100644 index 000000000..8a4c5c406 --- /dev/null +++ b/examples/animals/QuestionsEng.gf @@ -0,0 +1,2 @@ +concrete QuestionsEng of Questions = QuestionsI with + (Lang = LangEng) ; diff --git a/examples/animals/QuestionsFre.gf b/examples/animals/QuestionsFre.gf new file mode 100644 index 000000000..dab23b2ba --- /dev/null +++ b/examples/animals/QuestionsFre.gf @@ -0,0 +1,2 @@ +concrete QuestionsFre of Questions = QuestionsI with + (Lang = LangFre) ; diff --git a/examples/animals/QuestionsI.gf b/examples/animals/QuestionsI.gf new file mode 100644 index 000000000..30476ccdb --- /dev/null +++ b/examples/animals/QuestionsI.gf @@ -0,0 +1,27 @@ +-- to compile: echo "eb -file=QuestionsI.gfe" | gf $GF_LIB_PATH/present/LangEng.gfo +-- or use directly gf do + let file = optFile opts + mprobs <- optProbs opts pgf + let conf = configureExBased pgf mprobs (optLang opts) + file' <- parseExamplesInGrammar conf file + return (fromString ("wrote " ++ file')), + needsTypeCheck = False + }), ("gr", emptyCommandInfo { longname = "generate_random", synopsis = "generate random trees in the current abstract syntax", @@ -871,6 +899,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [ -- putStrLn $ prProbabilities ps return $ Just ps + optFile opts = valStrOpts "file" "_gftmp" opts + optType opts = let str = valStrOpts "cat" (showCId $ lookStartCat pgf) opts in case readType str of @@ -988,3 +1018,4 @@ prMorphoAnalysis (w,lps) = morphoMissing :: Morpho -> [String] -> [String] morphoMissing mo ws = [w | w <- ws, null (lookupMorpho mo w)] + diff --git a/src/compiler/GF/Compile/ExampleBased.hs b/src/compiler/GF/Compile/ExampleBased.hs new file mode 100644 index 000000000..10d7cdc88 --- /dev/null +++ b/src/compiler/GF/Compile/ExampleBased.hs @@ -0,0 +1,59 @@ +module GF.Compile.ExampleBased (parseExamplesInGrammar,configureExBased) where + +import PGF +import PGF.Probabilistic + +parseExamplesInGrammar :: ExConfiguration -> FilePath -> IO FilePath +parseExamplesInGrammar conf file = do + src <- readFile file -- .gfe + let file' = take (length file - 3) file ++ "gf" -- .gf + convertFile conf src file' + return file' + +convertFile :: ExConfiguration -> String -> FilePath -> IO () +convertFile conf src file = do + writeFile file "" -- "-- created by example-based grammar writing in GF\n" + conv src + where + conv s = do + (cex,end) <- findExample s + if null end then return () else do + convEx cex + conv 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 + lang = language conf + convEx (cat,ex) = do + appn "(" + let typ = maybe (error "no valid cat") id $ readType cat + let ts = rank $ parse pgf lang typ ex + case ts of + [] -> appv ("WARNING: cannot parse example " ++ ex) + t:tt -> appn t >> mapM_ (appn . (" --- " ++)) tt + appn ")" + rank ts = case probs conf of + Just probs -> [showExpr [] t ++ " -- " ++ show p | (t,p) <- rankTreesByProbs probs ts] + _ -> map (showExpr []) ts + appf = appendFile file + appn s = appf s >> appf "\n" + appv s = appn s >> putStrLn s + +data ExConfiguration = ExConf { + resource_file :: FilePath, + resource_pgf :: PGF, + probs :: Maybe Probabilities, + verbose :: Bool, + language :: Language + } + +configureExBased :: PGF -> Maybe Probabilities -> Language -> ExConfiguration +configureExBased pgf mprobs lang = ExConf [] pgf mprobs False lang +