From f2b6f36e02af9b41f8e7ad074721e9ab4d79bb44 Mon Sep 17 00:00:00 2001
From: krangelov <kr.angelov@gmail.com>
Date: Mon, 20 Dec 2021 15:44:30 +0100
Subject: [PATCH] generalize the syntax for pre patterns

---
 src/compiler/GF/Compile/TypeCheck/Concrete.hs |  7 +++++++
 src/compiler/GF/Grammar/Macros.hs             | 17 +++++++++++++++++
 src/compiler/GF/Grammar/Parser.y              | 10 ----------
 3 files changed, 24 insertions(+), 10 deletions(-)

diff --git a/src/compiler/GF/Compile/TypeCheck/Concrete.hs b/src/compiler/GF/Compile/TypeCheck/Concrete.hs
index 0727ffe14..521c9d6d6 100644
--- a/src/compiler/GF/Compile/TypeCheck/Concrete.hs
+++ b/src/compiler/GF/Compile/TypeCheck/Concrete.hs
@@ -213,6 +213,13 @@ inferLType gr g trm = case trm of
      aa' <- flip mapM aa (\ (c,v) -> do
         c' <- justCheck g c typeStr
         v' <- checks $ map (justCheck g v) [typeStrs, EPattType typeStr]
+        v' <- case v' of
+                Q q -> do t <- lookupResDef gr q
+                          t <- normalForm gr t
+                          case t of
+                            EPatt _ _ p -> mkStrs p
+                            _           -> return v'
+                _   -> return v'
         return (c',v'))
      return (Alts t' aa', typeStr)
 
diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs
index a69154c68..5df554957 100644
--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -563,3 +563,20 @@ topoSortJments2 (m,mi) = do
            (topoTest2 (allDependencies (==m) (jments mi)))
   return
     [[(i,info) | i<-is,Just info<-[Map.lookup i (jments mi)]] | is<-iss]
+
+
+mkStrs p = case p of
+ PAlt a b -> do
+   Strs as <- mkStrs a
+   Strs bs <- mkStrs b
+   return $ Strs $ as ++ bs
+ PSeq _ _ a _ _ b ->
+             do Strs as <- mkStrs a
+                Strs bs <- mkStrs b
+                return $ Strs $ [K (a++b) | K a <- as, K b <- bs]
+ PString s -> return $ Strs [K s]
+ PChars cs -> return $ Strs [K [c] | c <- cs]
+ PV x -> return (Vr x) --- for macros; not yet complete
+ PMacro x -> return (Vr x) --- for macros; not yet complete
+ PM c -> return (Q c) --- for macros; not yet complete
+ _ -> fail "no strs from pattern"
diff --git a/src/compiler/GF/Grammar/Parser.y b/src/compiler/GF/Grammar/Parser.y
index 7499f1074..f7873e421 100644
--- a/src/compiler/GF/Grammar/Parser.y
+++ b/src/compiler/GF/Grammar/Parser.y
@@ -811,16 +811,6 @@ mkAlts cs = case cs of
    mkAlt (p,t) = do
      ss <- mkStrs p
      return (t,ss)
-   mkStrs p = case p of
-     PAlt a b -> do
-       Strs as <- mkStrs a
-       Strs bs <- mkStrs b
-       return $ Strs $ as ++ bs
-     PString s -> return $ Strs [K s]
-     PV x -> return (Vr x) --- for macros; not yet complete
-     PMacro x -> return (Vr x) --- for macros; not yet complete
-     PM c -> return (Q c) --- for macros; not yet complete
-     _ -> fail "no strs from pattern"
 
 mkL :: Posn -> Posn -> x -> L x
 mkL (Pn l1 _) (Pn l2 _) x = L (Local l1 l2) x