PrintLe.hs revision 8c81b727b788d90ff3b8cbda7b0900c9009243bb
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina SojakovaModule : $Header$
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina SojakovaCopyright : (c) Christian Maeder and Uni Bremen 2002-2003
097b7fb3f8f90e87120d30bf37a1d89fe0ddfaf0Kristina SojakovaMaintainer : maeder@tzi.de
94e2e03f6efde106de095ef4ea0ec87f74955a31Kristina SojakovaStability : experimental
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuPortability : portable
94e2e03f6efde106de095ef4ea0ec87f74955a31Kristina Sojakovapretty printing a HasCASL environment
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakovaimport qualified Common.Lib.Map as Map
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakovaimport qualified Common.Lib.Set as Set
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakovainstance Pretty ClassInfo where
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova pretty (ClassInfo rk ks) = case ks of
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova [] -> colon <+> pretty rk
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova _ -> text lessS <+> printList0 ks
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina SojakovaprintGenKind :: GenKind -> Doc
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina SojakovaprintGenKind k = case k of
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova Loose -> empty
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova Free -> text freeS
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova Generated -> text generatedS
1a38107941725211e7c3f051f7a8f5e12199f03acmaederinstance Pretty TypeDefn where
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova pretty td = case td of
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova NoTypeDefn -> empty
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder PreDatatype -> text "%(data type)%"
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova AliasTypeDefn s -> text assignS <+> printPseudoType s
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova DatatypeDefn dd -> text " %[" <> pretty dd <> text "]%"
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina SojakovaprintAltDefn :: Id -> [TypeArg] -> RawKind -> AltDefn -> Doc
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina SojakovaprintAltDefn dt tArgs rk (Construct mi ts p sels) = case mi of
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova Just i -> fcat $ [pretty i <> space, colon <> space,
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder pretty (createConstrType dt tArgs rk p ts)]
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova ++ map (parens . semiDs) sels
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova Nothing -> text (typeS ++ sS) <+> ppWithCommas ts
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakovainstance Pretty Selector where
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova pretty (Select mi t p) =
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova Just i -> pretty i <+> (case p of
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakova Partial -> text colonQuMark
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova Total -> colon) <> space
14650c9e129d8dc51ed55b2edc6ec27d9f0f6d00Kristina Sojakova Nothing -> empty) <> pretty t
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakovainstance Pretty TypeInfo where
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakova pretty (TypeInfo _ ks sups def) =
14650c9e129d8dc51ed55b2edc6ec27d9f0f6d00Kristina Sojakova fsep $ [colon, printList0 ks]
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakova ++ (if Set.null sups then []
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakova else [less, printList0 $ Set.toList sups])
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova ++ case def of
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakova NoTypeDefn -> []
8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova _ -> [pretty def]
81d28e8372831ae5e6054d8d2212f0114b09b79aKristina Sojakovainstance Pretty TypeVarDefn where
81d28e8372831ae5e6054d8d2212f0114b09b79aKristina Sojakova pretty (TypeVarDefn v vk _ i) =
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakova printVarKind v vk <+> text ("%(var_" ++ shows i ")%")
81d28e8372831ae5e6054d8d2212f0114b09b79aKristina Sojakovainstance Pretty VarDefn where
fc08da86ea2ef76a631faca30ca30b8ed112d864Christian Maeder pretty (VarDefn ty) =
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova colon <+> pretty ty
cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakovainstance Pretty ConstrInfo where
81d28e8372831ae5e6054d8d2212f0114b09b79aKristina Sojakova pretty (ConstrInfo i t) =
81d28e8372831ae5e6054d8d2212f0114b09b79aKristina Sojakova pretty i <+> colon <+> pretty t
51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakovainstance Pretty OpDefn where
f2f62e61c66f678b0042d1a772ff89849d8b2113Kristina Sojakova pretty od = case od of
f2f62e61c66f678b0042d1a772ff89849d8b2113Kristina Sojakova NoOpDefn b -> text $ "%(" ++ shows b ")%"
14650c9e129d8dc51ed55b2edc6ec27d9f0f6d00Kristina Sojakova ConstructData i -> text $ "%(construct " ++ showId i ")%"
14650c9e129d8dc51ed55b2edc6ec27d9f0f6d00Kristina Sojakova SelectData c i -> text ("%(select from " ++ showId i " constructed by")
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder $+$ printList0 c <> text ")%"
f2f62e61c66f678b0042d1a772ff89849d8b2113Kristina Sojakova Definition b t -> fsep [pretty $ NoOpDefn b, equals, pretty t]
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakovainstance Pretty OpInfo where
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova pretty o = let l = opAttrs o in
887a1999374d1fb3a534e602a8d322de6ef4c8e8Kristina Sojakova fsep $ [ colon
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova , pretty (opType o) <> if null l then empty else comma]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder ++ punctuate comma (map pretty l)
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakova ++ [pretty $ opDefn o]
9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina Sojakovainstance Pretty OpInfos where
fc08da86ea2ef76a631faca30ca30b8ed112d864Christian Maeder pretty (OpInfos l) = vcat $ map pretty l
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakovainstance Pretty DataEntry where
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova pretty (DataEntry im i k args rk alts) =
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova printGenKind k <+> keyword typeS <+>
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova fsep ([fcat $ pretty i : map (parens . pretty) args
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova , defn, vcat $ map (printAltDefn i args rk) alts]
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova ++ if Map.null im then []
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova else [text withS, text (typeS ++ sS), printMap0 im])
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakovainstance Pretty Sentence where
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova pretty s = case s of
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova Formula t -> pretty t
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova DatatypeSen ls -> vcat (map pretty ls)
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova ProgEqSen _ _ pe -> keyword programS <+> pretty pe
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakovainstance Pretty Env where
12d9bff7c82145a8b68bfb8553688172655c926eKristina Sojakova pretty (Env{classMap=cm, typeMap=tm, localTypeVars=tvs,
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova assumps=ops, localVars=vs,
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova sentences=se, envDiags=ds}) =
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova let oops = foldr Map.delete ops $ map fst bList
12d9bff7c82145a8b68bfb8553688172655c926eKristina Sojakova otm = Map.difference tm $ addUnit Map.empty
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova header s = text "%%" <+> text s
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova <+> text (replicate (70 - length s) '-')
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova in noPrint (Map.null cm) (header "Classes")
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova $+$ printMap0 cm
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova $+$ noPrint (Map.null otm) (header "Type Constructors")
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova $+$ printMap0 otm
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova $+$ noPrint (Map.null tvs) (header "Type Variables")
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova $+$ printMap0 tvs
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova $+$ noPrint (Map.null oops) (header "Assumptions")
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova $+$ printMap0 oops
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova $+$ noPrint (Map.null vs) (header "Variables")
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova $+$ printMap0 vs
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova $+$ noPrint (null se) (header "Sentences")
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova $+$ vcat (map pretty $ reverse se)
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova $+$ noPrint (null ds) (header "Diagnostics")
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova $+$ vcat (map pretty $ reverse ds)
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaprintMap0 :: (Pretty a, Ord a, Pretty b) => Map.Map a b -> Doc
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaprintMap0 = printMyMap []
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaprintMap1 :: (Pretty a, Ord a, Pretty b) => Map.Map a b -> Doc
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina SojakovaprintMap1 = printMyMap [mapsto]
12d9bff7c82145a8b68bfb8553688172655c926eKristina SojakovaprintMyMap :: (Pretty a, Ord a, Pretty b) => [Doc] -> Map.Map a b -> Doc
12d9bff7c82145a8b68bfb8553688172655c926eKristina SojakovaprintMyMap d = printMap id vcat ( \ a b -> fsep $ a : d ++ [b])
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakovainstance Pretty Morphism where
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova let tm = typeIdMap m
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova ds = Map.foldWithKey ( \ (i, s) (j, t) l ->
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova (pretty i <+> colon <+> pretty s
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova <+> mapsto <+>
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova pretty j <+> colon <+> pretty t) : l)
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova in (if Map.null tm then empty
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova else keyword (typeS ++ sS) <+> printMap0 tm)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder $+$ (if Map.null fm then empty
fc08da86ea2ef76a631faca30ca30b8ed112d864Christian Maeder else keyword (opS ++ sS) <+> sepByCommas ds)
fc08da86ea2ef76a631faca30ca30b8ed112d864Christian Maeder $+$ colon <+> specBraces (pretty $ msource m)
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova <+> specBraces (pretty $ mtarget m)
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakovainstance Pretty a => Pretty (SymbolType a) where
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova pretty t = case t of
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder OpAsItemType sc -> pretty sc
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova TypeAsItemType k -> pretty k
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova ClassAsItemType k -> pretty k
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakovainstance Pretty Symbol where
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova pretty s = keyword (case symType s of
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder OpAsItemType _ -> opS
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova TypeAsItemType _ -> typeS
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova ClassAsItemType _ -> classS) <+>
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova pretty (symName s) <+> colon <+>
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova pretty (symType s)
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakovainstance Pretty RawSymbol where
fc08da86ea2ef76a631faca30ca30b8ed112d864Christian Maeder pretty rs = case rs of
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder AnID i -> pretty i
5b84285ea066187061fc123a3b86b1b6433e06b5Kristina Sojakova AKindedId k i -> printSK k <> pretty i
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova AQualId i t -> printSK (symbTypeToKind t) <> pretty i <+> colon
df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova ASymbol s -> pretty s