From 32f9499f2e7403d7f48887ebdb30e2eddeb8199a Mon Sep 17 00:00:00 2001 From: krasimir Date: Tue, 16 Feb 2010 21:47:58 +0000 Subject: [PATCH] fix the PGF printer for abstract --- src/runtime/haskell/PGF.hs | 2 +- src/runtime/haskell/PGF/Printer.hs | 2 +- src/runtime/haskell/PGF/Type.hs | 21 +++++++++++---------- 3 files changed, 13 insertions(+), 12 deletions(-) diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs index 895162e2e..f8c6dfc8c 100644 --- a/src/runtime/haskell/PGF.hs +++ b/src/runtime/haskell/PGF.hs @@ -306,7 +306,7 @@ browse pgf id = fmap (\def -> (def,producers,consumers)) definition in ppCId id <+> hsep ds <+> char '=' <+> ppExpr 0 scope res | Equ patts res <- eqs]) Just (ty,_,Nothing ) -> Just $ render (text "data" <+> ppCId id <+> colon <+> ppType 0 [] ty) Nothing -> case Map.lookup id (cats (abstract pgf)) of - Just hyps -> Just $ render (text "cat" <+> ppCId id <+> hsep (snd (mapAccumL ppHypo [] hyps))) + Just hyps -> Just $ render (text "cat" <+> ppCId id <+> hsep (snd (mapAccumL (ppHypo 4) [] hyps))) Nothing -> Nothing (producers,consumers) = Map.foldWithKey accum ([],[]) (funs (abstract pgf)) diff --git a/src/runtime/haskell/PGF/Printer.hs b/src/runtime/haskell/PGF/Printer.hs index d458eb1a7..d3ce0469e 100644 --- a/src/runtime/haskell/PGF/Printer.hs +++ b/src/runtime/haskell/PGF/Printer.hs @@ -25,7 +25,7 @@ ppAbs name a = text "abstract" <+> ppCId name <+> char '{' $$ char '}' ppCat :: CId -> [Hypo] -> Doc -ppCat c hyps = text "cat" <+> ppCId c <+> hsep (snd (mapAccumL ppHypo [] hyps)) +ppCat c hyps = text "cat" <+> ppCId c <+> hsep (snd (mapAccumL (ppHypo 4) [] hyps)) ppFun :: CId -> (Type,Int,Maybe [Equation]) -> Doc ppFun f (t,_,Just eqs) = text "fun" <+> ppCId f <+> colon <+> ppType 0 [] t $$ diff --git a/src/runtime/haskell/PGF/Type.hs b/src/runtime/haskell/PGF/Type.hs index 013754a45..f43b361ff 100644 --- a/src/runtime/haskell/PGF/Type.hs +++ b/src/runtime/haskell/PGF/Type.hs @@ -87,17 +87,18 @@ pType = do ppType :: Int -> [CId] -> Type -> PP.Doc ppType d scope (DTyp hyps cat args) - | null hyps = ppRes scope cat args - | otherwise = let (scope',hdocs) = mapAccumL ppHypo scope hyps + | null hyps = ppParens (d > 3) (ppRes scope cat args) + | otherwise = let (scope',hdocs) = mapAccumL (ppHypo 1) scope hyps in ppParens (d > 0) (foldr (\hdoc doc -> hdoc PP.<+> PP.text "->" PP.<+> doc) (ppRes scope' cat args) hdocs) where ppRes scope cat es = ppCId cat PP.<+> PP.hsep (map (ppExpr 4 scope) es) -ppHypo scope (Explicit,x,typ) = if x == wildCId - then (scope,ppType 1 scope typ) - else let y = freshName x scope - in (y:scope,PP.parens (ppCId y PP.<+> PP.char ':' PP.<+> ppType 0 scope typ)) -ppHypo scope (Implicit,x,typ) = if x == wildCId - then (scope,PP.parens (PP.braces (ppCId x) PP.<+> PP.char ':' PP.<+> ppType 0 scope typ)) - else let y = freshName x scope - in (y:scope,PP.parens (PP.braces (ppCId y) PP.<+> PP.char ':' PP.<+> ppType 0 scope typ)) +ppHypo :: Int -> [CId] -> (BindType,CId,Type) -> ([CId],PP.Doc) +ppHypo d scope (Explicit,x,typ) = if x == wildCId + then (scope,ppType d scope typ) + else let y = freshName x scope + in (y:scope,PP.parens (ppCId y PP.<+> PP.char ':' PP.<+> ppType 0 scope typ)) +ppHypo d scope (Implicit,x,typ) = if x == wildCId + then (scope,PP.parens (PP.braces (ppCId x) PP.<+> PP.char ':' PP.<+> ppType 0 scope typ)) + else let y = freshName x scope + in (y:scope,PP.parens (PP.braces (ppCId y) PP.<+> PP.char ':' PP.<+> ppType 0 scope typ))