diff --git a/src/compiler/GF/Data/TrieMap.hs b/src/compiler/GF/Data/TrieMap.hs index a15c780ab..5392b6c0d 100644 --- a/src/compiler/GF/Data/TrieMap.hs +++ b/src/compiler/GF/Data/TrieMap.hs @@ -7,6 +7,7 @@ module GF.Data.TrieMap , lookup , null + , compose , decompose , insertWith @@ -15,6 +16,7 @@ module GF.Data.TrieMap , unions, unionsWith , elems + , toList ) where import Prelude hiding (lookup, null) @@ -36,6 +38,9 @@ null :: TrieMap k v -> Bool null (Tr Nothing m) = Map.null m null _ = False +compose :: Maybe v -> Map.Map k (TrieMap k v) -> TrieMap k v +compose mb_v m = Tr mb_v m + decompose :: TrieMap k v -> (Maybe v, Map.Map k (TrieMap k v)) decompose (Tr mb_v m) = (mb_v,m) @@ -70,3 +75,8 @@ elems :: TrieMap k v -> [v] elems tr = collect tr [] where collect (Tr mb_v m) xs = maybe id (:) mb_v (Map.fold collect xs m) + +toList :: TrieMap k v -> [([k],v)] +toList tr = collect [] tr [] + where + collect ks (Tr mb_v m) xs = maybe id (\v -> (:) (ks,v)) mb_v (Map.foldWithKey (\k -> collect (k:ks)) xs m) diff --git a/src/runtime/haskell/PGF/Parse.hs b/src/runtime/haskell/PGF/Parse.hs index 6bf0979a4..4b8056009 100644 --- a/src/runtime/haskell/PGF/Parse.hs +++ b/src/runtime/haskell/PGF/Parse.hs @@ -211,12 +211,11 @@ recoveryStates open_types (EState pgf cnc chart) = -- the same as the startup category. getParseOutput :: ParseState -> Type -> (ParseOutput,BracketedString) getParseOutput (PState pgf cnc chart items) ty@(DTyp _ start _) = - let froots | null roots = getPartialSeq (sequences cnc) (reverse (active st : actives st)) acc1 + let froots | null roots = getPartialSeq (sequences cnc) (reverse (active chart1 : actives chart1)) seq | otherwise = [([SymCat 0 lbl],[fid]) | AK fid lbl <- roots] - bs = linearizeWithBrackets (Forest (abstract pgf) cnc (forest st) froots) - - + bs = linearizeWithBrackets (Forest (abstract pgf) cnc (forest chart1) froots) + exps = nubsort $ do (AK fid lbl) <- roots (fvs,e) <- go Set.empty 0 (0,fid) @@ -232,17 +231,27 @@ getParseOutput (PState pgf cnc chart items) ty@(DTyp _ start _) = where (mb_agenda,acc) = TMap.decompose items agenda = maybe [] Set.toList mb_agenda - (acc1,st) = process flit ftok (sequences cnc) (cncfuns cnc) agenda [] chart + (acc',chart1) = process flit ftok (sequences cnc) (cncfuns cnc) agenda (TMap.compose Nothing acc) chart + seq = [(j,cutAt ppos toks seqid,args,key) | (toks,set) <- TMap.toList acc', Active j ppos funid seqid args key <- Set.toList set] flit _ = Nothing - ftok _ (Active j ppos funid seqid args key) items = (j,lin,args,key) : items - where - lin = take (ppos-1) (elems (unsafeAt (sequences cnc) seqid)) + ftok toks item acc = TMap.insertWith Set.union toks (Set.singleton item) acc + + cutAt ppos toks seqid = + let seq = unsafeAt (sequences cnc) seqid + init = take (ppos-1) (elems seq) + tail = case unsafeAt seq (ppos-1) of + SymKS ts -> let ts' = reverse (drop (length toks) (reverse ts)) + in if null ts' then [] else [SymKS ts'] + SymKP ts _ -> let ts' = reverse (drop (length toks) (reverse ts)) + in if null ts' then [] else [SymKS ts'] + sym -> [] + in init ++ tail roots = case Map.lookup start (cnccats cnc) of Just (CncCat s e lbls) -> do cat <- range (s,e) lbl <- indices lbls - fid <- maybeToList (lookupPC (PK cat lbl 0) (passive st)) + fid <- maybeToList (lookupPC (PK cat lbl 0) (passive chart1)) return (AK fid lbl) Nothing -> mzero @@ -259,7 +268,7 @@ getParseOutput (PState pgf cnc chart items) ty@(DTyp _ start _) = return (freeVar const,const) `mplus` trees) - [] fcat (forest st) + [] fcat (forest chart1) check_ho_fun fun args | fun == _V = return (head args)