diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/runtime/haskell/PGF.hs | 2 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/Printer.hs | 2 | ||||
| -rw-r--r-- | 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))
|