msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

fix the algorithm for items cutting in the partial parser

Browse Source
This commit is contained in:
krasimir
2010-07-15 14:01:51 +00:00
parent 21063634ab
commit df555d54fb
2 changed files with 29 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
src/compiler/GF/Data/TrieMap.hs
View File

@@ -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)

29
src/runtime/haskell/PGF/Parse.hs
View File

@@ -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)