Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Add Show instances and bump version number.

  • Loading branch information...
commit ddf241bc0d562822295c33d48630159698b96205 1 parent 2c9b3a4
@mainland authored
Showing with 90 additions and 3 deletions.
  1. +89 −2 Language/C/Pretty.hs
  2. +1 −1  language-c-quote.cabal
View
91 Language/C/Pretty.hs
@@ -2,7 +2,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
--- Copyright (c) 2006-2011
+-- Copyright (c) 2006-2012
-- The President and Fellows of Harvard College.
--
-- Redistribution and use in source and binary forms, with or without
@@ -32,7 +32,7 @@
--------------------------------------------------------------------------------
-- |
-- Module : Language.C.Pretty
--- Copyright : (c) Harvard University 2006-2011
+-- Copyright : (c) Harvard University 2006-2012
-- License : BSD-style
-- Maintainer : mainland@eecs.harvard.edu
--
@@ -124,6 +124,9 @@ instance Pretty Id where
ppr (Id ident _) = text ident
ppr (AntiId v _) = ppr "$id:" <> ppr v
+instance Show Id where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Storage where
ppr (Tauto _) = text "auto"
ppr (Tregister _) = text "register"
@@ -132,6 +135,9 @@ instance Pretty Storage where
ppr (TexternL l _) = text "extern" <+> ppr l
ppr (Ttypedef _) = text "typedef"
+instance Show Storage where
+ showsPrec p = shows . pprPrec p
+
instance Pretty TypeQual where
ppr (Tconst _) = text "const"
ppr (Tvolatile _) = text "volatile"
@@ -154,10 +160,16 @@ instance Pretty TypeQual where
ppr (TCLwriteonly _) = text "write_only"
ppr (TCLkernel _) = text "__kernel"
+instance Show TypeQual where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Sign where
ppr (Tsigned _) = text "signed"
ppr (Tunsigned _) = text "unsigned"
+instance Show Sign where
+ showsPrec p = shows . pprPrec p
+
pprSign :: Maybe Sign -> Doc
pprSign Nothing = empty
pprSign (Just sign) = ppr sign <> space
@@ -194,6 +206,9 @@ instance Pretty TypeSpec where
ppr (Tva_list _) =
text "__builtin_va_list"
+instance Show TypeSpec where
+ showsPrec p = shows . pprPrec p
+
pprStructOrUnion :: String
-> Maybe Id
-> Maybe [FieldGroup]
@@ -244,12 +259,18 @@ instance Pretty DeclSpec where
spread (map ppr storage ++ map ppr quals) <+/>
ppr "$ty:" <> ppr v
+instance Show DeclSpec where
+ showsPrec p = shows . pprPrec p
+
instance Pretty ArraySize where
ppr (ArraySize True e _) = text "static" <+> ppr e
ppr (ArraySize False e _) = ppr e
ppr (VariableArraySize _) = text "*"
ppr (NoArraySize _) = empty
+instance Show ArraySize where
+ showsPrec p = shows . pprPrec p
+
pprDeclarator :: Maybe Id -> Decl -> Doc
pprDeclarator maybe_ident declarator =
case maybe_ident of
@@ -296,13 +317,22 @@ instance Pretty Type where
ppr (Type spec decl _) = ppr spec <> pprDeclarator Nothing decl
ppr (AntiType v _) = ppr "$ty:" <> ppr v
+instance Show Type where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Designator where
ppr (IndexDesignator e _) = brackets $ ppr e
ppr (MemberDesignator ident _) = dot <> ppr ident
+instance Show Designator where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Designation where
ppr (Designation ds _) = folddoc (<>) (map ppr ds)
+instance Show Designation where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Initializer where
ppr (ExpInitializer e _) = ppr e
@@ -313,6 +343,9 @@ instance Pretty Initializer where
pprInit (Nothing, init) = ppr init
pprInit (Just d, init) = ppr d <+> text "=" <//> ppr init
+instance Show Initializer where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Init where
ppr (Init ident decl maybe_asmlabel maybe_e attrs _) =
pprDeclarator (Just ident) decl
@@ -326,10 +359,16 @@ instance Pretty Init where
[] -> empty
_ -> softline <> ppr attrs
+instance Show Init where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Typedef where
ppr (Typedef ident decl attrs loc) =
ppr (Init ident decl Nothing Nothing attrs loc)
+instance Show Typedef where
+ showsPrec p = shows . pprPrec p
+
instance Pretty InitGroup where
ppr (InitGroup spec attrs inits _) =
ppr spec
@@ -352,6 +391,9 @@ instance Pretty InitGroup where
ppr (AntiDecls v _) = ppr "$decls:" <> ppr v
ppr (AntiDecl v _) = ppr "$decl:" <> ppr v
+instance Show InitGroup where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Field where
ppr (Field maybe_ident maybe_decl maybe_e _) =
case maybe_decl of
@@ -361,6 +403,9 @@ instance Pretty Field where
Nothing -> empty
Just e -> space <> colon <+> ppr e
+instance Show Field where
+ showsPrec p = shows . pprPrec p
+
instance Pretty FieldGroup where
ppr (FieldGroup spec fields _) =
ppr spec <> commasep (map ppr fields)
@@ -368,6 +413,9 @@ instance Pretty FieldGroup where
ppr (AntiSdecls v _) = ppr "$sdecls:" <> ppr v
ppr (AntiSdecl v _) = ppr "$sdecl:" <> ppr v
+instance Show FieldGroup where
+ showsPrec p = shows . pprPrec p
+
instance Pretty CEnum where
ppr (CEnum ident maybe_e _) =
ppr ident
@@ -378,6 +426,9 @@ instance Pretty CEnum where
ppr (AntiEnums v _) = ppr "$enums:" <> ppr v
ppr (AntiEnum v _) = ppr "$enum:" <> ppr v
+instance Show CEnum where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Attr where
ppr (Attr ident [] _) = ppr ident
ppr (Attr ident args _) =
@@ -387,6 +438,9 @@ instance Pretty Attr where
pprList attrs = text "__attribute__" <>
parens (parens (commasep (map ppr attrs)))
+instance Show Attr where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Param where
ppr (Param maybe_ident spec decl _) =
ppr spec <> pprDeclarator maybe_ident decl
@@ -394,6 +448,9 @@ instance Pretty Param where
ppr (AntiParams v _) = ppr "$params:" <> ppr v
ppr (AntiParam v _) = ppr "$param:" <> ppr v
+instance Show Param where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Params where
ppr (Params args True _) =
commasep (map ppr args ++ [text "..."])
@@ -401,6 +458,9 @@ instance Pretty Params where
ppr (Params args False _) =
commasep (map ppr args)
+instance Show Params where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Func where
ppr (Func spec ident decl args body loc) =
ppr spec <> pprDeclarator (Just ident) (Proto decl args loc)
@@ -414,6 +474,9 @@ instance Pretty Func where
stack (zipWith (<>) (map ppr initgroups) (repeat semi))
</> ppr body
+instance Show Func where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Definition where
ppr (FuncDef func loc) = srcloc loc <> ppr func
ppr (DecDef initgroup loc) = srcloc loc <> ppr initgroup <> semi
@@ -426,6 +489,9 @@ instance Pretty Definition where
pprList ds = stack (map ppr ds) <> line
+instance Show Definition where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Stm where
ppr (Label ident stm sloc) =
srcloc sloc <>
@@ -531,6 +597,9 @@ instance Pretty Stm where
ppr (AntiStm v _) = text $ "$stm:" ++ v ++ "$"
ppr (AntiStms v _) = text $ "$stms:" ++ v ++ "$"
+instance Show Stm where
+ showsPrec p = shows . pprPrec p
+
instance Pretty BlockItem where
ppr (BlockDecl decl) = ppr decl <> semi
ppr (BlockStm stm) = ppr stm
@@ -558,6 +627,9 @@ instance Pretty BlockItem where
nest 4 (line <> stack ds) </>
rbrace
+instance Show BlockItem where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Const where
ppr (IntConst s _ _ _) = text s
ppr (LongIntConst s _ _ _) = text s
@@ -578,6 +650,9 @@ instance Pretty Const where
ppr (AntiUInt v _) = ppr "$uint:" <> ppr v
ppr (AntiInt v _) = ppr "$int:" <> ppr v
+instance Show Const where
+ showsPrec p = shows . pprPrec p
+
instance Pretty Exp where
pprPrec _ (Var ident loc) = pprLoc loc $ ppr ident
pprPrec _ (Const k loc) = pprLoc loc $ ppr k
@@ -701,6 +776,9 @@ instance Pretty Exp where
pprPrec _ (AntiExp v _) = text "$var:" <> text v
+instance Show Exp where
+ showsPrec p = shows . pprPrec p
+
instance Pretty BinOp where
ppr Add = text "+"
ppr Sub = text "-"
@@ -721,6 +799,9 @@ instance Pretty BinOp where
ppr Lsh = text "<<"
ppr Rsh = text ">>"
+instance Show BinOp where
+ showsPrec p = shows . pprPrec p
+
instance Pretty AssignOp where
ppr JustAssign = text "="
ppr AddAssign = text "+="
@@ -734,6 +815,9 @@ instance Pretty AssignOp where
ppr XorAssign = text "^="
ppr OrAssign = text "|="
+instance Show AssignOp where
+ showsPrec p = shows . pprPrec p
+
instance Pretty UnOp where
ppr AddrOf = text "&"
ppr Deref = text "*"
@@ -741,3 +825,6 @@ instance Pretty UnOp where
ppr Negate = text "-"
ppr Not = text "~"
ppr Lnot = text "!"
+
+instance Show UnOp where
+ showsPrec p = shows . pprPrec p
View
2  language-c-quote.cabal
@@ -1,5 +1,5 @@
name: language-c-quote
-version: 0.3.1.2
+version: 0.3.2
cabal-version: >= 1.10
license: BSD3
license-file: LICENSE
Please sign in to comment.
Something went wrong with that request. Please try again.