diff options
| author | krasimir <krasimir@chalmers.se> | 2010-02-16 21:47:58 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2010-02-16 21:47:58 +0000 |
| commit | 32f9499f2e7403d7f48887ebdb30e2eddeb8199a (patch) | |
| tree | ca7e366112fa85e3f98df9401cbba7902e602b32 /src/runtime | |
| parent | 19b17dceb6a1882ee779e75b9703d7fd2b93cc95 (diff) | |
fix the PGF printer for abstract
Diffstat (limited to 'src/runtime')
| -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))
|