From f2e52d6f2c2bc90febceebdea0268b40ea37476c Mon Sep 17 00:00:00 2001 From: "John J. Camilleri" Date: Wed, 7 Jul 2021 09:40:41 +0200 Subject: Replace tabs for whitespace in source code --- src/compiler/GF/Grammar/PatternMatch.hs | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) (limited to 'src/compiler/GF/Grammar/PatternMatch.hs') 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 [] -- cgit v1.2.3