diff options
| author | hallgren <hallgren@chalmers.se> | 2013-03-16 13:36:23 +0000 |
|---|---|---|
| committer | hallgren <hallgren@chalmers.se> | 2013-03-16 13:36:23 +0000 |
| commit | 80fe693546552eed32135cf01195954f4f812760 (patch) | |
| tree | 720f85a46781e7c347a99c5e486c326203de0cff /src/compiler/GF/Compile | |
| parent | 411d91d410a38bf44e7892ce90ae79dda5364169 (diff) | |
Fix a problem with pattern macros in pre { } expressions
The old partial evaluator has special rules to convert pattern macros in
pre { } expressions. These rules were missing in the new partial evaluator.
Diffstat (limited to 'src/compiler/GF/Compile')
| -rw-r--r-- | src/compiler/GF/Compile/Compute/ConcreteNew.hs | 4 | ||||
| -rw-r--r-- | 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 |