diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/compiler/GF/Compile/GrammarToCanonical.hs | 19 | ||||
| -rw-r--r-- | src/compiler/GF/Grammar/Canonical.hs | 2 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/VisualizeTree.hs | 4 |
3 files changed, 21 insertions, 4 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 "_" diff --git a/src/runtime/haskell/PGF/VisualizeTree.hs b/src/runtime/haskell/PGF/VisualizeTree.hs index fa6f7126e..ef827093b 100644 --- a/src/runtime/haskell/PGF/VisualizeTree.hs +++ b/src/runtime/haskell/PGF/VisualizeTree.hs @@ -564,7 +564,7 @@ dep2latex d = Picture defaultUnit (width,height) ( [Put (wpos rwld i,0) (Text w) | (i,w) <- zip [0..] (map fst (tokens d))] -- words ++ [Put (wpos rwld i,15) (TinyText w) | (i,(w,_)) <- zip [0..] (map snd (tokens d))] -- pos tags 15u above bottom - ++ [Put (wpos rwld i,-15) (TinyText w) | (i,(_,w)) <- zip [0..] (map snd (tokens d))] -- features 15u below bottom +--- ++ [Put (wpos rwld i,-15) (TinyText w) | (i,(_,w)) <- zip [0..] (map snd (tokens d))] -- features 15u below bottom -> DON'T SHOW ++ concat [putArc rwld (aheight x y) x y label | ((x,y),label) <- deps d] -- arcs and labels ++ [Put (wpos rwld (root d) + 15,height) (ArrowDown (height-arcbase))] ++ [Put (wpos rwld (root d) + 20,height - 10) (TinyText "ROOT")] @@ -595,7 +595,7 @@ conll2dep' ls = Dep { , root = head $ [read x-1 | x:_:_:_:_:_:"0":_ <- ls] ++ [1] } where - wld i = maximum (0:[charWidth * fromIntegral (length w) | w <- let (tok,(pos,feat)) = toks !! i in [tok,pos,feat]]) + wld i = maximum (0:[charWidth * fromIntegral (length w) | w <- let (tok,(pos,feat)) = toks !! i in [tok,pos {-,feat-}]]) --- feat not shown toks = [(w,(c,m)) | _:w:_:c:_:m:_ <- ls] dps = [((read y-1, read x-1),lab) | x:_:_:_:_:_:y:lab:_ <- ls, y /="0"] --maxdist = maximum [abs (x-y) | ((x,y),_) <- dps] |