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.

src/editor/simple/editor.js

@@ -790,7 +790,7 @@ function draw_lins(g,ci) {
 		    if(!msg) {
 			if(f.template)
 			    conc.lins.push({fun:f.fun,args:f.args,lin:s});
-			else f.lin=s;
+			else { f.lin=s; f.eb_lin=null; }
 			reload_grammar(g);
 		    }
 		    cont(msg);

src/editor/simple/example_based.js

@@ -20,7 +20,7 @@ function exb_state(g,ci) {
 	return "("+lincat.cat+","+lincat.type+")"
     }
     function show_lin(lin) {
-	return "("+lin.fun+","+lin.lin+")"
+	return "("+lin.fun+","+(lin.eb_lin||"?")+")"
     }
     function show_funs(funs) { return show_list(show_fun,funs) }
     function show_lincats(lincats) { return show_list(show_lincat,lincats); }
@@ -88,11 +88,19 @@ function exb_linbuttons(g,ci,f) {
     var fun=f.fun;
     var eb=example_based[ci];
     var exb_output;
-    function fill_example(tree) {
-	exb_output.innerHTML="";
-	if(f.template) conc.lins.push({fun:f.fun,args:f.args,lin:tree});
-	else f.lin=s;
-	ask_possibilities(g,ci)
+    function fill_example(maybetree) {
+	var tree=maybetree.Just
+	if(tree) {
+	    if(f.template)
+		conc.lins.push({fun:f.fun,args:f.args,
+				lin:tree[0],eb_lin:tree[1]});
+	    else {
+		f.lin=tree[0];
+		f.eb_lin=tree[1];
+	    }
+	    ask_possibilities(g,ci)
+	}
+	else exb_output.innerHTML="Bug: no tree found"
     }
     function show_example(example){
 	exb_output.innerHTML="";
@@ -104,7 +112,9 @@ function exb_linbuttons(g,ci,f) {
 	    exb_output.innerHTML="...";
 	    //server.parse({from:"ParseEng",cat:cat,input:s},fill_example)
 	    exb_call(g,ci,"abstract_example",
-		     {cat:cat,input:s,abstract:example[0]},
+		     {cat:cat,input:s,
+		      params:"["+f.args.join(",")+"]",
+		      abstract:example[0]},
 		     fill_example)
 	}
     }

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

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
+    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