summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Grammar/PatternMatch.hs
diff options
context:
space:
mode:
authorJohn J. Camilleri <john@digitalgrammars.com>2021-07-07 09:40:41 +0200
committerJohn J. Camilleri <john@digitalgrammars.com>2021-07-07 09:40:41 +0200
commitf2e52d6f2c2bc90febceebdea0268b40ea37476c (patch)
tree710619761319d65c5d997ec008f57f9253eae5dd /src/compiler/GF/Grammar/PatternMatch.hs
parenta2b23d5897b4c04b50cd222ce8f215e45a3b6e40 (diff)
Replace tabs for whitespace in source code
Diffstat (limited to 'src/compiler/GF/Grammar/PatternMatch.hs')
-rw-r--r--src/compiler/GF/Grammar/PatternMatch.hs33
1 files changed, 17 insertions, 16 deletions
diff --git a/src/compiler/GF/Grammar/PatternMatch.hs b/src/compiler/GF/Grammar/PatternMatch.hs
index 9ef191554..dc0a5d3a5 100644
--- a/src/compiler/GF/Grammar/PatternMatch.hs
+++ b/src/compiler/GF/Grammar/PatternMatch.hs
@@ -5,18 +5,19 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/10/12 12:38:29 $
+-- > CVS $Date: 2005/10/12 12:38:29 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.7 $
--
-- pattern matching for both concrete and abstract syntax. AR -- 16\/6\/2003
-----------------------------------------------------------------------------
-module GF.Grammar.PatternMatch (matchPattern,
- testOvershadow,
- findMatch,
- measurePatt
- ) where
+module GF.Grammar.PatternMatch (
+ matchPattern,
+ testOvershadow,
+ findMatch,
+ measurePatt
+ ) where
import GF.Data.Operations
import GF.Grammar.Grammar
@@ -30,7 +31,7 @@ import GF.Text.Pretty
--import Debug.Trace
matchPattern :: ErrorMonad m => [(Patt,rhs)] -> Term -> m (rhs, Substitution)
-matchPattern pts term =
+matchPattern pts term =
if not (isInConstantForm term)
then raise (render ("variables occur in" <+> pp term))
else do
@@ -61,15 +62,15 @@ testOvershadow pts vs = do
findMatch :: ErrorMonad m => [([Patt],rhs)] -> [Term] -> m (rhs, Substitution)
findMatch cases terms = case cases of
[] -> raise (render ("no applicable case for" <+> hsep (punctuate ',' terms)))
- (patts,_):_ | length patts /= length terms ->
- raise (render ("wrong number of args for patterns :" <+> hsep patts <+>
+ (patts,_):_ | length patts /= length terms ->
+ raise (render ("wrong number of args for patterns :" <+> hsep patts <+>
"cannot take" <+> hsep terms))
(patts,val):cc -> case mapM tryMatch (zip patts terms) of
Ok substs -> return (val, concat substs)
_ -> findMatch cc terms
tryMatch :: (Patt, Term) -> Err [(Ident, Term)]
-tryMatch (p,t) = do
+tryMatch (p,t) = do
t' <- termForm t
trym p t'
where
@@ -83,26 +84,26 @@ tryMatch (p,t) = do
(PString s, ([],K i,[])) | s==i -> return []
(PInt s, ([],EInt i,[])) | s==i -> return []
(PFloat s,([],EFloat i,[])) | s==i -> return [] --- rounding?
- (PC p pp, ([], Con f, tt)) |
+ (PC p pp, ([], Con f, tt)) |
p `eqStrIdent` f && length pp == length tt ->
do matches <- mapM tryMatch (zip pp tt)
return (concat matches)
- (PP (q,p) pp, ([], QC (r,f), tt)) |
+ (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 ->
do matches <- mapM tryMatch (zip pp tt)
return (concat matches)
---- hack for AppPredef bug
- (PP (q,p) pp, ([], Q (r,f), tt)) |
- -- q `eqStrIdent` r && ---
+ (PP (q,p) pp, ([], Q (r,f), tt)) |
+ -- q `eqStrIdent` r && ---
p `eqStrIdent` f && length pp == length tt ->
do matches <- mapM tryMatch (zip pp tt)
return (concat matches)
(PR r, ([],R r',[])) |
all (`elem` map fst r') (map fst r) ->
- do matches <- mapM tryMatch
+ do matches <- mapM tryMatch
[(p,snd a) | (l,p) <- r, let Just a = lookup l r']
return (concat matches)
(PT _ p',_) -> trym p' t'
@@ -125,7 +126,7 @@ tryMatch (p,t) = do
(PMSeq mp1 mp2, ([],K s, [])) -> matchPMSeq mp1 mp2 s
(PRep p1, ([],K s, [])) -> checks [
- trym (foldr (const (PSeq p1)) (PString "")
+ trym (foldr (const (PSeq p1)) (PString "")
[1..n]) t' | n <- [0 .. length s]
] >>
return []