GF.Compile.GrammarToCanonical: keep unreachable rows in tables

since unreachable rows can become reachable after grammar transformation.
Also export smart constructors for projection and selection.
This commit is contained in:
Thomas Hallgren
2019-03-22 15:38:02 +01:00
parent b3387e80e4
commit a55c7c7889

View File

@@ -1,6 +1,9 @@
-- | Translate grammars to Canonical form -- | Translate grammars to Canonical form
-- (a common intermediate representation to simplify export to other formats) -- (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 Data.List(nub,partition)
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
@@ -238,6 +241,7 @@ concatValue v1 v2 =
(_,LiteralValue (StrConstant "")) -> v1 (_,LiteralValue (StrConstant "")) -> v1
_ -> ConcatValue v1 v2 _ -> ConcatValue v1 v2
-- | Smart constructor for projections
projection r l = maybe (Projection r l) id (proj r l) projection r l = maybe (Projection r l) id (proj r l)
proj r l = proj r l =
@@ -247,20 +251,31 @@ proj r l =
_ -> Nothing _ -> Nothing
_ -> Nothing _ -> Nothing
-- | Smart constructor for selections
selection t v = selection t v =
-- Note: impossible cases can become possible after grammar transformation
case t of case t of
TableValue tt r -> TableValue tt r ->
case nub [rv|TableRow _ rv<-keep] of case nub [rv|TableRow _ rv<-keep] of
[rv] -> rv [rv] -> rv
_ -> Selection (TableValue tt r') v _ -> Selection (TableValue tt r') v
where 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 r' = if null discard
then r then r
else keep++[TableRow WildPattern impossible] else keep++[TableRow WildPattern impossible]
-}
(keep,discard) = partition (mightMatchRow v) r (keep,discard) = partition (mightMatchRow v) r
_ -> Selection t v _ -> Selection t v
impossible = ErrorValue "impossible" impossible = CommentedValue "impossible"
mightMatchRow v (TableRow p _) = mightMatchRow v (TableRow p _) =
case p of case p of