summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Grammar/PatternMatch.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/GF/Grammar/PatternMatch.hs')
-rw-r--r--src/compiler/GF/Grammar/PatternMatch.hs20
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