mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-24 03:52:50 -06:00
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:
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user