From bb053119b3ffec3798b1db275d2ce79b61e53ace Mon Sep 17 00:00:00 2001
From: krangelov <kr.angelov@gmail.com>
Date: Mon, 13 Dec 2021 09:55:37 +0100
Subject: [PATCH] when a pattern macro is invoked, the operation must be
 computed first

---
 src/compiler/GF/Compile/TypeCheck/Concrete.hs | 61 ++++++++++---------
 1 file changed, 31 insertions(+), 30 deletions(-)

diff --git a/src/compiler/GF/Compile/TypeCheck/Concrete.hs b/src/compiler/GF/Compile/TypeCheck/Concrete.hs
index a3821edc2..80011af68 100644
--- a/src/compiler/GF/Compile/TypeCheck/Concrete.hs
+++ b/src/compiler/GF/Compile/TypeCheck/Concrete.hs
@@ -10,6 +10,7 @@ import GF.Grammar.Lookup
 import GF.Grammar.Predef
 import GF.Grammar.PatternMatch
 import GF.Grammar.Lockfield (isLockLabel, lockRecType, unlockRecord)
+import GF.Compile.Compute.Concrete(normalForm)
 import GF.Compile.TypeCheck.Primitives
 
 import Data.List
@@ -267,7 +268,7 @@ inferLType gr g trm = case trm of
      return (EPattType ty',typeType)
    EPatt _ _ p -> do
      ty <- inferPatt p
-     let (minp,maxp,p') = measurePatt gr p
+     (minp,maxp,p') <- measurePatt gr p
      return (EPatt minp maxp p', EPattType ty)
 
    ELin c trm -> do
@@ -324,35 +325,35 @@ inferLType gr g trm = case trm of
 
 measurePatt gr p =
   case p of
-    PM q       -> case lookupResDef gr q of
-                    Ok t    -> case t of
-                                 EPatt minp maxp _ -> (minp,maxp,p)
-                                 _ -> error "Expected pattern macro"
-                    Bad msg -> error msg
-    PR ass     -> let p' = PR (map (\(lbl,p) -> let (_,_,p') = measurePatt gr p in (lbl,p')) ass)
-                  in (0,Nothing,p')
-    PString s  -> let len=length s
-                  in (len,Just len,p)
-    PT t p     -> let (min,max,p') = measurePatt gr p
-                  in (min,max,PT t p')
-    PAs x p    -> let (min,max,p') = measurePatt gr p
-                  in (min,max,PAs x p')
-    PImplArg p -> let (min,max,p') = measurePatt gr p
-                  in (min,max,PImplArg p')
-    PNeg p     -> let (_,_,p') = measurePatt gr p
-                  in (0,Nothing,PNeg p')
-    PAlt p1 p2 -> let (min1,max1,p1') = measurePatt gr p1
-                      (min2,max2,p2') = measurePatt gr p2
-                  in (min min1 min2,liftM2 max max1 max2,PAlt p1' p2')
+    PM q       -> do t <- lookupResDef gr q
+                     t <- normalForm gr t
+                     case t of
+                       EPatt minp maxp _ -> return (minp,maxp,p)
+                       _                 -> checkError ("Expected pattern macro, but found:" $$ nest 2 (pp t))
+    PR ass     -> do ass <- mapM (\(lbl,p) -> measurePatt gr p >>= \(_,_,p') -> return (lbl,p')) ass
+                     return (0,Nothing,PR ass)
+    PString s  -> do let len=length s
+                     return (len,Just len,p)
+    PT t p     -> do (min,max,p') <- measurePatt gr p
+                     return (min,max,PT t p')
+    PAs x p    -> do (min,max,p') <- measurePatt gr p
+                     return (min,max,PAs x p')
+    PImplArg p -> do (min,max,p') <- measurePatt gr p
+                     return (min,max,PImplArg p')
+    PNeg p     -> do (_,_,p') <- measurePatt gr p
+                     return (0,Nothing,PNeg p')
+    PAlt p1 p2 -> do (min1,max1,p1') <- measurePatt gr p1
+                     (min2,max2,p2') <- measurePatt gr p2
+                     return (min min1 min2,liftM2 max max1 max2,PAlt p1' p2')
     PSeq _ _ p1 _ _ p2
-               -> let (min1,max1,p1') = measurePatt gr p1
-                      (min2,max2,p2') = measurePatt gr p2
-                  in (min1+min2,liftM2 (+) max1 max2,PSeq min1 max1 p1' min2 max2 p2')
-    PRep _ _ p -> let (minp,maxp,p') = measurePatt gr p
-                  in (0,Nothing,PRep minp maxp p')
-    PChar      -> (1,Just 1,p)
-    PChars _   -> (1,Just 1,p)
-    _          -> (0,Nothing,p)
+               -> do (min1,max1,p1') <- measurePatt gr p1
+                     (min2,max2,p2') <- measurePatt gr p2
+                     return (min1+min2,liftM2 (+) max1 max2,PSeq min1 max1 p1' min2 max2 p2')
+    PRep _ _ p -> do (minp,maxp,p') <- measurePatt gr p
+                     return (0,Nothing,PRep minp maxp p')
+    PChar      -> return (1,Just 1,p)
+    PChars _   -> return (1,Just 1,p)
+    _          -> return (0,Nothing,p)
 
 -- type inference: Nothing, type checking: Just t
 -- the latter permits matching with value type
@@ -632,7 +633,7 @@ checkLType gr g trm typ0 = do
    checkCase arg val (p,t) = do
      cont <- pattContext gr g arg p
      t' <- justCheck (reverse cont ++ g) t val
-     let (_,_,p') = measurePatt gr p
+     (_,_,p') <- measurePatt gr p
      return (p',t')
 
 pattContext :: SourceGrammar -> Context -> Type -> Patt -> Check Context