From 77a2630ed94265da8f56648f61deeacaf92960b3 Mon Sep 17 00:00:00 2001 From: krangelov Date: Sat, 11 Jul 2020 09:52:43 +0200 Subject: [PATCH 1/8] revert to using unconditional probabilities in the different lookup functions --- src/runtime/c/pgf/scanner.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/runtime/c/pgf/scanner.c b/src/runtime/c/pgf/scanner.c index ad78233ea..7a91b5c7c 100644 --- a/src/runtime/c/pgf/scanner.c +++ b/src/runtime/c/pgf/scanner.c @@ -115,7 +115,8 @@ pgf_morpho_iter(PgfProductionIdx* idx, PgfCId lemma = entry->papp->fun->absfun->name; GuString analysis = entry->ccat->cnccat->labels[entry->lin_idx]; - prob_t prob = entry->papp->fun->absfun->ep.prob; + prob_t prob = entry->ccat->cnccat->abscat->prob + + entry->papp->fun->absfun->ep.prob; callback->callback(callback, lemma, analysis, prob, err); if (!gu_ok(err)) From 2b09e70b4ac759a72cb4cb68b615f5380978f08f Mon Sep 17 00:00:00 2001 From: krangelov Date: Tue, 21 Jul 2020 13:19:19 +0200 Subject: [PATCH 2/8] allow specifying content-type in ajax_http --- src/www/js/support.js | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/www/js/support.js b/src/www/js/support.js index 2c7dd782e..fd84532c7 100644 --- a/src/www/js/support.js +++ b/src/www/js/support.js @@ -89,7 +89,7 @@ function GetXmlHttpObject(handler) return objXMLHttp } -function ajax_http(method,url,body,callback,errorcallback) { +function ajax_http(method,url,body,contenttype,callback,errorcallback) { var http=GetXmlHttpObject() if (!http) { var errortext="Browser does not support HTTP Request"; @@ -109,17 +109,20 @@ function ajax_http(method,url,body,callback,errorcallback) { } http.onreadystatechange=statechange; http.open(method,url,true) + if (contenttype != null) { + http.setRequestHeader("Content-Type", contenttype) + } http.send(body) } return http } function ajax_http_get(url,callback,errorcallback) { - ajax_http("GET",url,null,callback,errorcallback) + ajax_http("GET",url,null,null,callback,errorcallback) } function ajax_http_post(url,formdata,callback,errorcallback) { - ajax_http("POST",url,formdata,callback,errorcallback) + ajax_http("POST",url,formdata,null,callback,errorcallback) // See https://developer.mozilla.org/En/XMLHttpRequest/Using_XMLHttpRequest#Using_FormData_objects } From 8bc4cc71878cdf9d281678f3c0ca9e7ee7d49e28 Mon Sep 17 00:00:00 2001 From: krangelov Date: Tue, 21 Jul 2020 22:29:00 +0200 Subject: [PATCH 3/8] added function for posting query strings. scales better than get. --- src/www/js/support.js | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/www/js/support.js b/src/www/js/support.js index fd84532c7..e999f8298 100644 --- a/src/www/js/support.js +++ b/src/www/js/support.js @@ -135,6 +135,10 @@ function ajax_http_post_json(url,formdata,cont,errorcallback) { ajax_http_post(url, formdata, with_json(cont,errorcallback), errorcallback); } +function ajax_http_post_querystring_json(url,querystring,cont,errorcallback) { + ajax_http("POST",url,querystring,"application/x-www-form-urlencoded",with_json(cont,errorcallback),errorcallback); +} + function with_json(cont,errorcallback) { return function(txt){ if(txt) { From 7229033e427b4ec1668ef0dcbf70cd17f8c4937d Mon Sep 17 00:00:00 2001 From: krangelov Date: Wed, 22 Jul 2020 16:26:05 +0200 Subject: [PATCH 4/8] bugfix in bracketedLinearize --- src/runtime/haskell-bind/PGF2.hsc | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index 4b41a7471..cdb4a7994 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -1266,7 +1266,9 @@ withBracketLinFuncs ref exn f = then writeIORef ref (stack, bs') else do cat <- peekUtf8CString c_cat let fid = fromIntegral c_fid - ann <- peekUtf8CString c_ann + ann <- if c_ann == nullPtr + then return "" + else peekUtf8CString c_ann fun <- peekUtf8CString c_fun writeIORef ref (stack, Bracket cat fid ann fun (reverse bs) : bs') From 0cee82f7156166613b74b5347fbbe39e37d5913d Mon Sep 17 00:00:00 2001 From: krangelov Date: Wed, 22 Jul 2020 16:55:21 +0200 Subject: [PATCH 5/8] the if is actually unnecessary --- src/runtime/haskell-bind/PGF2.hsc | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index cdb4a7994..4b41a7471 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -1266,9 +1266,7 @@ withBracketLinFuncs ref exn f = then writeIORef ref (stack, bs') else do cat <- peekUtf8CString c_cat let fid = fromIntegral c_fid - ann <- if c_ann == nullPtr - then return "" - else peekUtf8CString c_ann + ann <- peekUtf8CString c_ann fun <- peekUtf8CString c_fun writeIORef ref (stack, Bracket cat fid ann fun (reverse bs) : bs') From a2d7f1369c7bc83b550e6198ce1ce4ef1cc39141 Mon Sep 17 00:00:00 2001 From: krangelov Date: Sun, 26 Jul 2020 15:55:18 +0200 Subject: [PATCH 6/8] filter out empty brackets --- src/runtime/c/pgf/parser.c | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/src/runtime/c/pgf/parser.c b/src/runtime/c/pgf/parser.c index c3255154d..1ee24ac59 100644 --- a/src/runtime/c/pgf/parser.c +++ b/src/runtime/c/pgf/parser.c @@ -2301,26 +2301,29 @@ pgf_get_parse_roots(PgfParsing* ps, GuPool* pool) PGF_API GuSeq* pgf_ccat_to_range(PgfParsing* ps, PgfCCat* ccat, GuPool* pool) { - PgfItemConts* conts = ccat->conts; PgfParseState* state = ps->before; GuBuf* buf = gu_new_buf(PgfParseRange, pool); - while (conts != NULL) { - PgfParseRange* range = gu_buf_extend(buf); - range->start = conts->state->end_offset; - range->end = conts->state->end_offset; - range->field = conts->ccat->cnccat->labels[conts->lin_idx]; - + while (ccat->conts != NULL) { + size_t start = ccat->conts->state->end_offset; + size_t end = start; while (state != NULL) { - if (pgf_parsing_get_completed(state, conts) == ccat) { - if (state->start_offset >= range->start) - range->end = state->start_offset; + if (pgf_parsing_get_completed(state, ccat->conts) == ccat) { + if (state->start_offset >= start) + end = state->start_offset; break; } state = state->next; } - conts = conts->ccat->conts; + if (start != end) { + PgfParseRange* range = gu_buf_extend(buf); + range->start = start; + range->end = end; + range->field = ccat->cnccat->labels[ccat->conts->lin_idx]; + } + + ccat = ccat->conts->ccat; } return gu_buf_data_seq(buf); From d7965d81b4c2d75e9a3f3e336da93d20019a2764 Mon Sep 17 00:00:00 2001 From: krangelov Date: Sun, 26 Jul 2020 15:56:21 +0200 Subject: [PATCH 7/8] parseToChart also returns the category --- src/runtime/haskell-bind/PGF2.hsc | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index 4b41a7471..827e19bf4 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -726,7 +726,7 @@ parseToChart :: Concr -- ^ the language with which we parse -- If a literal has been recognized then the output should -- be Just (expr,probability,end_offset) -> Int -- ^ the maximal number of roots - -> ParseOutput ([FId],Map.Map FId ([(Int,Int,String)],[(Expr,[PArg],Float)])) + -> ParseOutput ([FId],Map.Map FId ([(Int,Int,String)],[(Expr,[PArg],Float)],Cat)) parseToChart lang (Type ctype touchType) sent heuristic callbacks roots = unsafePerformIO $ withGuPool $ \parsePl -> do @@ -776,19 +776,23 @@ parseToChart lang (Type ctype touchType) sent heuristic callbacks roots = c_total_cats <- (#peek PgfConcr, total_cats) (concr lang) if Map.member fid chart || fid < c_total_cats then return (fid,chart) - else do range <- get_range c_ccat >>= peekSequence peekRange (#size PgfParseRange) + else do c_cnccat <- (#peek PgfCCat, cnccat) c_ccat + c_abscat <- (#peek PgfCCat, cnccat) c_cnccat + c_name <- (#peek PgfCCat, cnccat) c_abscat + cat <- peekUtf8CString c_name + range <- get_range c_ccat >>= peekSequence peekRange (#size PgfParseRange) c_prods <- (#peek PgfCCat, prods) c_ccat if c_prods == nullPtr - then do return (fid,Map.insert fid (range,[]) chart) + then do return (fid,Map.insert fid (range,[],cat) chart) else do c_len <- (#peek PgfCCat, n_synprods) c_ccat - (prods,chart) <- fixIO (\res -> peekProductions (Map.insert fid (range,fst res) chart) + (prods,chart) <- fixIO (\res -> peekProductions (Map.insert fid (range,fst res,cat) chart) (fromIntegral (c_len :: CSizeT)) (c_prods `plusPtr` (#offset GuSeq, data))) return (fid,chart) where peekProductions chart 0 ptr = return ([],chart) peekProductions chart len ptr = do - (ps1, chart) <- deRef (peekProduction chart) ptr + (ps1,chart) <- deRef (peekProduction chart) ptr (ps2,chart) <- peekProductions chart (len-1) (ptr `plusPtr` (#size GuVariant)) return (ps1++ps2,chart) @@ -806,13 +810,15 @@ parseToChart lang (Type ctype touchType) sent heuristic callbacks roots = return ([(Expr expr (touchConcr lang), pargs, p)],chart) } (#const PGF_PRODUCTION_COERCE) -> do { c_coerce <- (#peek PgfProductionCoerce, coerce) dt ; (fid,chart) <- peekCCat get_range chart c_coerce ; - return (maybe [] snd (Map.lookup fid chart),chart) } + return (maybe [] snd3 (Map.lookup fid chart),chart) } (#const PGF_PRODUCTION_EXTERN) -> do { c_ep <- (#peek PgfProductionExtern, ep) dt ; expr <- (#peek PgfExprProb, expr) c_ep ; p <- (#peek PgfExprProb, prob) c_ep ; return ([(Expr expr (touchConcr lang), [], p)],chart) } _ -> error ("Unknown production type "++show tag++" in the grammar") + snd3 (_,x,_) = x + peekPArgs chart 0 ptr = return ([],chart) peekPArgs chart len ptr = do (a, chart) <- peekPArg chart ptr From 830dbe760db2df0c573c06cb481d0611bf55908b Mon Sep 17 00:00:00 2001 From: krangelov Date: Sun, 26 Jul 2020 15:56:54 +0200 Subject: [PATCH 8/8] expose parseToChart via the Web API --- src/server/PGFService.hs | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs index 5817be7f0..e30ff8652 100644 --- a/src/server/PGFService.hs +++ b/src/server/PGFService.hs @@ -152,6 +152,8 @@ cpgfMain qsem command (t,(pgf,pc)) = case command of "c-parse" -> withQSem qsem $ out t=<< join (parse # input % start % limit % treeopts) + "c-parseToChart"-> withQSem qsem $ + out t=<< join (parseToChart # input % limit) "c-linearize" -> out t=<< lin # tree % to "c-bracketedLinearize" -> out t=<< bracketedLin # tree % to @@ -218,6 +220,35 @@ cpgfMain qsem command (t,(pgf,pc)) = purge r@(_,t') = if diffUTCTime t t'<120 then Just r else Nothing -- remove unused parse results after 2 minutes -} + + parseToChart ((from,concr),input) mlimit = + do r <- case C.parseToChart concr cat input (-1) callbacks (fromMaybe 5 mlimit) of + C.ParseOk chart -> return (good chart) + C.ParseFailed _ tok -> return (bad tok) + C.ParseIncomplete -> return (bad "") + return $ showJSON [makeObj ("from".=from:r)] + where + callbacks = maybe [] cb $ lookup (C.abstractName pgf) C.literalCallbacks + cb fs = [(cat,f pgf (from,concr) input)|(cat,f)<-fs] + + bad err = ["parseFailed".=err] + good (roots,chart) = ["roots".=showJSON roots, + "chart".=makeObj [show fid .= mkChartObj inf | (fid,inf)<-Map.toList chart]] + + mkChartObj (brackets,prods,cat) = + makeObj ["brackets".=map mkChartBracket brackets + ,"prods" .=map mkChartProd prods + ,"cat" .=cat + ] + + mkChartBracket (s,e,ann) = + makeObj ["start".=s,"end".=e,"ann".=ann] + + mkChartProd (expr,args,prob) = + makeObj ["tree".=expr,"args".=map mkChartPArg args,"prob".=prob] + + mkChartPArg (C.PArg _ fid) = showJSON fid + linAll tree to = showJSON (linAll' tree to) linAll' tree (tos,unlex) = [makeObj ["to".=to,