diff options
Diffstat (limited to 'src/compiler/GF/Grammar/PatternMatch.hs')
| -rw-r--r-- | src/compiler/GF/Grammar/PatternMatch.hs | 20 |
1 files changed, 10 insertions, 10 deletions
diff --git a/src/compiler/GF/Grammar/PatternMatch.hs b/src/compiler/GF/Grammar/PatternMatch.hs index 81541b2a3..48cb9bd3f 100644 --- a/src/compiler/GF/Grammar/PatternMatch.hs +++ b/src/compiler/GF/Grammar/PatternMatch.hs @@ -22,20 +22,20 @@ import GF.Data.Operations import GF.Grammar.Grammar import GF.Infra.Ident import GF.Grammar.Macros -import GF.Grammar.Printer +--import GF.Grammar.Printer --import Data.List import Control.Monad -import Text.PrettyPrint +import GF.Text.Pretty --import Debug.Trace matchPattern :: ErrorMonad m => [(Patt,rhs)] -> Term -> m (rhs, Substitution) matchPattern pts term = if not (isInConstantForm term) - then raise (render (text "variables occur in" <+> ppTerm Unqualified 0 term)) + then raise (render ("variables occur in" <+> pp term)) else do term' <- mkK term - errIn (render (text "trying patterns" <+> hsep (punctuate comma (map (ppPatt Unqualified 0 . fst) pts)))) $ + errIn (render ("trying patterns" <+> hsep (punctuate ',' (map fst pts)))) $ findMatch [([p],t) | (p,t) <- pts] [term'] where -- to capture all Str with string pattern matching @@ -49,7 +49,7 @@ matchPattern pts term = K w -> return [w] C v w -> liftM2 (++) (getS v) (getS w) Empty -> return [] - _ -> raise (render (text "cannot get string from" <+> ppTerm Unqualified 0 s)) + _ -> raise (render ("cannot get string from" <+> s)) testOvershadow :: ErrorMonad m => [Patt] -> [Term] -> m [Patt] testOvershadow pts vs = do @@ -60,10 +60,10 @@ testOvershadow pts vs = do findMatch :: ErrorMonad m => [([Patt],rhs)] -> [Term] -> m (rhs, Substitution) findMatch cases terms = case cases of - [] -> raise (render (text "no applicable case for" <+> hsep (punctuate comma (map (ppTerm Unqualified 0) terms)))) + [] -> raise (render ("no applicable case for" <+> hsep (punctuate ',' terms))) (patts,_):_ | length patts /= length terms -> - raise (render (text "wrong number of args for patterns :" <+> hsep (map (ppPatt Unqualified 0) patts) <+> - text "cannot take" <+> hsep (map (ppTerm Unqualified 0) 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 @@ -116,7 +116,7 @@ tryMatch (p,t) = do (PNeg p',_) -> case tryMatch (p',t) of Bad _ -> return [] - _ -> raise (render (text "no match with negative pattern" <+> ppPatt Unqualified 0 p)) + _ -> raise (render ("no match with negative pattern" <+> p)) (PSeq p1 p2, ([],K s, [])) -> matchPSeq p1 p2 s (PMSeq mp1 mp2, ([],K s, [])) -> matchPMSeq mp1 mp2 s @@ -130,7 +130,7 @@ tryMatch (p,t) = do (PChar, ([],K [_], [])) -> return [] (PChars cs, ([],K [c], [])) | elem c cs -> return [] - _ -> raise (render (text "no match in case expr for" <+> ppTerm Unqualified 0 t)) + _ -> raise (render ("no match in case expr for" <+> t)) matchPMSeq (m1,p1) (m2,p2) s = matchPSeq' m1 p1 m2 p2 s --matchPSeq p1 p2 s = matchPSeq' (0,maxBound::Int) p1 (0,maxBound::Int) p2 s |
