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

fix the "stack overflow" error with the Swedish grammar

Browse Source
This commit is contained in:
kr.angelov
2006-06-02 08:34:17 +00:00
parent 81f2e036e7
commit 58bcb9e22e
1 changed files with 6 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
src/GF/Conversion/SimpleToFCFG.hs
View File

@@ -340,7 +340,6 @@ data STermSelector
| TblPrj STerm STermSelector | TblPrj STerm STermSelector
| ConSel [STerm] | ConSel [STerm]
| StrSel | StrSel
deriving Show
mkSingletonSelector :: SLinType -> BacktrackM () STermSelector mkSingletonSelector :: SLinType -> BacktrackM () STermSelector
@@ -377,10 +376,14 @@ mkSelector rcs tcss =
add (cas@(pat',sub_sel):cases) add (cas@(pat',sub_sel):cases)
| pat == pat' = (pat',addProjection sub_sel path):cases | pat == pat' = (pat',addProjection sub_sel path):cases
| otherwise = cas : add cases | otherwise = cas : add cases
addProjection x y = error ("addProjection "++show x ++ " " ++ prt (Path y))
addRestriction :: STermSelector -> ([Either Label STerm],STerm) -> STermSelector addRestriction :: STermSelector -> ([Either Label STerm],STerm) -> STermSelector
addRestriction (ConSel terms) ([] ,term) = ConSel (term:terms) addRestriction (ConSel terms) ([] ,term) = ConSel (add terms)
where
add [] = [term]
add (term':terms)
| term == term' = term': terms
| otherwise = term':add terms
addRestriction (RecSel fields) (Left lbl : path,term) = RecSel (add fields) addRestriction (RecSel fields) (Left lbl : path,term) = RecSel (add fields)
where where
add [] = [(lbl,path2selector (ConSel [term]) path)] add [] = [(lbl,path2selector (ConSel [term]) path)]