GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-27 03:38:55 -06:00
Code Issues Packages Projects Releases Wiki Activity

the parser is not forced to respect the linref while parsing discontious phrases

Browse Source
This commit is contained in:
Krasimir Angelov
2017-08-18 21:23:58 +02:00
parent f71b96da2d
commit 1f3c9d0b17
2 changed files with 34 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
src/runtime/haskell/PGF/Data.hs
View File

@@ -124,11 +124,12 @@ readLanguage = readCId
showLanguage :: Language -> String showLanguage :: Language -> String
showLanguage = showCId showLanguage = showCId
fidString, fidInt, fidFloat, fidVar :: FId fidString, fidInt, fidFloat, fidVar, fidStart :: FId
fidString = (-1) fidString = (-1)
fidInt = (-2) fidInt = (-2)
fidFloat = (-3) fidFloat = (-3)
fidVar = (-4) fidVar = (-4)
fidStart = (-5)
isPredefFId :: FId -> Bool isPredefFId :: FId -> Bool
isPredefFId = (`elem` [fidString, fidInt, fidFloat, fidVar]) isPredefFId = (`elem` [fidString, fidInt, fidFloat, fidVar])

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

@@ -77,34 +77,27 @@ parseWithRecovery pgf lang typ open_typs dp toks = accept (initState pgf lang ty
Just ps -> accept ps ts Just ps -> accept ps ts
Nothing -> skip ps_map ts Nothing -> skip ps_map ts
-- | Creates an initial parsing state for a given language and -- | Creates an initial parsing state for a given language and
-- startup category. -- startup category.
initState :: PGF -> Language -> Type -> ParseState initState :: PGF -> Language -> Type -> ParseState
initState pgf lang (DTyp _ start _) = initState pgf lang (DTyp _ start _) =
let (acc,items) = case Map.lookup start (cnccats cnc) of let items = case Map.lookup start (cnccats cnc) of
Just (CncCat s e labels) -> Just (CncCat s e labels) ->
let keys = do fid <- range (s,e) do fid <- range (s,e)
lbl <- indices labels funid <- fromMaybe [] (IntMap.lookup fid (linrefs cnc))
return (AK fid lbl) let lbl = 0
in foldl' (\(acc,items) key -> predict flit ftok cnc CncFun _ lins = unsafeAt (cncfuns cnc) funid
(pproductions cnc) return (Active 0 0 funid (unsafeAt lins lbl) [PArg [] fid] (AK fidStart lbl))
key key 0 Nothing -> []
acc items)
(Map.empty,[])
keys
Nothing -> (Map.empty,[])
in PState abs in PState abs
cnc cnc
(Chart emptyAC [] emptyPC (pproductions cnc) (totalCats cnc) 0) (Chart emptyAC [] emptyPC (pproductions cnc) (totalCats cnc) 0)
(TrieMap.compose (Just (Set.fromList items)) acc) (TrieMap.compose (Just (Set.fromList items)) Map.empty)
where where
abs = abstract pgf abs = abstract pgf
cnc = lookConcrComplete pgf lang cnc = lookConcrComplete pgf lang
flit _ = Nothing
ftok = Map.unionWith (TrieMap.unionWith Set.union)
-- | This function constructs the simplest possible parser input. -- | This function constructs the simplest possible parser input.
-- It checks the tokens for exact matching and recognizes only @String@, @Int@ and @Float@ literals. -- It checks the tokens for exact matching and recognizes only @String@, @Int@ and @Float@ literals.
@@ -218,7 +211,7 @@ recoveryStates open_types (EState abs cnc chart) =
-- limited by the category specified, which is usually -- limited by the category specified, which is usually
-- the same as the startup category. -- the same as the startup category.
getParseOutput :: ParseState -> Type -> Maybe Int -> (ParseOutput,BracketedString) getParseOutput :: ParseState -> Type -> Maybe Int -> (ParseOutput,BracketedString)
getParseOutput (PState abs cnc chart cnt) ty@(DTyp _ start _) dp = getParseOutput (PState abs cnc chart cnt) ty dp =
let froots | null roots = getPartialSeq (sequences cnc) (reverse (active chart1 : actives chart1)) seq let froots | null roots = getPartialSeq (sequences cnc) (reverse (active chart1 : actives chart1)) seq
| otherwise = [([SymCat 0 lbl],[PArg [] fid]) | AK fid lbl <- roots] | otherwise = [([SymCat 0 lbl],[PArg [] fid]) | AK fid lbl <- roots]
@@ -253,12 +246,11 @@ getParseOutput (PState abs cnc chart cnt) ty@(DTyp _ start _) dp =
sym -> [] sym -> []
in init ++ tail in init ++ tail
roots = case Map.lookup start (cnccats cnc) of roots = do let lbl = 0
Just (CncCat s e lbls) -> do cat <- range (s,e) fid <- maybeToList (lookupPC (PK fidStart lbl 0) (passive chart1))
lbl <- indices lbls PApply _ [PArg _ fid] <- maybe [] Set.toList (IntMap.lookup fid (forest chart1))
fid <- maybeToList (lookupPC (PK cat lbl 0) (passive chart1)) return (AK fid lbl)
return (AK fid lbl)
Nothing -> mzero
getPartialSeq seqs actives = expand Set.empty getPartialSeq seqs actives = expand Set.empty
where where
@@ -400,29 +392,25 @@ process flit ftok cnc (item@(Active j ppos funid seqid args key0):items) acc cha
ftok_ (tok:toks) item cnt = ftok_ (tok:toks) item cnt =
ftok (Map.singleton tok (TrieMap.singleton toks (Set.singleton item))) cnt ftok (Map.singleton tok (TrieMap.singleton toks (Set.singleton item))) cnt
predict flit ftok cnc forest key0 key@(AK fid lbl) k acc items = predict flit ftok cnc forest key0 key@(AK fid lbl) k acc items =
let (acc1,items1) = case IntMap.lookup fid forest of let (acc1,items1) = case IntMap.lookup fid forest of
Nothing -> (acc,items) Nothing -> (acc,items)
Just set -> Set.fold foldProd (acc,items) set Just set -> Set.fold foldProd (acc,items) set
(acc2,items2) = case IntMap.lookup fid (lexicon cnc) >>= IntMap.lookup lbl of (acc2,items2) = case IntMap.lookup fid (lexicon cnc) >>= IntMap.lookup lbl of
Just tmap -> let (mb_v,toks) = TrieMap.decompose (TrieMap.map (toItems key0 k) tmap) Just tmap -> let (mb_v,toks) = TrieMap.decompose (TrieMap.map (toItems key0 k) tmap)
acc1' = ftok toks acc1 acc1' = ftok toks acc1
items1' = maybe [] Set.toList mb_v ++ items1 items1' = maybe [] Set.toList mb_v ++ items1
in (acc1',items1') in (acc1',items1')
Nothing -> (acc1,items1) Nothing -> (acc1,items1)
in (acc2,items2) in (acc2,items2)
where
foldProd (PCoerce fid) (acc,items) = predict flit ftok cnc forest key0 (AK fid lbl) k acc items
foldProd (PApply funid args) (acc,items) = (acc,Active k 0 funid (rhs funid lbl) args key0 : items)
foldProd (PConst _ const toks) (acc,items) = (acc,items)
rhs funid lbl = unsafeAt lins lbl
where where
CncFun _ lins = unsafeAt (cncfuns cnc) funid foldProd (PCoerce fid) (acc,items) = predict flit ftok cnc forest key0 (AK fid lbl) k acc items
foldProd (PApply funid args) (acc,items) = (acc,Active k 0 funid (rhs funid lbl) args key0 : items)
foldProd (PConst _ const toks) (acc,items) = (acc,items)
toItems key@(AK fid lbl) k funids = toItems key@(AK fid lbl) k funids =
Set.fromList [Active k 1 funid (rhs funid lbl) [] key | funid <- IntSet.toList funids] Set.fromList [Active k 1 funid (rhs funid lbl) [] key | funid <- IntSet.toList funids]
updateAt :: Int -> a -> [a] -> [a] updateAt :: Int -> a -> [a] -> [a]