pattern matching for "x"*

src/compiler/GF/Compile/Compute/Concrete.hs

@@ -25,7 +25,6 @@ import Control.Applicative
 import qualified Control.Monad.Fail as Fail
 import qualified Data.Map as Map
 import GF.Text.Pretty
-import Debug.Trace
 
 -- * Main entry points
 
@@ -161,6 +160,14 @@ patternMatch v0 ((env0,ps,args0,t):eqs) = match env0 ps eqs args0
                                              eqs <- matchStr env (p1:p2:ps) eqs (hi-lo) (reverse ds) cs args
                                              patternMatch v0 eqs
                                Nothing -> return v0
+        (PRep minp maxp p, v)
+          | minp == 0     -> match env ps eqs args
+          | otherwise     -> case value2string v of
+                               Just s  -> do let n = length s `div` minp
+                                                 eqs0 = eqs
+                                             eqs <- matchRep env n minp maxp p minp maxp p ps eqs (arg:args)
+                                             patternMatch v0 eqs
+                               Nothing -> return v0
         (PChar, VStr [_]) -> match env ps eqs args
         (PChars cs, VStr [c])
           | elem c cs     -> match env ps eqs args
@@ -194,6 +201,11 @@ patternMatch v0 ((env0,ps,args0,t):eqs) = match env0 ps eqs args0
       eqs  <- matchStr env ps eqs (i-1 :: Int) (c:ds) cs args
       return ((env,ps,arg1:arg2:args,t) : eqs)
 
+    matchRep env 0 minp maxp p minq maxq q ps eqs args = do
+      return ((env,PString []:ps,args,t) : eqs)
+    matchRep env n minp maxp p minq maxq q ps eqs args = do
+      matchRep env (n-1) minp maxp p (minp+minq) (maxp+maxq) (PSeq minp maxp p minq maxq q) ps ((env,q:ps,args,t) : eqs) args
+
     vc s =
       case words s of
         []  -> VC []

src/compiler/GF/Compile/Rename.hs

@@ -311,9 +311,9 @@ renamePattern env patt =
         (q',ws) <- renp q
         return (PSeq minp maxp p' minq maxq q', vs ++ ws)
 
-      PRep p -> do
+      PRep minp maxp p -> do
         (p',vs) <- renp p
-        return (PRep p', vs)
+        return (PRep minp maxp p', vs)
 
       PNeg p -> do
         (p',vs) <- renp p

src/compiler/GF/Compile/TypeCheck/Concrete.hs

@@ -305,7 +305,7 @@ inferLType gr g trm = case trm of
      PChars _ -> True
      PSeq _ _ p _ _ q -> isConstPatt p && isConstPatt q
      PAlt p q -> isConstPatt p && isConstPatt q
-     PRep p -> isConstPatt p
+     PRep _ _ p -> isConstPatt p
      PNeg p -> isConstPatt p
      PAs _ p -> isConstPatt p
      _ -> False
@@ -316,7 +316,7 @@ inferLType gr g trm = case trm of
      PNeg p   -> inferPatt p
      PAlt p q -> checks [inferPatt p, inferPatt q]
      PSeq _ _ _ _ _ _ -> return $ typeStr
-     PRep _   -> return $ typeStr
+     PRep _ _ _ -> return $ typeStr
      PChar    -> return $ typeStr
      PChars _ -> return $ typeStr
      _ -> inferLType gr g (patt2term p) >>= return . snd
@@ -342,8 +342,8 @@ measurePatt p =
                -> let (min1,max1,p1') = measurePatt p1
                       (min2,max2,p2') = measurePatt p2
                   in (min1+min2,liftM2 (+) max1 max2,PSeq min1 (fromMaybe maxBound max1) p1' min2 (fromMaybe maxBound max2) p2')
-    PRep p     -> let (_,_,p') = measurePatt p
-                  in (0,Nothing,PRep p')
+    PRep _ _ p -> let (minp,maxp,p') = measurePatt p
+                  in (0,Nothing,PRep minp (fromMaybe maxBound maxp) p')
     PChar      -> (1,Just 1,p)
     PChars _   -> (1,Just 1,p)
     _          -> (0,Nothing,p)
@@ -666,7 +666,7 @@ pattContext env g typ p = case p of
     g1 <- pattContext env g typ p
     g2 <- pattContext env g typ q
     return $ g1 ++ g2
-  PRep p' -> noBind typeStr p'
+  PRep _ _ p' -> noBind typeStr p'
   PNeg p' -> noBind typ p'
 
   _ -> return [] ---- check types!