PrintLe.hs revision f454c20b6c126bea7d31d400cc8824b9ee8cc6ea
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerModule : $Header$
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiDescription : pretty printing signatures
333780eae2be9f20fe46dedbf5eb46ffa0cbfd02Christian MaederCopyright : (c) Christian Maeder and Uni Bremen 2002-2003
41eeec8620877f96835b4d543b6a6b615847d6f2Till MossakowskiMaintainer : Christian.Maeder@dfki.de
cfbd735270fe52115cef0508d265785efcb99cd7Christian MaederStability : experimental
41eeec8620877f96835b4d543b6a6b615847d6f2Till MossakowskiPortability : portable
41eeec8620877f96835b4d543b6a6b615847d6f2Till Mossakowskipretty printing a HasCASL environment
0cbb0121c81f5307eeefe7ffbeeac79ff6c5cdf2Jorina Freya Gerkenimport qualified Data.Map as Map
0cbb0121c81f5307eeefe7ffbeeac79ff6c5cdf2Jorina Freya Gerkenimport qualified Data.Set as Set
54ea981a0503c396c2923a1c06421c6235baf27fChristian Maederinstance Pretty ClassInfo where
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maeder pretty (ClassInfo rk ks) = if Set.null ks then colon <+> pretty rk else
54ea981a0503c396c2923a1c06421c6235baf27fChristian Maeder text lessS <+> printList0 (Set.toList ks)
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaederprintGenKind :: GenKind -> Doc
54ea981a0503c396c2923a1c06421c6235baf27fChristian MaederprintGenKind k = case k of
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maeder Loose -> empty
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder Free -> text freeS
0cbb0121c81f5307eeefe7ffbeeac79ff6c5cdf2Jorina Freya Gerken Generated -> text generatedS
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maederinstance Pretty TypeDefn where
afe76697dd6888856a066934a1112a38809b27faChristian Maeder pretty td = case td of
58aa0caa9f05787b4bffc2e32d1494cc1766b8cfRazvan Pascanu NoTypeDefn -> empty
2c81e2bd9f9dee247c74a642c03620a2f799d0a4Razvan Pascanu PreDatatype -> text "%(data type)%"
a5c67efbd82e10368fda4e30d528157066d45c03Christian Maeder AliasTypeDefn s -> text assignS <+> pretty s
a5c67efbd82e10368fda4e30d528157066d45c03Christian Maeder DatatypeDefn dd -> text " %[" <> pretty dd <> text "]%"
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian MaederprintAltDefn :: AltDefn -> Doc
2c81e2bd9f9dee247c74a642c03620a2f799d0a4Razvan PascanuprintAltDefn (Construct mi ts p sels) = case mi of
04d04d19fdd5320953c78ad5b6d2d11f85bc4bcfChristian Maeder Just i -> pretty i <+> fsep (map (parens . semiDs) sels) <> pretty p
a5c67efbd82e10368fda4e30d528157066d45c03Christian Maeder Nothing -> text (typeS ++ sS) <+> ppWithCommas ts
04d04d19fdd5320953c78ad5b6d2d11f85bc4bcfChristian Maederinstance Pretty Selector where
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian Maeder pretty (Select mi t p) =
333780eae2be9f20fe46dedbf5eb46ffa0cbfd02Christian Maeder Just i -> pretty i <+> (case p of
2c81e2bd9f9dee247c74a642c03620a2f799d0a4Razvan Pascanu Partial -> text colonQuMark
d5aadb569823a9d41ef761433f27dd00d7e4e147Christian Maeder Total -> colon) <> space
da955132262baab309a50fdffe228c9efe68251dCui Jian Nothing -> empty) <> pretty t
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maederinstance Pretty TypeInfo where
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder pretty (TypeInfo _ ks sups def) =
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder fsep $ [colon, printList0 $ Set.toList ks]
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder ++ (if Set.null sups then []
fd4856f5eeac6f144f6116002233e5ce4cc8f41bJorina Freya Gerken else [less, printList0 $ Set.toList sups])
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder ++ case def of
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder NoTypeDefn -> []
7ec5cb48d588cc641d27fb2dbeccb6c28856c8daChristian Maeder _ -> [pretty def]
c458c6f5a2ce173d8af7a7f5cb434813eb870937Jorina Freya Gerkeninstance Pretty TypeVarDefn where
fd4856f5eeac6f144f6116002233e5ce4cc8f41bJorina Freya Gerken pretty (TypeVarDefn v vk _ i) =
e953bea49e7f0e1a43bccf2a66c5e2a2b50848e0Christian Maeder printVarKind v vk <+> text ("%(var_" ++ shows i ")%")
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maederinstance Pretty VarDefn where
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maeder pretty (VarDefn ty) =
d11391a2447a2005329a95b5d770f24e62bf5b63Christian Maeder colon <+> pretty ty
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maederinstance Pretty ConstrInfo where
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maeder pretty (ConstrInfo i t) =
d11391a2447a2005329a95b5d770f24e62bf5b63Christian Maeder pretty i <+> colon <+> pretty t
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maederinstance Pretty OpDefn where
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder pretty od = case od of
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maeder NoOpDefn b -> text $ "%(" ++ shows b ")%"
c458c6f5a2ce173d8af7a7f5cb434813eb870937Jorina Freya Gerken ConstructData _ -> text "%(constructor)%"
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian Maeder SelectData cs _ -> sep [ text "%(selector of constructor(s)"
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian Maeder , printList0 (Set.toList cs) <> text ")%" ]
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian Maeder Definition b t -> fsep [pretty $ NoOpDefn b, equals, pretty t]
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian Maederinstance Pretty OpInfo where
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder pretty o = let l = Set.toList $ opAttrs o in
afe76697dd6888856a066934a1112a38809b27faChristian Maeder fsep $ [pretty (opType o) <> if null l then empty else comma]
ce3e8067c8e5c5ffe7e76d75ead46e2b67adcafcChristian Maeder ++ punctuate comma (map pretty l)
ce3e8067c8e5c5ffe7e76d75ead46e2b67adcafcChristian Maeder ++ [pretty $ opDefn o]
ce3e8067c8e5c5ffe7e76d75ead46e2b67adcafcChristian Maederinstance Pretty DataEntry where
ce3e8067c8e5c5ffe7e76d75ead46e2b67adcafcChristian Maeder pretty (DataEntry im i k args _ alts) =
fd4856f5eeac6f144f6116002233e5ce4cc8f41bJorina Freya Gerken printGenKind k <+> keyword typeS <+>
afe76697dd6888856a066934a1112a38809b27faChristian Maeder fsep ([fcat $ pretty i : map (parens . pretty) args
fb88eac77c89b668f5c306173a6fbe2d513e4bccMarkus Gross , defn, cat $ punctuate (space <> bar <> space)
fb88eac77c89b668f5c306173a6fbe2d513e4bccMarkus Gross $ map printAltDefn $ Set.toList alts]
ce3e8067c8e5c5ffe7e76d75ead46e2b67adcafcChristian Maeder ++ if Map.null im then []
ce3e8067c8e5c5ffe7e76d75ead46e2b67adcafcChristian Maeder else [text withS, text (typeS ++ sS), printMap1 im])
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maederinstance Pretty Sentence where
fd4856f5eeac6f144f6116002233e5ce4cc8f41bJorina Freya Gerken pretty s = case s of
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maeder Formula t -> pretty t
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder DatatypeSen ls -> vcat (map pretty ls)
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder ProgEqSen _ _ pe -> keyword programS <+> pretty pe
ce3e8067c8e5c5ffe7e76d75ead46e2b67adcafcChristian Maederinstance Pretty Env where
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder pretty (Env{classMap=cm, typeMap=tm, localTypeVars=tvs,
afe76697dd6888856a066934a1112a38809b27faChristian Maeder assumps=ops, localVars=vs,
afe76697dd6888856a066934a1112a38809b27faChristian Maeder sentences=se, envDiags=ds}) =
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder let oops = foldr Map.delete ops $ map fst bList
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maeder otm = Map.difference tm $ addUnit Map.empty
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder header s = text "%%" <+> text s
2c81e2bd9f9dee247c74a642c03620a2f799d0a4Razvan Pascanu <+> text (replicate (70 - length s) '-')
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian Maeder in noPrint (Map.null cm) (header "Classes")
04d04d19fdd5320953c78ad5b6d2d11f85bc4bcfChristian Maeder $+$ printMap0 cm
04d04d19fdd5320953c78ad5b6d2d11f85bc4bcfChristian Maeder $+$ noPrint (Map.null otm) (header "Type Constructors")
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian Maeder $+$ printMap0 otm
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder $+$ noPrint (Map.null tvs) (header "Type Variables")
04d04d19fdd5320953c78ad5b6d2d11f85bc4bcfChristian Maeder $+$ printMap0 tvs
0cbb0121c81f5307eeefe7ffbeeac79ff6c5cdf2Jorina Freya Gerken $+$ noPrint (Map.null oops) (header "Assumptions")
d5aadb569823a9d41ef761433f27dd00d7e4e147Christian Maeder $+$ printSetMap empty space oops
58aa0caa9f05787b4bffc2e32d1494cc1766b8cfRazvan Pascanu $+$ noPrint (Map.null vs) (header "Variables")
0cbb0121c81f5307eeefe7ffbeeac79ff6c5cdf2Jorina Freya Gerken $+$ printMap0 vs
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maeder $+$ noPrint (null se) (header "Sentences")
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder $+$ vcat (map (pretty . fromLabelledSen) $ reverse se)
afe76697dd6888856a066934a1112a38809b27faChristian Maeder $+$ noPrint (null ds) (header "Diagnostics")
0cbb0121c81f5307eeefe7ffbeeac79ff6c5cdf2Jorina Freya Gerken $+$ vcat (map pretty $ reverse ds)
afe76697dd6888856a066934a1112a38809b27faChristian MaederprintMap0 :: (Pretty a, Ord a, Pretty b) => Map.Map a b -> Doc
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian MaederprintMap0 = printMyMap []
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian MaederprintMap1 :: (Pretty a, Ord a, Pretty b) => Map.Map a b -> Doc
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian MaederprintMap1 = printMyMap [mapsto]
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian MaederprintMyMap :: (Pretty a, Ord a, Pretty b) => [Doc] -> Map.Map a b -> Doc
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian MaederprintMyMap d = printMap id vcat ( \ a b -> fsep $ a : d ++ [b])
04d04d19fdd5320953c78ad5b6d2d11f85bc4bcfChristian Maederinstance Pretty Morphism where
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maeder let tm = typeIdMap m
f45fad43ee1673ab280fbc700821d5d20a493eaaChristian Maeder -- the types in funs are already mapped
0cbb0121c81f5307eeefe7ffbeeac79ff6c5cdf2Jorina Freya Gerken -- key und value types only differ wrt. partiality
0cbb0121c81f5307eeefe7ffbeeac79ff6c5cdf2Jorina Freya Gerken ds = Map.foldWithKey ( \ (i, _) (j, t) l ->
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian Maeder (pretty i <+> mapsto <+>
0cbb0121c81f5307eeefe7ffbeeac79ff6c5cdf2Jorina Freya Gerken pretty j <+> colon <+> pretty t) : l)
04d04d19fdd5320953c78ad5b6d2d11f85bc4bcfChristian Maeder in (if Map.null tm then empty
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder else keyword (typeS ++ sS) <+> printMap1 tm)
0cbb0121c81f5307eeefe7ffbeeac79ff6c5cdf2Jorina Freya Gerken $+$ (if Map.null fm then empty
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maeder else keyword (opS ++ sS) <+> sepByCommas ds)
04d04d19fdd5320953c78ad5b6d2d11f85bc4bcfChristian Maeder $+$ colon <+> specBraces (pretty $ msource m)
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maeder <+> specBraces (pretty $ mtarget m)
0cbb0121c81f5307eeefe7ffbeeac79ff6c5cdf2Jorina Freya Gerkeninstance Pretty a => Pretty (SymbolType a) where
0cbb0121c81f5307eeefe7ffbeeac79ff6c5cdf2Jorina Freya Gerken pretty t = case t of
c458c6f5a2ce173d8af7a7f5cb434813eb870937Jorina Freya Gerken OpAsItemType sc -> pretty sc
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maeder TypeAsItemType k -> pretty k
9192fdd8f0e682ac0f0183dd854d5210fbfa4ec5Christian Maeder ClassAsItemType k -> pretty k
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maederinstance Pretty Symbol where
9192fdd8f0e682ac0f0183dd854d5210fbfa4ec5Christian Maeder pretty s = keyword (case symType s of
9192fdd8f0e682ac0f0183dd854d5210fbfa4ec5Christian Maeder OpAsItemType _ -> opS
9192fdd8f0e682ac0f0183dd854d5210fbfa4ec5Christian Maeder TypeAsItemType _ -> typeS
0cbb0121c81f5307eeefe7ffbeeac79ff6c5cdf2Jorina Freya Gerken ClassAsItemType _ -> classS) <+>
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian Maeder pretty (symName s) <+> colon <+>
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian Maeder pretty (symType s)
54a0a1e10bd93721cf52dbd9b816c8f108997ec0Christian Maederinstance Pretty RawSymbol where
07eb349813c50aff304df13337b5cbc42f48c0a5Jorina Freya Gerken pretty rs = case rs of
4b136ad539bd9f4e115dff4eee4d552a42d4437eChristian Maeder AnID i -> pretty i
07eb349813c50aff304df13337b5cbc42f48c0a5Jorina Freya Gerken AKindedId k i -> printSK k [i] <> pretty i
07eb349813c50aff304df13337b5cbc42f48c0a5Jorina Freya Gerken AQualId i t -> printSK (symbTypeToKind t) [i] <> pretty i <+> colon
0a5165c161ce13d434b5c0488b533a8de98aafaaChristian Maeder ASymbol s -> pretty s