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

Optimized mkSingletonSelectors

Browse Source
This commit is contained in:
kr.angelov
2006-06-21 19:37:18 +00:00
parent 4813788a9b
commit af555cc6a7
1 changed files with 5 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -354,14 +354,14 @@ data STermSelector
| StrSel | StrSel
mkSingletonSelectors :: SLinType -> [STermSelector] mkSingletonSelectors :: SLinType -> [STermSelector]
mkSingletonSelectors ctype = mkSingletonSelectors ctype = sels0
let (rcss,tcss) = loop emptyPath ([],[]) ctype
in [mkSelector [rcs] tcss | rcs <- rcss]
where where
(sels0,tcss0) = loop emptyPath ([],[]) ctype
loop path st (RecT record) = List.foldl' (\st (lbl,ctype) -> loop (path ++. lbl ) st ctype) st record loop path st (RecT record) = List.foldl' (\st (lbl,ctype) -> loop (path ++. lbl ) st ctype) st record
loop path st (TblT terms ctype) = List.foldl' (\st term -> loop (path ++! term) st ctype) st terms loop path st (TblT terms ctype) = List.foldl' (\st term -> loop (path ++! term) st ctype) st terms
loop path (rcss,tcss) (ConT terms) = (rcss, map ((,) path) terms : tcss) loop path (sels,tcss) (ConT terms) = ( sels,map ((,) path) terms : tcss)
loop path (rcss,tcss) (StrT) = (path : rcss, tcss) loop path (sels,tcss) (StrT) = (mkSelector [path] tcss0 : sels, tcss)
mkSelector :: [SPath] -> [[(SPath,STerm)]] -> STermSelector mkSelector :: [SPath] -> [[(SPath,STerm)]] -> STermSelector