From 80fe693546552eed32135cf01195954f4f812760 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Sat, 16 Mar 2013 13:36:23 +0000
Subject: [PATCH] =?UTF-8?q?Fix=20a=20problem=20with=20pattern=20macros=20i?=
 =?UTF-8?q?n=20pre=20{=20}=C2=A0expressions?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The old partial evaluator has special rules to convert pattern macros in
pre { } expressions. These rules were missing in the new partial evaluator.
---
 .../GF/Compile/Compute/ConcreteNew.hs         |  4 +++-
 src/compiler/GF/Compile/GeneratePMCFG.hs      | 22 ++++++++++++++-----
 2 files changed, 19 insertions(+), 7 deletions(-)

diff --git a/src/compiler/GF/Compile/Compute/ConcreteNew.hs b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
index 22df5301b..d35890930 100644
--- a/src/compiler/GF/Compile/Compute/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
@@ -436,12 +436,14 @@ value2term loc xs v0 =
     VC v1 v2       -> C (v2t v1) (v2t v2)
     VS v1 v2       -> S (v2t v1) (v2t v2)
     VP v l         -> P (v2t v) l
+    VPatt p        -> EPatt p -- hmm
+--  VPattType v    -> ...
     VAlts v vvs    -> Alts (v2t v) (mapBoth v2t vvs)
     VStrs vs       -> Strs (map v2t vs)
 --  VGlue v1 v2    -> Glue (v2t v1) (v2t v2)
     VExtR v1 v2    -> ExtR (v2t v1) (v2t v2)
     VError err     -> Error err
-    _              -> bug ("value2term "++show loc++" "++show v0)
+    _              -> bug ("value2term "++show loc++" : "++show v0)
   where
     v2t = value2term loc xs
     v2t' x f = value2term loc (x:xs) (f (gen xs))
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index d1765729e..2db007635 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -374,12 +374,22 @@ convertTerm opts sel ctype (K t)        = return (CStr [SymKS [t]])
 convertTerm opts sel ctype Empty        = return (CStr [])
 convertTerm opts sel ctype (Alts s alts)
                                         = return (CStr [SymKP (strings s) [Alt (strings u) (strings v) | (u,v) <- alts]])
-                                            where
-                                              strings (K s)     = [s]
-                                              strings (C u v)   = strings u ++ strings v
-                                              strings (Strs ss) = concatMap strings ss
-                                              strings Empty = [] -- ??
-                                              strings t = bug $ "strings "++show t
+           where
+             strings (K s)     = [s]
+             strings (C u v)   = strings u ++ strings v
+             strings (Strs ss) = concatMap strings ss
+             strings (EPatt p) = getPatts p
+             strings Empty = [] -- ??
+             strings t = bug $ "strings "++show t
+
+             getPatts p =
+               case p of
+                 PAlt a b  -> getPatts a ++ getPatts b
+                 PString s -> [s]
+                 PSeq a b  -> [s ++ t | s <- getPatts a, t <- getPatts b]
+                 _ -> ppbug $ hang (text "not valid pattern in pre expression:")
+                                   4
+                                   (ppPatt Unqualified 0 p)
 
 convertTerm opts sel@(CProj l _) ctype (ExtR t1 t2@(R rs2))
                     | l `elem` map fst rs2 = convertTerm opts sel ctype t2