diff options
Diffstat (limited to 'src/compiler')
| -rw-r--r-- | src/compiler/GF/Compile/GrammarToCanonical.hs | 19 | ||||
| -rw-r--r-- | src/compiler/GF/Grammar/Canonical.hs | 2 |
2 files changed, 19 insertions, 2 deletions
diff --git a/src/compiler/GF/Compile/GrammarToCanonical.hs b/src/compiler/GF/Compile/GrammarToCanonical.hs index 32a4e301b..5494a1daa 100644 --- a/src/compiler/GF/Compile/GrammarToCanonical.hs +++ b/src/compiler/GF/Compile/GrammarToCanonical.hs @@ -1,6 +1,9 @@ -- | Translate grammars to Canonical form -- (a common intermediate representation to simplify export to other formats) -module GF.Compile.GrammarToCanonical(grammar2canonical,abstract2canonical,concretes2canonical) where +module GF.Compile.GrammarToCanonical( + grammar2canonical,abstract2canonical,concretes2canonical, + projection,selection + ) where import Data.List(nub,partition) import qualified Data.Map as M import qualified Data.Set as S @@ -238,6 +241,7 @@ concatValue v1 v2 = (_,LiteralValue (StrConstant "")) -> v1 _ -> ConcatValue v1 v2 +-- | Smart constructor for projections projection r l = maybe (Projection r l) id (proj r l) proj r l = @@ -247,20 +251,31 @@ proj r l = _ -> Nothing _ -> Nothing +-- | Smart constructor for selections selection t v = + -- Note: impossible cases can become possible after grammar transformation case t of TableValue tt r -> case nub [rv|TableRow _ rv<-keep] of [rv] -> rv _ -> Selection (TableValue tt r') v where + -- Don't introduce wildcard patterns, true to the canonical format, + -- annotate (or eliminate) rhs in impossible rows + r' = map trunc r + trunc r@(TableRow p e) = if mightMatchRow v r + then r + else TableRow p (impossible e) + {- + -- Creates smaller tables, but introduces wildcard patterns r' = if null discard then r else keep++[TableRow WildPattern impossible] + -} (keep,discard) = partition (mightMatchRow v) r _ -> Selection t v -impossible = ErrorValue "impossible" +impossible = CommentedValue "impossible" mightMatchRow v (TableRow p _) = case p of diff --git a/src/compiler/GF/Grammar/Canonical.hs b/src/compiler/GF/Grammar/Canonical.hs index ed4f3fc9e..4adff02f2 100644 --- a/src/compiler/GF/Grammar/Canonical.hs +++ b/src/compiler/GF/Grammar/Canonical.hs @@ -217,6 +217,7 @@ instance Pretty LinValue where pp lv = case lv of ConcatValue v1 v2 -> sep [v1 <+> "++",pp v2] ErrorValue s -> "Predef.error"<+>doubleQuotes s + ParamConstant pv -> pp pv Projection lv l -> ppA lv<>"."<>l Selection tv pv -> ppA tv<>"!"<>ppA pv VariantValue vs -> "variants"<+>block vs @@ -260,6 +261,7 @@ instance Pretty LinPattern where instance PPA LinPattern where ppA p = case p of + ParamPattern pv -> ppA pv RecordPattern r -> block r TuplePattern ps -> "<"<>punctuate "," ps<>">" WildPattern -> pp "_" |
