a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maeder{- |

e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerModule : $Header$

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian MaederCopyright : (c) Christian Maeder and Uni Bremen 2003

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt

98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu Prodescu

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian MaederMaintainer : maeder@tzi.de

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian MaederStability : experimental

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian MaederPortability : portable

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maeder

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maederprinting data types of the abstract syntax

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maeder-}

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maeder

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maedermodule HasCASL.PrintAs where

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maeder

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maederimport HasCASL.As

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maederimport HasCASL.AsUtils

35cf46c965af6974021ff1745fa9c310862e0b57Christian Maederimport HasCASL.HToken

c3ebe5e0a6545997d56e4156de02d00518c71c0cChristian Maederimport HasCASL.MixPrint

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maederimport Common.Lib.Pretty

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maederimport Common.Id

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maederimport Common.Keywords

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maederimport Common.PPUtils

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maederimport Common.PrettyPrint

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maederimport Common.GlobalAnnotations(GlobalAnnos)

21489db35f79507a68ee6e6926e01b8e8ea60c6bChristian Maederimport Common.AS_Annotation(mapAnM)

38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maederimport Data.List

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maeder

6519f127467b96775226c98f6086fccd5b6723aaChristian Maeder-- | short cut for: if b then empty else d

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian MaedernoPrint :: Bool -> Doc -> Doc

2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian MaedernoPrint b d = if b then empty else d

e0f1794e365dd347e97b37d7d22b2fce27296fa1Christian Maeder

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maederinstance PrettyPrint Variance where

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder printText0 _ = text . show

e0f1794e365dd347e97b37d7d22b2fce27296fa1Christian Maeder

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maederinstance PrettyPrint a => PrettyPrint (AnyKind a) where

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder printText0 ga knd = case knd of

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder ClassKind ci -> printText0 ga ci

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu FunKind v k1 k2 _ -> printText0 ga v <>

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder (case k1 of

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder FunKind _ _ _ _ -> parens

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu _ -> id) (printText0 ga k1)

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder <+> text funS

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu <+> printText0 ga k2

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maederinstance PrettyPrint TypePattern where

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu printText0 ga tp = case tp of

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu TypePattern name args _ -> printText0 ga name

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu <> fcat (map (parens . printText0 ga) args)

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu TypePatternToken t -> printText0 ga t

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu MixfixTypePattern ts -> fsep (map (printText0 ga) ts)

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu BracketTypePattern k l _ -> bracket k $ commaT_text ga l

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu TypePatternArg t _ -> parens $ printText0 ga t

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu-- | put proper brackets around a document

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maederbracket :: BracketKind -> Doc -> Doc

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maederbracket b t = let (o,c) = getBrackets b in text o <> t <> text c

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder-- | print a 'Kind' plus a preceding colon (or nothing for 'star')

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian MaederprintKind :: GlobalAnnos -> Kind -> Doc

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian MaederprintKind ga k = if k == universe then empty else

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder printVarKind ga InVar (VarKind k)

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu-- | print the kind of a variable with its variance and a preceding colon

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian MaederprintVarKind :: GlobalAnnos -> Variance -> VarKind -> Doc

62d5dbbceb675837039e6bad0971c324cce96a21Mihai CodescuprintVarKind ga e vk = case vk of

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder Downset t ->

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu space <> text lessS <+> printText0 ga t

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder VarKind k -> space <> colon <+>

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder printText0 ga e <> printText0 ga k

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder MissingKind -> empty

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescudata TypePrec = Outfix | Prefix | ProdInfix | FunInfix deriving (Eq, Ord)

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder

62d5dbbceb675837039e6bad0971c324cce96a21Mihai CodescuparenPrec :: TypePrec -> (TypePrec, Type) -> Type

62d5dbbceb675837039e6bad0971c324cce96a21Mihai CodescuparenPrec p1 (p2, d) = if p2 < p1 then d else BracketType Parens [d] nullRange

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder

62d5dbbceb675837039e6bad0971c324cce96a21Mihai CodescutoMixType :: Type -> (TypePrec, Type)

62d5dbbceb675837039e6bad0971c324cce96a21Mihai CodescutoMixType typ = case typ of

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu ExpandedType t1 _ -> toMixType t1

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder {- (Prefix, ExpandedType

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu (parenPrec Prefix $ toMixType t1)

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu $ parenPrec Prefix $ toMixType t2) -}

ab2ff2c8e08cd0f13064b87348f78a00775c54e5Mihai Codescu BracketType k l ps -> (Outfix, BracketType k (map

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu (snd . toMixType) l) ps)

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu KindedType t kind ps -> (Prefix, KindedType

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder (parenPrec Prefix $ toMixType t) kind ps)

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu MixfixType ts -> (Prefix, MixfixType $ map (snd . toMixType) ts)

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu _ -> let (topTy, tyArgs) = getTypeAppl typ in

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder case topTy of

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder TypeName name@(Id ts cs _) _k _i -> case tyArgs of

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu [] -> (Outfix, topTy)

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder [arg] -> let dArg = toMixType arg in

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder case ts of

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder [e1, e2, e3] | not (isPlace e1) && isPlace e2

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu && not (isPlace e3) && null cs ->

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder (Outfix, MixfixType [TypeToken e1, snd dArg, TypeToken e3])

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder _ -> (Prefix, MixfixType [topTy, parenPrec Prefix dArg])

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu [arg1, arg2] -> let dArg1 = toMixType arg1

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder dArg2 = toMixType arg2 in

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu case ts of

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu [e1, e2, e3] | isPlace e1 && not (isPlace e2)

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder && isPlace e3 && null cs ->

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder if tokStr e2 == prodS then

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder (ProdInfix, MixfixType [

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu parenPrec ProdInfix dArg1, TypeToken e2,

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu parenPrec ProdInfix dArg2])

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu else -- assume fun type

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu (FunInfix, MixfixType [

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maeder parenPrec FunInfix dArg1, TypeToken e2, snd dArg2])

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu _ -> (Prefix, MixfixType [topTy, parenPrec Prefix dArg1,

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder parenPrec Prefix dArg2])

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu _ -> if name == productId (length tyArgs) then

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu (ProdInfix, MixfixType $ intersperse

ab2ff2c8e08cd0f13064b87348f78a00775c54e5Mihai Codescu (TypeToken $ mkSimpleId prodS) $

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu map (parenPrec ProdInfix . toMixType) tyArgs)

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu else (Prefix, MixfixType $ topTy :

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder map (parenPrec Prefix . toMixType) tyArgs)

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu _ | null tyArgs -> (Outfix, topTy)

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu _ -> (Prefix, MixfixType $ parenPrec ProdInfix (toMixType topTy)

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder : map (parenPrec Prefix . toMixType) tyArgs)

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder

94e112d16f89130a688db8b03ad3224903f5e97eChristian MaederprintType :: GlobalAnnos -> Type -> Doc

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian MaederprintType ga ty = case ty of

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder TypeName name _ _ -> printText0 ga name

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu -- if i == 0 then empty else text ("_v"++ show i)

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder TypeAppl t1 t2 -> parens (printType ga t1) <>

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder parens (printType ga t2)

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu ExpandedType t1 t2 -> printType ga t1 <> text asP <> printType ga t2

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu TypeToken t -> printText0 ga t

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu BracketType k l _ -> bracket k $ fsep $

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder punctuate comma $ map (printType ga) l

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder KindedType t kind _ -> printType ga t

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder <+> colon <+> printText0 ga kind

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu MixfixType ts -> fsep $ map (printType ga) ts

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescuinstance PrettyPrint Type where

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu printText0 ga = printType ga . snd . toMixType

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu-- no curried notation for bound variables

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescuinstance PrettyPrint TypeScheme where

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu printText0 ga (TypeScheme vs t _) = let tdoc = printText0 ga t in

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder if null vs then tdoc else

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder hang (text forallS <+> semiT_text ga vs <+> text dotS) 2 tdoc

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescuinstance PrettyPrint Instance where

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu printText0 _ i = case i of

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu Instance -> space <> text instanceS

b5dec828644f9f441c6d5dc38325ac6332b6eef7Christian Maeder Plain -> empty

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maederinstance PrettyPrint Partiality where

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder printText0 _ p = case p of

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu Partial -> text quMark

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu Total -> empty

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescuinstance PrettyPrint Arrow where

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder printText0 _ a = text $ show a

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maederinstance PrettyPrint Quantifier where

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder printText0 _ q = text $ show q

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescuinstance PrettyPrint TypeQual where

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu printText0 _ q = text $ show q

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescuinstance PrettyPrint Term where

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu printText0 ga t = printTerm ga $ convTerm ga t

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai CodescuunPredType :: Type -> Type

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai CodescuunPredType t = case getTypeAppl t of

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu (TypeName at _ 0, [ty, TypeName ut (ClassKind _) 0]) |

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder ut == unitTypeId && at == arrowId PFunArr -> ty

154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu _ -> t

62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu

de2f13b8310de00ca228385b1530660e036054c2Christian MaederunPredTypeScheme :: TypeScheme -> TypeScheme

6519f127467b96775226c98f6086fccd5b6723aaChristian MaederunPredTypeScheme = mapTypeOfScheme unPredType

d58b2e1dc7d2254fa2e10d8c0b5a498ac207d6eaChristian Maeder

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian MaederprintTerm :: GlobalAnnos -> Term -> Doc

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian MaederprintTerm ga trm =

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder let commaT = fsep . punctuate comma . map (printTerm ga)

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder in case trm of

21489db35f79507a68ee6e6926e01b8e8ea60c6bChristian Maeder QualVar vd -> parens $ text varS <+> printText0 ga vd

21489db35f79507a68ee6e6926e01b8e8ea60c6bChristian Maeder QualOp br n t _ -> parens $ fsep [printText0 ga br, printText0 ga n,

07d65f8d6e942389273f18950619d314c48e182bChristian Maeder colon, printText0 ga $

21489db35f79507a68ee6e6926e01b8e8ea60c6bChristian Maeder if isPred br then unPredTypeScheme t else t]

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder ResolvedMixTerm n ts _ ->

21489db35f79507a68ee6e6926e01b8e8ea60c6bChristian Maeder case ts of

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder [] -> printText0 ga n

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder [t] -> printText0 ga n <> (case t of

d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder TupleTerm _ _ -> id

d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder BracketTerm _ _ _ -> id

d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder QualVar _ -> id

d4aed7a2eea6b546c0d9520d85038addb7beb12fChristian Maeder QualOp _ _ _ _ -> id

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder ResolvedMixTerm _ [] _ -> (space <>)

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maeder TermToken _ -> (space <>)

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder _ -> parens) (printTerm ga t)

06f58a67e6df999858bf4f97d5e0786956562d29Christian Maeder _ -> printText0 ga n <> parens (commaT ts)

06f58a67e6df999858bf4f97d5e0786956562d29Christian Maeder ApplTerm t1 t2 _ ->

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maeder hang (printTerm ga t1) 2 $ printTerm ga t2

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder TupleTerm ts _ -> parens (commaT ts)

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maeder TypedTerm t q typ _ ->

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maeder fsep [printTerm ga t, printText0 ga q, printText0 ga typ]

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder QuantifiedTerm q vs t _ -> hang (printText0 ga q <+> semiT_text ga vs)

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maeder 2 (text dotS <+> printTerm ga t)

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder LambdaTerm ps q t _ -> hang (text lamS <+> (case ps of

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder [p] -> printTerm ga p

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maeder _ -> fcat $ map (parens . printTerm ga) ps))

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder 2 $ (case q of

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder Partial -> text dotS

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder Total -> text $ dotS ++ exMark) <+> printTerm ga t

94e112d16f89130a688db8b03ad3224903f5e97eChristian Maeder CaseTerm t es _ -> hang (fsep [text caseS, printText0 ga t, text ofS])

b79567bdb08bc2c2dfff8d89cd79023fc139b5d3Mihai Codescu 4 $ vcat (punctuate (text " | ") $ map (printEq0 ga funS) es)

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder LetTerm br es t _ ->

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder let dt = printTerm ga t

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder des = vcat $ punctuate semi $ map (printEq0 ga equalS) es

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder in case br of

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder Let -> hang (sep [text letS <+> des, text inS]) 3 dt

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder Where -> hang (sep [dt, text whereS]) 6 des

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder Program -> text programS <+> des

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder TermToken t -> printText0 ga t

a94f7b3982dccd2e01bd87f64de1aeab6edac118Christian Maeder MixTypeTerm q t _ -> printText0 ga q <+> printText0 ga t

38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maeder MixfixTerm ts -> fsep $ map (printTerm ga) ts

38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maeder BracketTerm k l _ -> bracket k $ commaT l

38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maeder AsPattern (VarDecl v _ _ _) p _ ->

38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maeder printText0 ga v <+> text asP <+> printTerm ga p

38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maeder

38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maeder-- | print an equation with different symbols between 'Pattern' and 'Term'

ebbe7382423f69d67ffa140163054bc2f8dcd810Christian MaederprintEq0 :: GlobalAnnos -> String -> ProgEq -> Doc

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian MaederprintEq0 ga s (ProgEq p t _) =

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder hang (hang (printTerm ga p) 2 $ text s) 4 $ printTerm ga t

bb2c1beb7ab66a49627a2a34df80864a3c65cc83Christian Maeder

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maederinstance PrettyPrint VarDecl where

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder printText0 ga (VarDecl v t _ _) = printText0 ga v <>

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder case t of

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder MixfixType [] -> empty

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder _ -> space <> colon <+> printText0 ga t

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maederinstance PrettyPrint GenVarDecl where

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder printText0 ga gvd = case gvd of

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder GenVarDecl v -> printText0 ga v

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder GenTypeVarDecl tv -> printText0 ga tv

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maederinstance PrettyPrint TypeArg where

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder printText0 ga (TypeArg v e c _ _ _ _) =

f99c9fca932e8e6e8111049fd93164ed81e1b0abChristian Maeder printText0 ga v <> printVarKind ga e c

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder-- | don't print an empty list and put parens around longer lists

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian MaederprintList0 :: (PrettyPrint a) => GlobalAnnos -> [a] -> Doc

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian MaederprintList0 ga l = case l of

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder [] -> empty

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder [x] -> printText0 ga x

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder _ -> parens $ commaT_text ga l

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maederinstance PrettyPrint InstOpId where

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder printText0 ga (InstOpId n l _) = printText0 ga n <> noPrint (null l)

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder (brackets $ semiT_text ga l)

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder-- | print a 'TypeScheme' as a pseudo type

38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian MaederprintPseudoType :: GlobalAnnos -> TypeScheme -> Doc

38824a7dba4f7d82532afec67e0b594a5af5d76bChristian MaederprintPseudoType ga (TypeScheme l t _) = noPrint (null l) (text lamS

36a493b7eec0f9d719674296c26afe7fd9bfe327Christian Maeder <+> (if null $ tail l then printText0 ga $ head l

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder else fcat(map (parens . printText0 ga) l))

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder <+> text dotS <> space) <> printText0 ga t

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maederinstance PrettyPrint BasicSpec where

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder printText0 ga (BasicSpec l) = vcat (map (printText0 ga) l)

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maederinstance PrettyPrint ProgEq where

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maeder printText0 ga (ProgEq p q ps) =

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder printEq0 ga equalS $ ProgEq (convTerm ga p) (convTerm ga q) ps

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maederinstance PrettyPrint BasicItem where

38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maeder printText0 ga bi = case bi of

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder SigItems s -> printText0 ga s

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder ProgItems l _ -> noPrint (null l) $ text programS <+> semiT_text ga l

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder ClassItems i l _ -> noPrint (null l) $ text classS <> printText0 ga i

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder <+> semiT_text ga l

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder GenVarItems l _ -> noPrint (null l) $ text varS <+> semiT_text ga l

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder FreeDatatype l _ -> noPrint (null l) $ text freeS <+> text typeS

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maeder <+> semiT_text ga l

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maeder GenItems l _ -> noPrint (null l) $ text generatedS

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder <+> braces (semiT_text ga l)

7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder AxiomItems vs fs _ -> (noPrint (null vs) $ text forallS

38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maeder <+> semiT_text ga vs)

38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maeder $$ vcat (map ( \ x -> text dotS

38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maeder <+> printText0 ga x) fs)

38f35f2c4a3b6a778f4f68e7af047a174e93abbeChristian Maeder Internal l _ -> noPrint (null l) $ text internalS

c43270ad64272b1509c4c29645136c269dae7c9eChristian Maeder <+> braces (semiT_text ga l)

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maeder

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maederinstance PrettyPrint OpBrand where

720eeee7c9d8442093c8d05bed743193eee906e0Christian Maeder printText0 _ b = text $ show b

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maeder

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maederinstance PrettyPrint SigItems where

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maeder printText0 ga si = case si of

e0f1794e365dd347e97b37d7d22b2fce27296fa1Christian Maeder TypeItems i l _ -> noPrint (null l) $ text typeS <> printText0 ga i

e0f1794e365dd347e97b37d7d22b2fce27296fa1Christian Maeder <+> semiT_text ga l

dece9056c18ada64bcc8f2fba285270374139ee8Christian Maeder OpItems b l _ -> noPrint (null l) $ printText0 ga b <+> semiT_text ga

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maeder (if isPred b then concat $

2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder mapAnM ((:[]) . mapOpItem) l else l)

2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maederinstance PrettyPrint ClassItem where

2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder printText0 ga (ClassItem d l _) = printText0 ga d $$

2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder if null l then empty

248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maeder else braces (semiT_text ga l)

instance PrettyPrint ClassDecl where

printText0 ga (ClassDecl l k _) = commaT_text ga l

<+> text lessS <+> printText0 ga k

instance PrettyPrint Vars where

printText0 ga vd = case vd of

Var v -> printText0 ga v

VarTuple vs _ -> parens $ commaT_text ga vs

instance PrettyPrint TypeItem where

printText0 ga ti = case ti of

TypeDecl l k _ -> if null l then error "printText0 TypeDecl" else

commaT_text ga l <> printKind ga k

SubtypeDecl l t _ -> if null l then error "printText0 SubtypeDecl"

else commaT_text ga l <+> text lessS <+> printText0 ga t

IsoDecl l _ -> cat(punctuate (text " = ")

(map (printText0 ga) l))

SubtypeDefn p v t f _ -> printText0 ga p

<+> text equalS

<+> braces (printText0 ga v

<+> colon

<+> printText0 ga t

<+> text dotS

<+> printText0 ga f)

AliasType p k t _ -> (printText0 ga p <>

case k of

Nothing -> empty

Just j -> space <> colon <+>

printText0 ga j)

<+> text assignS

<+> printPseudoType ga t

Datatype t -> printText0 ga t

mapOpItem :: OpItem -> OpItem

mapOpItem oi = case oi of

OpDecl l t as ps -> OpDecl l (unPredTypeScheme t) as ps

OpDefn n ps s p t qs -> OpDefn n ps (unPredTypeScheme s) p t qs

instance PrettyPrint OpItem where

printText0 ga oi = case oi of

OpDecl l t attrs _ -> if null l then error "printText0 OpDecl" else

commaT_text ga l <+> colon <+> (printText0 ga t

<> (if null attrs then empty else comma <> space)

<> commaT_text ga attrs)

OpDefn n ps s p t _ -> hang

(hang (printText0 ga n <> fcat (map (parens . semiT_text ga) ps))

2 (colon <> printText0 ga p

<+> printText0 ga s))

2 (text equalS

<+> printText0 ga t)

instance PrettyPrint BinOpAttr where

printText0 _ a = text $ case a of

Assoc -> assocS

Comm -> commS

Idem -> idemS

instance PrettyPrint OpAttr where

printText0 ga oa = case oa of

BinOpAttr a _ -> printText0 ga a

UnitOpAttr t _ -> text unitS <+> printText0 ga t

instance PrettyPrint DatatypeDecl where

printText0 ga (DatatypeDecl p k alts d _) = (printText0 ga p <>

printKind ga k)

<+> text defnS

<+> vcat(punctuate (text " | ")

(map (printText0 ga) alts))

<+> case d of [] -> empty

_ -> text derivingS

<+> commaT_text ga d

instance PrettyPrint Alternative where

printText0 ga alt = case alt of

Constructor n cs p _ ->

printText0 ga n <+> fsep (map (parens . semiT_text ga) cs)

<> printText0 ga p

Subtype l _ -> noPrint (null l) $ text typeS <+> commaT_text ga l

instance PrettyPrint Component where

printText0 ga sel = case sel of

Selector n p t _ _ -> printText0 ga n

<+> colon <> printText0 ga p

<+> printText0 ga t

NoSelector t -> printText0 ga t

instance PrettyPrint OpId where

printText0 ga (OpId n ts _) = printText0 ga n

<+> noPrint (null ts)

(brackets $ commaT_text ga ts)

instance PrettyPrint Symb where

printText0 ga (Symb i mt _) =

printText0 ga i <> (case mt of Nothing -> empty

Just (SymbType t) ->

empty <+> colon <+>

printText0 ga t)

instance PrettyPrint SymbItems where

printText0 ga (SymbItems k syms _ _) =

printSK k <> commaT_text ga syms

instance PrettyPrint SymbOrMap where

printText0 ga (SymbOrMap s mt _) =

printText0 ga s <> (case mt of Nothing -> empty

Just t ->

empty <+> text mapsTo <+>

printText0 ga t)

instance PrettyPrint SymbMapItems where

printText0 ga (SymbMapItems k syms _ _) =

printSK k <> commaT_text ga syms

-- | print symbol kind

printSK :: SymbKind -> Doc

printSK k =

case k of Implicit -> empty

_ -> text (drop 3 $ show k) <> space