enable matching of ++ strings with regular patterns

1 files changed, 19 insertions, 3 deletions

diff --git a/src/GF/Grammar/PatternMatch.hs b/src/GF/Grammar/PatternMatch.hs
index b96d35b93..92d75f2d3 100644
--- a/src/GF/Grammar/PatternMatch.hs
+++ b/src/GF/Grammar/PatternMatch.hs
@@ -31,9 +31,23 @@ matchPattern :: [(Patt,Term)] -> Term -> Err (Term, Substitution)
 matchPattern pts term = 
   if not (isInConstantForm term)
     then prtBad "variables occur in" term
-  else 
+  else do
+    term' <- mkK term
     errIn ("trying patterns" +++ unwords (intersperse "," (map (prt . fst) pts))) $
-    findMatch [([p],t) | (p,t) <- pts] [term]
+      findMatch [([p],t) | (p,t) <- pts] [term']
+ where
+  -- to capture all Str with string pattern matching
+  mkK s = case s of
+    C _ _ -> do
+      s' <- getS s
+      return (K (unwords s'))
+    _ -> return s
+
+  getS s = case s of
+    K w -> return [w]
+    C v w -> liftM2 (++) (getS v) (getS w)
+    Empty -> return []
+    _ -> prtBad "cannot get string from" s
 
 testOvershadow :: [Patt] -> [Term] -> Err [Patt]
 testOvershadow pts vs = do
@@ -57,7 +71,8 @@ tryMatch (p,t) = do
   t' <- termForm t
   trym p t'
  where
-  isInConstantFormt = True -- tested already
+
+  isInConstantFormt = True -- tested already in matchPattern
   trym p t' =
     case (p,t') of
       (PVal _ i, (_,Val _ j,_)) 
@@ -129,6 +144,7 @@ isInConstantForm trm = case trm of
     Q _ _    -> True
     QC _ _   -> True
     Abs _ _  -> True
+    C c a    -> isInConstantForm c && isInConstantForm a
     App c a  -> isInConstantForm c && isInConstantForm a
     R r      -> all (isInConstantForm . snd . snd) r
     K _      -> True