PrintAs.hs revision 24f79601ad5e42ce74f4152a36aad257d7c4d7b5
208651a016b098f4fa1f6279559f104d70f1632dtakashi{- |
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiModule : $Header$
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiCopyright : (c) Christian Maeder and Uni Bremen 2003
a1d62218cdb0efd0f02da1b54fd3eda91a681d98ndLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
acc36ab93565d2880447d535da6ca6e5feac7a70ndMaintainer : maeder@tzi.de
db479b48bd4d75423ed4a45e15b75089d1a8ad72fieldingStability : experimental
db479b48bd4d75423ed4a45e15b75089d1a8ad72fieldingPortability : portable
db479b48bd4d75423ed4a45e15b75089d1a8ad72fielding
db479b48bd4d75423ed4a45e15b75089d1a8ad72fieldingprinting data types of the abstract syntax
db479b48bd4d75423ed4a45e15b75089d1a8ad72fielding-}
db479b48bd4d75423ed4a45e15b75089d1a8ad72fielding
acc36ab93565d2880447d535da6ca6e5feac7a70ndmodule HasCASL.PrintAs where
acc36ab93565d2880447d535da6ca6e5feac7a70nd
acc36ab93565d2880447d535da6ca6e5feac7a70ndimport HasCASL.As
acc36ab93565d2880447d535da6ca6e5feac7a70ndimport HasCASL.AsUtils
acc36ab93565d2880447d535da6ca6e5feac7a70ndimport HasCASL.FoldTerm
acc36ab93565d2880447d535da6ca6e5feac7a70ndimport HasCASL.Builtin
acc36ab93565d2880447d535da6ca6e5feac7a70ndimport Common.Id
acc36ab93565d2880447d535da6ca6e5feac7a70ndimport Common.Keywords
acc36ab93565d2880447d535da6ca6e5feac7a70ndimport Common.DocUtils
acc36ab93565d2880447d535da6ca6e5feac7a70ndimport Common.Doc
7db9f691a00ead175b03335457ca296a33ddf31bndimport Common.AS_Annotation
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
208651a016b098f4fa1f6279559f104d70f1632dtakashi-- | short cut for: if b then empty else d
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikinoPrint :: Bool -> Doc -> Doc
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikinoPrint b d = if b then empty else d
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashinoNullPrint :: [a] -> Doc -> Doc
208651a016b098f4fa1f6279559f104d70f1632dtakashinoNullPrint = noPrint . null
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashisemiDs :: Pretty a => [a] -> Doc
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikisemiDs = fsep . punctuate semi . map pretty
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikisemiAnnoted :: Pretty a => [Annoted a] -> Doc
208651a016b098f4fa1f6279559f104d70f1632dtakashisemiAnnoted = vcat . map (printSemiAnno pretty True)
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty Variance where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty = sidDoc . mkSimpleId . show
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty a => Pretty (AnyKind a) where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty knd = case knd of
208651a016b098f4fa1f6279559f104d70f1632dtakashi ClassKind ci -> pretty ci
208651a016b098f4fa1f6279559f104d70f1632dtakashi FunKind v k1 k2 _ -> fsep [pretty v <>
208651a016b098f4fa1f6279559f104d70f1632dtakashi (case k1 of
208651a016b098f4fa1f6279559f104d70f1632dtakashi FunKind _ _ _ _ -> parens
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> id) (pretty k1)
208651a016b098f4fa1f6279559f104d70f1632dtakashi , funArrow
208651a016b098f4fa1f6279559f104d70f1632dtakashi , pretty k2]
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiinstance Pretty TypePattern where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty tp = case tp of
208651a016b098f4fa1f6279559f104d70f1632dtakashi TypePattern name args _ -> pretty name
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki <> fsep (map (parens . pretty) args)
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki TypePatternToken t -> pretty t
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki MixfixTypePattern ts -> fsep (map (pretty) ts)
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki BracketTypePattern k l _ -> bracket k $ ppWithCommas l
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki TypePatternArg t _ -> parens $ pretty t
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki-- | put proper brackets around a document
208651a016b098f4fa1f6279559f104d70f1632dtakashibracket :: BracketKind -> Doc -> Doc
208651a016b098f4fa1f6279559f104d70f1632dtakashibracket b = case b of
208651a016b098f4fa1f6279559f104d70f1632dtakashi Parens -> parens
208651a016b098f4fa1f6279559f104d70f1632dtakashi Squares -> brackets
208651a016b098f4fa1f6279559f104d70f1632dtakashi Braces -> specBraces
208651a016b098f4fa1f6279559f104d70f1632dtakashi NoBrackets -> id
208651a016b098f4fa1f6279559f104d70f1632dtakashi
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki-- | print a 'Kind' plus a preceding colon (or nothing)
cba0b38dd66ebf99f437479c12771475046da0cakawaiprintKind :: Kind -> Doc
208651a016b098f4fa1f6279559f104d70f1632dtakashiprintKind k = noPrint (k == universe) $ printVarKind InVar (VarKind k)
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashi-- | print the kind of a variable with its variance and a preceding colon
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiprintVarKind :: Variance -> VarKind -> Doc
208651a016b098f4fa1f6279559f104d70f1632dtakashiprintVarKind e vk = case vk of
208651a016b098f4fa1f6279559f104d70f1632dtakashi Downset t ->
208651a016b098f4fa1f6279559f104d70f1632dtakashi space <> less <+> pretty t
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki VarKind k -> space <> colon <+>
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty e <> pretty k
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki MissingKind -> empty
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikidata TypePrec = Outfix | Prefix | ProdInfix | FunInfix deriving (Eq, Ord)
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiparenPrec :: TypePrec -> (TypePrec, Doc) -> Doc
208651a016b098f4fa1f6279559f104d70f1632dtakashiparenPrec p1 (p2, d) = if p2 < p1 then d else parens d
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiprintTypeToken :: Token -> Doc
208651a016b098f4fa1f6279559f104d70f1632dtakashiprintTypeToken t = let
208651a016b098f4fa1f6279559f104d70f1632dtakashi l = ("*", cross) : map ( \ (a, d) -> (show a, d) )
208651a016b098f4fa1f6279559f104d70f1632dtakashi [ (FunArr, funArrow)
208651a016b098f4fa1f6279559f104d70f1632dtakashi , (PFunArr, pfun)
208651a016b098f4fa1f6279559f104d70f1632dtakashi , (ContFunArr, cfun)
208651a016b098f4fa1f6279559f104d70f1632dtakashi , (PContFunArr, pcfun) ]
208651a016b098f4fa1f6279559f104d70f1632dtakashi in case lookup (tokStr t) l of
208651a016b098f4fa1f6279559f104d70f1632dtakashi Just d -> d
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> pretty t
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashitoMixType :: Type -> (TypePrec, Doc)
208651a016b098f4fa1f6279559f104d70f1632dtakashitoMixType typ = case typ of
208651a016b098f4fa1f6279559f104d70f1632dtakashi ExpandedType t1 _ -> toMixType t1
208651a016b098f4fa1f6279559f104d70f1632dtakashi {- (Prefix, ExpandedType
208651a016b098f4fa1f6279559f104d70f1632dtakashi (parenPrec Prefix $ toMixType t1)
208651a016b098f4fa1f6279559f104d70f1632dtakashi $ parenPrec Prefix $ toMixType t2) -}
208651a016b098f4fa1f6279559f104d70f1632dtakashi BracketType k l _ -> (Outfix, bracket k $ sepByCommas $ map
208651a016b098f4fa1f6279559f104d70f1632dtakashi (snd . toMixType) l)
208651a016b098f4fa1f6279559f104d70f1632dtakashi KindedType t kind _ -> (Prefix,
208651a016b098f4fa1f6279559f104d70f1632dtakashi fsep [parenPrec Prefix $ toMixType t, colon, pretty kind])
208651a016b098f4fa1f6279559f104d70f1632dtakashi MixfixType ts -> (Prefix, fsep $ map (snd . toMixType) ts)
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> let (topTy, tyArgs) = getTypeAppl typ in
208651a016b098f4fa1f6279559f104d70f1632dtakashi case topTy of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki TypeName name@(Id ts cs _) _k _i -> let topDoc = pretty name in
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki case tyArgs of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki [] -> (Outfix, pretty name)
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki [arg] -> let dArg = toMixType arg in
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki case ts of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki [e1, e2, e3] | not (isPlace e1) && isPlace e2
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki && not (isPlace e3) && null cs ->
208651a016b098f4fa1f6279559f104d70f1632dtakashi (Outfix, fsep [pretty e1, snd dArg, pretty e3])
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki _ -> (Prefix, fsep [topDoc, parenPrec Prefix dArg])
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki [arg1, arg2] -> let dArg1 = toMixType arg1
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki dArg2 = toMixType arg2 in
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki case ts of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki [e1, e2, e3] | isPlace e1 && not (isPlace e2)
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki && isPlace e3 && null cs ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki if tokStr e2 == prodS then
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki (ProdInfix, fsep [
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki parenPrec ProdInfix dArg1, cross,
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki parenPrec ProdInfix dArg2])
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki else -- assume fun type
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki (FunInfix, fsep [
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki parenPrec FunInfix dArg1, printTypeToken e2, snd dArg2])
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> (Prefix, fsep [topDoc, parenPrec Prefix dArg1,
208651a016b098f4fa1f6279559f104d70f1632dtakashi parenPrec Prefix dArg2])
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki _ -> if name == productId (length tyArgs) then
208651a016b098f4fa1f6279559f104d70f1632dtakashi (ProdInfix, fsep $ punctuate (space <> cross) $
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki map (parenPrec ProdInfix . toMixType) tyArgs)
208651a016b098f4fa1f6279559f104d70f1632dtakashi else (Prefix, fsep $ topDoc :
208651a016b098f4fa1f6279559f104d70f1632dtakashi map (parenPrec Prefix . toMixType) tyArgs)
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ | null tyArgs -> (Outfix, printType topTy)
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> (Prefix, fsep $ parenPrec ProdInfix (toMixType topTy)
208651a016b098f4fa1f6279559f104d70f1632dtakashi : map (parenPrec Prefix . toMixType) tyArgs)
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiprintType :: Type -> Doc
208651a016b098f4fa1f6279559f104d70f1632dtakashiprintType ty = case ty of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki TypeName name _ _ -> pretty name
208651a016b098f4fa1f6279559f104d70f1632dtakashi TypeAppl t1 t2 -> fcat [parens (printType t1),
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki parens (printType t2)]
208651a016b098f4fa1f6279559f104d70f1632dtakashi ExpandedType t1 t2 -> fcat [printType t1, text asP, printType t2]
208651a016b098f4fa1f6279559f104d70f1632dtakashi TypeToken t -> printTypeToken t
208651a016b098f4fa1f6279559f104d70f1632dtakashi BracketType k l _ -> bracket k $ sepByCommas $ map (printType) l
208651a016b098f4fa1f6279559f104d70f1632dtakashi KindedType t kind _ -> sep [printType t, colon <+> pretty kind]
208651a016b098f4fa1f6279559f104d70f1632dtakashi MixfixType ts -> fsep $ map printType ts
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty Type where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty = snd . toMixType
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashi-- no curried notation for bound variables
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty TypeScheme where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty (TypeScheme vs t _) = let tdoc = pretty t in
208651a016b098f4fa1f6279559f104d70f1632dtakashi if null vs then tdoc else
208651a016b098f4fa1f6279559f104d70f1632dtakashi fsep [forallDoc, semiDs vs, bullet, tdoc]
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty Partiality where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty p = case p of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Partial -> quMarkD
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Total -> empty
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty Quantifier where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty q = case q of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Universal -> forallDoc
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Existential -> exists
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Unique -> unique
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiinstance Pretty TypeQual where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty q = case q of
208651a016b098f4fa1f6279559f104d70f1632dtakashi OfType -> colon
208651a016b098f4fa1f6279559f104d70f1632dtakashi AsType -> text asS
208651a016b098f4fa1f6279559f104d70f1632dtakashi InType -> inDoc
208651a016b098f4fa1f6279559f104d70f1632dtakashi Inferred -> colon
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty Term where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty = printTerm . rmSomeTypes
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiisSimpleTerm :: Term -> Bool
208651a016b098f4fa1f6279559f104d70f1632dtakashiisSimpleTerm trm = case trm of
208651a016b098f4fa1f6279559f104d70f1632dtakashi QualVar _ -> True
208651a016b098f4fa1f6279559f104d70f1632dtakashi QualOp _ _ _ _ -> True
208651a016b098f4fa1f6279559f104d70f1632dtakashi ResolvedMixTerm _ _ _ -> True
208651a016b098f4fa1f6279559f104d70f1632dtakashi ApplTerm _ _ _ -> True
208651a016b098f4fa1f6279559f104d70f1632dtakashi TupleTerm _ _ -> True
208651a016b098f4fa1f6279559f104d70f1632dtakashi TermToken _ -> True
208651a016b098f4fa1f6279559f104d70f1632dtakashi BracketTerm _ _ _ -> True
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> False
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashi-- | used only to produce CASL applications
208651a016b098f4fa1f6279559f104d70f1632dtakashiisSimpleArgTerm :: Term -> Bool
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiisSimpleArgTerm trm = case trm of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki QualVar vd -> not (isPatVarDecl vd)
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki QualOp _ _ _ _ -> True
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki ResolvedMixTerm n l _ -> placeCount n /= 0 || not (null l)
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki TupleTerm _ _ -> True
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki BracketTerm _ _ _ -> True
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> False
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiisPatVarDecl :: VarDecl -> Bool
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiisPatVarDecl (VarDecl v ty _ _) = case ty of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki TypeName t _ _ -> isSimpleId v && take 2 (show t) == "_v"
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> False
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiparenTermDoc :: Term -> Doc -> Doc
208651a016b098f4fa1f6279559f104d70f1632dtakashiparenTermDoc trm = if isSimpleTerm trm then id else parens
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiprintTermRec :: FoldRec Doc (Doc, Doc)
208651a016b098f4fa1f6279559f104d70f1632dtakashiprintTermRec = FoldRec
208651a016b098f4fa1f6279559f104d70f1632dtakashi { foldQualVar = \ _ vd@(VarDecl v _ _ _) ->
208651a016b098f4fa1f6279559f104d70f1632dtakashi if isPatVarDecl vd then pretty v
208651a016b098f4fa1f6279559f104d70f1632dtakashi else parens $ keyword varS <+> pretty vd
208651a016b098f4fa1f6279559f104d70f1632dtakashi , foldQualOp = \ _ br n t _ ->
208651a016b098f4fa1f6279559f104d70f1632dtakashi parens $ fsep [pretty br, pretty n, colon, pretty $
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki if isPred br then unPredTypeScheme t else t]
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldResolvedMixTerm = \ (ResolvedMixTerm _ os _) n ts _ ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki if placeCount n == length ts || null ts then
208651a016b098f4fa1f6279559f104d70f1632dtakashi idApplDoc n $ zipWith parenTermDoc os ts
208651a016b098f4fa1f6279559f104d70f1632dtakashi else idApplDoc applId [idDoc n, parens $ sepByCommas ts]
208651a016b098f4fa1f6279559f104d70f1632dtakashi , foldApplTerm = \ (ApplTerm o1 o2 _) t1 t2 _ ->
208651a016b098f4fa1f6279559f104d70f1632dtakashi case (o1, o2) of
208651a016b098f4fa1f6279559f104d70f1632dtakashi (ResolvedMixTerm n [] _, TupleTerm ts _)
208651a016b098f4fa1f6279559f104d70f1632dtakashi | placeCount n == length ts ->
208651a016b098f4fa1f6279559f104d70f1632dtakashi idApplDoc n $ zipWith parenTermDoc ts $ map printTerm ts
208651a016b098f4fa1f6279559f104d70f1632dtakashi (ResolvedMixTerm n [] _, _) | placeCount n == 1 ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki idApplDoc n [parenTermDoc o2 t2]
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki _ -> idApplDoc applId [parenTermDoc o1 t1, parenTermDoc o2 t2]
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki-- use "if isSimpleArgTerm o2 then t2 else parens t2" to output real CASL
208651a016b098f4fa1f6279559f104d70f1632dtakashi , foldTupleTerm = \ _ ts _ -> parens $ sepByCommas ts
208651a016b098f4fa1f6279559f104d70f1632dtakashi , foldTypedTerm = \ (TypedTerm ot _ _ _) t q typ _ -> fsep [(case ot of
208651a016b098f4fa1f6279559f104d70f1632dtakashi LambdaTerm {} -> parens
208651a016b098f4fa1f6279559f104d70f1632dtakashi LetTerm {} -> parens
208651a016b098f4fa1f6279559f104d70f1632dtakashi CaseTerm {} -> parens
cba0b38dd66ebf99f437479c12771475046da0cakawai QuantifiedTerm {} -> parens
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> id) t, pretty q, pretty typ]
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldQuantifiedTerm = \ _ q vs t _ ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki fsep [pretty q, semiDs vs, bullet, t]
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldLambdaTerm = \ _ ps q t _ ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki fsep [ lambda
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , case ps of
208651a016b098f4fa1f6279559f104d70f1632dtakashi [p] -> p
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki _ -> fcat $ map parens ps
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , case q of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Partial -> bullet
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Total -> bullet <> text exMark
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , t]
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldCaseTerm = \ _ t es _ ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki fsep [text caseS, t, text ofS,
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki cat $ punctuate (space <> bar <> space) $
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki map (printEq0 funArrow) es]
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldLetTerm = \ _ br es t _ ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki let des = sep $ punctuate semi $ map (printEq0 equals) es
208651a016b098f4fa1f6279559f104d70f1632dtakashi in case br of
208651a016b098f4fa1f6279559f104d70f1632dtakashi Let -> fsep [sep [text letS <+> des, text inS], t]
208651a016b098f4fa1f6279559f104d70f1632dtakashi Where -> fsep [sep [t, text whereS], des]
208651a016b098f4fa1f6279559f104d70f1632dtakashi Program -> text programS <+> des
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldTermToken = \ _ t -> pretty t
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldMixTypeTerm = \ _ q t _ -> pretty q <+> pretty t
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldMixfixTerm = \ _ ts -> fsep ts
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldBracketTerm = \ _ k l _ -> bracket k $ sepByCommas l
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldAsPattern = \ _ (VarDecl v _ _ _) p _ ->
208651a016b098f4fa1f6279559f104d70f1632dtakashi fsep [pretty v, text asP, p]
208651a016b098f4fa1f6279559f104d70f1632dtakashi , foldProgEq = \ _ p t _ -> (p, t)
208651a016b098f4fa1f6279559f104d70f1632dtakashi }
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiprintTerm :: Term -> Doc
208651a016b098f4fa1f6279559f104d70f1632dtakashiprintTerm = foldTerm printTermRec
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashirmTypeRec :: MapRec
208651a016b098f4fa1f6279559f104d70f1632dtakashirmTypeRec = mapRec
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki { foldQualOp = \ t _ (InstOpId i _ _) _ ps ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki if elem i $ map fst bList then
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki ResolvedMixTerm i [] ps else t
208651a016b098f4fa1f6279559f104d70f1632dtakashi , foldTypedTerm = \ _ nt q ty ps ->
208651a016b098f4fa1f6279559f104d70f1632dtakashi case q of
208651a016b098f4fa1f6279559f104d70f1632dtakashi Inferred -> nt
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> case nt of
cba0b38dd66ebf99f437479c12771475046da0cakawai TypedTerm _ oq oty _ | oty == ty || oq == InType -> nt
208651a016b098f4fa1f6279559f104d70f1632dtakashi QualVar (VarDecl _ oty _ _) | oty == ty -> nt
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki _ -> TypedTerm nt q ty ps
208651a016b098f4fa1f6279559f104d70f1632dtakashi }
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikirmSomeTypes :: Term -> Term
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikirmSomeTypes = foldTerm rmTypeRec
cba0b38dd66ebf99f437479c12771475046da0cakawai
cba0b38dd66ebf99f437479c12771475046da0cakawai-- | put parenthesis around applications
208651a016b098f4fa1f6279559f104d70f1632dtakashiparenTermRec :: MapRec
208651a016b098f4fa1f6279559f104d70f1632dtakashiparenTermRec = let
208651a016b098f4fa1f6279559f104d70f1632dtakashi addParAppl t = case t of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki ResolvedMixTerm _ [] _ -> t
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki QualVar _ -> t
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki QualOp _ _ _ _ -> t
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki TermToken _ -> t
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki BracketTerm _ _ _ -> t
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki TupleTerm _ _ -> t
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki _ -> TupleTerm [t] nullRange
208651a016b098f4fa1f6279559f104d70f1632dtakashi in mapRec
208651a016b098f4fa1f6279559f104d70f1632dtakashi { foldApplTerm = \ _ t1 t2 ps ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki ApplTerm (addParAppl t1) (addParAppl t2) ps
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldResolvedMixTerm = \ _ n ts ps ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki ResolvedMixTerm n (map addParAppl ts) ps
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldTypedTerm = \ _ t q typ ps ->
eb0e40cd83eb61adb74ef3f4933e551b3531930eyoshiki TypedTerm (addParAppl t) q typ ps
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldMixfixTerm = \ _ ts -> MixfixTerm $ map addParAppl ts
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , foldAsPattern = \ _ v p ps -> AsPattern v (addParAppl p) ps
208651a016b098f4fa1f6279559f104d70f1632dtakashi }
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiparenTerm :: Term -> Term
208651a016b098f4fa1f6279559f104d70f1632dtakashiparenTerm = foldTerm parenTermRec
208651a016b098f4fa1f6279559f104d70f1632dtakashi
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki-- | print an equation with different symbols between 'Pattern' and 'Term'
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiprintEq0 :: Doc -> (Doc, Doc) -> Doc
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiprintEq0 s (p, t) = fsep [p, s, t]
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiinstance Pretty VarDecl where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty (VarDecl v t _ _) = pretty v <>
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki case t of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki MixfixType [] -> empty
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> space <> colon <+> pretty t
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiinstance Pretty GenVarDecl where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty gvd = case gvd of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki GenVarDecl v -> pretty v
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki GenTypeVarDecl tv -> pretty tv
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty TypeArg where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty (TypeArg v e c _ _ _ _) =
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty v <> printVarKind e c
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki-- | don't print an empty list and put parens around longer lists
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiprintList0 :: (Pretty a) => [a] -> Doc
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiprintList0 l = case l of
208651a016b098f4fa1f6279559f104d70f1632dtakashi [] -> empty
208651a016b098f4fa1f6279559f104d70f1632dtakashi [x] -> pretty x
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki _ -> parens $ ppWithCommas l
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiinstance Pretty InstOpId where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty (InstOpId n l _) = pretty n <> noNullPrint l
208651a016b098f4fa1f6279559f104d70f1632dtakashi (brackets $ semiDs l)
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
208651a016b098f4fa1f6279559f104d70f1632dtakashi-- | print a 'TypeScheme' as a pseudo type
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiprintPseudoType :: TypeScheme -> Doc
208651a016b098f4fa1f6279559f104d70f1632dtakashiprintPseudoType (TypeScheme l t _) = noNullPrint l (lambda
208651a016b098f4fa1f6279559f104d70f1632dtakashi <+> (if null $ tail l then pretty $ head l
208651a016b098f4fa1f6279559f104d70f1632dtakashi else fsep(map (parens . pretty) l))
208651a016b098f4fa1f6279559f104d70f1632dtakashi <+> bullet <> space) <> pretty t
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty BasicSpec where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty (BasicSpec l) = changeGlobalAnnos addBuiltins . vcat $ map pretty l
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiinstance Pretty ProgEq where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty = printEq0 equals . foldEq printTermRec
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiinstance Pretty BasicItem where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty bi = case bi of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki SigItems s -> pretty s
208651a016b098f4fa1f6279559f104d70f1632dtakashi ProgItems l _ -> sep [keyword programS, semiAnnoted l]
208651a016b098f4fa1f6279559f104d70f1632dtakashi ClassItems i l _ -> let b = semiAnnoted l in case i of
208651a016b098f4fa1f6279559f104d70f1632dtakashi Plain -> topSigKey classS <+>b
208651a016b098f4fa1f6279559f104d70f1632dtakashi Instance -> sep [keyword classS <+> keyword instanceS, b]
208651a016b098f4fa1f6279559f104d70f1632dtakashi GenVarItems l _ -> topSigKey varS <+> semiDs l
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki FreeDatatype l _ ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki sep [keyword freeS <+> keyword typeS, semiAnnos pretty l]
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki GenItems l _ -> sep [ keyword generatedS
208651a016b098f4fa1f6279559f104d70f1632dtakashi , specBraces . vcat $ map (printAnnoted pretty) l]
208651a016b098f4fa1f6279559f104d70f1632dtakashi AxiomItems vs fs _ ->
208651a016b098f4fa1f6279559f104d70f1632dtakashi vcat $ (if null vs then [] else
208651a016b098f4fa1f6279559f104d70f1632dtakashi [forallDoc <+> semiDs vs])
208651a016b098f4fa1f6279559f104d70f1632dtakashi ++ case fs of
cba0b38dd66ebf99f437479c12771475046da0cakawai [] -> []
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> map (printAnnoted $ addBullet . pretty) (init fs)
208651a016b098f4fa1f6279559f104d70f1632dtakashi ++ [printSemiAnno (addBullet . pretty) True $ last fs]
208651a016b098f4fa1f6279559f104d70f1632dtakashi Internal l _ -> sep [keyword internalS, specBraces $ semiAnnoted l]
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty OpBrand where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty b = keyword $ show b
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiinstance Pretty SigItems where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty si = case si of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki TypeItems i l _ -> let b = semiAnnos pretty l in case i of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Plain -> topSigKey (if all (isSimpleTypeItem . item) l
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki then sortS else typeS) <+> b
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Instance -> sep [keyword typeS <+> keyword instanceS, b]
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki OpItems b l _ -> noNullPrint l $ topSigKey (show b)
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki <+> let po = (prettyOpItem $ isPred b) in
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki if case item $ last l of
208651a016b098f4fa1f6279559f104d70f1632dtakashi OpDecl _ _ a@(_ : _) _ -> case last a of
208651a016b098f4fa1f6279559f104d70f1632dtakashi UnitOpAttr {} -> True
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki _ -> False
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki OpDefn {} -> True
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki _ -> False
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki then vcat (map (printSemiAnno po True) l)
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki else semiAnnos po l
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiisSimpleTypeItem :: TypeItem -> Bool
208651a016b098f4fa1f6279559f104d70f1632dtakashiisSimpleTypeItem ti = case ti of
208651a016b098f4fa1f6279559f104d70f1632dtakashi TypeDecl l k _ -> k == universe && all isSimpleTypePat l
208651a016b098f4fa1f6279559f104d70f1632dtakashi SubtypeDecl l (TypeName i _ _) _ ->
208651a016b098f4fa1f6279559f104d70f1632dtakashi not (isMixfix i) && all isSimpleTypePat l
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki SubtypeDefn p (Var _) t _ _ ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki isSimpleTypePat p && isSimpleType t
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki _ -> False
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
208651a016b098f4fa1f6279559f104d70f1632dtakashiisSimpleTypePat :: TypePattern -> Bool
208651a016b098f4fa1f6279559f104d70f1632dtakashiisSimpleTypePat tp = case tp of
208651a016b098f4fa1f6279559f104d70f1632dtakashi TypePattern i [] _ -> not $ isMixfix i
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> False
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiisSimpleType :: Type -> Bool
208651a016b098f4fa1f6279559f104d70f1632dtakashiisSimpleType t = case t of
208651a016b098f4fa1f6279559f104d70f1632dtakashi TypeName i _ _ -> not $ isMixfix i
208651a016b098f4fa1f6279559f104d70f1632dtakashi TypeToken _ -> True
208651a016b098f4fa1f6279559f104d70f1632dtakashi MixfixType[TypeToken _, BracketType Squares (_ : _) _] -> True
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> False
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty ClassItem where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty (ClassItem d l _) =
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty d $+$ noNullPrint l (specBraces $ semiAnnoted l)
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty ClassDecl where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty (ClassDecl l k _) = fsep [ppWithCommas l, less, pretty k]
208651a016b098f4fa1f6279559f104d70f1632dtakashi
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiinstance Pretty Vars where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty vd = case vd of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Var v -> pretty v
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki VarTuple vs _ -> parens $ ppWithCommas vs
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiinstance Pretty TypeItem where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty ti = case ti of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki TypeDecl l k _ -> ppWithCommas l <> printKind k
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki SubtypeDecl l t _ ->
208651a016b098f4fa1f6279559f104d70f1632dtakashi fsep [ppWithCommas l, less, pretty t]
208651a016b098f4fa1f6279559f104d70f1632dtakashi IsoDecl l _ -> fsep $ punctuate (space <> equals) $ map pretty l
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki SubtypeDefn p v t f _ ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki fsep [pretty p, equals,
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki specBraces $ fsep
208651a016b098f4fa1f6279559f104d70f1632dtakashi [pretty v, colon, pretty t, bullet, pretty f]]
208651a016b098f4fa1f6279559f104d70f1632dtakashi AliasType p k t _ ->
208651a016b098f4fa1f6279559f104d70f1632dtakashi fsep $ pretty p : (case k of
208651a016b098f4fa1f6279559f104d70f1632dtakashi Just j | j /= universe -> [colon <+> pretty j]
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> [])
208651a016b098f4fa1f6279559f104d70f1632dtakashi ++ [text assignS <+> printPseudoType t]
208651a016b098f4fa1f6279559f104d70f1632dtakashi Datatype t -> pretty t
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiprettyTypeScheme :: Bool -> TypeScheme -> Doc
208651a016b098f4fa1f6279559f104d70f1632dtakashiprettyTypeScheme b = pretty . (if b then unPredTypeScheme else id)
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiprettyOpItem :: Bool -> OpItem -> Doc
208651a016b098f4fa1f6279559f104d70f1632dtakashiprettyOpItem b oi = case oi of
208651a016b098f4fa1f6279559f104d70f1632dtakashi OpDecl l t a _ -> fsep $ punctuate comma (map pretty l)
cba0b38dd66ebf99f437479c12771475046da0cakawai ++ [colon <+>
208651a016b098f4fa1f6279559f104d70f1632dtakashi (if null a then id else (<> comma))(prettyTypeScheme b t)]
208651a016b098f4fa1f6279559f104d70f1632dtakashi ++ punctuate comma (map pretty a)
208651a016b098f4fa1f6279559f104d70f1632dtakashi OpDefn n ps s p t _ ->
208651a016b098f4fa1f6279559f104d70f1632dtakashi fcat $ ((if null ps then (<> space) else id) $ pretty n)
208651a016b098f4fa1f6279559f104d70f1632dtakashi : map ((<> space) . parens . semiDs) ps
208651a016b098f4fa1f6279559f104d70f1632dtakashi ++ (if b then [] else
208651a016b098f4fa1f6279559f104d70f1632dtakashi [colon <> pretty p <+> prettyTypeScheme b s <> space])
208651a016b098f4fa1f6279559f104d70f1632dtakashi ++ [(if b then equiv else equals) <> space, pretty t]
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiinstance Pretty BinOpAttr where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty a = text $ case a of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Assoc -> assocS
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Comm -> commS
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Idem -> idemS
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty OpAttr where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty oa = case oa of
4623c7971666391ad157a24769d9b5b32911911dyoshiki BinOpAttr a _ -> pretty a
208651a016b098f4fa1f6279559f104d70f1632dtakashi UnitOpAttr t _ -> text unitS <+> pretty t
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty DatatypeDecl where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty (DatatypeDecl p k alts d _) =
208651a016b098f4fa1f6279559f104d70f1632dtakashi fsep [ pretty p <> printKind k, defn
208651a016b098f4fa1f6279559f104d70f1632dtakashi <+> cat (punctuate (space <> bar <> space)
208651a016b098f4fa1f6279559f104d70f1632dtakashi $ map pretty alts)
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki , case d of
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki [] -> empty
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki _ -> keyword derivingS <+> ppWithCommas d]
208651a016b098f4fa1f6279559f104d70f1632dtakashi
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiinstance Pretty Alternative where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty alt = case alt of
208651a016b098f4fa1f6279559f104d70f1632dtakashi Constructor n cs p _ -> pretty n <+> fsep
208651a016b098f4fa1f6279559f104d70f1632dtakashi (map ( \ l -> case (l, p) of
208651a016b098f4fa1f6279559f104d70f1632dtakashi-- comment out the following line to output real CASL
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki ([NoSelector (TypeToken t)], Total) -> pretty t
208651a016b098f4fa1f6279559f104d70f1632dtakashi _ -> parens $ semiDs l) cs) <> pretty p
208651a016b098f4fa1f6279559f104d70f1632dtakashi Subtype l _ -> text (if all isSimpleType l then sortS else typeS)
208651a016b098f4fa1f6279559f104d70f1632dtakashi <+> ppWithCommas l
208651a016b098f4fa1f6279559f104d70f1632dtakashi
cba0b38dd66ebf99f437479c12771475046da0cakawaiinstance Pretty Component where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty sel = case sel of
208651a016b098f4fa1f6279559f104d70f1632dtakashi Selector n p t _ _ -> pretty n
208651a016b098f4fa1f6279559f104d70f1632dtakashi <+> colon <> pretty p
208651a016b098f4fa1f6279559f104d70f1632dtakashi <+> pretty t
208651a016b098f4fa1f6279559f104d70f1632dtakashi NoSelector t -> pretty t
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty OpId where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty (OpId n ts _) = pretty n
208651a016b098f4fa1f6279559f104d70f1632dtakashi <+> noNullPrint ts
208651a016b098f4fa1f6279559f104d70f1632dtakashi (brackets $ ppWithCommas ts)
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty Symb where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty (Symb i mt _) =
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty i <> (case mt of
208651a016b098f4fa1f6279559f104d70f1632dtakashi Nothing -> empty
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki Just (SymbType t) ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki space <> colon <+> pretty t)
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiinstance Pretty SymbItems where
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki pretty (SymbItems k syms _ _) =
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki printSK k <> ppWithCommas syms
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty SymbOrMap where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty (SymbOrMap s mt _) =
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty s <> (case mt of
208651a016b098f4fa1f6279559f104d70f1632dtakashi Nothing -> empty
208651a016b098f4fa1f6279559f104d70f1632dtakashi Just t ->
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki space <> mapsto <+> pretty t)
208651a016b098f4fa1f6279559f104d70f1632dtakashi
208651a016b098f4fa1f6279559f104d70f1632dtakashiinstance Pretty SymbMapItems where
208651a016b098f4fa1f6279559f104d70f1632dtakashi pretty (SymbMapItems k syms _ _) =
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki printSK k <> ppWithCommas syms
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki-- | print symbol kind
208651a016b098f4fa1f6279559f104d70f1632dtakashiprintSK :: SymbKind -> Doc
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshikiprintSK k =
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki case k of Implicit -> empty
0d419faf71b4d392a596273bd6cc6db401bf6ab7yoshiki _ -> keyword (drop 3 $ show k) <> space
cba0b38dd66ebf99f437479c12771475046da0cakawai