GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

Fix a problem with pattern macros in pre { } expressions

Browse Source 
The old partial evaluator has special rules to convert pattern macros in
pre { } expressions. These rules were missing in the new partial evaluator.
This commit is contained in:
hallgren
2013-03-16 13:36:23 +00:00
parent 411d91d410
commit 80fe693546
2 changed files with 19 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/compiler/GF/Compile/Compute/ConcreteNew.hs
View File

@@ -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))

22
src/compiler/GF/Compile/GeneratePMCFG.hs
View File

@@ -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