GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-17 16:59:34 -06:00
Code Issues Packages Projects Releases Wiki Activity

The SLinType type is changed so that you don't have to use enumerateTerms each time when you want to know the possible table arguments

Browse Source
This commit is contained in:
kr.angelov
2006-06-01 10:26:49 +00:00
parent a73aa39dcc
commit 0c0c82603c
4 changed files with 23 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
src/GF/Conversion/SimpleToMCFG/Nondet.hs
View File

@@ -136,15 +136,13 @@ simplifyCase (pat, term) = liftM2 (,) (simplifyTerm pat) (simplifyTerm term)
reduceTerm :: SLinType -> SPath -> STerm -> CnvMonad ()
--reduceTerm ctype path (Variants terms)
-- = member terms >>= reduceTerm ctype path
reduceTerm (StrT) path term = updateLin (path, term)
reduceTerm (ConT _ _) path term = do pat <- expandTerm term
updateHead (path, pat)
reduceTerm (StrT) path term = updateLin (path, term)
reduceTerm (ConT _) path term = do pat <- expandTerm term
updateHead (path, pat)
reduceTerm (RecT rtype) path term
= sequence_ [ reduceTerm ctype (path ++. lbl) (term +. lbl) |
(lbl, ctype) <- rtype ]
reduceTerm (TblT ptype vtype) path table
= sequence_ [ reduceTerm vtype (path ++! pat) (table +! pat) |
pat <- enumeratePatterns ptype ]
= sequence_ [ reduceTerm ctype (path ++. lbl) (term +. lbl) | (lbl, ctype) <- rtype ]
reduceTerm (TblT pats vtype) path table
= sequence_ [ reduceTerm vtype (path ++! pat) (table +! pat) | pat <- pats ]
------------------------------------------------------------
@@ -174,7 +172,7 @@ unifyPType arg (RecT prec) =
sequence [ liftM ((,) lbl) $
unifyPType (arg +. lbl) ptype |
(lbl, ptype) <- prec ]
unifyPType (Arg nr _ path) (ConT con terms) =
unifyPType (Arg nr _ path) (ConT terms) =
do (_, args, _, _) <- readState
case lookup path (ecatConstraints (args !! nr)) of
Just term -> return term

2
src/GF/Conversion/SimpleToMCFG/Strict.hs
View File

@@ -109,7 +109,7 @@ termPaths ctype term | isBaseType ctype = [ (emptyPath, (ctype, term)) ]
parPaths :: SLinType -> STerm -> [[(SPath, STerm)]]
parPaths ctype term = mapM (uncurry (map . (,))) $ groupPairs $
nubsort [ (path, value) |
(path, (ConT _ _, value)) <- termPaths ctype term ]
(path, (ConT _, value)) <- termPaths ctype term ]
strPaths :: SLinType -> STerm -> [(SPath, STerm)]
strPaths ctype term = [ (path, variants values) | (path, values) <- groupPairs paths ]