GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 03:32:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

fix the loopchecking in PGF.Forest.bracketedTokn

Browse Source
This commit is contained in:
krasimir
2010-07-13 12:04:06 +00:00
parent c9cca8a77e
commit ef68e209c2
1 changed files with 13 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
src/runtime/haskell/PGF/Forest.hs
View File

@@ -51,27 +51,27 @@ linearizeWithBrackets = head . snd . untokn "" . bracketedTokn
bracketedTokn :: Forest -> BracketedTokn bracketedTokn :: Forest -> BracketedTokn
bracketedTokn f@(Forest abs cnc forest root) = bracketedTokn f@(Forest abs cnc forest root) =
case [computeSeq seq (map (render IntMap.empty) args) | (seq,args) <- root] of case [computeSeq seq (map (render forest) args) | (seq,args) <- root] of
([bs@(Bracket_ _ _ _ _ _)]:_) -> bs ([bs@(Bracket_ _ _ _ _ _)]:_) -> bs
(bss:_) -> Bracket_ wildCId 0 0 [] bss (bss:_) -> Bracket_ wildCId 0 0 [] bss
[] -> Bracket_ wildCId 0 0 [] [] [] -> Bracket_ wildCId 0 0 [] []
where where
trusted = foldl1 IntSet.intersection [IntSet.unions (map (trustedSpots IntSet.empty) args) | (_,args) <- root] trusted = foldl1 IntSet.intersection [IntSet.unions (map (trustedSpots IntSet.empty) args) | (_,args) <- root]
render parents fid = render forest fid =
case (IntMap.lookup fid parents) `mplus` (fmap Set.toList $ IntMap.lookup fid forest) of case IntMap.lookup fid forest >>= Set.maxView of
Just (p:ps) -> descend (IntMap.insert fid ps parents) p Just (p,set) -> descend (if Set.null set then forest else IntMap.insert fid set forest) p
Nothing -> error ("wrong forest id " ++ show fid) Nothing -> error ("wrong forest id " ++ show fid)
where where
descend parents (PApply funid args) = let (CncFun fun lins) = cncfuns cnc ! funid descend forest (PApply funid args) = let (CncFun fun lins) = cncfuns cnc ! funid
Just (DTyp _ cat _,_,_) = Map.lookup fun (funs abs) Just (DTyp _ cat _,_,_) = Map.lookup fun (funs abs)
largs = map (render parents) args largs = map (render forest) args
ltable = listArray (bounds lins) ltable = listArray (bounds lins)
[computeSeq (elems (sequences cnc ! seqid)) largs | [computeSeq (elems (sequences cnc ! seqid)) largs |
seqid <- elems lins] seqid <- elems lins]
in (fid,cat,ltable) in (fid,cat,ltable)
descend parents (PCoerce fid) = render parents fid descend forest (PCoerce fid) = render forest fid
descend parents (PConst cat _ ts) = (fid,cat,listArray (0,0) [[LeafKS ts]]) descend forest (PConst cat _ ts) = (fid,cat,listArray (0,0) [[LeafKS ts]])
trustedSpots parents fid trustedSpots parents fid
| fid < totalCats cnc || -- forest ids from the grammar correspond to metavariables | fid < totalCats cnc || -- forest ids from the grammar correspond to metavariables