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); 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)) 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 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, diff --git a/src/www/js/support.js b/src/www/js/support.js index 2c7dd782e..e999f8298 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 } @@ -132,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) {