PrintLe.hs revision ad270004874ce1d0697fb30d7309f180553bb315
25cc5fbba63f84b47e389af749f55abbbde71c8cChristian MaederModule : $Header$
25cc5fbba63f84b47e389af749f55abbbde71c8cChristian MaederCopyright : (c) Christian Maeder and Uni Bremen 2002-2003
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederMaintainer : maeder@tzi.de
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederStability : experimental
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederPortability : portable
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maederpretty printing a HasCASL environment
5c53db0f07c1032e2850dc6e7df344c82a6dec57Christian Maederimport qualified Data.Map as Map
88c800932dd7053322501ea2039d9f234be6866cKlaus Luettichimport qualified Data.Set as Set
8410667510a76409aca9bb24ff0eda0420088274Christian Maederinstance Pretty ClassInfo where
8410667510a76409aca9bb24ff0eda0420088274Christian Maeder pretty (ClassInfo rk ks) = case ks of
8410667510a76409aca9bb24ff0eda0420088274Christian Maeder [] -> colon <+> pretty rk
404166b9366552e9ec5abb87a37c76ec8a815fb7Klaus Luettich _ -> text lessS <+> printList0 ks
3474624438293363cada4e49225aae1e292fa597Christian MaederprintGenKind :: GenKind -> Doc
404166b9366552e9ec5abb87a37c76ec8a815fb7Klaus LuettichprintGenKind k = case k of
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Loose -> empty
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Free -> text freeS
d67a33b40578beef2e255a274f89bb9c34aaf056Christian Maeder Generated -> text generatedS
e593b89bfd4952698dc37feced21cefe869d87a2Christian Maederinstance Pretty TypeDefn where
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder pretty td = case td of
6e049108aa87dc46bcff96fae50a4625df1d9648Klaus Luettich NoTypeDefn -> empty
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder PreDatatype -> text "%(data type)%"
5d44c8cecd07b47ce537c7e14bf7b41a39f08507Christian Maeder AliasTypeDefn s -> text assignS <+> printPseudoType s
a2d6702f18737cc5fff8e8631c08f221f8375c4bChristian Maeder DatatypeDefn dd -> text " %[" <> pretty dd <> text "]%"
c6fcd42c6d6d9dae8c7835c24fcb7ce8531a9050Christian MaederprintAltDefn :: Id -> [TypeArg] -> RawKind -> AltDefn -> Doc
31c49f2fa23d4ac089f35145d80a224deb6ea7e4Till MossakowskiprintAltDefn dt tArgs rk (Construct mi ts p sels) = case mi of
c55a0f77be7e88d3620b419ec8961f4379a586e3Klaus Luettich Just i -> fcat $ [pretty i <> space, colon <> space,
7b2177999334c920c5669621bd3c142fe198a8d7Christian Maeder pretty (createConstrType dt tArgs rk p ts)]
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder ++ map (parens . semiDs) sels
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder Nothing -> text (typeS ++ sS) <+> ppWithCommas ts
9e748851c150e1022fb952bab3315e869aaf0214Christian Maederinstance Pretty Selector where
f4505a64a089693012a3f5c3b1f12a82cd7a2a5aKlaus Luettich pretty (Select mi t p) =
a3c6d8e0670bf2aa71bc8e2a3b1f45d56dd65e4cChristian Maeder Just i -> pretty i <+> (case p of
a3c6d8e0670bf2aa71bc8e2a3b1f45d56dd65e4cChristian Maeder Partial -> text colonQuMark
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder Total -> colon) <> space
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder Nothing -> empty) <> pretty t
9e748851c150e1022fb952bab3315e869aaf0214Christian Maederinstance Pretty TypeInfo where
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder pretty (TypeInfo _ ks sups def) =
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder fsep $ [colon, printList0 ks]
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder ++ (if Set.null sups then []
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder else [less, printList0 $ Set.toList sups])
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder ++ case def of
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder NoTypeDefn -> []
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder _ -> [pretty def]
9e748851c150e1022fb952bab3315e869aaf0214Christian Maederinstance Pretty TypeVarDefn where
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder pretty (TypeVarDefn v vk _ i) =
c0c2380bced8159ff0297ece14eba948bd236471Christian Maeder printVarKind v vk <+> text ("%(var_" ++ shows i ")%")
fd09d0eee026d0db12542af37fd0fbd0790f0eeaChristian Maederinstance Pretty VarDefn where
fd09d0eee026d0db12542af37fd0fbd0790f0eeaChristian Maeder pretty (VarDefn ty) =
fd09d0eee026d0db12542af37fd0fbd0790f0eeaChristian Maeder colon <+> pretty ty
9e748851c150e1022fb952bab3315e869aaf0214Christian Maederinstance Pretty ConstrInfo where
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder pretty (ConstrInfo i t) =
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder pretty i <+> colon <+> pretty t
9e748851c150e1022fb952bab3315e869aaf0214Christian Maederinstance Pretty OpDefn where
c0c2380bced8159ff0297ece14eba948bd236471Christian Maeder pretty od = case od of
549b97cfbe3a6687db74440a550b68b2fc19a272Christian Maeder NoOpDefn b -> text $ "%(" ++ shows b ")%"
549b97cfbe3a6687db74440a550b68b2fc19a272Christian Maeder ConstructData i -> text $ "%(construct " ++ showId i ")%"
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder SelectData c i -> text ("%(select from " ++ showId i " constructed by")
a3c6d8e0670bf2aa71bc8e2a3b1f45d56dd65e4cChristian Maeder $+$ printList0 c <> text ")%"
f2f9df2e17e70674f0bf426ed1763c973ee4cde0Christian Maeder Definition b t -> fsep [pretty $ NoOpDefn b, equals, pretty t]
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maederinstance Pretty OpInfo where
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder pretty o = let l = opAttrs o in
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder fsep $ [ colon
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder , pretty (opType o) <> if null l then empty else comma]
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder ++ punctuate comma (map pretty l)
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder ++ [pretty $ opDefn o]
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maederinstance Pretty OpInfos where
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder pretty (OpInfos l) = vcat $ map pretty l
f2f9df2e17e70674f0bf426ed1763c973ee4cde0Christian Maederinstance Pretty DataEntry where
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder pretty (DataEntry im i k args rk alts) =
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder printGenKind k <+> keyword typeS <+>
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder fsep ([fcat $ pretty i : map (parens . pretty) args
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder , defn, vcat $ map (printAltDefn i args rk) alts]
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder ++ if Map.null im then []
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder else [text withS, text (typeS ++ sS), printMap0 im])
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maederinstance Pretty Sentence where
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder pretty s = case s of
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder Formula t -> pretty t
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder DatatypeSen ls -> vcat (map pretty ls)
f2f9df2e17e70674f0bf426ed1763c973ee4cde0Christian Maeder ProgEqSen _ _ pe -> keyword programS <+> pretty pe
f2f9df2e17e70674f0bf426ed1763c973ee4cde0Christian Maederinstance Pretty Env where
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder pretty (Env{classMap=cm, typeMap=tm, localTypeVars=tvs,
afa6ceaf4359ae437aaa6830949583143ace2752Christian Maeder assumps=ops, localVars=vs,
c0c2380bced8159ff0297ece14eba948bd236471Christian Maeder sentences=se, envDiags=ds}) =
f4505a64a089693012a3f5c3b1f12a82cd7a2a5aKlaus Luettich let oops = foldr Map.delete ops $ map fst bList
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder otm = Map.difference tm $ addUnit Map.empty
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder header s = text "%%" <+> text s
f4505a64a089693012a3f5c3b1f12a82cd7a2a5aKlaus Luettich <+> text (replicate (70 - length s) '-')
f4505a64a089693012a3f5c3b1f12a82cd7a2a5aKlaus Luettich in noPrint (Map.null cm) (header "Classes")
f4505a64a089693012a3f5c3b1f12a82cd7a2a5aKlaus Luettich $+$ printMap0 cm
5d4038657f6a63e131f5804af2f7957b69e15a43Klaus Luettich $+$ noPrint (Map.null otm) (header "Type Constructors")
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder $+$ printMap0 otm
c0c2380bced8159ff0297ece14eba948bd236471Christian Maeder $+$ noPrint (Map.null tvs) (header "Type Variables")
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder $+$ printMap0 tvs
77a65251ee036c6aaf09c2775315a4ee24259fbdJorina Freya Gerken $+$ noPrint (Map.null oops) (header "Assumptions")
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder $+$ printMap0 oops
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder $+$ noPrint (Map.null vs) (header "Variables")
afa6ceaf4359ae437aaa6830949583143ace2752Christian Maeder $+$ printMap0 vs
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder $+$ noPrint (null se) (header "Sentences")
97812b7ce9860bf514a8822a63503451795dbc65Klaus Luettich $+$ vcat (map pretty $ reverse se)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder $+$ noPrint (null ds) (header "Diagnostics")
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder $+$ vcat (map pretty $ reverse ds)
61fa0ac06ede811c7aad54ec4c4202346727368eChristian MaederprintMap0 :: (Pretty a, Ord a, Pretty b) => Map.Map a b -> Doc
61fa0ac06ede811c7aad54ec4c4202346727368eChristian MaederprintMap0 = printMyMap []
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederprintMap1 :: (Pretty a, Ord a, Pretty b) => Map.Map a b -> Doc
61fa0ac06ede811c7aad54ec4c4202346727368eChristian MaederprintMap1 = printMyMap [mapsto]
9e748851c150e1022fb952bab3315e869aaf0214Christian MaederprintMyMap :: (Pretty a, Ord a, Pretty b) => [Doc] -> Map.Map a b -> Doc
08e5741dd8b6bf9b7419e89298e384e18bc57f64Christian MaederprintMyMap d = printMap id vcat ( \ a b -> fsep $ a : d ++ [b])
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maederinstance Pretty Morphism where
9df11f85fd7f8c4745d64464876e84ec4e263692Christian Maeder let tm = typeIdMap m
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckers fm = funMap m
9df11f85fd7f8c4745d64464876e84ec4e263692Christian Maeder ds = Map.foldWithKey ( \ (i, s) (j, t) l ->
5b818f10e11fc79def1fdd5c8a080d64a6438d87Christian Maeder (pretty i <+> colon <+> pretty s
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckers <+> mapsto <+>
5d4038657f6a63e131f5804af2f7957b69e15a43Klaus Luettich pretty j <+> colon <+> pretty t) : l)
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder in (if Map.null tm then empty
c432483b64662e8db604a58758cd18ea7fa65659Christian Maeder else keyword (typeS ++ sS) <+> printMap0 tm)
857992065be4ed40a72c6296b6c0aec62ab4c5b9Christian Maeder $+$ (if Map.null fm then empty
857992065be4ed40a72c6296b6c0aec62ab4c5b9Christian Maeder else keyword (opS ++ sS) <+> sepByCommas ds)
8659594bb40eb5f3da5439692f0908300947191eSonja Gröning $+$ colon <+> specBraces (pretty $ msource m)
eeb419aa20c97b4af973e97ee6ae77a8eed29e15Till Mossakowski <+> specBraces (pretty $ mtarget m)
9e748851c150e1022fb952bab3315e869aaf0214Christian Maederinstance Pretty a => Pretty (SymbolType a) where
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder pretty t = case t of
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder OpAsItemType sc -> pretty sc
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder TypeAsItemType k -> pretty k
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder ClassAsItemType k -> pretty k
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maederinstance Pretty Symbol where
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder pretty s = keyword (case symType s of
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder OpAsItemType _ -> opS
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder TypeAsItemType _ -> typeS
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder ClassAsItemType _ -> classS) <+>
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder pretty (symName s) <+> colon <+>
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder pretty (symType s)
afa6ceaf4359ae437aaa6830949583143ace2752Christian Maederinstance Pretty RawSymbol where
afa6ceaf4359ae437aaa6830949583143ace2752Christian Maeder pretty rs = case rs of
afa6ceaf4359ae437aaa6830949583143ace2752Christian Maeder AnID i -> pretty i
afa6ceaf4359ae437aaa6830949583143ace2752Christian Maeder AKindedId k i -> printSK k [i] <> pretty i
afa6ceaf4359ae437aaa6830949583143ace2752Christian Maeder AQualId i t -> printSK (symbTypeToKind t) [i] <> pretty i <+> colon
afa6ceaf4359ae437aaa6830949583143ace2752Christian Maeder ASymbol s -> pretty s