summaryrefslogtreecommitdiff
path: root/src/GF/Grammar
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2006-01-06 21:49:25 +0000
committeraarne <aarne@cs.chalmers.se>2006-01-06 21:49:25 +0000
commit88b09b8ae0d5b239d2c4fbb17d83778df12db618 (patch)
tree057a11bda78fb5841c286a601c66608008eee065 /src/GF/Grammar
parent3bf8e5ce6fbc026fd045762fbbf63eee58f09367 (diff)
concatenation string patterns
Diffstat (limited to 'src/GF/Grammar')
-rw-r--r--src/GF/Grammar/AppPredefined.hs2
-rw-r--r--src/GF/Grammar/PatternMatch.hs7
2 files changed, 9 insertions, 0 deletions
diff --git a/src/GF/Grammar/AppPredefined.hs b/src/GF/Grammar/AppPredefined.hs
index c8710f32d..442328eb4 100644
--- a/src/GF/Grammar/AppPredefined.hs
+++ b/src/GF/Grammar/AppPredefined.hs
@@ -35,6 +35,7 @@ typPredefined c@(IC f) = case f of
"PBool" -> return typePType
"PFalse" -> return $ cnPredef "PBool"
"PTrue" -> return $ cnPredef "PBool"
+ "CC" -> return $ mkFunType [typeTok,typeTok] typeTok
"dp" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
"drop" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
"eqInt" -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
@@ -73,6 +74,7 @@ appPredefined t = case t of
App (Q (IC "Predef") (IC f)) z0 -> do
(z,_) <- appPredefined z0
case (f, norm z, norm x) of
+ ("CC", K r, K s) -> retb $ K (r ++ s)
("drop", EInt i, K s) -> retb $ K (drop (fi i) s)
("take", EInt i, K s) -> retb $ K (take (fi i) s)
("tk", EInt i, K s) -> retb $ K (take (max 0 (length s - fi i)) s)
diff --git a/src/GF/Grammar/PatternMatch.hs b/src/GF/Grammar/PatternMatch.hs
index db6f7dc5b..b996efa0a 100644
--- a/src/GF/Grammar/PatternMatch.hs
+++ b/src/GF/Grammar/PatternMatch.hs
@@ -66,6 +66,12 @@ tryMatch (p,t) = do
p `eqStrIdent` f && length pp == length tt ->
do matches <- mapM tryMatch (zip pp tt)
return (concat matches)
+
+ (PP (IC "Predef") (IC "CC") [p1,p2], ([],K s, [])) -> do
+ let cuts = [splitAt n s | n <- [0 .. length s]]
+ matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts]
+ return (concat matches)
+
(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 ->
@@ -97,6 +103,7 @@ isInConstantForm trm = case trm of
App c a -> isInConstantForm c && isInConstantForm a
R r -> all (isInConstantForm . snd . snd) r
K _ -> True
+ Empty -> True
Alias _ _ t -> isInConstantForm t
EInt _ -> True
_ -> False ---- isInArgVarForm trm