Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core

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 "_"