GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 11:42:49 -06:00
Code Issues Packages Projects Releases Wiki Activity

fix the PGF printer for abstract

Browse Source
This commit is contained in:
krasimir
2010-02-16 21:47:58 +00:00
parent 899ed163a1
commit e1ac90f543
3 changed files with 13 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/runtime/haskell/PGF.hs
View File

@@ -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]) 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) Just (ty,_,Nothing ) -> Just $ render (text "data" <+> ppCId id <+> colon <+> ppType 0 [] ty)
Nothing -> case Map.lookup id (cats (abstract pgf)) of 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 Nothing -> Nothing
(producers,consumers) = Map.foldWithKey accum ([],[]) (funs (abstract pgf)) (producers,consumers) = Map.foldWithKey accum ([],[]) (funs (abstract pgf))

2
src/runtime/haskell/PGF/Printer.hs
View File

@@ -25,7 +25,7 @@ ppAbs name a = text "abstract" <+> ppCId name <+> char '{' $$
char '}' char '}'
ppCat :: CId -> [Hypo] -> Doc 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 :: CId -> (Type,Int,Maybe [Equation]) -> Doc
ppFun f (t,_,Just eqs) = text "fun" <+> ppCId f <+> colon <+> ppType 0 [] t $$ ppFun f (t,_,Just eqs) = text "fun" <+> ppCId f <+> colon <+> ppType 0 [] t $$

21
src/runtime/haskell/PGF/Type.hs
View File

@@ -87,17 +87,18 @@ pType = do
ppType :: Int -> [CId] -> Type -> PP.Doc ppType :: Int -> [CId] -> Type -> PP.Doc
ppType d scope (DTyp hyps cat args) ppType d scope (DTyp hyps cat args)
| null hyps = ppRes scope cat args | null hyps = ppParens (d > 3) (ppRes scope cat args)
| otherwise = let (scope',hdocs) = mapAccumL ppHypo scope hyps | 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) in ppParens (d > 0) (foldr (\hdoc doc -> hdoc PP.<+> PP.text "->" PP.<+> doc) (ppRes scope' cat args) hdocs)
where where
ppRes scope cat es = ppCId cat PP.<+> PP.hsep (map (ppExpr 4 scope) es) ppRes scope cat es = ppCId cat PP.<+> PP.hsep (map (ppExpr 4 scope) es)
ppHypo scope (Explicit,x,typ) = if x == wildCId ppHypo :: Int -> [CId] -> (BindType,CId,Type) -> ([CId],PP.Doc)
then (scope,ppType 1 scope typ) ppHypo d scope (Explicit,x,typ) = if x == wildCId
else let y = freshName x scope then (scope,ppType d scope typ)
in (y:scope,PP.parens (ppCId y PP.<+> PP.char ':' PP.<+> ppType 0 scope typ)) else let y = freshName x scope
ppHypo scope (Implicit,x,typ) = if x == wildCId in (y:scope,PP.parens (ppCId y PP.<+> PP.char ':' PP.<+> ppType 0 scope typ))
then (scope,PP.parens (PP.braces (ppCId x) PP.<+> PP.char ':' PP.<+> ppType 0 scope typ)) ppHypo d scope (Implicit,x,typ) = if x == wildCId
else let y = freshName x scope then (scope,PP.parens (PP.braces (ppCId x) PP.<+> PP.char ':' PP.<+> ppType 0 scope typ))
in (y:scope,PP.parens (PP.braces (ppCId y) 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))