summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile/ExampleBased.hs
diff options
context:
space:
mode:
authoraarne <aarne@chalmers.se>2010-01-27 17:51:15 +0000
committeraarne <aarne@chalmers.se>2010-01-27 17:51:15 +0000
commit750a2639b0f46153c36f6c713f522db5bb2d8587 (patch)
treeeb021744f904a0e62b44d4012bea27368651faad /src/compiler/GF/Compile/ExampleBased.hs
parent890d45579300f39d50a5a18a9f6feed8634ae8ba (diff)
command eb for example-based grammar conversion; see 'help eb' and the example in examples/animals/QuestionsI.gfe
Diffstat (limited to 'src/compiler/GF/Compile/ExampleBased.hs')
-rw-r--r--src/compiler/GF/Compile/ExampleBased.hs59
1 files changed, 59 insertions, 0 deletions
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
+