Example-based grammar writing: fix problems caused by the use of exprToAPI

The editor needs to keep track of both the raw term and the nice term returned
by exprToAPI. (Manually constructed linearization rules will now have the
raw term and can not be tested.)

Also replace metavariables in generalized terms with the apropriate parameter
from the linearization rule.

Also fix communication problems caused by inconsistent use of show/read vs
showExpr/readExpr.

2 files changed, 34 insertions, 11 deletions

diff --git a/src/example-based/ExampleDemo.hs b/src/example-based/ExampleDemo.hs
index b26a9b4b1..b64d1d7a2 100644
--- a/src/example-based/ExampleDemo.hs
+++ b/src/example-based/ExampleDemo.hs
@@ -1,4 +1,4 @@
-module ExampleDemo (Environ,initial,getNext, provideExample, testThis,mkFuncWithArg,searchGoodTree)
+module ExampleDemo (Environ,initial,getNext, provideExample, testThis,mkFuncWithArg,searchGoodTree,isMeta)
   where
 
 import PGF
diff --git a/src/example-based/ExampleService.hs b/src/example-based/ExampleService.hs
index 0d105c746..165caccba 100644
--- a/src/example-based/ExampleService.hs
+++ b/src/example-based/ExampleService.hs
@@ -1,5 +1,7 @@
 module ExampleService(cgiMain,newPGFCache) where
 import Data.Map(fromList)
+import Data.Char(isDigit)
+import Data.Maybe(fromJust)
 import PGF
 import GF.Compile.ToAPI
 import Network.CGI
@@ -31,18 +33,23 @@ doProvideExample cache environ =
      fun <- getCId "fun"
      parsePGF <- readParsePGF cache
      pgf <- liftIO . readCache cache =<< getInp "grammar"
-     let Just s = E.provideExample environ fun parsePGF pgf lang
-     outputJSONP s
+     let Just (e,s) = E.provideExample environ fun parsePGF pgf lang
+         res = (showExpr [] e,s)
+     liftIO $ logError $ "proveExample ... = "++show res
+     outputJSONP res
 
 doAbstractExample cache environ =
   do example <- getInp "input"
-     Just abs <- readInput "abstract"
+     Just params <- readInput "params"
+     absstr <- getInp "abstract"
+     Just abs <- return $ readExpr absstr
+     liftIO $ logError $ "abstract = "++showExpr [] abs
      Just cat <- readInput "cat"
      let t = mkType [] cat []
      parsePGF <- readParsePGF cache
      let lang:_ = languages parsePGF
-     Just (e,_) <- liftIO $ abstractExample parsePGF environ lang t abs example
-     outputJSONP (exprToAPI e)
+     ae <- liftIO $ abstractExample parsePGF environ lang t abs example
+     outputJSONP (fmap (\(e,_)->(exprToAPI (instExpMeta params e),e)) ae)
 
 abstractExample parsePGF env lang cat abs example =
     E.searchGoodTree env abs (parse parsePGF lang cat example)
@@ -77,20 +84,36 @@ instance JSON CId where
     readJSON = (readResult =<<) . readJSON
 
 instance JSON Expr where
-   showJSON = showJSON . show
-   readJSON = (readResult =<<) . readJSON
+   showJSON = showJSON . showExpr []
+   readJSON = (m2r . readExpr =<<) . readJSON
+
+m2r = maybe (Error "read failed") Ok
 
 readResult s = case reads s of
                  (x,r):_ | lex r==[("","")] -> Ok x
                  _ -> Error "read failed"
 
-
+--------------------------------------------------------------------------------
 --            cat  lincat  fun  lin       fun  cat    cat
 environ :: ([(CId, CId)],[(CId, Expr)],[((CId, CId), [CId])]) -> E.Environ
-environ (lincats,lins,funs) =
+environ (lincats,lins0,funs) =
     E.initial (fromList lincats) concmap fs allfs
   where
     concmap = fromList lins
     allfs = map E.mkFuncWithArg funs
     fs = [E.mkFuncWithArg f | f@((fn,_),_)<-funs, fn `elem` cns]
-    cns = map fst lins
\ No newline at end of file
+    cns = map fst lins
+    lins = filter (not . E.isMeta .snd) lins0
+
+
+instExpMeta :: [CId] -> Expr -> Expr
+instExpMeta ps = fromJust . readExpr . instMeta ps . showExpr []
+
+instMeta :: [CId] -> String -> String
+instMeta ps s =
+  case break (=='?') s of
+    (s1,'?':s2) ->
+       case span isDigit s2 of
+         (s21@(_:_),s22) -> s1++show (ps!!(read s21-1))++instMeta ps s22
+         ("",s22) -> s1++'?':instMeta ps s22
+    (_,_) -> s