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

regex patterns for tokens

Browse Source
This commit is contained in:
aarne
2006-01-07 12:26:11 +00:00
parent 5e0dad4362
commit 16a4868efa
16 changed files with 358 additions and 199 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
src/GF/Grammar/PatternMatch.hs
View File

@@ -67,11 +67,6 @@ tryMatch (p,t) = do
do matches <- mapM tryMatch (zip pp tt)
return (concat matches)
(PP (IC "Predef") (IC "CC") [p1,p2], ([],K s, [])) -> do
let cuts = [splitAt n s | n <- [0 .. length s]]
matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts]
return (concat matches)
(PP q p pp, ([], QC r f, tt)) |
-- q `eqStrIdent` r && --- not for inherited AR 10/10/2005
p `eqStrIdent` f && length pp == length tt ->
@@ -91,6 +86,24 @@ tryMatch (p,t) = do
return (concat matches)
(PT _ p',_) -> trym p' t'
(_, ([],Alias _ _ d,[])) -> tryMatch (p,d)
-- (PP (IC "Predef") (IC "CC") [p1,p2], ([],K s, [])) -> do
(PAs x p',_) -> do
subst <- trym p' t'
return $ (x,t) : subst
(PAlt p1 p2,_) -> checks [trym p1 t', trym p2 t']
(PSeq p1 p2, ([],K s, [])) -> do
let cuts = [splitAt n s | n <- [0 .. length s]]
matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts]
return (concat matches)
(PRep p1, ([],K s, [])) -> checks [
trym (foldr (const (PSeq p1)) (PString "") [0..n]) t' | n <- [1 .. length s]
]
_ -> prtBad "no match in case expr for" t
isInConstantForm :: Term -> Bool