summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/editor/simple/editor.js2
-rw-r--r--src/editor/simple/example_based.js24
-rw-r--r--src/example-based/ExampleDemo.hs2
-rw-r--r--src/example-based/ExampleService.hs43
4 files changed, 52 insertions, 19 deletions
diff --git a/src/editor/simple/editor.js b/src/editor/simple/editor.js
index 1a3dabf92..a2ddc80b3 100644
--- a/src/editor/simple/editor.js
+++ b/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);
diff --git a/src/editor/simple/example_based.js b/src/editor/simple/example_based.js
index 20c9d2ade..f38f657c7 100644
--- a/src/editor/simple/example_based.js
+++ b/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)
}
}
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