diff --git a/src/runtime/haskell/PGF/Parse.hs b/src/runtime/haskell/PGF/Parse.hs index ad31cc25f..40abb78fd 100644 --- a/src/runtime/haskell/PGF/Parse.hs +++ b/src/runtime/haskell/PGF/Parse.hs @@ -15,7 +15,7 @@ module PGF.Parse import Data.Array.IArray import Data.Array.Base (unsafeAt) -import Data.List (isPrefixOf, foldl') +import Data.List (isPrefixOf, foldl', intercalate) import Data.Maybe (fromMaybe, maybeToList) import qualified Data.Map as Map import qualified PGF.TrieMap as TrieMap @@ -506,14 +506,26 @@ type Continuation = TrieMap.TrieMap Token ActiveSet -- | Return the Continuation of a Parsestate with exportable types -- Used by PGFService -getContinuationInfo :: ParseState -> Map.Map [Token] [(FunId, CId)] +getContinuationInfo :: ParseState -> Map.Map [Token] [(FunId, CId, String)] getContinuationInfo pstate = Map.map (map f . Set.toList) contMap where PState abstr concr chart cont = pstate contMap = Map.fromList (TrieMap.toList cont) -- always get [([], _::ActiveSet)] - f :: Active -> (FunId,CId) - f (Active int dotpos funid seqid pargs ak) = (funid, cid) - where CncFun cid _ = cncfuns concr ! funid + f :: Active -> (FunId,CId,String) + f (Active int dotpos funid seqid pargs ak) = (funid, cid, seq) + where + CncFun cid _ = cncfuns concr ! funid + seq = showSeq dotpos (sequences concr ! seqid) + + showSeq :: DotPos -> Sequence -> String + showSeq pos seq = intercalate " " $ scan (drop (pos-1) (elems seq)) + where + -- Scan left-to-right, stop at first non-token + scan :: [Symbol] -> [String] + scan [] = [] + scan (sym:syms) = case sym of + SymKS token -> token : scan syms + _ -> [] ---------------------------------------------------------------- -- Error State diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs index 854f70936..509591ba2 100644 --- a/src/server/PGFService.hs +++ b/src/server/PGFService.hs @@ -30,7 +30,7 @@ import Control.Monad import Control.Monad.State(State,evalState,get,put) import Data.Char import Data.Function (on) -import Data.List (sortBy,intersperse,mapAccumL,nub,isSuffixOf) +import Data.List (sortBy,intersperse,mapAccumL,nub,isSuffixOf,nubBy) import qualified Data.Map as Map import Data.Maybe import System.Random @@ -594,18 +594,19 @@ completionInfo :: PGF -> PGF.Token -> PGF.ParseState -> JSValue completionInfo pgf token pstate = makeObj ["token".= token - ,"funs" .= (nub (map mkFun funs)) + ,"funs" .= (map mkFun (nubBy ignoreFunIds funs)) ] where contInfo = PGF.getContinuationInfo pstate - funs = snd . head $ Map.toList contInfo -- always get [([],_)] ; funs :: [(fid,cid)] - mkFun (funid,cid) = case PGF.functionType pgf cid of + funs = snd . head $ Map.toList contInfo -- always get [([],_)] ; funs :: [(fid,cid,seq)] + ignoreFunIds (_,cid1,seq1) (_,cid2,seq2) = (cid1,seq1) == (cid2,seq2) + mkFun (funid,cid,seq) = case PGF.functionType pgf cid of Just typ -> - makeObj [ "fid".=funid, "fun".=cid, "hyps".=hyps', "cat".=cat ] + makeObj [ {-"fid".=funid,-} "fun".=cid, "hyps".=hyps', "cat".=cat, "seq".=seq ] where (hyps,cat,es) = PGF.unType typ hyps' = [ PGF.showType [] typ | (_,_,typ) <- hyps ] - Nothing -> makeObj [] -- shouldn't happen + Nothing -> makeObj [ "error".=("Function "++show cid++" not found") ] -- shouldn't happen doLinearize :: PGF -> PGF.Tree -> To -> JSValue doLinearize pgf tree (tos,unlex) = showJSON