mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 19:22:50 -06:00
Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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 "_"
|
||||
|
||||
Reference in New Issue
Block a user