module Language.Bluespec.Classic.AST.Syntax
  ( CPackage(..)
  , CExport(..)
  , CImport(..)
  , CSignature(..)
  , CFixity(..)
  , CDefn(..)
  , IdK(..)
  , CFunDeps
  , CExpr(..)
  , CLiteral(..)
  , COp(..)
  , CSummands
  , CInternalSummand(..)
  , COSummands
  , COriginalSummand(..)
  , CField(..)
  , CFields
  , CCaseArm(..)
  , CCaseArms
  , CStmt(..)
  , CStmts
  , CMStmt(..)
  , CRule(..)
  , CDefl(..)
  , CDef(..)
  , CClause(..)
  , CQual(..)
  , CPat(..)
  , CPOp(..)
  , CInclude(..)

  , cApply
  , cVApply
  , getName
  , iKName
  ) where

import Data.Char (isAlpha)
import qualified Data.List as L
import Text.PrettyPrint.HughesPJClass

import Language.Bluespec.Classic.AST.Builtin.Ids
import Language.Bluespec.Classic.AST.Builtin.FStrings
import Language.Bluespec.Classic.AST.FString
import Language.Bluespec.Classic.AST.Id
import Language.Bluespec.Classic.AST.Literal
import Language.Bluespec.Classic.AST.Position
import Language.Bluespec.Classic.AST.Pragma
import Language.Bluespec.Classic.AST.Type
import Language.Bluespec.Classic.AST.Undefined
import Language.Bluespec.Classic.AST.VModInfo
import Language.Bluespec.IntegerUtil
import Language.Bluespec.Lex
import Language.Bluespec.Log2
import Language.Bluespec.Prelude
import Language.Bluespec.Pretty
import Language.Bluespec.Util

-- Complete package
data CPackage = CPackage
                Id                -- package name
                (Either [CExport]
                        [CExport]) -- export identifiers
                                  -- Left exps = export only exps
                                  -- Right exps = export everything but exps
                [CImport]         -- imported identifiers
                [CFixity]         -- fixity declarations for infix operators
                [CDefn]                  -- top level definitions
                [CInclude]        -- any `include files
        deriving (CPackage -> CPackage -> Bool
(CPackage -> CPackage -> Bool)
-> (CPackage -> CPackage -> Bool) -> Eq CPackage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CPackage -> CPackage -> Bool
== :: CPackage -> CPackage -> Bool
$c/= :: CPackage -> CPackage -> Bool
/= :: CPackage -> CPackage -> Bool
Eq, Eq CPackage
Eq CPackage =>
(CPackage -> CPackage -> Ordering)
-> (CPackage -> CPackage -> Bool)
-> (CPackage -> CPackage -> Bool)
-> (CPackage -> CPackage -> Bool)
-> (CPackage -> CPackage -> Bool)
-> (CPackage -> CPackage -> CPackage)
-> (CPackage -> CPackage -> CPackage)
-> Ord CPackage
CPackage -> CPackage -> Bool
CPackage -> CPackage -> Ordering
CPackage -> CPackage -> CPackage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CPackage -> CPackage -> Ordering
compare :: CPackage -> CPackage -> Ordering
$c< :: CPackage -> CPackage -> Bool
< :: CPackage -> CPackage -> Bool
$c<= :: CPackage -> CPackage -> Bool
<= :: CPackage -> CPackage -> Bool
$c> :: CPackage -> CPackage -> Bool
> :: CPackage -> CPackage -> Bool
$c>= :: CPackage -> CPackage -> Bool
>= :: CPackage -> CPackage -> Bool
$cmax :: CPackage -> CPackage -> CPackage
max :: CPackage -> CPackage -> CPackage
$cmin :: CPackage -> CPackage -> CPackage
min :: CPackage -> CPackage -> CPackage
Ord, Int -> CPackage -> ShowS
[CPackage] -> ShowS
CPackage -> String
(Int -> CPackage -> ShowS)
-> (CPackage -> String) -> ([CPackage] -> ShowS) -> Show CPackage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CPackage -> ShowS
showsPrec :: Int -> CPackage -> ShowS
$cshow :: CPackage -> String
show :: CPackage -> String
$cshowList :: [CPackage] -> ShowS
showList :: [CPackage] -> ShowS
Show)

instance Pretty CPackage where
    pPrintPrec :: PrettyLevel -> Rational -> CPackage -> Doc
pPrintPrec PrettyLevel
d Rational
_ (CPackage Id
i Either [CExport] [CExport]
exps [CImport]
imps [CFixity]
fixs [CDefn]
def [CInclude]
includes) =
        (String -> Doc
tString
"package" Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i Doc -> Doc -> Doc
<> PrettyLevel -> Either [CExport] [CExport] -> Doc
ppExports PrettyLevel
d Either [CExport] [CExport]
exps Doc -> Doc -> Doc
<+> String -> Doc
t String
"where {") Doc -> Doc -> Doc
$+$
        PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
d Int
0 Bool
True ((CImport -> Doc) -> [CImport] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CImport -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CImport]
imps [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (CFixity -> Doc) -> [CFixity] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CFixity -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CFixity]
fixs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (CDefn -> Doc) -> [CDefn] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CDefn -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CDefn]
def [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (CInclude -> Doc) -> [CInclude] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CInclude -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CInclude]
includes)

data CExport
        = CExpVar Id    -- export a variable identifier
        | CExpCon Id    -- export a constructor
        | CExpConAll Id -- export an identifier and constructors
                        -- (datatypes, interfaces, etc.)
        | CExpPkg Id    -- export an entire package
        deriving (CExport -> CExport -> Bool
(CExport -> CExport -> Bool)
-> (CExport -> CExport -> Bool) -> Eq CExport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CExport -> CExport -> Bool
== :: CExport -> CExport -> Bool
$c/= :: CExport -> CExport -> Bool
/= :: CExport -> CExport -> Bool
Eq, Eq CExport
Eq CExport =>
(CExport -> CExport -> Ordering)
-> (CExport -> CExport -> Bool)
-> (CExport -> CExport -> Bool)
-> (CExport -> CExport -> Bool)
-> (CExport -> CExport -> Bool)
-> (CExport -> CExport -> CExport)
-> (CExport -> CExport -> CExport)
-> Ord CExport
CExport -> CExport -> Bool
CExport -> CExport -> Ordering
CExport -> CExport -> CExport
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CExport -> CExport -> Ordering
compare :: CExport -> CExport -> Ordering
$c< :: CExport -> CExport -> Bool
< :: CExport -> CExport -> Bool
$c<= :: CExport -> CExport -> Bool
<= :: CExport -> CExport -> Bool
$c> :: CExport -> CExport -> Bool
> :: CExport -> CExport -> Bool
$c>= :: CExport -> CExport -> Bool
>= :: CExport -> CExport -> Bool
$cmax :: CExport -> CExport -> CExport
max :: CExport -> CExport -> CExport
$cmin :: CExport -> CExport -> CExport
min :: CExport -> CExport -> CExport
Ord, Int -> CExport -> ShowS
[CExport] -> ShowS
CExport -> String
(Int -> CExport -> ShowS)
-> (CExport -> String) -> ([CExport] -> ShowS) -> Show CExport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CExport -> ShowS
showsPrec :: Int -> CExport -> ShowS
$cshow :: CExport -> String
show :: CExport -> String
$cshowList :: [CExport] -> ShowS
showList :: [CExport] -> ShowS
Show)

instance Pretty CExport where
    pPrintPrec :: PrettyLevel -> Rational -> CExport -> Doc
pPrintPrec PrettyLevel
d Rational
_p (CExpVar Id
i) = PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i
    pPrintPrec PrettyLevel
d Rational
_p (CExpCon Id
i) = PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i
    pPrintPrec PrettyLevel
d Rational
_p (CExpConAll Id
i) = PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i Doc -> Doc -> Doc
<> String -> Doc
tString
"(..)"
    pPrintPrec PrettyLevel
d Rational
_p (CExpPkg Id
i) = String -> Doc
tString
"package" Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppId PrettyLevel
d Id
i

ppExports :: PDetail -> Either [CExport] [CExport] -> Doc
ppExports :: PrettyLevel -> Either [CExport] [CExport] -> Doc
ppExports PrettyLevel
_d (Right []) = Doc
empty
ppExports  PrettyLevel
d (Right [CExport]
noexps) = String -> Doc
t String
" hiding (" Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList ((CExport -> Doc) -> [CExport] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CExport -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CExport]
noexps) (String -> Doc
tString
",") Doc -> Doc -> Doc
<> String -> Doc
tString
")"
ppExports  PrettyLevel
d (Left [CExport]
exports) = String -> Doc
t String
"(" Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList ((CExport -> Doc) -> [CExport] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CExport -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CExport]
exports) (String -> Doc
tString
",") Doc -> Doc -> Doc
<> String -> Doc
tString
")"

data CImport
        = CImpId Bool Id                                -- Bool indicates qualified
        | CImpSign String Bool CSignature
        deriving (CImport -> CImport -> Bool
(CImport -> CImport -> Bool)
-> (CImport -> CImport -> Bool) -> Eq CImport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CImport -> CImport -> Bool
== :: CImport -> CImport -> Bool
$c/= :: CImport -> CImport -> Bool
/= :: CImport -> CImport -> Bool
Eq, Eq CImport
Eq CImport =>
(CImport -> CImport -> Ordering)
-> (CImport -> CImport -> Bool)
-> (CImport -> CImport -> Bool)
-> (CImport -> CImport -> Bool)
-> (CImport -> CImport -> Bool)
-> (CImport -> CImport -> CImport)
-> (CImport -> CImport -> CImport)
-> Ord CImport
CImport -> CImport -> Bool
CImport -> CImport -> Ordering
CImport -> CImport -> CImport
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CImport -> CImport -> Ordering
compare :: CImport -> CImport -> Ordering
$c< :: CImport -> CImport -> Bool
< :: CImport -> CImport -> Bool
$c<= :: CImport -> CImport -> Bool
<= :: CImport -> CImport -> Bool
$c> :: CImport -> CImport -> Bool
> :: CImport -> CImport -> Bool
$c>= :: CImport -> CImport -> Bool
>= :: CImport -> CImport -> Bool
$cmax :: CImport -> CImport -> CImport
max :: CImport -> CImport -> CImport
$cmin :: CImport -> CImport -> CImport
min :: CImport -> CImport -> CImport
Ord, Int -> CImport -> ShowS
[CImport] -> ShowS
CImport -> String
(Int -> CImport -> ShowS)
-> (CImport -> String) -> ([CImport] -> ShowS) -> Show CImport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CImport -> ShowS
showsPrec :: Int -> CImport -> ShowS
$cshow :: CImport -> String
show :: CImport -> String
$cshowList :: [CImport] -> ShowS
showList :: [CImport] -> ShowS
Show)

instance Pretty CImport where
    pPrintPrec :: PrettyLevel -> Rational -> CImport -> Doc
pPrintPrec PrettyLevel
d Rational
_p (CImpId Bool
q Id
i) = String -> Doc
tString
"import" Doc -> Doc -> Doc
<+> Bool -> Doc
ppQualified Bool
q Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i
    pPrintPrec PrettyLevel
d Rational
_p (CImpSign String
_ Bool
q (CSignature Id
i [Id]
_ [CFixity]
_ [CDefn]
_)) = String -> Doc
tString
"import" Doc -> Doc -> Doc
<+> Bool -> Doc
ppQualified Bool
q Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"..."

ppQualified :: Bool -> Doc
ppQualified :: Bool -> Doc
ppQualified Bool
True = String -> Doc
text String
"qualified"
ppQualified Bool
False = Doc
empty

-- Package signature from import
data CSignature
        = CSignature Id [Id] [CFixity] [CDefn]        -- package name, imported packages, definitions
        deriving (CSignature -> CSignature -> Bool
(CSignature -> CSignature -> Bool)
-> (CSignature -> CSignature -> Bool) -> Eq CSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CSignature -> CSignature -> Bool
== :: CSignature -> CSignature -> Bool
$c/= :: CSignature -> CSignature -> Bool
/= :: CSignature -> CSignature -> Bool
Eq, Eq CSignature
Eq CSignature =>
(CSignature -> CSignature -> Ordering)
-> (CSignature -> CSignature -> Bool)
-> (CSignature -> CSignature -> Bool)
-> (CSignature -> CSignature -> Bool)
-> (CSignature -> CSignature -> Bool)
-> (CSignature -> CSignature -> CSignature)
-> (CSignature -> CSignature -> CSignature)
-> Ord CSignature
CSignature -> CSignature -> Bool
CSignature -> CSignature -> Ordering
CSignature -> CSignature -> CSignature
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CSignature -> CSignature -> Ordering
compare :: CSignature -> CSignature -> Ordering
$c< :: CSignature -> CSignature -> Bool
< :: CSignature -> CSignature -> Bool
$c<= :: CSignature -> CSignature -> Bool
<= :: CSignature -> CSignature -> Bool
$c> :: CSignature -> CSignature -> Bool
> :: CSignature -> CSignature -> Bool
$c>= :: CSignature -> CSignature -> Bool
>= :: CSignature -> CSignature -> Bool
$cmax :: CSignature -> CSignature -> CSignature
max :: CSignature -> CSignature -> CSignature
$cmin :: CSignature -> CSignature -> CSignature
min :: CSignature -> CSignature -> CSignature
Ord, Int -> CSignature -> ShowS
[CSignature] -> ShowS
CSignature -> String
(Int -> CSignature -> ShowS)
-> (CSignature -> String)
-> ([CSignature] -> ShowS)
-> Show CSignature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CSignature -> ShowS
showsPrec :: Int -> CSignature -> ShowS
$cshow :: CSignature -> String
show :: CSignature -> String
$cshowList :: [CSignature] -> ShowS
showList :: [CSignature] -> ShowS
Show)

instance Pretty CSignature where
    pPrintPrec :: PrettyLevel -> Rational -> CSignature -> Doc
pPrintPrec PrettyLevel
d Rational
_ (CSignature Id
i [Id]
imps [CFixity]
fixs [CDefn]
def) =
        (String -> Doc
tString
"signature" Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"where" Doc -> Doc -> Doc
<+> String -> Doc
t String
"{") Doc -> Doc -> Doc
$+$
        PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
d Int
0 Bool
True ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Doc
pi' [Id]
imps [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (CFixity -> Doc) -> [CFixity] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CFixity -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CFixity]
fixs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (CDefn -> Doc) -> [CDefn] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CDefn -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CDefn]
def)
      where pi' :: Id -> Doc
pi' Id
i' = String -> Doc
tString
"import" Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i'

data CFixity
        = CInfix  Integer Id
        | CInfixl Integer Id
        | CInfixr Integer Id
        deriving (CFixity -> CFixity -> Bool
(CFixity -> CFixity -> Bool)
-> (CFixity -> CFixity -> Bool) -> Eq CFixity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CFixity -> CFixity -> Bool
== :: CFixity -> CFixity -> Bool
$c/= :: CFixity -> CFixity -> Bool
/= :: CFixity -> CFixity -> Bool
Eq, Eq CFixity
Eq CFixity =>
(CFixity -> CFixity -> Ordering)
-> (CFixity -> CFixity -> Bool)
-> (CFixity -> CFixity -> Bool)
-> (CFixity -> CFixity -> Bool)
-> (CFixity -> CFixity -> Bool)
-> (CFixity -> CFixity -> CFixity)
-> (CFixity -> CFixity -> CFixity)
-> Ord CFixity
CFixity -> CFixity -> Bool
CFixity -> CFixity -> Ordering
CFixity -> CFixity -> CFixity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CFixity -> CFixity -> Ordering
compare :: CFixity -> CFixity -> Ordering
$c< :: CFixity -> CFixity -> Bool
< :: CFixity -> CFixity -> Bool
$c<= :: CFixity -> CFixity -> Bool
<= :: CFixity -> CFixity -> Bool
$c> :: CFixity -> CFixity -> Bool
> :: CFixity -> CFixity -> Bool
$c>= :: CFixity -> CFixity -> Bool
>= :: CFixity -> CFixity -> Bool
$cmax :: CFixity -> CFixity -> CFixity
max :: CFixity -> CFixity -> CFixity
$cmin :: CFixity -> CFixity -> CFixity
min :: CFixity -> CFixity -> CFixity
Ord, Int -> CFixity -> ShowS
[CFixity] -> ShowS
CFixity -> String
(Int -> CFixity -> ShowS)
-> (CFixity -> String) -> ([CFixity] -> ShowS) -> Show CFixity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CFixity -> ShowS
showsPrec :: Int -> CFixity -> ShowS
$cshow :: CFixity -> String
show :: CFixity -> String
$cshowList :: [CFixity] -> ShowS
showList :: [CFixity] -> ShowS
Show)

instance Pretty CFixity where
    pPrintPrec :: PrettyLevel -> Rational -> CFixity -> Doc
pPrintPrec PrettyLevel
d Rational
_ (CInfix  Integer
p Id
i) = String -> Doc
text String
"infix"  Doc -> Doc -> Doc
<+> String -> Doc
text (Integer -> String
forall a. Show a => a -> String
show Integer
p) Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppInfix PrettyLevel
d Id
i
    pPrintPrec PrettyLevel
d Rational
_ (CInfixl Integer
p Id
i) = String -> Doc
text String
"infixl" Doc -> Doc -> Doc
<+> String -> Doc
text (Integer -> String
forall a. Show a => a -> String
show Integer
p) Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppInfix PrettyLevel
d Id
i
    pPrintPrec PrettyLevel
d Rational
_ (CInfixr Integer
p Id
i) = String -> Doc
text String
"infixr" Doc -> Doc -> Doc
<+> String -> Doc
text (Integer -> String
forall a. Show a => a -> String
show Integer
p) Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppInfix PrettyLevel
d Id
i

-- Top level definition
data CDefn
        = Ctype IdK [Id] CType
        | Cdata { CDefn -> Bool
cd_visible :: Bool,
                  CDefn -> IdK
cd_name :: IdK,
                  CDefn -> [Id]
cd_type_vars :: [Id],
                  CDefn -> COSummands
cd_original_summands :: COSummands,
                  CDefn -> CSummands
cd_internal_summands :: CSummands,
                  CDefn -> [CTypeclass]
cd_derivings :: [CTypeclass] }
        | Cstruct Bool StructSubType IdK [Id] CFields
                  [CTypeclass]
                  -- Bool indicates the constrs are visible
                  -- first [Id] are the names of this definition's argument type variables
                  -- last [CTypeclass] are derived classes
        -- incoherent_matches superclasses name_with_kind variables fundeps default_methods
        | Cclass (Maybe Bool) [CPred] IdK [Id] CFunDeps CFields
        | Cinstance CQType [CDefl]
        | CValue Id [CClause]
        | CValueSign CDef
        | Cforeign { CDefn -> Id
cforg_name :: Id,
                     CDefn -> CQType
cforg_type :: CQType,
                     CDefn -> Maybe String
cforg_foreign_name :: Maybe String,
                     CDefn -> Maybe ([String], [String])
cforg_ports :: Maybe ([String], [String]) }
        | Cprimitive Id CQType
        | CprimType IdK
        | CPragma Pragma
        -- only in package signatures
        | CIinstance Id CQType
        -- CItype is imported abstractly
        | CItype IdK [Id] [Position] -- positions of use that caused export
        | CIclass (Maybe Bool) [CPred] IdK [Id] CFunDeps [Position] -- positions of use that caused export
        | CIValueSign Id CQType
        deriving (CDefn -> CDefn -> Bool
(CDefn -> CDefn -> Bool) -> (CDefn -> CDefn -> Bool) -> Eq CDefn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CDefn -> CDefn -> Bool
== :: CDefn -> CDefn -> Bool
$c/= :: CDefn -> CDefn -> Bool
/= :: CDefn -> CDefn -> Bool
Eq, Eq CDefn
Eq CDefn =>
(CDefn -> CDefn -> Ordering)
-> (CDefn -> CDefn -> Bool)
-> (CDefn -> CDefn -> Bool)
-> (CDefn -> CDefn -> Bool)
-> (CDefn -> CDefn -> Bool)
-> (CDefn -> CDefn -> CDefn)
-> (CDefn -> CDefn -> CDefn)
-> Ord CDefn
CDefn -> CDefn -> Bool
CDefn -> CDefn -> Ordering
CDefn -> CDefn -> CDefn
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CDefn -> CDefn -> Ordering
compare :: CDefn -> CDefn -> Ordering
$c< :: CDefn -> CDefn -> Bool
< :: CDefn -> CDefn -> Bool
$c<= :: CDefn -> CDefn -> Bool
<= :: CDefn -> CDefn -> Bool
$c> :: CDefn -> CDefn -> Bool
> :: CDefn -> CDefn -> Bool
$c>= :: CDefn -> CDefn -> Bool
>= :: CDefn -> CDefn -> Bool
$cmax :: CDefn -> CDefn -> CDefn
max :: CDefn -> CDefn -> CDefn
$cmin :: CDefn -> CDefn -> CDefn
min :: CDefn -> CDefn -> CDefn
Ord, Int -> CDefn -> ShowS
[CDefn] -> ShowS
CDefn -> String
(Int -> CDefn -> ShowS)
-> (CDefn -> String) -> ([CDefn] -> ShowS) -> Show CDefn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CDefn -> ShowS
showsPrec :: Int -> CDefn -> ShowS
$cshow :: CDefn -> String
show :: CDefn -> String
$cshowList :: [CDefn] -> ShowS
showList :: [CDefn] -> ShowS
Show)

instance Pretty CDefn where
    pPrintPrec :: PrettyLevel -> Rational -> CDefn -> Doc
pPrintPrec PrettyLevel
d Rational
_p (Ctype IdK
i [Id]
as CType
ty) =
        [Doc] -> Doc
sep [[Doc] -> Doc
sep ((String -> Doc
tString
"type" Doc -> Doc -> Doc
<+> PrettyLevel -> IdK -> Doc
ppConIdK PrettyLevel
d IdK
i) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> (Id -> Doc) -> Id -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d) [Id]
as) Doc -> Doc -> Doc
<+> String -> Doc
t String
"=",
                  Int -> Doc -> Doc
nest Int
2 (PrettyLevel -> CType -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CType
ty)]
    pPrintPrec PrettyLevel
d Rational
_p (Cdata { cd_visible :: CDefn -> Bool
cd_visible = Bool
vis,
                        cd_name :: CDefn -> IdK
cd_name = IdK
i,
                        cd_type_vars :: CDefn -> [Id]
cd_type_vars = [Id]
as,
                        cd_original_summands :: CDefn -> COSummands
cd_original_summands = cs :: COSummands
cs@(COriginalSummand
_:COSummands
_),
                        cd_internal_summands :: CDefn -> CSummands
cd_internal_summands = [],
                        cd_derivings :: CDefn -> [CTypeclass]
cd_derivings = [CTypeclass]
_ds }) =                -- a hack to print original constructors
        [Doc] -> Doc
sep [[Doc] -> Doc
sep ((String -> Doc
tString
"data" Doc -> Doc -> Doc
<+> PrettyLevel -> IdK -> Doc
ppConIdK PrettyLevel
d IdK
i) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> (Id -> Doc) -> Id -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d) [Id]
as) Doc -> Doc -> Doc
<> String -> Doc
t(if Bool
vis then String
" =" else String
" =="),
                  Int -> Doc -> Doc
nest Int
2 (PrettyLevel -> COSummands -> Doc
ppOSummands PrettyLevel
d COSummands
cs)]
    pPrintPrec PrettyLevel
d Rational
_p (Cdata { cd_visible :: CDefn -> Bool
cd_visible = Bool
vis,
                        cd_name :: CDefn -> IdK
cd_name = IdK
i,
                        cd_type_vars :: CDefn -> [Id]
cd_type_vars = [Id]
as,
                        cd_internal_summands :: CDefn -> CSummands
cd_internal_summands = CSummands
cs,
                        cd_derivings :: CDefn -> [CTypeclass]
cd_derivings = [CTypeclass]
ds }) =
        [Doc] -> Doc
sep [[Doc] -> Doc
sep ((String -> Doc
tString
"data" Doc -> Doc -> Doc
<+> PrettyLevel -> IdK -> Doc
ppConIdK PrettyLevel
d IdK
i) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> (Id -> Doc) -> Id -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d) [Id]
as) Doc -> Doc -> Doc
<> String -> Doc
t(if Bool
vis then String
" =" else String
" =="),
                  Int -> Doc -> Doc
nest Int
2 (PrettyLevel -> CSummands -> Doc
ppSummands PrettyLevel
d CSummands
cs)]
        Doc -> Doc -> Doc
<> PrettyLevel -> [CTypeclass] -> Doc
ppDer PrettyLevel
d [CTypeclass]
ds
    pPrintPrec PrettyLevel
d Rational
_p (Cstruct Bool
vis (SInterface [IfcPragma]
prags) IdK
i [Id]
as CFields
fs [CTypeclass]
ds) =
        (String -> Doc
t(String
"interface ") Doc -> Doc -> Doc
<> [Doc] -> Doc
sep (PrettyLevel -> IdK -> Doc
ppConIdK PrettyLevel
d IdK
i Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> (Id -> Doc) -> Id -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d) [Id]
as) Doc -> Doc -> Doc
<+> PrettyLevel -> [IfcPragma] -> Doc
ppIfcPragma PrettyLevel
d [IfcPragma]
prags Doc -> Doc -> Doc
<+> String -> Doc
t(if Bool
vis then String
"= {" else String
"== {")) Doc -> Doc -> Doc
$+$
        PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
d Int
4 Bool
False ((CField -> Doc) -> CFields -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CField -> Doc
ppField PrettyLevel
d) CFields
fs) Doc -> Doc -> Doc
<> PrettyLevel -> [CTypeclass] -> Doc
ppDer PrettyLevel
d [CTypeclass]
ds
    pPrintPrec PrettyLevel
d Rational
_p (Cstruct Bool
vis StructSubType
_ss IdK
i [Id]
as CFields
fs [CTypeclass]
ds) =
        (String -> Doc
t(String
"struct ") Doc -> Doc -> Doc
<> [Doc] -> Doc
sep (PrettyLevel -> IdK -> Doc
ppConIdK PrettyLevel
d IdK
i Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> (Id -> Doc) -> Id -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d) [Id]
as) Doc -> Doc -> Doc
<+> String -> Doc
t(if Bool
vis then String
"= {" else String
"== {")) Doc -> Doc -> Doc
$+$
        PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
d Int
4 Bool
False ((CField -> Doc) -> CFields -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CField -> Doc
ppField PrettyLevel
d) CFields
fs) Doc -> Doc -> Doc
<> PrettyLevel -> [CTypeclass] -> Doc
ppDer PrettyLevel
d [CTypeclass]
ds
    pPrintPrec PrettyLevel
d Rational
_p (Cclass Maybe Bool
incoh [CPred]
ps IdK
ik [Id]
is CFunDeps
fd CFields
ss) =
        (Doc
t_cls Doc -> Doc -> Doc
<+> PrettyLevel -> [CPred] -> Doc -> Doc
ppPreds PrettyLevel
d [CPred]
ps ([Doc] -> Doc
sep (PrettyLevel -> IdK -> Doc
ppConIdK PrettyLevel
d IdK
ik Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d) [Id]
is)) Doc -> Doc -> Doc
<> PrettyLevel -> CFunDeps -> Doc
ppFDs PrettyLevel
d CFunDeps
fd Doc -> Doc -> Doc
<+> String -> Doc
t String
"where {") Doc -> Doc -> Doc
$+$
        PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
d Int
4 Bool
False ((CField -> Doc) -> CFields -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CField -> Doc
ppField PrettyLevel
d) CFields
ss)
      where t_cls :: Doc
t_cls = case Maybe Bool
incoh of
                     Just Bool
False -> String -> Doc
tString
"class coherent"
                     Just Bool
True  -> String -> Doc
tString
"class incoherent"
                     Maybe Bool
Nothing    -> String -> Doc
tString
"class"
    pPrintPrec PrettyLevel
d Rational
_p (Cinstance CQType
qt [CDefl]
ds) =
        (String -> Doc
tString
"instance" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> CQType -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 CQType
qt Doc -> Doc -> Doc
<+> String -> Doc
t String
"where {") Doc -> Doc -> Doc
$+$
        PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
d Int
4 Bool
False ((CDefl -> Doc) -> [CDefl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> CDefl -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0) [CDefl]
ds)
    pPrintPrec PrettyLevel
d Rational
p (CValueSign CDef
def) = PrettyLevel -> Rational -> CDef -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p CDef
def
    pPrintPrec PrettyLevel
d Rational
p (CValue Id
i [CClause]
cs) =
        [Doc] -> Doc
vcat ((CClause -> Doc) -> [CClause] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\ CClause
cl -> PrettyLevel -> Rational -> [Doc] -> CClause -> Doc
ppClause PrettyLevel
d Rational
p [PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i] CClause
cl Doc -> Doc -> Doc
<> String -> Doc
tString
";") [CClause]
cs)
    pPrintPrec PrettyLevel
d Rational
_p (Cprimitive Id
i CQType
ty) =
        String -> Doc
text String
"primitive" Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"::" Doc -> Doc -> Doc
<+> PrettyLevel -> CQType -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CQType
ty
    pPrintPrec PrettyLevel
d  Rational
p (CPragma Pragma
pr) = PrettyLevel -> Rational -> Pragma -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p Pragma
pr
    pPrintPrec PrettyLevel
d Rational
_p (CprimType IdK
ik) =
        String -> Doc
tString
"primitive type" Doc -> Doc -> Doc
<+>
        -- don't use ppConIdK because this syntax has no parentheses
        case (IdK
ik) of
            (IdK Id
i)        -> PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i
            (IdKind Id
i Kind
k)   -> PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"::" Doc -> Doc -> Doc
<+> PrettyLevel -> Kind -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d Kind
k
            (IdPKind Id
i PartialKind
pk) -> PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"::" Doc -> Doc -> Doc
<+> PrettyLevel -> PartialKind -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d PartialKind
pk
    pPrintPrec PrettyLevel
d Rational
_p (Cforeign Id
i CQType
ty Maybe String
oname Maybe ([String], [String])
opnames) =
        String -> Doc
text String
"foreign" Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"::" Doc -> Doc -> Doc
<+> PrettyLevel -> CQType -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CQType
ty Doc -> Doc -> Doc
<> (case Maybe String
oname of Maybe String
Nothing -> String -> Doc
text String
""; Just String
s -> String -> Doc
text (String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s)) Doc -> Doc -> Doc
<> (case Maybe ([String], [String])
opnames of Maybe ([String], [String])
Nothing -> String -> Doc
text String
""; Just ([String]
is, [String]
os) -> String -> Doc
tString
"," Doc -> Doc -> Doc
<> Bool -> Doc -> Doc
pparen Bool
True ([Doc] -> Doc
sep ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> ShowS -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show) [String]
is [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String] -> [Doc]
forall {a}. Show a => [a] -> [Doc]
po [String]
os)))
      where po :: [a] -> [Doc]
po [a
o] = [String -> Doc
text String
",", String -> Doc
text (a -> String
forall a. Show a => a -> String
show a
o)]
            po [a]
os = [String -> Doc
tString
"(" Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (a -> String) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) [a]
os) (String -> Doc
tString
",") Doc -> Doc -> Doc
<> String -> Doc
t String
")"]
    pPrintPrec PrettyLevel
d Rational
_p (CIinstance Id
i CQType
qt) =
        String -> Doc
tString
"instance" Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> CQType -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 CQType
qt
    pPrintPrec PrettyLevel
d Rational
_p (CItype IdK
i [Id]
as [Position]
_positions) =
        [Doc] -> Doc
sep (String -> Doc
tString
"type" Doc -> Doc -> Doc
<+> PrettyLevel -> IdK -> Doc
ppConIdK PrettyLevel
d IdK
i Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> (Id -> Doc) -> Id -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d) [Id]
as)
    pPrintPrec PrettyLevel
d Rational
_p (CIclass Maybe Bool
incoh [CPred]
ps IdK
ik [Id]
is CFunDeps
fd [Position]
_positions) =
        Doc
t_cls Doc -> Doc -> Doc
<+> PrettyLevel -> [CPred] -> Doc -> Doc
ppPreds PrettyLevel
d [CPred]
ps ([Doc] -> Doc
sep (PrettyLevel -> IdK -> Doc
ppConIdK PrettyLevel
d IdK
ik Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> (Id -> Doc) -> Id -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d) [Id]
is)) Doc -> Doc -> Doc
<> PrettyLevel -> CFunDeps -> Doc
ppFDs PrettyLevel
d CFunDeps
fd
      where t_cls :: Doc
t_cls = case Maybe Bool
incoh of
                     Just Bool
False -> String -> Doc
tString
"class coherent"
                     Just Bool
True  -> String -> Doc
tString
"class incoherent"
                     Maybe Bool
Nothing    -> String -> Doc
tString
"class"
    pPrintPrec PrettyLevel
d Rational
_p (CIValueSign Id
i CQType
ty) = PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"::" Doc -> Doc -> Doc
<+> PrettyLevel -> CQType -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CQType
ty

instance HasPosition CDefn where
    getPosition :: CDefn -> Position
getPosition CDefn
d = Either Position Id -> Position
forall a. HasPosition a => a -> Position
getPosition (CDefn -> Either Position Id
getName CDefn
d)

-- Since IdPKind is only expected in some disjuncts of CDefn, we could
-- create a separate IdPK for those cases, but that seems like overkill.
-- IdPKind in other locations will just be treated like IdK (no kind info).
data IdK
        = IdK Id
        | IdKind Id Kind
        -- this should not exist after typecheck
        | IdPKind Id PartialKind
        deriving (IdK -> IdK -> Bool
(IdK -> IdK -> Bool) -> (IdK -> IdK -> Bool) -> Eq IdK
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdK -> IdK -> Bool
== :: IdK -> IdK -> Bool
$c/= :: IdK -> IdK -> Bool
/= :: IdK -> IdK -> Bool
Eq, Eq IdK
Eq IdK =>
(IdK -> IdK -> Ordering)
-> (IdK -> IdK -> Bool)
-> (IdK -> IdK -> Bool)
-> (IdK -> IdK -> Bool)
-> (IdK -> IdK -> Bool)
-> (IdK -> IdK -> IdK)
-> (IdK -> IdK -> IdK)
-> Ord IdK
IdK -> IdK -> Bool
IdK -> IdK -> Ordering
IdK -> IdK -> IdK
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IdK -> IdK -> Ordering
compare :: IdK -> IdK -> Ordering
$c< :: IdK -> IdK -> Bool
< :: IdK -> IdK -> Bool
$c<= :: IdK -> IdK -> Bool
<= :: IdK -> IdK -> Bool
$c> :: IdK -> IdK -> Bool
> :: IdK -> IdK -> Bool
$c>= :: IdK -> IdK -> Bool
>= :: IdK -> IdK -> Bool
$cmax :: IdK -> IdK -> IdK
max :: IdK -> IdK -> IdK
$cmin :: IdK -> IdK -> IdK
min :: IdK -> IdK -> IdK
Ord, Int -> IdK -> ShowS
[IdK] -> ShowS
IdK -> String
(Int -> IdK -> ShowS)
-> (IdK -> String) -> ([IdK] -> ShowS) -> Show IdK
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdK -> ShowS
showsPrec :: Int -> IdK -> ShowS
$cshow :: IdK -> String
show :: IdK -> String
$cshowList :: [IdK] -> ShowS
showList :: [IdK] -> ShowS
Show)

instance Pretty IdK where
    pPrintPrec :: PrettyLevel -> Rational -> IdK -> Doc
pPrintPrec PrettyLevel
d  Rational
p (IdK Id
i) = PrettyLevel -> Rational -> Id -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p Id
i
    pPrintPrec PrettyLevel
d Rational
_p (IdKind Id
i Kind
k) = Bool -> Doc -> Doc
pparen Bool
True (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Id -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"::" Doc -> Doc -> Doc
<+> PrettyLevel -> Kind -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d Kind
k
    pPrintPrec PrettyLevel
d Rational
_p (IdPKind Id
i PartialKind
pk) = Bool -> Doc -> Doc
pparen Bool
True (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Id -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"::" Doc -> Doc -> Doc
<+> PrettyLevel -> PartialKind -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d PartialKind
pk

instance HasPosition IdK where
    getPosition :: IdK -> Position
getPosition (IdK Id
i) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i
    getPosition (IdKind Id
i Kind
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i
    getPosition (IdPKind Id
i PartialKind
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i

pBlock :: PDetail -> Int -> Bool -> [Doc] -> Doc
pBlock :: PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
_ Int
_n Bool
_ [] = String -> Doc
tString
"}"
pBlock PrettyLevel
_  Int
n Bool
nl [Doc]
xs =
        (String -> Doc
t (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' ') Doc -> Doc -> Doc
<>
        (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc -> Doc -> Doc
($+$) ((Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\ Doc
x -> Doc
x Doc -> Doc -> Doc
<> if Bool
nl then String -> Doc
tString
";" Doc -> Doc -> Doc
$+$ String -> Doc
tString
"" else String -> Doc
tString
";") ([Doc] -> [Doc]
forall a. HasCallStack => [a] -> [a]
init [Doc]
xs) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
forall a. HasCallStack => [a] -> a
last [Doc]
xs])) Doc -> Doc -> Doc
$+$
        String -> Doc
tString
"}"

ppDer :: PDetail -> [CTypeclass] -> Doc
ppDer :: PrettyLevel -> [CTypeclass] -> Doc
ppDer PrettyLevel
_d [] = String -> Doc
text String
""
ppDer  PrettyLevel
d [CTypeclass]
is = String -> Doc
text String
" deriving (" Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList ((CTypeclass -> Doc) -> [CTypeclass] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> CTypeclass -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0) [CTypeclass]
is) (String -> Doc
text String
",") Doc -> Doc -> Doc
<> String -> Doc
text String
")"

type CFunDeps = [([Id],[Id])]

-- Expressions
data CExpr
        = CLam (Either Position Id) CExpr
        | CLamT (Either Position Id) CQType CExpr
        | Cletseq [CDefl] CExpr -- rhs of "let x = x" refers to previous def
                                --   before current let or in earlier arm
        | Cletrec [CDefl] CExpr -- rhs of "let x = x" refers to self
        | CSelect CExpr Id                        -- expr, field id
        | CCon Id [CExpr]                        -- constructor id, arguments
        | Ccase Position CExpr CCaseArms
        -- Either a struct type or a constructor with named fields.
        -- The 'Maybe Bool' argument can indicate if it is specifically
        -- one or the other (True for struct), otherwise the typechecker
        -- will attempt to determine which is intended.
        | CStruct (Maybe Bool) Id [(Id, CExpr)]
        | CStructUpd CExpr [(Id, CExpr)]

        -- for hardware writes
        -- lhs <= rhs
        | Cwrite Position CExpr CExpr

        | CAny Position UndefKind
        | CVar Id
        | CApply CExpr [CExpr]
        | CTaskApply CExpr [CExpr] -- system task calls
        | CTaskApplyT CExpr CType [CExpr] -- type-checked $task (only $display) calls (the type is the inferred function type for the varargs task)
        | CLit CLiteral
        | CBinOp CExpr Id CExpr
        | CHasType CExpr CQType
        | Cif Position CExpr CExpr CExpr
        -- x[a]
        | CSub Position CExpr CExpr
        -- x[a:b]
        | CSub2 CExpr CExpr CExpr
        -- x[a:b] = y
        | CSubUpdate Position CExpr (CExpr, CExpr) CExpr
        | Cmodule Position [CMStmt]
        | Cinterface Position (Maybe Id) [CDefl]
        | CmoduleVerilog
              CExpr               -- expr for the module name (type String)
              Bool                -- whether it is a user-imported module
              VClockInfo          -- clocks
              VResetInfo          -- resets
              [(VArgInfo,CExpr)]  -- input arguments
              [VFieldInfo]        -- output interface fields
              VSchedInfo          -- scheduling annotations
              VPathInfo           -- path annotations
        | CForeignFuncC Id CQType -- link name, wrapped type
        | Cdo Bool CStmts        -- Bool indicates recursive binding
        | Caction Position CStmts
        | Crules [CSchedulePragma] [CRule]
        -- used before operator parsing
        | COper [COp]
        -- from deriving
        | CCon1 Id Id CExpr                        -- type id, con id, expr
        | CSelectTT Id CExpr Id                        -- type id, expr, field id
        -- INTERNAL in type checker
        | CCon0 (Maybe Id) Id                        -- type id, constructor id
        -- Not part of the surface syntax, used after type checking
        | CConT Id Id [CExpr]                        -- type id, constructor id, arguments
        | CStructT CType [(Id, CExpr)]
        | CSelectT Id Id                        -- type id, field id
        | CLitT CType CLiteral
        | CAnyT Position UndefKind CType
        | CmoduleVerilogT CType
              CExpr               -- expr for the module name (type String)
              Bool                -- whether it is a user-imported module
              VClockInfo          -- clocks
              VResetInfo          -- resets
              [(VArgInfo,CExpr)]  -- input arguments
              [VFieldInfo]        -- output interface fields
              VSchedInfo          -- scheduling annotations
              VPathInfo           -- path annotations
        | CForeignFuncCT Id CType -- link name, primitive type
        | CTApply CExpr [CType]
        -- for passing pprops as values
        | Cattributes [(Position,PProp)]
        deriving (CExpr -> CExpr -> Bool
(CExpr -> CExpr -> Bool) -> (CExpr -> CExpr -> Bool) -> Eq CExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CExpr -> CExpr -> Bool
== :: CExpr -> CExpr -> Bool
$c/= :: CExpr -> CExpr -> Bool
/= :: CExpr -> CExpr -> Bool
Eq, Eq CExpr
Eq CExpr =>
(CExpr -> CExpr -> Ordering)
-> (CExpr -> CExpr -> Bool)
-> (CExpr -> CExpr -> Bool)
-> (CExpr -> CExpr -> Bool)
-> (CExpr -> CExpr -> Bool)
-> (CExpr -> CExpr -> CExpr)
-> (CExpr -> CExpr -> CExpr)
-> Ord CExpr
CExpr -> CExpr -> Bool
CExpr -> CExpr -> Ordering
CExpr -> CExpr -> CExpr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CExpr -> CExpr -> Ordering
compare :: CExpr -> CExpr -> Ordering
$c< :: CExpr -> CExpr -> Bool
< :: CExpr -> CExpr -> Bool
$c<= :: CExpr -> CExpr -> Bool
<= :: CExpr -> CExpr -> Bool
$c> :: CExpr -> CExpr -> Bool
> :: CExpr -> CExpr -> Bool
$c>= :: CExpr -> CExpr -> Bool
>= :: CExpr -> CExpr -> Bool
$cmax :: CExpr -> CExpr -> CExpr
max :: CExpr -> CExpr -> CExpr
$cmin :: CExpr -> CExpr -> CExpr
min :: CExpr -> CExpr -> CExpr
Ord, Int -> CExpr -> ShowS
[CExpr] -> ShowS
CExpr -> String
(Int -> CExpr -> ShowS)
-> (CExpr -> String) -> ([CExpr] -> ShowS) -> Show CExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CExpr -> ShowS
showsPrec :: Int -> CExpr -> ShowS
$cshow :: CExpr -> String
show :: CExpr -> String
$cshowList :: [CExpr] -> ShowS
showList :: [CExpr] -> ShowS
Show)

instance Pretty CExpr where
    pPrintPrec :: PrettyLevel -> Rational -> CExpr -> Doc
pPrintPrec PrettyLevel
d Rational
p (CLam Either Position Id
ei CExpr
e) = String
-> PrettyLevel -> Rational -> Either Position Id -> CExpr -> Doc
ppQuant String
"\\ "  PrettyLevel
d Rational
p Either Position Id
ei CExpr
e
    pPrintPrec PrettyLevel
d Rational
p (CLamT Either Position Id
ei CQType
_ty CExpr
e) = String
-> PrettyLevel -> Rational -> Either Position Id -> CExpr -> Doc
ppQuant String
"\\ "  PrettyLevel
d Rational
p Either Position Id
ei CExpr
e
    pPrintPrec PrettyLevel
d Rational
p (Cletseq [] CExpr
e) = Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        (String -> Doc
tString
"letseq in" Doc -> Doc -> Doc
<+> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
e)
    pPrintPrec PrettyLevel
d Rational
p (Cletseq [CDefl]
ds CExpr
e) = Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        (String -> Doc
tString
"letseq" Doc -> Doc -> Doc
<+> String -> Doc
text String
"{" Doc -> Doc -> Doc
<+> (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc -> Doc -> Doc
($+$) ((CDefl -> Doc) -> [CDefl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CDefl -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CDefl]
ds)) Doc -> Doc -> Doc
<+> String -> Doc
text String
"}" Doc -> Doc -> Doc
$+$
        (String -> Doc
tString
"in  " Doc -> Doc -> Doc
<> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
e)
    pPrintPrec PrettyLevel
d Rational
p (Cletrec [] CExpr
e) = Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        (String -> Doc
tString
"let in" Doc -> Doc -> Doc
<+> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
e)
    pPrintPrec PrettyLevel
d Rational
p (Cletrec [CDefl]
ds CExpr
e) = Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        (String -> Doc
tString
"let" Doc -> Doc -> Doc
<+> String -> Doc
t String
"{" Doc -> Doc -> Doc
<+> (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc -> Doc -> Doc
($+$) ((CDefl -> Doc) -> [CDefl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CDefl -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CDefl]
ds)) Doc -> Doc -> Doc
<+> String -> Doc
t String
"}" Doc -> Doc -> Doc
$+$
        (String -> Doc
tString
"in  " Doc -> Doc -> Doc
<> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
e)
    pPrintPrec  PrettyLevel
d  Rational
p (CSelect CExpr
e Id
i) = Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
2)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
2) CExpr
e Doc -> Doc -> Doc
<> String -> Doc
tString
"." Doc -> Doc -> Doc
<> PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i
    pPrintPrec  PrettyLevel
d Rational
_p (CCon Id
i []) = PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i
    pPrintPrec  PrettyLevel
d  Rational
p (CCon Id
i [CExpr]
es) = PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p (CExpr -> [CExpr] -> CExpr
CApply (Id -> [CExpr] -> CExpr
CCon Id
i []) [CExpr]
es)
    pPrintPrec  PrettyLevel
d  Rational
p (Ccase Position
_pos CExpr
e CCaseArms
arms) = Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> CExpr -> CCaseArms -> Doc
ppCase PrettyLevel
d CExpr
e CCaseArms
arms
    pPrintPrec PrettyLevel
_d Rational
_p (CAny {}) = String -> Doc
text String
"_"
    pPrintPrec  PrettyLevel
d Rational
_p (CVar Id
i) = PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i
    pPrintPrec PrettyLevel
_d Rational
_p (CStruct Maybe Bool
_ Id
tyc []) | Id
tyc Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
idPrimUnit = String -> Doc
text String
"()"
    pPrintPrec  PrettyLevel
d  Rational
p (CStruct Maybe Bool
_ Id
tyc [(Id, CExpr)]
ies) = Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Rational -> Id -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
1) Id
tyc Doc -> Doc -> Doc
<+> String -> Doc
t String
"{" Doc -> Doc -> Doc
<+> [Doc] -> Doc -> Doc
sepList (((Id, CExpr) -> Doc) -> [(Id, CExpr)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Id, CExpr) -> Doc
forall {a}. Pretty a => (Id, a) -> Doc
f [(Id, CExpr)]
ies [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
tString
"}"]) (String -> Doc
tString
";")
        where f :: (Id, a) -> Doc
f (Id
i, a
e) = PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"=" Doc -> Doc -> Doc
<+> PrettyLevel -> a -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d a
e
    pPrintPrec PrettyLevel
d Rational
p (CStructUpd CExpr
e [(Id, CExpr)]
ies) = Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
1) CExpr
e Doc -> Doc -> Doc
<+> String -> Doc
t String
"{" Doc -> Doc -> Doc
<+> [Doc] -> Doc -> Doc
sepList (((Id, CExpr) -> Doc) -> [(Id, CExpr)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Id, CExpr) -> Doc
forall {a}. Pretty a => (Id, a) -> Doc
f [(Id, CExpr)]
ies [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
tString
"}"]) (String -> Doc
tString
";")
        where f :: (Id, a) -> Doc
f (Id
i, a
e') = PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"=" Doc -> Doc -> Doc
<+> PrettyLevel -> a -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d a
e'
    pPrintPrec PrettyLevel
d Rational
p (Cwrite Position
_ CExpr
e CExpr
v)  = Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
1) CExpr
e Doc -> Doc -> Doc
<+> String -> Doc
t String
":=" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p CExpr
v
    pPrintPrec PrettyLevel
d Rational
p (CApply CExpr
e [])
      | PrettyLevel
d PrettyLevel -> PrettyLevel -> Bool
forall a. Eq a => a -> a -> Bool
== PrettyLevel
pdReadable
      = PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
pdReadable Rational
p CExpr
e
    pPrintPrec PrettyLevel
d Rational
p (CApply CExpr
e [CExpr]
es) = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>(Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        [Doc] -> Doc
sep (PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1) CExpr
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (CExpr -> Doc) -> [CExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> (CExpr -> Doc) -> CExpr -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CExpr -> Doc
forall {a}. Pretty a => a -> Doc
ppApArg) [CExpr]
es)
        where ppApArg :: a -> Doc
ppApArg a
e' = PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec) a
e'
    pPrintPrec PrettyLevel
d Rational
p (CTaskApply CExpr
e [CExpr]
es) = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>(Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        [Doc] -> Doc
sep (PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1) CExpr
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (CExpr -> Doc) -> [CExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> (CExpr -> Doc) -> CExpr -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CExpr -> Doc
forall {a}. Pretty a => a -> Doc
ppApArg) [CExpr]
es)
        where ppApArg :: a -> Doc
ppApArg a
e' = PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec) a
e'
    -- XXX: should include t?
    pPrintPrec PrettyLevel
d Rational
p (CTaskApplyT CExpr
e CType
_t [CExpr]
es) = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>(Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        [Doc] -> Doc
sep (PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1) CExpr
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (CExpr -> Doc) -> [CExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> (CExpr -> Doc) -> CExpr -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CExpr -> Doc
forall {a}. Pretty a => a -> Doc
ppApArg) [CExpr]
es)
        where ppApArg :: a -> Doc
ppApArg a
e' = PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec) a
e'
    pPrintPrec PrettyLevel
d  Rational
p (CLit CLiteral
l) = PrettyLevel -> Rational -> CLiteral -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p CLiteral
l
    pPrintPrec PrettyLevel
d  Rational
p (CBinOp CExpr
e1 Id
i CExpr
e2) = PrettyLevel -> Rational -> Id -> CExpr -> CExpr -> Doc
ppOp PrettyLevel
d Rational
p Id
i CExpr
e1 CExpr
e2
    pPrintPrec PrettyLevel
d  Rational
p (CHasType CExpr
e CQType
t') = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec) CExpr
e Doc -> Doc -> Doc
<> String -> Doc
text String
"::" Doc -> Doc -> Doc
<> PrettyLevel -> Rational -> CQType -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec) CQType
t'
    pPrintPrec PrettyLevel
d  Rational
p (Cif Position
_pos CExpr
c CExpr
tr CExpr
e) = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
0) ([Doc] -> Doc
sep [String -> Doc
tString
"if" Doc -> Doc -> Doc
<+> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
c Doc -> Doc -> Doc
<+> String -> Doc
t String
"then", Int -> Doc -> Doc
nest Int
4 (PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
tr), String -> Doc
tString
"else", Int -> Doc -> Doc
nest Int
4 (PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
e)])
    pPrintPrec PrettyLevel
d Rational
_p (CSub Position
_pos CExpr
e CExpr
s) = PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec) CExpr
e Doc -> Doc -> Doc
<> String -> Doc
tString
"[" Doc -> Doc -> Doc
<> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
s Doc -> Doc -> Doc
<> String -> Doc
tString
"]"
    pPrintPrec PrettyLevel
d Rational
_p (CSub2 CExpr
e CExpr
h CExpr
l) = PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec) CExpr
e Doc -> Doc -> Doc
<> String -> Doc
tString
"[" Doc -> Doc -> Doc
<> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
h Doc -> Doc -> Doc
<> String -> Doc
tString
":" Doc -> Doc -> Doc
<> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
l Doc -> Doc -> Doc
<> String -> Doc
tString
"]"
    pPrintPrec PrettyLevel
d  Rational
p (CSubUpdate Position
_pos CExpr
e (CExpr
h, CExpr
l) CExpr
rhs) = PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p (CExpr -> CExpr -> CExpr -> CExpr
CSub2 CExpr
e CExpr
h CExpr
l) Doc -> Doc -> Doc
<> String -> Doc
tString
"=" Doc -> Doc -> Doc
<> PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec) CExpr
rhs
    pPrintPrec PrettyLevel
d Rational
_p (Cmodule Position
_ [CMStmt]
is) = String -> Doc
tString
"module {" Doc -> Doc -> Doc
$+$ PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
d Int
2 Bool
False ((CMStmt -> Doc) -> [CMStmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CMStmt -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CMStmt]
is)
    pPrintPrec PrettyLevel
d  Rational
p (Cinterface Position
_pos Maybe Id
Nothing [CDefl]
ds) =
        Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
0) (String -> Doc
tString
"interface {" Doc -> Doc -> Doc
$+$ PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
d Int
2 Bool
False ((CDefl -> Doc) -> [CDefl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CDefl -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CDefl]
ds))
    pPrintPrec PrettyLevel
d Rational
p (Cinterface Position
_pos (Just Id
i) [CDefl]
ds) =
        Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
0) (String -> Doc
tString
"interface" Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"{" Doc -> Doc -> Doc
$+$ PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
d Int
2 Bool
False ((CDefl -> Doc) -> [CDefl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CDefl -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CDefl]
ds))
    pPrintPrec PrettyLevel
d Rational
_p (CmoduleVerilog CExpr
m Bool
_ui VClockInfo
c VResetInfo
r [(VArgInfo, CExpr)]
ses [VFieldInfo]
fs VSchedInfo
sch VPathInfo
_ps) =
        [Doc] -> Doc
sep [
          String -> Doc
tString
"module verilog" Doc -> Doc -> Doc
<+> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
m Doc -> Doc -> Doc
<+>
          PrettyLevel -> VClockInfo -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d VClockInfo
c Doc -> Doc -> Doc
<> String -> Doc
tString
"" Doc -> Doc -> Doc
<+> PrettyLevel -> VResetInfo -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d VResetInfo
r Doc -> Doc -> Doc
<+> String -> Doc
tString
"",
          Int -> Doc -> Doc
nest Int
4 (if [(VArgInfo, CExpr)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(VArgInfo, CExpr)]
ses then String -> Doc
tString
"" else Bool -> Doc -> Doc
pparen Bool
True ([Doc] -> Doc -> Doc
sepList (((VArgInfo, CExpr) -> Doc) -> [(VArgInfo, CExpr)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (VArgInfo, CExpr) -> Doc
forall {a} {a}. (Pretty a, Pretty a) => (a, a) -> Doc
ppA [(VArgInfo, CExpr)]
ses) (String -> Doc
tString
","))),
          Int -> Doc -> Doc
nest Int
4 (String -> Doc
tString
"{" Doc -> Doc -> Doc
$+$ PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
d Int
2 Bool
False ((VFieldInfo -> Doc) -> [VFieldInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map VFieldInfo -> Doc
f [VFieldInfo]
fs)),
          Int -> Doc -> Doc
nest Int
4 (PrettyLevel -> VSchedInfo -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d VSchedInfo
sch) ]
          where mfi :: String -> Maybe Id -> Doc
mfi String
_s Maybe Id
Nothing = Doc
empty
                mfi  String
s (Just Id
i) = String -> Doc
t String
s Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i
                mfp :: String -> Maybe (VName, b) -> Doc
mfp String
_s Maybe (VName, b)
Nothing = Doc
empty
                mfp  String
s (Just (VName String
s', b
_)) = String -> Doc
t String
s Doc -> Doc -> Doc
<+> String -> Doc
t String
s'
                f :: VFieldInfo -> Doc
f (Clock Id
i) = String -> Doc
t String
"clock_field " Doc -> Doc -> Doc
<> PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i
                f (Reset Id
i) = String -> Doc
t String
"reset_field " Doc -> Doc -> Doc
<> PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i
                f (Inout Id
i (VName String
p') Maybe Id
mc Maybe Id
mr) =
                    String -> Doc
t String
"inout_field " Doc -> Doc -> Doc
<> PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
p' Doc -> Doc -> Doc
<+>
                    String -> Maybe Id -> Doc
mfi String
"clocked_by" Maybe Id
mc Doc -> Doc -> Doc
<+> String -> Maybe Id -> Doc
mfi String
"reset_by" Maybe Id
mr
                f (Method Id
i Maybe Id
mc Maybe Id
mr Integer
n [VPort]
ps Maybe VPort
mo Maybe VPort
me) =
                    PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i Doc -> Doc -> Doc
<> Integer -> Doc
forall {a}. (Eq a, Num a, ToString a) => a -> Doc
g Integer
n Doc -> Doc -> Doc
<+> String -> Doc
t String
"=" Doc -> Doc -> Doc
<+> String -> Doc
t ([String] -> String
unwords ((VPort -> String) -> [VPort] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map VPort -> String
forall {a} {a}. (Show a, Show a) => (a, [a]) -> String
h [VPort]
ps)) Doc -> Doc -> Doc
<+>
                    String -> Maybe Id -> Doc
mfi String
"clocked_by" Maybe Id
mc Doc -> Doc -> Doc
<+> String -> Maybe Id -> Doc
mfi String
"reset_by" Maybe Id
mr Doc -> Doc -> Doc
<+> String -> Maybe VPort -> Doc
forall {b}. String -> Maybe (VName, b) -> Doc
mfp String
"output" Maybe VPort
mo Doc -> Doc -> Doc
<+> String -> Maybe VPort -> Doc
forall {b}. String -> Maybe (VName, b) -> Doc
mfp String
"enable" Maybe VPort
me
                g :: a -> Doc
g a
1 = String -> Doc
tString
""
                g a
n = String -> Doc
t(String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. ToString a => a -> String
itos a
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]")
                h :: (a, [a]) -> String
h (a
s,[]) = a -> String
forall a. Show a => a -> String
show a
s
                h (a
s,[a]
ps) = a -> String
forall a. Show a => a -> String
show a
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"," ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) [a]
ps) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
                ppA :: (a, a) -> Doc
ppA (a
ai, a
e) = String -> Doc
text String
"(" Doc -> Doc -> Doc
<> String -> Doc
text (a -> String
forall a. Pretty a => a -> String
ppReadable a
ai) Doc -> Doc -> Doc
<> String -> Doc
text String
"," Doc -> Doc -> Doc
<+> PrettyLevel -> a -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d a
e Doc -> Doc -> Doc
<> String -> Doc
text String
")"
    pPrintPrec PrettyLevel
d Rational
_p (CForeignFuncC Id
i CQType
_wrap_ty) =
        -- There's no real Classic syntax for this:
        String -> Doc
tString
"ForeignFuncC" Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d Id
i
    pPrintPrec PrettyLevel
d Rational
p (Cdo Bool
_ CStmts
ss) = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
t String
"do" Doc -> Doc -> Doc
<+> String -> Doc
t String
"{" Doc -> Doc -> Doc
<+> [Doc] -> Doc -> Doc
sepList ((CStmt -> Doc) -> CStmts -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> CStmt -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0) CStmts
ss [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
tString
"}"]) (String -> Doc
tString
";")
    pPrintPrec PrettyLevel
d Rational
p (Caction Position
_ CStmts
ss) = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
t String
"action" Doc -> Doc -> Doc
<+> String -> Doc
t String
"{" Doc -> Doc -> Doc
<+> [Doc] -> Doc -> Doc
sepList ((CStmt -> Doc) -> CStmts -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> CStmt -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0) CStmts
ss [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
tString
"}"]) (String -> Doc
tString
";")
    pPrintPrec PrettyLevel
d Rational
p (Crules [] [CRule]
rs) = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
tString
"rules {" Doc -> Doc -> Doc
$+$ PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
d Int
2 Bool
False ((CRule -> Doc) -> [CRule] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CRule -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CRule]
rs)
    pPrintPrec PrettyLevel
d Rational
p (Crules [CSchedulePragma]
ps [CRule]
rs) = PrettyLevel -> Rational -> [CSchedulePragma] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p [CSchedulePragma]
ps Doc -> Doc -> Doc
$+$
                                (Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
tString
"rules {" Doc -> Doc -> Doc
$+$ PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
d Int
2 Bool
False ((CRule -> Doc) -> [CRule] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CRule -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CRule]
rs))
    pPrintPrec PrettyLevel
d Rational
p (COper [COp]
ops) = Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1) ([Doc] -> Doc
sep ((COp -> Doc) -> [COp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> COp -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1)) [COp]
ops))
    ----
    pPrintPrec PrettyLevel
d Rational
p (CCon1 Id
_ Id
i CExpr
e) = PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p (Id -> [CExpr] -> CExpr
CCon Id
i [CExpr
e])
    pPrintPrec PrettyLevel
d Rational
p (CSelectTT Id
_ CExpr
e Id
i) = Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
2)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
2) CExpr
e Doc -> Doc -> Doc
<> String -> Doc
tString
"." Doc -> Doc -> Doc
<> PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i
    ----
    pPrintPrec PrettyLevel
d Rational
_p (CCon0 Maybe Id
_ Id
i) = PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i
    ----
    pPrintPrec PrettyLevel
d Rational
p (CConT Id
_ Id
i [CExpr]
es) = PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p (Id -> [CExpr] -> CExpr
CCon Id
i [CExpr]
es)
    pPrintPrec PrettyLevel
d Rational
p (CStructT CType
ty [(Id, CExpr)]
ies) = PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p (Maybe Bool -> Id -> [(Id, CExpr)] -> CExpr
CStruct (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) Id
tyc [(Id, CExpr)]
ies)
        -- where (Just tyc) = leftCon ty
        where tyc :: Id
tyc = case CType -> Maybe Id
leftCon CType
ty of
                      Just Id
tyc' -> Id
tyc'
                      Maybe Id
Nothing   -> String -> Id
forall a. HasCallStack => String -> a
error String
"Syntax.Pretty(CExpr): CStructT (leftCon ty failed)"
    pPrintPrec  PrettyLevel
d Rational
_p (CSelectT Id
_ Id
i) = String -> Doc
text String
"." Doc -> Doc -> Doc
<> PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i
    pPrintPrec  PrettyLevel
d  Rational
p (CLitT CType
_ CLiteral
l) = PrettyLevel -> Rational -> CLiteral -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p CLiteral
l
    pPrintPrec PrettyLevel
_d Rational
_p (CAnyT Position
_pos UndefKind
_uk CType
_t) = String -> Doc
text String
"_"
    pPrintPrec  PrettyLevel
d  Rational
p (CmoduleVerilogT CType
_ CExpr
m Bool
ui VClockInfo
c VResetInfo
mr [(VArgInfo, CExpr)]
ses [VFieldInfo]
fs VSchedInfo
sch VPathInfo
ps) = PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p (CExpr
-> Bool
-> VClockInfo
-> VResetInfo
-> [(VArgInfo, CExpr)]
-> [VFieldInfo]
-> VSchedInfo
-> VPathInfo
-> CExpr
CmoduleVerilog CExpr
m Bool
ui VClockInfo
c VResetInfo
mr [(VArgInfo, CExpr)]
ses [VFieldInfo]
fs VSchedInfo
sch VPathInfo
ps)
    pPrintPrec  PrettyLevel
d Rational
_p (CForeignFuncCT Id
i CType
_prim_ty) = String -> Doc
tString
"ForeignFuncC" Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d Id
i
    pPrintPrec  PrettyLevel
d  Rational
p (CTApply CExpr
e [CType]
ts) = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>(Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        [Doc] -> Doc
sep (PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1) CExpr
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (CType -> Doc) -> [CType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> (CType -> Doc) -> CType -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CType -> Doc
forall {a}. Pretty a => a -> Doc
ppApArg) [CType]
ts)
        where ppApArg :: a -> Doc
ppApArg a
ty = String -> Doc
tString
"\183" Doc -> Doc -> Doc
<> PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec) a
ty
    pPrintPrec PrettyLevel
d Rational
_p (Cattributes [(Position, PProp)]
pps) = Bool -> Doc -> Doc
pparen Bool
True (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Attributes" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> [PProp] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 (((Position, PProp) -> PProp) -> [(Position, PProp)] -> [PProp]
forall a b. (a -> b) -> [a] -> [b]
map (Position, PProp) -> PProp
forall a b. (a, b) -> b
snd [(Position, PProp)]
pps)

instance HasPosition CExpr where
    getPosition :: CExpr -> Position
getPosition (CLam Either Position Id
ei CExpr
_) = Either Position Id -> Position
forall a. HasPosition a => a -> Position
getPosition Either Position Id
ei
    getPosition (CLamT Either Position Id
ei CQType
_ CExpr
_) = Either Position Id -> Position
forall a. HasPosition a => a -> Position
getPosition Either Position Id
ei
    getPosition (Cletseq [CDefl]
ds CExpr
e) = ([CDefl], CExpr) -> Position
forall a. HasPosition a => a -> Position
getPosition ([CDefl]
ds, CExpr
e)
    getPosition (Cletrec [CDefl]
ds CExpr
e) = ([CDefl], CExpr) -> Position
forall a. HasPosition a => a -> Position
getPosition ([CDefl]
ds, CExpr
e)
    getPosition (CSelect CExpr
e Id
_) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e
    getPosition (CSelectTT Id
_ CExpr
e Id
_) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e
    getPosition (CCon Id
c [CExpr]
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
c
    getPosition (Ccase Position
pos CExpr
_ CCaseArms
_) = Position
pos
    getPosition (CStruct Maybe Bool
_ Id
i [(Id, CExpr)]
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i
    getPosition (CStructUpd CExpr
e [(Id, CExpr)]
_) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e
    getPosition (Cwrite Position
pos CExpr
_ CExpr
_) = Position
pos
    getPosition (CAny Position
pos UndefKind
_) = Position
pos
    getPosition (CVar Id
i) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i
    getPosition (CApply CExpr
e [CExpr]
_) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e
    getPosition (CTaskApply CExpr
e [CExpr]
_) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e
    getPosition (CTaskApplyT CExpr
e CType
_ [CExpr]
_) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e
    getPosition (CLit CLiteral
l) = CLiteral -> Position
forall a. HasPosition a => a -> Position
getPosition CLiteral
l
    getPosition (CBinOp CExpr
e Id
_ CExpr
_) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e
    getPosition (CHasType CExpr
e CQType
_) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e
    getPosition (Cif Position
pos CExpr
_ CExpr
_ CExpr
_) = Position
pos
    getPosition (CSub Position
pos CExpr
_ CExpr
_) = Position
pos
    getPosition (CSub2 CExpr
e CExpr
_ CExpr
_) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e
    getPosition (CSubUpdate Position
pos CExpr
_ (CExpr, CExpr)
_ CExpr
_) = Position
pos
    getPosition (CCon1 Id
_ Id
c CExpr
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
c
    getPosition (Cmodule Position
pos [CMStmt]
_) = Position
pos
    getPosition (Cinterface Position
pos Maybe Id
_i [CDefl]
_ds) = Position
pos
    getPosition (CmoduleVerilog CExpr
e Bool
_ VClockInfo
_ VResetInfo
_ [(VArgInfo, CExpr)]
ses [VFieldInfo]
fs VSchedInfo
_ VPathInfo
_) =
        (CExpr, [CExpr], [VFieldInfo]) -> Position
forall a. HasPosition a => a -> Position
getPosition (CExpr
e, ((VArgInfo, CExpr) -> CExpr) -> [(VArgInfo, CExpr)] -> [CExpr]
forall a b. (a -> b) -> [a] -> [b]
map (VArgInfo, CExpr) -> CExpr
forall a b. (a, b) -> b
snd [(VArgInfo, CExpr)]
ses, [VFieldInfo]
fs)
    getPosition (CmoduleVerilogT CType
_ CExpr
e Bool
_ VClockInfo
_ VResetInfo
_ [(VArgInfo, CExpr)]
ses [VFieldInfo]
fs VSchedInfo
_ VPathInfo
_) =
        (CExpr, [CExpr], [VFieldInfo]) -> Position
forall a. HasPosition a => a -> Position
getPosition (CExpr
e, ((VArgInfo, CExpr) -> CExpr) -> [(VArgInfo, CExpr)] -> [CExpr]
forall a b. (a -> b) -> [a] -> [b]
map (VArgInfo, CExpr) -> CExpr
forall a b. (a, b) -> b
snd [(VArgInfo, CExpr)]
ses, [VFieldInfo]
fs)
    getPosition (CForeignFuncC Id
i CQType
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i
    getPosition (CForeignFuncCT Id
i CType
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i
    getPosition (Cdo Bool
_ CStmts
ss) = CStmts -> Position
forall a. HasPosition a => a -> Position
getPosition CStmts
ss
    getPosition (Caction Position
pos CStmts
_ss) = Position
pos
    getPosition (Crules [CSchedulePragma]
_ [CRule]
rs) = [CRule] -> Position
forall a. HasPosition a => a -> Position
getPosition [CRule]
rs
    getPosition (COper [COp]
es) = [COp] -> Position
forall a. HasPosition a => a -> Position
getPosition [COp]
es
    getPosition (Cattributes [(Position, PProp)]
pps) =
        -- take the position of the first pprop with a good position
        [Position] -> Position
forall a. HasPosition a => a -> Position
getPosition (((Position, PProp) -> Position)
-> [(Position, PProp)] -> [Position]
forall a b. (a -> b) -> [a] -> [b]
map (Position, PProp) -> Position
forall a b. (a, b) -> a
fst [(Position, PProp)]
pps)
    --
    getPosition (CTApply CExpr
e [CType]
ts) = (CExpr, [CType]) -> Position
forall a. HasPosition a => a -> Position
getPosition (CExpr
e, [CType]
ts)
    getPosition (CConT Id
_ Id
c [CExpr]
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
c
    getPosition (CCon0 Maybe Id
_ Id
c) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
c
    getPosition (CSelectT Id
_ Id
i) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i
    getPosition (CLitT CType
_ CLiteral
l) = CLiteral -> Position
forall a. HasPosition a => a -> Position
getPosition CLiteral
l
    getPosition (CAnyT Position
pos UndefKind
_ CType
_) = Position
pos
    getPosition CExpr
e = String -> Position
forall a. HasCallStack => String -> a
error (String
"no match in getPosition: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CExpr -> String
forall a. Pretty a => a -> String
ppReadable CExpr
e)

data CLiteral = CLiteral Position Literal deriving (Int -> CLiteral -> ShowS
[CLiteral] -> ShowS
CLiteral -> String
(Int -> CLiteral -> ShowS)
-> (CLiteral -> String) -> ([CLiteral] -> ShowS) -> Show CLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CLiteral -> ShowS
showsPrec :: Int -> CLiteral -> ShowS
$cshow :: CLiteral -> String
show :: CLiteral -> String
$cshowList :: [CLiteral] -> ShowS
showList :: [CLiteral] -> ShowS
Show)

instance Eq CLiteral where
        CLiteral Position
_ Literal
l == :: CLiteral -> CLiteral -> Bool
== CLiteral Position
_ Literal
l'  =  Literal
l Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Literal
l'

instance Ord CLiteral where
        CLiteral Position
_ Literal
l compare :: CLiteral -> CLiteral -> Ordering
`compare` CLiteral Position
_ Literal
l'  =  Literal
l Literal -> Literal -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Literal
l'

instance Pretty CLiteral where
    pPrintPrec :: PrettyLevel -> Rational -> CLiteral -> Doc
pPrintPrec PrettyLevel
d Rational
p (CLiteral Position
_ Literal
l) = PrettyLevel -> Rational -> Literal -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p Literal
l

instance HasPosition CLiteral where
    getPosition :: CLiteral -> Position
getPosition (CLiteral Position
p Literal
_) = Position
p

ppQuant :: String -> PDetail -> Rational -> Either Position Id -> CExpr -> Doc
ppQuant :: String
-> PrettyLevel -> Rational -> Either Position Id -> CExpr -> Doc
ppQuant String
s PrettyLevel
d Rational
p Either Position Id
ei CExpr
e =
    let ppI :: Either a a -> Doc
ppI (Left a
_) = String -> Doc
text String
"_"
        ppI (Right a
i) = PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 a
i
    in  Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
0) ([Doc] -> Doc
sep [String -> Doc
t String
s Doc -> Doc -> Doc
<> Either Position Id -> Doc
forall {a} {a}. Pretty a => Either a a -> Doc
ppI Either Position Id
ei Doc -> Doc -> Doc
<+> String -> Doc
t String
"->", PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
e])

data COp
        = CRand CExpr    -- operand
        | CRator Int Id  -- infix operator Id, Int is the number of arguments?
        deriving (COp -> COp -> Bool
(COp -> COp -> Bool) -> (COp -> COp -> Bool) -> Eq COp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: COp -> COp -> Bool
== :: COp -> COp -> Bool
$c/= :: COp -> COp -> Bool
/= :: COp -> COp -> Bool
Eq, Eq COp
Eq COp =>
(COp -> COp -> Ordering)
-> (COp -> COp -> Bool)
-> (COp -> COp -> Bool)
-> (COp -> COp -> Bool)
-> (COp -> COp -> Bool)
-> (COp -> COp -> COp)
-> (COp -> COp -> COp)
-> Ord COp
COp -> COp -> Bool
COp -> COp -> Ordering
COp -> COp -> COp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: COp -> COp -> Ordering
compare :: COp -> COp -> Ordering
$c< :: COp -> COp -> Bool
< :: COp -> COp -> Bool
$c<= :: COp -> COp -> Bool
<= :: COp -> COp -> Bool
$c> :: COp -> COp -> Bool
> :: COp -> COp -> Bool
$c>= :: COp -> COp -> Bool
>= :: COp -> COp -> Bool
$cmax :: COp -> COp -> COp
max :: COp -> COp -> COp
$cmin :: COp -> COp -> COp
min :: COp -> COp -> COp
Ord, Int -> COp -> ShowS
[COp] -> ShowS
COp -> String
(Int -> COp -> ShowS)
-> (COp -> String) -> ([COp] -> ShowS) -> Show COp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> COp -> ShowS
showsPrec :: Int -> COp -> ShowS
$cshow :: COp -> String
show :: COp -> String
$cshowList :: [COp] -> ShowS
showList :: [COp] -> ShowS
Show)

instance Pretty COp where
    pPrintPrec :: PrettyLevel -> Rational -> COp -> Doc
pPrintPrec PrettyLevel
d Rational
_ (CRand CExpr
p) = PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
p
    pPrintPrec PrettyLevel
d Rational
_ (CRator Int
_ Id
i) = PrettyLevel -> Id -> Doc
ppInfix PrettyLevel
d Id
i

instance HasPosition COp where
    getPosition :: COp -> Position
getPosition (CRand CExpr
e) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e
    getPosition (CRator Int
_ Id
i) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i

ppCase :: PDetail -> CExpr -> [CCaseArm] -> Doc
ppCase :: PrettyLevel -> CExpr -> CCaseArms -> Doc
ppCase PrettyLevel
detail CExpr
scrutinee CCaseArms
arms =
    (String -> Doc
tString
"case" Doc -> Doc -> Doc
<+> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
detail CExpr
scrutinee Doc -> Doc -> Doc
<+> String -> Doc
t String
"of {") Doc -> Doc -> Doc
$+$
    PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
detail Int
0 Bool
False ((CCaseArm -> Doc) -> CCaseArms -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CCaseArm -> Doc
ppArm CCaseArms
arms)
  where ppArm :: CCaseArm -> Doc
ppArm CCaseArm
arm =
            [Doc] -> Doc
sep [PrettyLevel -> Rational -> CPat -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
detail Rational
0 (CCaseArm -> CPat
cca_pattern CCaseArm
arm) Doc -> Doc -> Doc
<>
                 PrettyLevel -> [CQual] -> Doc
ppQuals PrettyLevel
detail (CCaseArm -> [CQual]
cca_filters CCaseArm
arm) Doc -> Doc -> Doc
<+> String -> Doc
t String
"-> ",
                 Int -> Doc -> Doc
nest Int
2 (PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
detail (CCaseArm -> CExpr
cca_consequent CCaseArm
arm))]

ppOp :: PDetail -> Rational -> Id -> CExpr -> CExpr -> Doc
ppOp :: PrettyLevel -> Rational -> Id -> CExpr -> CExpr -> Doc
ppOp PrettyLevel
d Rational
pd Id
i CExpr
p1 CExpr
p2 =
        Bool -> Doc -> Doc
pparen (Rational
pd Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0) ([Doc] -> Doc
sep [PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
1 CExpr
p1 Doc -> Doc -> Doc
<> String -> Doc
tString
"" Doc -> Doc -> Doc
<+> PrettyLevel -> Id -> Doc
ppInfix PrettyLevel
d Id
i, PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
1 CExpr
p2])
{-
        let (p, lp, rp) =
                case getFixity i of
                FInfixl p -> (p, p, p+1)
                FInfixr p -> (p, p+1, p)
                FInfix  p -> (p, p+1, p+1)
        in pparen (d > PDReadable || pd>p)
                  (sep [pPrint d lp p1 <> t"" <+> ppInfix d i, pPrint d rp p2])
-}

type CSummands = [CInternalSummand]

-- summand in internal form (each summand only takes a single argument
-- whose type is CType)
-- Data constructors can have multiple names for a constructor (for backwards
-- compatibility with old names), but the first name is the primary name
-- (used in compiler output etc).
data CInternalSummand =
    CInternalSummand { CInternalSummand -> [Id]
cis_names :: [Id],
                       CInternalSummand -> CType
cis_arg_type :: CType,
                       CInternalSummand -> Integer
cis_tag_encoding :: Integer }
    deriving (CInternalSummand -> CInternalSummand -> Bool
(CInternalSummand -> CInternalSummand -> Bool)
-> (CInternalSummand -> CInternalSummand -> Bool)
-> Eq CInternalSummand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CInternalSummand -> CInternalSummand -> Bool
== :: CInternalSummand -> CInternalSummand -> Bool
$c/= :: CInternalSummand -> CInternalSummand -> Bool
/= :: CInternalSummand -> CInternalSummand -> Bool
Eq, Eq CInternalSummand
Eq CInternalSummand =>
(CInternalSummand -> CInternalSummand -> Ordering)
-> (CInternalSummand -> CInternalSummand -> Bool)
-> (CInternalSummand -> CInternalSummand -> Bool)
-> (CInternalSummand -> CInternalSummand -> Bool)
-> (CInternalSummand -> CInternalSummand -> Bool)
-> (CInternalSummand -> CInternalSummand -> CInternalSummand)
-> (CInternalSummand -> CInternalSummand -> CInternalSummand)
-> Ord CInternalSummand
CInternalSummand -> CInternalSummand -> Bool
CInternalSummand -> CInternalSummand -> Ordering
CInternalSummand -> CInternalSummand -> CInternalSummand
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CInternalSummand -> CInternalSummand -> Ordering
compare :: CInternalSummand -> CInternalSummand -> Ordering
$c< :: CInternalSummand -> CInternalSummand -> Bool
< :: CInternalSummand -> CInternalSummand -> Bool
$c<= :: CInternalSummand -> CInternalSummand -> Bool
<= :: CInternalSummand -> CInternalSummand -> Bool
$c> :: CInternalSummand -> CInternalSummand -> Bool
> :: CInternalSummand -> CInternalSummand -> Bool
$c>= :: CInternalSummand -> CInternalSummand -> Bool
>= :: CInternalSummand -> CInternalSummand -> Bool
$cmax :: CInternalSummand -> CInternalSummand -> CInternalSummand
max :: CInternalSummand -> CInternalSummand -> CInternalSummand
$cmin :: CInternalSummand -> CInternalSummand -> CInternalSummand
min :: CInternalSummand -> CInternalSummand -> CInternalSummand
Ord, Int -> CInternalSummand -> ShowS
CSummands -> ShowS
CInternalSummand -> String
(Int -> CInternalSummand -> ShowS)
-> (CInternalSummand -> String)
-> (CSummands -> ShowS)
-> Show CInternalSummand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CInternalSummand -> ShowS
showsPrec :: Int -> CInternalSummand -> ShowS
$cshow :: CInternalSummand -> String
show :: CInternalSummand -> String
$cshowList :: CSummands -> ShowS
showList :: CSummands -> ShowS
Show)

instance HasPosition CInternalSummand where
    getPosition :: CInternalSummand -> Position
getPosition CInternalSummand
summand = [Id] -> Position
forall a. HasPosition a => a -> Position
getPosition (CInternalSummand -> [Id]
cis_names CInternalSummand
summand)

-- original summands (taking a list of arguments, each of whose types
-- is given by CQType); the Int is a hack to support Enums with
-- noncontiguous Bits encodings
-- Data constructors can have multiple names for a constructor (for backwards
-- compatibility with old names), but the first name is the primary name
-- (used in compiler output etc).
type COSummands = [COriginalSummand]

data COriginalSummand =
    COriginalSummand { COriginalSummand -> [Id]
cos_names :: [Id],
                       COriginalSummand -> [CQType]
cos_arg_types :: [CQType],
                       COriginalSummand -> Maybe [Id]
cos_field_names :: Maybe [Id],
                       COriginalSummand -> Maybe Integer
cos_tag_encoding :: Maybe Integer }
    deriving (COriginalSummand -> COriginalSummand -> Bool
(COriginalSummand -> COriginalSummand -> Bool)
-> (COriginalSummand -> COriginalSummand -> Bool)
-> Eq COriginalSummand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: COriginalSummand -> COriginalSummand -> Bool
== :: COriginalSummand -> COriginalSummand -> Bool
$c/= :: COriginalSummand -> COriginalSummand -> Bool
/= :: COriginalSummand -> COriginalSummand -> Bool
Eq, Eq COriginalSummand
Eq COriginalSummand =>
(COriginalSummand -> COriginalSummand -> Ordering)
-> (COriginalSummand -> COriginalSummand -> Bool)
-> (COriginalSummand -> COriginalSummand -> Bool)
-> (COriginalSummand -> COriginalSummand -> Bool)
-> (COriginalSummand -> COriginalSummand -> Bool)
-> (COriginalSummand -> COriginalSummand -> COriginalSummand)
-> (COriginalSummand -> COriginalSummand -> COriginalSummand)
-> Ord COriginalSummand
COriginalSummand -> COriginalSummand -> Bool
COriginalSummand -> COriginalSummand -> Ordering
COriginalSummand -> COriginalSummand -> COriginalSummand
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: COriginalSummand -> COriginalSummand -> Ordering
compare :: COriginalSummand -> COriginalSummand -> Ordering
$c< :: COriginalSummand -> COriginalSummand -> Bool
< :: COriginalSummand -> COriginalSummand -> Bool
$c<= :: COriginalSummand -> COriginalSummand -> Bool
<= :: COriginalSummand -> COriginalSummand -> Bool
$c> :: COriginalSummand -> COriginalSummand -> Bool
> :: COriginalSummand -> COriginalSummand -> Bool
$c>= :: COriginalSummand -> COriginalSummand -> Bool
>= :: COriginalSummand -> COriginalSummand -> Bool
$cmax :: COriginalSummand -> COriginalSummand -> COriginalSummand
max :: COriginalSummand -> COriginalSummand -> COriginalSummand
$cmin :: COriginalSummand -> COriginalSummand -> COriginalSummand
min :: COriginalSummand -> COriginalSummand -> COriginalSummand
Ord, Int -> COriginalSummand -> ShowS
COSummands -> ShowS
COriginalSummand -> String
(Int -> COriginalSummand -> ShowS)
-> (COriginalSummand -> String)
-> (COSummands -> ShowS)
-> Show COriginalSummand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> COriginalSummand -> ShowS
showsPrec :: Int -> COriginalSummand -> ShowS
$cshow :: COriginalSummand -> String
show :: COriginalSummand -> String
$cshowList :: COSummands -> ShowS
showList :: COSummands -> ShowS
Show)

-- if CQType is a function, [IfcPragmas] (if present) lists argument names
-- (used by the backend to generate pretty names for module ports)
data CField = CField { CField -> Id
cf_name :: Id,
                       CField -> Maybe [IfcPragma]
cf_pragmas :: Maybe [IfcPragma],
                       CField -> CQType
cf_type :: CQType,
                       CField -> [CClause]
cf_default :: [CClause],
                       CField -> Maybe CType
cf_orig_type :: Maybe CType
                     }
              deriving (CField -> CField -> Bool
(CField -> CField -> Bool)
-> (CField -> CField -> Bool) -> Eq CField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CField -> CField -> Bool
== :: CField -> CField -> Bool
$c/= :: CField -> CField -> Bool
/= :: CField -> CField -> Bool
Eq, Eq CField
Eq CField =>
(CField -> CField -> Ordering)
-> (CField -> CField -> Bool)
-> (CField -> CField -> Bool)
-> (CField -> CField -> Bool)
-> (CField -> CField -> Bool)
-> (CField -> CField -> CField)
-> (CField -> CField -> CField)
-> Ord CField
CField -> CField -> Bool
CField -> CField -> Ordering
CField -> CField -> CField
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CField -> CField -> Ordering
compare :: CField -> CField -> Ordering
$c< :: CField -> CField -> Bool
< :: CField -> CField -> Bool
$c<= :: CField -> CField -> Bool
<= :: CField -> CField -> Bool
$c> :: CField -> CField -> Bool
> :: CField -> CField -> Bool
$c>= :: CField -> CField -> Bool
>= :: CField -> CField -> Bool
$cmax :: CField -> CField -> CField
max :: CField -> CField -> CField
$cmin :: CField -> CField -> CField
min :: CField -> CField -> CField
Ord, Int -> CField -> ShowS
CFields -> ShowS
CField -> String
(Int -> CField -> ShowS)
-> (CField -> String) -> (CFields -> ShowS) -> Show CField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CField -> ShowS
showsPrec :: Int -> CField -> ShowS
$cshow :: CField -> String
show :: CField -> String
$cshowList :: CFields -> ShowS
showList :: CFields -> ShowS
Show)

instance Pretty CField where
    pPrintPrec :: PrettyLevel -> Rational -> CField -> Doc
pPrintPrec PrettyLevel
d Rational
_p CField
f = PrettyLevel -> CField -> Doc
ppField PrettyLevel
d CField
f

ppField :: PDetail -> CField -> Doc
ppField :: PrettyLevel -> CField -> Doc
ppField PrettyLevel
detail CField
field =
  let fid :: Id
fid = CField -> Id
cf_name CField
field
      dfl :: [CClause]
dfl = CField -> [CClause]
cf_default CField
field
  in
    (PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
detail Id
fid Doc -> Doc -> Doc
<+> String -> Doc
t String
"::" Doc -> Doc -> Doc
<+> PrettyLevel -> CQType -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
detail (CField -> CQType
cf_type CField
field)
        Doc -> Doc -> Doc
<+> Doc -> ([IfcPragma] -> Doc) -> Maybe [IfcPragma] -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (PrettyLevel -> [IfcPragma] -> Doc
ppIfcPragma PrettyLevel
detail) (CField -> Maybe [IfcPragma]
cf_pragmas CField
field) Doc -> Doc -> Doc
<>
        if ([CClause] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CClause]
dfl) then Doc
empty else String -> Doc
text String
";") Doc -> Doc -> Doc
$$
    -- display the default, if it exists
    if ([CClause] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CClause]
dfl)
     then Doc
empty
     else let ppC :: CClause -> Doc
ppC CClause
cl = PrettyLevel -> Rational -> [Doc] -> CClause -> Doc
ppClause PrettyLevel
detail Rational
0 [PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
detail Id
fid] CClause
cl
          in  (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\ Doc
x Doc
y -> Doc
x Doc -> Doc -> Doc
<> String -> Doc
text String
";" Doc -> Doc -> Doc
$$ Doc
y) ((CClause -> Doc) -> [CClause] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CClause -> Doc
ppC [CClause]
dfl)
    -- XXX not including orig_type

ppIfcPragma :: PDetail -> [IfcPragma] -> Doc
ppIfcPragma :: PrettyLevel -> [IfcPragma] -> Doc
ppIfcPragma PrettyLevel
_detail [] = Doc
empty
ppIfcPragma  PrettyLevel
detail [IfcPragma]
ps =
        String -> Doc
text String
"{-#" Doc -> Doc -> Doc
<+>
        [Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((IfcPragma -> Doc) -> [IfcPragma] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> IfcPragma -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
detail Rational
0) [IfcPragma]
ps ) )
        Doc -> Doc -> Doc
<+> String -> Doc
text String
"#-}"

ppFDs :: PDetail -> CFunDeps -> Doc
ppFDs :: PrettyLevel -> CFunDeps -> Doc
ppFDs PrettyLevel
_d [] = Doc
empty
ppFDs  PrettyLevel
d CFunDeps
fd = String -> Doc
text String
" |" Doc -> Doc -> Doc
<+> [Doc] -> Doc -> Doc
sepList ((([Id], [Id]) -> Doc) -> CFunDeps -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> ([Id], [Id]) -> Doc
ppFD PrettyLevel
d) CFunDeps
fd) (String -> Doc
tString
",")

ppFD :: PDetail -> ([Id], [Id]) -> Doc
ppFD :: PrettyLevel -> ([Id], [Id]) -> Doc
ppFD PrettyLevel
d ([Id]
as,[Id]
rs) = [Doc] -> Doc
sep (PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d (Id -> Doc) -> [Id] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Id]
as) Doc -> Doc -> Doc
<+> String -> Doc
t String
"->" Doc -> Doc -> Doc
<+> [Doc] -> Doc
sep (PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d (Id -> Doc) -> [Id] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Id]
rs)

ppPreds :: PDetail -> [CPred] -> Doc -> Doc
ppPreds :: PrettyLevel -> [CPred] -> Doc -> Doc
ppPreds PrettyLevel
_d [] Doc
x = Doc
x
ppPreds  PrettyLevel
d [CPred]
preds Doc
x = String -> Doc
t String
"(" Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList ((CPred -> Doc) -> [CPred] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> CPred -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0) [CPred]
preds) (String -> Doc
t String
",") Doc -> Doc -> Doc
<> String -> Doc
t String
") =>" Doc -> Doc -> Doc
<+> Doc
x

ppConIdK :: PDetail -> IdK -> Doc
ppConIdK :: PrettyLevel -> IdK -> Doc
ppConIdK PrettyLevel
d (IdK Id
i) = PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i
ppConIdK PrettyLevel
d (IdKind Id
i Kind
k) = Bool -> Doc -> Doc
pparen Bool
True (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"::" Doc -> Doc -> Doc
<+> PrettyLevel -> Kind -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d Kind
k
ppConIdK PrettyLevel
d (IdPKind Id
i PartialKind
pk) = Bool -> Doc -> Doc
pparen Bool
True (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"::" Doc -> Doc -> Doc
<+> PrettyLevel -> PartialKind -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d PartialKind
pk

type CFields = [CField] -- just a list of CField

-- redundant
--type Ids = [Id]
data CCaseArm = CCaseArm { CCaseArm -> CPat
cca_pattern :: CPat,
                           CCaseArm -> [CQual]
cca_filters :: [CQual],
                           CCaseArm -> CExpr
cca_consequent :: CExpr }
              deriving (CCaseArm -> CCaseArm -> Bool
(CCaseArm -> CCaseArm -> Bool)
-> (CCaseArm -> CCaseArm -> Bool) -> Eq CCaseArm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CCaseArm -> CCaseArm -> Bool
== :: CCaseArm -> CCaseArm -> Bool
$c/= :: CCaseArm -> CCaseArm -> Bool
/= :: CCaseArm -> CCaseArm -> Bool
Eq, Eq CCaseArm
Eq CCaseArm =>
(CCaseArm -> CCaseArm -> Ordering)
-> (CCaseArm -> CCaseArm -> Bool)
-> (CCaseArm -> CCaseArm -> Bool)
-> (CCaseArm -> CCaseArm -> Bool)
-> (CCaseArm -> CCaseArm -> Bool)
-> (CCaseArm -> CCaseArm -> CCaseArm)
-> (CCaseArm -> CCaseArm -> CCaseArm)
-> Ord CCaseArm
CCaseArm -> CCaseArm -> Bool
CCaseArm -> CCaseArm -> Ordering
CCaseArm -> CCaseArm -> CCaseArm
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CCaseArm -> CCaseArm -> Ordering
compare :: CCaseArm -> CCaseArm -> Ordering
$c< :: CCaseArm -> CCaseArm -> Bool
< :: CCaseArm -> CCaseArm -> Bool
$c<= :: CCaseArm -> CCaseArm -> Bool
<= :: CCaseArm -> CCaseArm -> Bool
$c> :: CCaseArm -> CCaseArm -> Bool
> :: CCaseArm -> CCaseArm -> Bool
$c>= :: CCaseArm -> CCaseArm -> Bool
>= :: CCaseArm -> CCaseArm -> Bool
$cmax :: CCaseArm -> CCaseArm -> CCaseArm
max :: CCaseArm -> CCaseArm -> CCaseArm
$cmin :: CCaseArm -> CCaseArm -> CCaseArm
min :: CCaseArm -> CCaseArm -> CCaseArm
Ord, Int -> CCaseArm -> ShowS
CCaseArms -> ShowS
CCaseArm -> String
(Int -> CCaseArm -> ShowS)
-> (CCaseArm -> String) -> (CCaseArms -> ShowS) -> Show CCaseArm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CCaseArm -> ShowS
showsPrec :: Int -> CCaseArm -> ShowS
$cshow :: CCaseArm -> String
show :: CCaseArm -> String
$cshowList :: CCaseArms -> ShowS
showList :: CCaseArms -> ShowS
Show)

instance HasPosition CCaseArm where
    getPosition :: CCaseArm -> Position
getPosition CCaseArm
arm =
        CPat -> Position
forall a. HasPosition a => a -> Position
getPosition (CCaseArm -> CPat
cca_pattern CCaseArm
arm) Position -> Position -> Position
`bestPosition`
        [CQual] -> Position
forall a. HasPosition a => a -> Position
getPosition (CCaseArm -> [CQual]
cca_filters CCaseArm
arm) Position -> Position -> Position
`bestPosition`
        CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition (CCaseArm -> CExpr
cca_consequent CCaseArm
arm)

type CCaseArms = [CCaseArm] -- [(CPat, [CQual], CExpr)]

data CStmt
          -- bind cexpr of type cqtype to cpat; id, if present, is instance name
        = CSBindT CPat (Maybe CExpr) [(Position,PProp)] CQType CExpr
          -- bind cexpr to cpat; id, if present, is instance name
        | CSBind CPat (Maybe CExpr) [(Position,PProp)] CExpr
        | CSletseq [CDefl] -- rhs of "let x = x" refers to previous def
                           --   before current let or in earlier arm
        | CSletrec [CDefl] -- rhs of "let x = x" refers to self
        | CSExpr (Maybe CExpr) CExpr
        deriving (CStmt -> CStmt -> Bool
(CStmt -> CStmt -> Bool) -> (CStmt -> CStmt -> Bool) -> Eq CStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CStmt -> CStmt -> Bool
== :: CStmt -> CStmt -> Bool
$c/= :: CStmt -> CStmt -> Bool
/= :: CStmt -> CStmt -> Bool
Eq, Eq CStmt
Eq CStmt =>
(CStmt -> CStmt -> Ordering)
-> (CStmt -> CStmt -> Bool)
-> (CStmt -> CStmt -> Bool)
-> (CStmt -> CStmt -> Bool)
-> (CStmt -> CStmt -> Bool)
-> (CStmt -> CStmt -> CStmt)
-> (CStmt -> CStmt -> CStmt)
-> Ord CStmt
CStmt -> CStmt -> Bool
CStmt -> CStmt -> Ordering
CStmt -> CStmt -> CStmt
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CStmt -> CStmt -> Ordering
compare :: CStmt -> CStmt -> Ordering
$c< :: CStmt -> CStmt -> Bool
< :: CStmt -> CStmt -> Bool
$c<= :: CStmt -> CStmt -> Bool
<= :: CStmt -> CStmt -> Bool
$c> :: CStmt -> CStmt -> Bool
> :: CStmt -> CStmt -> Bool
$c>= :: CStmt -> CStmt -> Bool
>= :: CStmt -> CStmt -> Bool
$cmax :: CStmt -> CStmt -> CStmt
max :: CStmt -> CStmt -> CStmt
$cmin :: CStmt -> CStmt -> CStmt
min :: CStmt -> CStmt -> CStmt
Ord, Int -> CStmt -> ShowS
CStmts -> ShowS
CStmt -> String
(Int -> CStmt -> ShowS)
-> (CStmt -> String) -> (CStmts -> ShowS) -> Show CStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CStmt -> ShowS
showsPrec :: Int -> CStmt -> ShowS
$cshow :: CStmt -> String
show :: CStmt -> String
$cshowList :: CStmts -> ShowS
showList :: CStmts -> ShowS
Show)

instance Pretty CStmt where
    pPrintPrec :: PrettyLevel -> Rational -> CStmt -> Doc
pPrintPrec PrettyLevel
d Rational
_p (CSBindT CPat
pat Maybe CExpr
_inst [(Position, PProp)]
pprops CQType
ty CExpr
e) =
        (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($+$) Doc
empty ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            (((Position, PProp) -> Doc) -> [(Position, PProp)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> PProp -> Doc
ppPProp PrettyLevel
d (PProp -> Doc)
-> ((Position, PProp) -> PProp) -> (Position, PProp) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, PProp) -> PProp
forall a b. (a, b) -> b
snd) [(Position, PProp)]
pprops) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
            [PrettyLevel -> CPat -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CPat
pat Doc -> Doc -> Doc
<+> String -> Doc
t String
"::" Doc -> Doc -> Doc
<+> PrettyLevel -> CQType -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CQType
ty Doc -> Doc -> Doc
<+> String -> Doc
t String
"<-" Doc -> Doc -> Doc
<+> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
e]
    pPrintPrec PrettyLevel
d Rational
_p (CSBind CPat
pat Maybe CExpr
_inst [(Position, PProp)]
pprops CExpr
e) =
        (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($+$) Doc
empty ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            (((Position, PProp) -> Doc) -> [(Position, PProp)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> PProp -> Doc
ppPProp PrettyLevel
d (PProp -> Doc)
-> ((Position, PProp) -> PProp) -> (Position, PProp) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, PProp) -> PProp
forall a b. (a, b) -> b
snd) [(Position, PProp)]
pprops) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
            [PrettyLevel -> CPat -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CPat
pat Doc -> Doc -> Doc
<+> String -> Doc
t String
"<-" Doc -> Doc -> Doc
<+> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
e]
    pPrintPrec PrettyLevel
_d Rational
_p (CSletseq []) = String -> Doc
forall a. HasCallStack => String -> a
error String
"Syntax.Pretty(CStmt): CSletseq []"
    pPrintPrec  PrettyLevel
d Rational
_p (CSletseq [CDefl]
ds) = String -> Doc
text String
"letseq" Doc -> Doc -> Doc
<+> String -> Doc
text String
"{" Doc -> Doc -> Doc
<+> (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc -> Doc -> Doc
($+$) ((CDefl -> Doc) -> [CDefl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CDefl -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CDefl]
ds) Doc -> Doc -> Doc
<+> String -> Doc
text String
"}"
    pPrintPrec PrettyLevel
_d Rational
_p (CSletrec []) = String -> Doc
forall a. HasCallStack => String -> a
error String
"Syntax.Pretty(CStmt): CSletrec []"
    pPrintPrec  PrettyLevel
d Rational
_p (CSletrec [CDefl]
ds) = String -> Doc
text String
"let" Doc -> Doc -> Doc
<+> String -> Doc
text String
"{" Doc -> Doc -> Doc
<+> (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc -> Doc -> Doc
($+$) ((CDefl -> Doc) -> [CDefl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CDefl -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CDefl]
ds) Doc -> Doc -> Doc
<+> String -> Doc
text String
"}"
    pPrintPrec  PrettyLevel
d Rational
p (CSExpr Maybe CExpr
_ CExpr
e) = PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p CExpr
e

instance HasPosition CStmt where
    getPosition :: CStmt -> Position
getPosition (CSBindT CPat
p Maybe CExpr
_i [(Position, PProp)]
_pps CQType
_t CExpr
_e) = CPat -> Position
forall a. HasPosition a => a -> Position
getPosition CPat
p
    getPosition (CSBind CPat
p Maybe CExpr
_i [(Position, PProp)]
_pps CExpr
_e) = CPat -> Position
forall a. HasPosition a => a -> Position
getPosition CPat
p
    getPosition (CSletseq [CDefl]
ds) = [CDefl] -> Position
forall a. HasPosition a => a -> Position
getPosition [CDefl]
ds
    getPosition (CSletrec [CDefl]
ds) = [CDefl] -> Position
forall a. HasPosition a => a -> Position
getPosition [CDefl]
ds
    getPosition (CSExpr Maybe CExpr
_ CExpr
e) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e

type CStmts = [CStmt]

data CMStmt
        = CMStmt CStmt
        | CMrules CExpr
        | CMinterface CExpr
        | CMTupleInterface Position [CExpr]
        deriving (CMStmt -> CMStmt -> Bool
(CMStmt -> CMStmt -> Bool)
-> (CMStmt -> CMStmt -> Bool) -> Eq CMStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CMStmt -> CMStmt -> Bool
== :: CMStmt -> CMStmt -> Bool
$c/= :: CMStmt -> CMStmt -> Bool
/= :: CMStmt -> CMStmt -> Bool
Eq, Eq CMStmt
Eq CMStmt =>
(CMStmt -> CMStmt -> Ordering)
-> (CMStmt -> CMStmt -> Bool)
-> (CMStmt -> CMStmt -> Bool)
-> (CMStmt -> CMStmt -> Bool)
-> (CMStmt -> CMStmt -> Bool)
-> (CMStmt -> CMStmt -> CMStmt)
-> (CMStmt -> CMStmt -> CMStmt)
-> Ord CMStmt
CMStmt -> CMStmt -> Bool
CMStmt -> CMStmt -> Ordering
CMStmt -> CMStmt -> CMStmt
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CMStmt -> CMStmt -> Ordering
compare :: CMStmt -> CMStmt -> Ordering
$c< :: CMStmt -> CMStmt -> Bool
< :: CMStmt -> CMStmt -> Bool
$c<= :: CMStmt -> CMStmt -> Bool
<= :: CMStmt -> CMStmt -> Bool
$c> :: CMStmt -> CMStmt -> Bool
> :: CMStmt -> CMStmt -> Bool
$c>= :: CMStmt -> CMStmt -> Bool
>= :: CMStmt -> CMStmt -> Bool
$cmax :: CMStmt -> CMStmt -> CMStmt
max :: CMStmt -> CMStmt -> CMStmt
$cmin :: CMStmt -> CMStmt -> CMStmt
min :: CMStmt -> CMStmt -> CMStmt
Ord, Int -> CMStmt -> ShowS
[CMStmt] -> ShowS
CMStmt -> String
(Int -> CMStmt -> ShowS)
-> (CMStmt -> String) -> ([CMStmt] -> ShowS) -> Show CMStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CMStmt -> ShowS
showsPrec :: Int -> CMStmt -> ShowS
$cshow :: CMStmt -> String
show :: CMStmt -> String
$cshowList :: [CMStmt] -> ShowS
showList :: [CMStmt] -> ShowS
Show)

instance Pretty CMStmt where
    pPrintPrec :: PrettyLevel -> Rational -> CMStmt -> Doc
pPrintPrec PrettyLevel
d Rational
p (CMStmt CStmt
s) = PrettyLevel -> Rational -> CStmt -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p CStmt
s
    pPrintPrec PrettyLevel
d Rational
p (CMrules CExpr
e) = PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p CExpr
e
    pPrintPrec PrettyLevel
d Rational
p (CMinterface CExpr
e) = PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p (Id -> [CExpr] -> CExpr
cVApply (Position -> Id
idReturn (CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e)) [CExpr
e])
    pPrintPrec PrettyLevel
d Rational
p (CMTupleInterface Position
_ [CExpr]
es) = String -> Doc
textString
"(" Doc -> Doc -> Doc
<> [Doc] -> Doc -> Doc
sepList ((CExpr -> Doc) -> [CExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p) [CExpr]
es) (String -> Doc
text String
",") Doc -> Doc -> Doc
<> String -> Doc
text String
")"

instance HasPosition CMStmt where
    getPosition :: CMStmt -> Position
getPosition (CMStmt CStmt
s) = CStmt -> Position
forall a. HasPosition a => a -> Position
getPosition CStmt
s
    getPosition (CMrules CExpr
e) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e
    getPosition (CMinterface CExpr
e) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e
    getPosition (CMTupleInterface Position
pos [CExpr]
_e) = Position
pos

data CRule
        = CRule [RulePragma] (Maybe CExpr) [CQual] CExpr
        | CRuleNest [RulePragma] (Maybe CExpr) [CQual] [CRule]
        deriving (CRule -> CRule -> Bool
(CRule -> CRule -> Bool) -> (CRule -> CRule -> Bool) -> Eq CRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CRule -> CRule -> Bool
== :: CRule -> CRule -> Bool
$c/= :: CRule -> CRule -> Bool
/= :: CRule -> CRule -> Bool
Eq, Eq CRule
Eq CRule =>
(CRule -> CRule -> Ordering)
-> (CRule -> CRule -> Bool)
-> (CRule -> CRule -> Bool)
-> (CRule -> CRule -> Bool)
-> (CRule -> CRule -> Bool)
-> (CRule -> CRule -> CRule)
-> (CRule -> CRule -> CRule)
-> Ord CRule
CRule -> CRule -> Bool
CRule -> CRule -> Ordering
CRule -> CRule -> CRule
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CRule -> CRule -> Ordering
compare :: CRule -> CRule -> Ordering
$c< :: CRule -> CRule -> Bool
< :: CRule -> CRule -> Bool
$c<= :: CRule -> CRule -> Bool
<= :: CRule -> CRule -> Bool
$c> :: CRule -> CRule -> Bool
> :: CRule -> CRule -> Bool
$c>= :: CRule -> CRule -> Bool
>= :: CRule -> CRule -> Bool
$cmax :: CRule -> CRule -> CRule
max :: CRule -> CRule -> CRule
$cmin :: CRule -> CRule -> CRule
min :: CRule -> CRule -> CRule
Ord, Int -> CRule -> ShowS
[CRule] -> ShowS
CRule -> String
(Int -> CRule -> ShowS)
-> (CRule -> String) -> ([CRule] -> ShowS) -> Show CRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CRule -> ShowS
showsPrec :: Int -> CRule -> ShowS
$cshow :: CRule -> String
show :: CRule -> String
$cshowList :: [CRule] -> ShowS
showList :: [CRule] -> ShowS
Show)

instance HasPosition CRule where
    getPosition :: CRule -> Position
getPosition (CRule [RulePragma]
_ Maybe CExpr
i [CQual]
qs CExpr
e) = (Maybe CExpr, [CQual], CExpr) -> Position
forall a. HasPosition a => a -> Position
getPosition (Maybe CExpr
i, [CQual]
qs, CExpr
e)
    getPosition (CRuleNest [RulePragma]
_ Maybe CExpr
i [CQual]
qs [CRule]
rs) = (Maybe CExpr, [CQual], [CRule]) -> Position
forall a. HasPosition a => a -> Position
getPosition (Maybe CExpr
i, [CQual]
qs, [CRule]
rs)

instance Pretty CRule where
        pPrintPrec :: PrettyLevel -> Rational -> CRule -> Doc
pPrintPrec PrettyLevel
d Rational
_p (CRule [RulePragma]
rps Maybe CExpr
mlbl [CQual]
mqs CExpr
e) =
                PrettyLevel -> [RulePragma] -> Doc
ppRPS PrettyLevel
d [RulePragma]
rps Doc -> Doc -> Doc
$+$
                (case Maybe CExpr
mlbl of Maybe CExpr
Nothing -> String -> Doc
tString
""; Just CExpr
i -> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
i Doc -> Doc -> Doc
<> String -> Doc
tString
": ") Doc -> Doc -> Doc
<> [Doc] -> Doc
sep [PrettyLevel -> [CQual] -> Doc
ppQuals PrettyLevel
d [CQual]
mqs, String -> Doc
t String
"  ==>",
                Int -> Doc -> Doc
nest Int
4 (PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
e)]
        pPrintPrec PrettyLevel
d Rational
_p (CRuleNest [RulePragma]
rps Maybe CExpr
mlbl [CQual]
mqs [CRule]
rs) =
                PrettyLevel -> [RulePragma] -> Doc
ppRPS PrettyLevel
d [RulePragma]
rps Doc -> Doc -> Doc
$+$
                (case Maybe CExpr
mlbl of Maybe CExpr
Nothing -> String -> Doc
tString
""; Just CExpr
i -> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
i Doc -> Doc -> Doc
<> String -> Doc
tString
": ") Doc -> Doc -> Doc
<>
                        (PrettyLevel -> [CQual] -> Doc
ppQuals PrettyLevel
d [CQual]
mqs Doc -> Doc -> Doc
$+$ PrettyLevel -> Int -> Bool -> [Doc] -> Doc
pBlock PrettyLevel
d Int
2 Bool
False ((CRule -> Doc) -> [CRule] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CRule -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CRule]
rs))

ppRPS :: PDetail -> [RulePragma] -> Doc
ppRPS :: PrettyLevel -> [RulePragma] -> Doc
ppRPS PrettyLevel
_d [] = String -> Doc
text String
""
ppRPS  PrettyLevel
d [RulePragma]
rps = [Doc] -> Doc
vcat ((RulePragma -> Doc) -> [RulePragma] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> RulePragma -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0) [RulePragma]
rps)

-- | A definition with a binding. Can occur as a let expression, let statement
-- in a do block, a typeclass instance defn, or bindings in an interface.
data CDefl                -- [CQual] part is the when clause used in an interface
                          -- binding, ie the explicit condition attached to each method
        = CLValueSign CDef [CQual]     -- let x :: T = e2 -- explicit type sig
        | CLValue Id [CClause] [CQual] -- let y = e2      -- no explicit type sig
        | CLMatch CPat CExpr           -- let [z] = e3
        deriving (CDefl -> CDefl -> Bool
(CDefl -> CDefl -> Bool) -> (CDefl -> CDefl -> Bool) -> Eq CDefl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CDefl -> CDefl -> Bool
== :: CDefl -> CDefl -> Bool
$c/= :: CDefl -> CDefl -> Bool
/= :: CDefl -> CDefl -> Bool
Eq, Eq CDefl
Eq CDefl =>
(CDefl -> CDefl -> Ordering)
-> (CDefl -> CDefl -> Bool)
-> (CDefl -> CDefl -> Bool)
-> (CDefl -> CDefl -> Bool)
-> (CDefl -> CDefl -> Bool)
-> (CDefl -> CDefl -> CDefl)
-> (CDefl -> CDefl -> CDefl)
-> Ord CDefl
CDefl -> CDefl -> Bool
CDefl -> CDefl -> Ordering
CDefl -> CDefl -> CDefl
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CDefl -> CDefl -> Ordering
compare :: CDefl -> CDefl -> Ordering
$c< :: CDefl -> CDefl -> Bool
< :: CDefl -> CDefl -> Bool
$c<= :: CDefl -> CDefl -> Bool
<= :: CDefl -> CDefl -> Bool
$c> :: CDefl -> CDefl -> Bool
> :: CDefl -> CDefl -> Bool
$c>= :: CDefl -> CDefl -> Bool
>= :: CDefl -> CDefl -> Bool
$cmax :: CDefl -> CDefl -> CDefl
max :: CDefl -> CDefl -> CDefl
$cmin :: CDefl -> CDefl -> CDefl
min :: CDefl -> CDefl -> CDefl
Ord, Int -> CDefl -> ShowS
[CDefl] -> ShowS
CDefl -> String
(Int -> CDefl -> ShowS)
-> (CDefl -> String) -> ([CDefl] -> ShowS) -> Show CDefl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CDefl -> ShowS
showsPrec :: Int -> CDefl -> ShowS
$cshow :: CDefl -> String
show :: CDefl -> String
$cshowList :: [CDefl] -> ShowS
showList :: [CDefl] -> ShowS
Show)

instance Pretty CDefl where
    pPrintPrec :: PrettyLevel -> Rational -> CDefl -> Doc
pPrintPrec PrettyLevel
d Rational
p (CLValueSign CDef
def [CQual]
me) = PrettyLevel -> [CQual] -> Doc -> Doc
optWhen PrettyLevel
d [CQual]
me (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Rational -> CDef -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p CDef
def
    pPrintPrec PrettyLevel
d Rational
p (CLValue Id
i [CClause]
cs [CQual]
me) = PrettyLevel -> [CQual] -> Doc -> Doc
optWhen PrettyLevel
d [CQual]
me (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc -> Doc -> Doc
($+$) ((CClause -> Doc) -> [CClause] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\ CClause
cl -> PrettyLevel -> Rational -> [Doc] -> CClause -> Doc
ppClause PrettyLevel
d Rational
p [PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i] CClause
cl Doc -> Doc -> Doc
<> String -> Doc
tString
";") [CClause]
cs)
    pPrintPrec PrettyLevel
d Rational
p (CLMatch CPat
pat CExpr
e) = PrettyLevel -> Rational -> [Doc] -> CClause -> Doc
ppClause PrettyLevel
d Rational
p [] ([CPat] -> [CQual] -> CExpr -> CClause
CClause [CPat
pat] [] CExpr
e)

instance HasPosition CDefl where
    getPosition :: CDefl -> Position
getPosition (CLValueSign CDef
d [CQual]
_) = CDef -> Position
forall a. HasPosition a => a -> Position
getPosition CDef
d
    getPosition (CLValue Id
i [CClause]
_ [CQual]
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i
    getPosition (CLMatch CPat
p CExpr
e) = (CPat, CExpr) -> Position
forall a. HasPosition a => a -> Position
getPosition (CPat
p, CExpr
e)

optWhen :: PDetail -> [CQual] -> Doc -> Doc
optWhen :: PrettyLevel -> [CQual] -> Doc -> Doc
optWhen PrettyLevel
_d [] Doc
s = Doc
s
optWhen  PrettyLevel
d [CQual]
qs Doc
s = Doc
s Doc -> Doc -> Doc
$+$ (String -> Doc
tString
"    " Doc -> Doc -> Doc
<> PrettyLevel -> [CQual] -> Doc
ppQuals PrettyLevel
d [CQual]
qs)

ppValueSign :: PDetail -> Id -> [TyVar] -> CQType -> [CClause] -> Doc
ppValueSign :: PrettyLevel -> Id -> [TyVar] -> CQType -> [CClause] -> Doc
ppValueSign PrettyLevel
d Id
i [] CQType
ty [CClause]
cs =
        (PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"::" Doc -> Doc -> Doc
<+> PrettyLevel -> CQType -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CQType
ty Doc -> Doc -> Doc
<> String -> Doc
tString
";") Doc -> Doc -> Doc
$+$
        (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc -> Doc -> Doc
($+$) ((CClause -> Doc) -> [CClause] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\ CClause
cl -> PrettyLevel -> Rational -> [Doc] -> CClause -> Doc
ppClause PrettyLevel
d Rational
0 [PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i] CClause
cl Doc -> Doc -> Doc
<> String -> Doc
tString
";") [CClause]
cs)
ppValueSign PrettyLevel
d Id
i [TyVar]
vs CQType
ty [CClause]
cs =
        (PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
":: /\\" Doc -> Doc -> Doc
<> [Doc] -> Doc
sep ((TyVar -> Doc) -> [TyVar] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> TyVar -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec)) [TyVar]
vs) Doc -> Doc -> Doc
<> String -> Doc
tString
"." Doc -> Doc -> Doc
<> PrettyLevel -> CQType -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CQType
ty Doc -> Doc -> Doc
<> String -> Doc
tString
";") Doc -> Doc -> Doc
$+$
        (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc -> Doc -> Doc
($+$) ((CClause -> Doc) -> [CClause] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\ CClause
cl -> PrettyLevel -> Rational -> [Doc] -> CClause -> Doc
ppClause PrettyLevel
d Rational
0 [PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i] CClause
cl Doc -> Doc -> Doc
<> String -> Doc
tString
";") [CClause]
cs)

ppClause :: PDetail -> Rational -> [Doc] -> CClause -> Doc
ppClause :: PrettyLevel -> Rational -> [Doc] -> CClause -> Doc
ppClause PrettyLevel
d Rational
_p [Doc]
xs (CClause [CPat]
ps [CQual]
mqs CExpr
e) =
        [Doc] -> Doc
sep [[Doc] -> Doc
sep ([Doc]
xs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (CPat -> Doc) -> [CPat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> CPat -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec)) [CPat]
ps) Doc -> Doc -> Doc
<> PrettyLevel -> [CQual] -> Doc
ppQuals PrettyLevel
d [CQual]
mqs Doc -> Doc -> Doc
<+> String -> Doc
t String
"= ",
                  Int -> Doc -> Doc
nest Int
4 (PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
e)]

-- Definition, local or global
data CDef
        = CDef Id CQType [CClause]                        -- before type checking
        | CDefT Id [TyVar] CQType [CClause]                -- after type checking, with type variables from the CQType
        deriving (CDef -> CDef -> Bool
(CDef -> CDef -> Bool) -> (CDef -> CDef -> Bool) -> Eq CDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CDef -> CDef -> Bool
== :: CDef -> CDef -> Bool
$c/= :: CDef -> CDef -> Bool
/= :: CDef -> CDef -> Bool
Eq, Eq CDef
Eq CDef =>
(CDef -> CDef -> Ordering)
-> (CDef -> CDef -> Bool)
-> (CDef -> CDef -> Bool)
-> (CDef -> CDef -> Bool)
-> (CDef -> CDef -> Bool)
-> (CDef -> CDef -> CDef)
-> (CDef -> CDef -> CDef)
-> Ord CDef
CDef -> CDef -> Bool
CDef -> CDef -> Ordering
CDef -> CDef -> CDef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CDef -> CDef -> Ordering
compare :: CDef -> CDef -> Ordering
$c< :: CDef -> CDef -> Bool
< :: CDef -> CDef -> Bool
$c<= :: CDef -> CDef -> Bool
<= :: CDef -> CDef -> Bool
$c> :: CDef -> CDef -> Bool
> :: CDef -> CDef -> Bool
$c>= :: CDef -> CDef -> Bool
>= :: CDef -> CDef -> Bool
$cmax :: CDef -> CDef -> CDef
max :: CDef -> CDef -> CDef
$cmin :: CDef -> CDef -> CDef
min :: CDef -> CDef -> CDef
Ord, Int -> CDef -> ShowS
[CDef] -> ShowS
CDef -> String
(Int -> CDef -> ShowS)
-> (CDef -> String) -> ([CDef] -> ShowS) -> Show CDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CDef -> ShowS
showsPrec :: Int -> CDef -> ShowS
$cshow :: CDef -> String
show :: CDef -> String
$cshowList :: [CDef] -> ShowS
showList :: [CDef] -> ShowS
Show)

instance Pretty CDef where
    pPrintPrec :: PrettyLevel -> Rational -> CDef -> Doc
pPrintPrec PrettyLevel
d Rational
_p (CDef  Id
i    CQType
ty [CClause]
cs) = PrettyLevel -> Id -> [TyVar] -> CQType -> [CClause] -> Doc
ppValueSign PrettyLevel
d Id
i [] CQType
ty [CClause]
cs
    pPrintPrec PrettyLevel
d Rational
_p (CDefT Id
i [TyVar]
vs CQType
ty [CClause]
cs) = PrettyLevel -> Id -> [TyVar] -> CQType -> [CClause] -> Doc
ppValueSign PrettyLevel
d Id
i [TyVar]
vs CQType
ty [CClause]
cs

instance HasPosition CDef where
    getPosition :: CDef -> Position
getPosition (CDef Id
i CQType
_ [CClause]
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i
    getPosition (CDefT Id
i [TyVar]
_ CQType
_ [CClause]
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i

-- Definition clause
-- each interface's definitions (within the module) correspond to one of these
data CClause
        = CClause [CPat]                -- arguments (including patterns)
                  [CQual]               -- qualifier on the args
                  CExpr                 -- the body
        deriving (CClause -> CClause -> Bool
(CClause -> CClause -> Bool)
-> (CClause -> CClause -> Bool) -> Eq CClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CClause -> CClause -> Bool
== :: CClause -> CClause -> Bool
$c/= :: CClause -> CClause -> Bool
/= :: CClause -> CClause -> Bool
Eq, Eq CClause
Eq CClause =>
(CClause -> CClause -> Ordering)
-> (CClause -> CClause -> Bool)
-> (CClause -> CClause -> Bool)
-> (CClause -> CClause -> Bool)
-> (CClause -> CClause -> Bool)
-> (CClause -> CClause -> CClause)
-> (CClause -> CClause -> CClause)
-> Ord CClause
CClause -> CClause -> Bool
CClause -> CClause -> Ordering
CClause -> CClause -> CClause
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CClause -> CClause -> Ordering
compare :: CClause -> CClause -> Ordering
$c< :: CClause -> CClause -> Bool
< :: CClause -> CClause -> Bool
$c<= :: CClause -> CClause -> Bool
<= :: CClause -> CClause -> Bool
$c> :: CClause -> CClause -> Bool
> :: CClause -> CClause -> Bool
$c>= :: CClause -> CClause -> Bool
>= :: CClause -> CClause -> Bool
$cmax :: CClause -> CClause -> CClause
max :: CClause -> CClause -> CClause
$cmin :: CClause -> CClause -> CClause
min :: CClause -> CClause -> CClause
Ord, Int -> CClause -> ShowS
[CClause] -> ShowS
CClause -> String
(Int -> CClause -> ShowS)
-> (CClause -> String) -> ([CClause] -> ShowS) -> Show CClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CClause -> ShowS
showsPrec :: Int -> CClause -> ShowS
$cshow :: CClause -> String
show :: CClause -> String
$cshowList :: [CClause] -> ShowS
showList :: [CClause] -> ShowS
Show)

instance Pretty CClause where
    pPrintPrec :: PrettyLevel -> Rational -> CClause -> Doc
pPrintPrec PrettyLevel
d Rational
p CClause
cl = PrettyLevel -> Rational -> [Doc] -> CClause -> Doc
ppClause PrettyLevel
d Rational
p [] CClause
cl

instance HasPosition CClause where
    getPosition :: CClause -> Position
getPosition (CClause [CPat]
ps [CQual]
qs CExpr
e) = ([CPat], [CQual], CExpr) -> Position
forall a. HasPosition a => a -> Position
getPosition ([CPat]
ps, [CQual]
qs, CExpr
e)

-- Pattern matching
data CQual
        = CQGen CType CPat CExpr
        | CQFilter CExpr
        deriving (CQual -> CQual -> Bool
(CQual -> CQual -> Bool) -> (CQual -> CQual -> Bool) -> Eq CQual
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CQual -> CQual -> Bool
== :: CQual -> CQual -> Bool
$c/= :: CQual -> CQual -> Bool
/= :: CQual -> CQual -> Bool
Eq, Eq CQual
Eq CQual =>
(CQual -> CQual -> Ordering)
-> (CQual -> CQual -> Bool)
-> (CQual -> CQual -> Bool)
-> (CQual -> CQual -> Bool)
-> (CQual -> CQual -> Bool)
-> (CQual -> CQual -> CQual)
-> (CQual -> CQual -> CQual)
-> Ord CQual
CQual -> CQual -> Bool
CQual -> CQual -> Ordering
CQual -> CQual -> CQual
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CQual -> CQual -> Ordering
compare :: CQual -> CQual -> Ordering
$c< :: CQual -> CQual -> Bool
< :: CQual -> CQual -> Bool
$c<= :: CQual -> CQual -> Bool
<= :: CQual -> CQual -> Bool
$c> :: CQual -> CQual -> Bool
> :: CQual -> CQual -> Bool
$c>= :: CQual -> CQual -> Bool
>= :: CQual -> CQual -> Bool
$cmax :: CQual -> CQual -> CQual
max :: CQual -> CQual -> CQual
$cmin :: CQual -> CQual -> CQual
min :: CQual -> CQual -> CQual
Ord, Int -> CQual -> ShowS
[CQual] -> ShowS
CQual -> String
(Int -> CQual -> ShowS)
-> (CQual -> String) -> ([CQual] -> ShowS) -> Show CQual
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CQual -> ShowS
showsPrec :: Int -> CQual -> ShowS
$cshow :: CQual -> String
show :: CQual -> String
$cshowList :: [CQual] -> ShowS
showList :: [CQual] -> ShowS
Show)

instance Pretty CQual where
        pPrintPrec :: PrettyLevel -> Rational -> CQual -> Doc
pPrintPrec PrettyLevel
d Rational
_p (CQGen CType
_ CPat
pa CExpr
e) = PrettyLevel -> CPat -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CPat
pa Doc -> Doc -> Doc
<+> String -> Doc
t String
"<-" Doc -> Doc -> Doc
<+> PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
e
        pPrintPrec PrettyLevel
d Rational
_p (CQFilter CExpr
e) = PrettyLevel -> CExpr -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CExpr
e

instance HasPosition CQual where
    getPosition :: CQual -> Position
getPosition (CQGen CType
_ CPat
p CExpr
_) = CPat -> Position
forall a. HasPosition a => a -> Position
getPosition CPat
p
    getPosition (CQFilter CExpr
e) = CExpr -> Position
forall a. HasPosition a => a -> Position
getPosition CExpr
e

ppQuals :: PDetail -> [CQual] -> Doc
ppQuals :: PrettyLevel -> [CQual] -> Doc
ppQuals PrettyLevel
_d [] = String -> Doc
tString
""
ppQuals  PrettyLevel
d [CQual]
qs = String -> Doc
tString
" when" Doc -> Doc -> Doc
<+> [Doc] -> Doc -> Doc
sepList ((CQual -> Doc) -> [CQual] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> CQual -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d) [CQual]
qs) (String -> Doc
tString
",")

ppOSummands :: PDetail -> [COriginalSummand] -> Doc
ppOSummands :: PrettyLevel -> COSummands -> Doc
ppOSummands PrettyLevel
d COSummands
cs = [Doc] -> Doc -> Doc
sepList ((COriginalSummand -> Doc) -> COSummands -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc)
-> (COriginalSummand -> Doc) -> COriginalSummand -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. COriginalSummand -> Doc
ppOCon) COSummands
cs) (String -> Doc
tString
" |")
  where ppOCon :: COriginalSummand -> Doc
ppOCon COriginalSummand
summand =
            let pp_name :: Doc
pp_name = case (COriginalSummand -> [Id]
cos_names COriginalSummand
summand) of
                            [Id
cn] -> PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
cn
                            [Id]
cns -> String -> Doc
text String
"(" Doc -> Doc -> Doc
<>
                                   [Doc] -> Doc -> Doc
sepList ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d) [Id]
cns) (String -> Doc
text String
",") Doc -> Doc -> Doc
<>
                                   String -> Doc
text String
")"
                pp_args :: [Doc]
pp_args = (CQType -> Doc) -> [CQType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> CQType -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec)) (COriginalSummand -> [CQType]
cos_arg_types COriginalSummand
summand)
                pp_encoding :: Doc
pp_encoding =
                    case COriginalSummand -> Maybe Integer
cos_tag_encoding COriginalSummand
summand of
                    Maybe Integer
Nothing -> Doc
empty
                    Just Integer
num ->
                        String -> Doc
text String
"{-# tag " Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> Integer -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 Integer
num Doc -> Doc -> Doc
<+> String -> Doc
text String
"#-}"
            in  [Doc] -> Doc
sep (Doc
pp_name Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc
pp_encoding Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
pp_args)

ppSummands :: PDetail -> [CInternalSummand] -> Doc
ppSummands :: PrettyLevel -> CSummands -> Doc
ppSummands PrettyLevel
d CSummands
cs = [Doc] -> Doc -> Doc
sepList ((CInternalSummand -> Doc) -> CSummands -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc)
-> (CInternalSummand -> Doc) -> CInternalSummand -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInternalSummand -> Doc
ppCon) CSummands
cs) (String -> Doc
tString
" |")
  where ppCon :: CInternalSummand -> Doc
ppCon CInternalSummand
summand =
            let pp_name :: Doc
pp_name = case (CInternalSummand -> [Id]
cis_names CInternalSummand
summand) of
                            [Id
cn] -> PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
cn
                            [Id]
cns -> String -> Doc
text String
"(" Doc -> Doc -> Doc
<>
                                   [Doc] -> Doc -> Doc
sepList ((Id -> Doc) -> [Id] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d) [Id]
cns) (String -> Doc
text String
",") Doc -> Doc -> Doc
<>
                                   String -> Doc
text String
")"
                pp_arg :: Doc
pp_arg = PrettyLevel -> Rational -> CType -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec) (CInternalSummand -> CType
cis_arg_type CInternalSummand
summand)
            in  [Doc] -> Doc
sep [Doc
pp_name, Doc
pp_arg]

data CPat
        = CPCon Id [CPat]
        -- Either a struct type or a constructor with named fields.
        -- The 'Maybe Bool' argument can indicate if it is specifically
        -- one or the other (True for struct), otherwise the typechecker
        -- will attempt to determine which is intended.
        | CPstruct (Maybe Bool) Id [(Id, CPat)]
        | CPVar Id
        | CPAs Id CPat
        | CPAny Position
        | CPLit CLiteral
        -- position, base, [(length, value or don't-care)] starting from MSB
        -- note that length is length in digits, not bits!
        | CPMixedLit Position Integer [(Integer, Maybe Integer)]
        -- used before operator parsing
        | CPOper [CPOp]
        -- generated by deriving code
        | CPCon1 Id Id CPat                        -- first Id is type of constructor
        -- After type checking
        | CPConTs Id Id [CType] [CPat]
        deriving (CPat -> CPat -> Bool
(CPat -> CPat -> Bool) -> (CPat -> CPat -> Bool) -> Eq CPat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CPat -> CPat -> Bool
== :: CPat -> CPat -> Bool
$c/= :: CPat -> CPat -> Bool
/= :: CPat -> CPat -> Bool
Eq, Eq CPat
Eq CPat =>
(CPat -> CPat -> Ordering)
-> (CPat -> CPat -> Bool)
-> (CPat -> CPat -> Bool)
-> (CPat -> CPat -> Bool)
-> (CPat -> CPat -> Bool)
-> (CPat -> CPat -> CPat)
-> (CPat -> CPat -> CPat)
-> Ord CPat
CPat -> CPat -> Bool
CPat -> CPat -> Ordering
CPat -> CPat -> CPat
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CPat -> CPat -> Ordering
compare :: CPat -> CPat -> Ordering
$c< :: CPat -> CPat -> Bool
< :: CPat -> CPat -> Bool
$c<= :: CPat -> CPat -> Bool
<= :: CPat -> CPat -> Bool
$c> :: CPat -> CPat -> Bool
> :: CPat -> CPat -> Bool
$c>= :: CPat -> CPat -> Bool
>= :: CPat -> CPat -> Bool
$cmax :: CPat -> CPat -> CPat
max :: CPat -> CPat -> CPat
$cmin :: CPat -> CPat -> CPat
min :: CPat -> CPat -> CPat
Ord, Int -> CPat -> ShowS
[CPat] -> ShowS
CPat -> String
(Int -> CPat -> ShowS)
-> (CPat -> String) -> ([CPat] -> ShowS) -> Show CPat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CPat -> ShowS
showsPrec :: Int -> CPat -> ShowS
$cshow :: CPat -> String
show :: CPat -> String
$cshowList :: [CPat] -> ShowS
showList :: [CPat] -> ShowS
Show)

instance Pretty CPat where
    pPrintPrec :: PrettyLevel -> Rational -> CPat -> Doc
pPrintPrec PrettyLevel
d Rational
p (CPVar Id
a) = PrettyLevel -> Rational -> Id -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p Id
a
    pPrintPrec PrettyLevel
d Rational
p (CPCon Id
i [CPat]
as) = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>(Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep (PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (CPat -> Doc) -> [CPat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> CPat -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec)) [CPat]
as)
    pPrintPrec PrettyLevel
_d Rational
_p (CPstruct Maybe Bool
_ Id
tyc []) | Id
tyc Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
idPrimUnit = String -> Doc
text String
"()"
    pPrintPrec  PrettyLevel
d Rational
_p (CPstruct Maybe Bool
_ Id
tyc [(Id
_, CPat
fst'), (Id
_, CPat
snd')]) | Id
tyc Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
idPrimPair =
        Bool -> Doc -> Doc
pparen Bool
True (PrettyLevel -> Rational -> CPat -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 CPat
fst' Doc -> Doc -> Doc
<> String -> Doc
tString
"," Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> CPat -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 CPat
snd')
    pPrintPrec PrettyLevel
d Rational
p (CPstruct Maybe Bool
_ Id
i [(Id, CPat)]
fs) = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>(Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i Doc -> Doc -> Doc
<+> String -> Doc
t String
"{" Doc -> Doc -> Doc
<+> [Doc] -> Doc
sep (((Id, CPat) -> Doc) -> [(Id, CPat)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Id, CPat) -> Doc
ppField' [(Id, CPat)]
fs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
tString
"}"])
        where ppField' :: (Id, CPat) -> Doc
ppField' (Id
i', CPVar Id
i'') | Id
i' Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
i'' = PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i' Doc -> Doc -> Doc
<> String -> Doc
tString
";"
              ppField' (Id
i', CPat
p') = PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i' Doc -> Doc -> Doc
<+> String -> Doc
t String
"=" Doc -> Doc -> Doc
<+> PrettyLevel -> CPat -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CPat
p' Doc -> Doc -> Doc
<> String -> Doc
tString
";"
    pPrintPrec  PrettyLevel
d Rational
_p (CPAs Id
a CPat
pp') = PrettyLevel -> Rational -> Id -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec) Id
a Doc -> Doc -> Doc
<> String -> Doc
tString
"@" Doc -> Doc -> Doc
<> PrettyLevel -> Rational -> CPat -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec) CPat
pp'
    pPrintPrec PrettyLevel
_d Rational
_p (CPAny Position
_) = String -> Doc
text String
"_"
    pPrintPrec  PrettyLevel
d  Rational
p (CPLit CLiteral
l) = PrettyLevel -> Rational -> CLiteral -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p CLiteral
l
    pPrintPrec PrettyLevel
_d Rational
_p (CPMixedLit Position
_ Integer
base [(Integer, Maybe Integer)]
ps) =
        let digitBits :: Integer
digitBits = Integer -> Integer
forall a b. (Integral a, Integral b) => a -> b
log2 Integer
base
            f :: (Integer, Maybe Integer) -> String
f (Integer
len, Just Integer
val) = Integer -> Integer -> Integer -> String
integerFormat (Integer
len Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
digitBits) Integer
base Integer
val
            f (Integer
len, Maybe Integer
Nothing)  = Integer -> Char -> String
forall i a. Integral i => i -> a -> [a]
L.genericReplicate (Integer
len Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
digitBits) Char
'?'
            pref :: a -> String
pref  a
2 = String
"0b"
            pref  a
8 = String
"0o"
            pref a
10 = String
""
            pref a
16 = String
"0x"
            pref a
x = ShowS
forall a. HasCallStack => String -> a
error (String
"bad radix to CPMixedLit: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x)
        in  String -> Doc
text (Integer -> String
forall {a}. (Eq a, Num a, Show a) => a -> String
pref Integer
base String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((Integer, Maybe Integer) -> String)
-> [(Integer, Maybe Integer)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Integer, Maybe Integer) -> String
f [(Integer, Maybe Integer)]
ps)
    pPrintPrec PrettyLevel
d Rational
p (CPOper [CPOp]
ops) = Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1) ([Doc] -> Doc
sep ((CPOp -> Doc) -> [CPOp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> CPOp -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1)) [CPOp]
ops))
    pPrintPrec PrettyLevel
d Rational
p (CPCon1 Id
_ Id
i CPat
a) = PrettyLevel -> Rational -> CPat -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p (Id -> [CPat] -> CPat
CPCon Id
i [CPat
a])
    ----
    pPrintPrec PrettyLevel
d Rational
p (CPConTs Id
_ Id
i [CType]
ts [CPat]
as) = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>(Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
1)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep (PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (CType -> Doc) -> [CType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CType -> Doc
forall {a}. Pretty a => a -> Doc
ppApArg [CType]
ts [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (CPat -> Doc) -> [CPat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> CPat -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec)) [CPat]
as)
        where ppApArg :: a -> Doc
ppApArg a
ty = String -> Doc
tString
"\183" Doc -> Doc -> Doc
<> PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPrec) a
ty

instance HasPosition CPat where
    getPosition :: CPat -> Position
getPosition (CPCon Id
c [CPat]
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
c
    getPosition (CPstruct Maybe Bool
_ Id
c [(Id, CPat)]
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
c
    getPosition (CPVar Id
i) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i
    getPosition (CPAs Id
i CPat
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i
    getPosition (CPAny Position
p) = Position
p
    getPosition (CPLit CLiteral
l) = CLiteral -> Position
forall a. HasPosition a => a -> Position
getPosition CLiteral
l
    getPosition (CPMixedLit Position
p Integer
_ [(Integer, Maybe Integer)]
_) = Position
p
    getPosition (CPOper [CPOp]
ps) = [CPOp] -> Position
forall a. HasPosition a => a -> Position
getPosition [CPOp]
ps
    getPosition (CPCon1 Id
_ Id
c CPat
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
c
    getPosition (CPConTs Id
_ Id
c [CType]
_ [CPat]
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
c

data CPOp
        = CPRand CPat
        | CPRator Int Id
        deriving (CPOp -> CPOp -> Bool
(CPOp -> CPOp -> Bool) -> (CPOp -> CPOp -> Bool) -> Eq CPOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CPOp -> CPOp -> Bool
== :: CPOp -> CPOp -> Bool
$c/= :: CPOp -> CPOp -> Bool
/= :: CPOp -> CPOp -> Bool
Eq, Eq CPOp
Eq CPOp =>
(CPOp -> CPOp -> Ordering)
-> (CPOp -> CPOp -> Bool)
-> (CPOp -> CPOp -> Bool)
-> (CPOp -> CPOp -> Bool)
-> (CPOp -> CPOp -> Bool)
-> (CPOp -> CPOp -> CPOp)
-> (CPOp -> CPOp -> CPOp)
-> Ord CPOp
CPOp -> CPOp -> Bool
CPOp -> CPOp -> Ordering
CPOp -> CPOp -> CPOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CPOp -> CPOp -> Ordering
compare :: CPOp -> CPOp -> Ordering
$c< :: CPOp -> CPOp -> Bool
< :: CPOp -> CPOp -> Bool
$c<= :: CPOp -> CPOp -> Bool
<= :: CPOp -> CPOp -> Bool
$c> :: CPOp -> CPOp -> Bool
> :: CPOp -> CPOp -> Bool
$c>= :: CPOp -> CPOp -> Bool
>= :: CPOp -> CPOp -> Bool
$cmax :: CPOp -> CPOp -> CPOp
max :: CPOp -> CPOp -> CPOp
$cmin :: CPOp -> CPOp -> CPOp
min :: CPOp -> CPOp -> CPOp
Ord, Int -> CPOp -> ShowS
[CPOp] -> ShowS
CPOp -> String
(Int -> CPOp -> ShowS)
-> (CPOp -> String) -> ([CPOp] -> ShowS) -> Show CPOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CPOp -> ShowS
showsPrec :: Int -> CPOp -> ShowS
$cshow :: CPOp -> String
show :: CPOp -> String
$cshowList :: [CPOp] -> ShowS
showList :: [CPOp] -> ShowS
Show)

instance Pretty CPOp where
    pPrintPrec :: PrettyLevel -> Rational -> CPOp -> Doc
pPrintPrec PrettyLevel
d Rational
_ (CPRand CPat
p) = PrettyLevel -> CPat -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d CPat
p
    pPrintPrec PrettyLevel
d Rational
_ (CPRator Int
_ Id
i) = PrettyLevel -> Id -> Doc
ppInfix PrettyLevel
d Id
i

instance HasPosition CPOp where
    getPosition :: CPOp -> Position
getPosition (CPRand CPat
p) = CPat -> Position
forall a. HasPosition a => a -> Position
getPosition CPat
p
    getPosition (CPRator Int
_ Id
i) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
i

ppInfix :: PDetail -> Id -> Doc
ppInfix :: PrettyLevel -> Id -> Doc
ppInfix PrettyLevel
_d Id
i =
    --case getIdString i of
    --s@(c:_) | isIdChar c -> t"`" <> t s <> t"`"
    --s -> t s
    let p :: FString
p = Id -> FString
getIdQual Id
i
        b :: FString
b = Id -> FString
getIdBase Id
i
    in if (FString
pFString -> FString -> Bool
forall a. Eq a => a -> a -> Bool
==FString
fsEmpty) then
              (case FString -> String
getFString FString
b of
               s :: String
s@(Char
c:String
_) | Char -> Bool
isIdChar Char
c -> String -> Doc
tString
"`" Doc -> Doc -> Doc
<> String -> Doc
t String
s Doc -> Doc -> Doc
<> String -> Doc
tString
"`"
               String
s -> String -> Doc
t String
s)
        else (String -> Doc
tString
"`" Doc -> Doc -> Doc
<> String -> Doc
t (FString -> String
getFString FString
p) Doc -> Doc -> Doc
<> String -> Doc
t String
"." Doc -> Doc -> Doc
<>
              (case FString -> String
getFString FString
b of
               s :: String
s@(Char
c:String
_) | Char -> Bool
isIdChar Char
c -> String -> Doc
t String
s
               String
s -> String -> Doc
t String
"(" Doc -> Doc -> Doc
<> String -> Doc
t String
s Doc -> Doc -> Doc
<> String -> Doc
tString
")") Doc -> Doc -> Doc
<> String -> Doc
tString
"`")

pp :: (Pretty a) => PDetail -> a -> Doc
pp :: forall a. Pretty a => PrettyLevel -> a -> Doc
pp PrettyLevel
d a
x = PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 a
x

t :: String -> Doc
t :: String -> Doc
t String
s = String -> Doc
text String
s

newtype CInclude
       = CInclude String
    deriving (CInclude -> CInclude -> Bool
(CInclude -> CInclude -> Bool)
-> (CInclude -> CInclude -> Bool) -> Eq CInclude
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CInclude -> CInclude -> Bool
== :: CInclude -> CInclude -> Bool
$c/= :: CInclude -> CInclude -> Bool
/= :: CInclude -> CInclude -> Bool
Eq, Eq CInclude
Eq CInclude =>
(CInclude -> CInclude -> Ordering)
-> (CInclude -> CInclude -> Bool)
-> (CInclude -> CInclude -> Bool)
-> (CInclude -> CInclude -> Bool)
-> (CInclude -> CInclude -> Bool)
-> (CInclude -> CInclude -> CInclude)
-> (CInclude -> CInclude -> CInclude)
-> Ord CInclude
CInclude -> CInclude -> Bool
CInclude -> CInclude -> Ordering
CInclude -> CInclude -> CInclude
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CInclude -> CInclude -> Ordering
compare :: CInclude -> CInclude -> Ordering
$c< :: CInclude -> CInclude -> Bool
< :: CInclude -> CInclude -> Bool
$c<= :: CInclude -> CInclude -> Bool
<= :: CInclude -> CInclude -> Bool
$c> :: CInclude -> CInclude -> Bool
> :: CInclude -> CInclude -> Bool
$c>= :: CInclude -> CInclude -> Bool
>= :: CInclude -> CInclude -> Bool
$cmax :: CInclude -> CInclude -> CInclude
max :: CInclude -> CInclude -> CInclude
$cmin :: CInclude -> CInclude -> CInclude
min :: CInclude -> CInclude -> CInclude
Ord, Int -> CInclude -> ShowS
[CInclude] -> ShowS
CInclude -> String
(Int -> CInclude -> ShowS)
-> (CInclude -> String) -> ([CInclude] -> ShowS) -> Show CInclude
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CInclude -> ShowS
showsPrec :: Int -> CInclude -> ShowS
$cshow :: CInclude -> String
show :: CInclude -> String
$cshowList :: [CInclude] -> ShowS
showList :: [CInclude] -> ShowS
Show)

instance Pretty CInclude where
    pPrintPrec :: PrettyLevel -> Rational -> CInclude -> Doc
pPrintPrec PrettyLevel
d Rational
p (CInclude String
s) = PrettyLevel -> Rational -> String -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p String
s

--------
-- Utilities

cApply :: Int -> CExpr -> [CExpr] -> CExpr
cApply :: Int -> CExpr -> [CExpr] -> CExpr
cApply Int
_n CExpr
e [] = CExpr
e
cApply Int
_n (CCon Id
i [CExpr]
es) [CExpr]
es' = Id -> [CExpr] -> CExpr
CCon Id
i ([CExpr]
es [CExpr] -> [CExpr] -> [CExpr]
forall a. [a] -> [a] -> [a]
++ [CExpr]
es')
cApply Int
_n (CConT Id
t' Id
i [CExpr]
es) [CExpr]
es' = Id -> Id -> [CExpr] -> CExpr
CConT Id
t' Id
i ([CExpr]
es [CExpr] -> [CExpr] -> [CExpr]
forall a. [a] -> [a] -> [a]
++ [CExpr]
es')
cApply Int
_n (CApply CExpr
e [CExpr]
es) [CExpr]
es' = CExpr -> [CExpr] -> CExpr
CApply CExpr
e ([CExpr]
es [CExpr] -> [CExpr] -> [CExpr]
forall a. [a] -> [a] -> [a]
++ [CExpr]
es')
cApply Int
_n (CTaskApply CExpr
e [CExpr]
es) [CExpr]
es' = CExpr -> [CExpr] -> CExpr
CTaskApply CExpr
e ([CExpr]
es [CExpr] -> [CExpr] -> [CExpr]
forall a. [a] -> [a] -> [a]
++ [CExpr]
es')
cApply Int
_n CExpr
e [CExpr]
as = CExpr -> [CExpr] -> CExpr
CApply CExpr
e [CExpr]
as

cVApply :: Id -> [CExpr] -> CExpr
cVApply :: Id -> [CExpr] -> CExpr
cVApply Id
i [CExpr]
_es | String -> Bool
isTaskName (Id -> String
getIdBaseString Id
i) =
    String -> CExpr
forall a. HasCallStack => String -> a
error (String -> CExpr) -> String -> CExpr
forall a b. (a -> b) -> a -> b
$ String
"cVApply to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Id -> String
forall a. Show a => a -> String
show Id
i) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
cVApply Id
i [CExpr]
es = Int -> CExpr -> [CExpr] -> CExpr
cApply Int
2 (Id -> CExpr
CVar Id
i) [CExpr]
es

-- tasks start with $ followed by a letter
isTaskName :: String -> Bool
isTaskName :: String -> Bool
isTaskName (Char
'$':Char
c:String
_) = Char -> Bool
isAlpha Char
c
isTaskName String
_ = Bool
False

getName :: CDefn -> Either Position Id
getName :: CDefn -> Either Position Id
getName (CValue Id
i [CClause]
_) = Id -> Either Position Id
forall a b. b -> Either a b
Right Id
i
getName (CValueSign (CDef Id
i CQType
_ [CClause]
_)) = Id -> Either Position Id
forall a b. b -> Either a b
Right Id
i
getName (CValueSign (CDefT Id
i [TyVar]
_ CQType
_ [CClause]
_)) = Id -> Either Position Id
forall a b. b -> Either a b
Right Id
i
getName (Cprimitive Id
i CQType
_) = Id -> Either Position Id
forall a b. b -> Either a b
Right Id
i
getName (CprimType IdK
i) = Id -> Either Position Id
forall a b. b -> Either a b
Right (Id -> Either Position Id) -> Id -> Either Position Id
forall a b. (a -> b) -> a -> b
$ IdK -> Id
iKName IdK
i
getName (CPragma Pragma
pr) = Position -> Either Position Id
forall a b. a -> Either a b
Left (Position -> Either Position Id) -> Position -> Either Position Id
forall a b. (a -> b) -> a -> b
$ Pragma -> Position
forall a. HasPosition a => a -> Position
getPosition Pragma
pr
getName (Cforeign { cforg_name :: CDefn -> Id
cforg_name = Id
i }) = Id -> Either Position Id
forall a b. b -> Either a b
Right Id
i
getName (Ctype IdK
i [Id]
_ CType
_) = Id -> Either Position Id
forall a b. b -> Either a b
Right (Id -> Either Position Id) -> Id -> Either Position Id
forall a b. (a -> b) -> a -> b
$ IdK -> Id
iKName IdK
i
getName (Cdata { cd_name :: CDefn -> IdK
cd_name = IdK
name }) = Id -> Either Position Id
forall a b. b -> Either a b
Right (Id -> Either Position Id) -> Id -> Either Position Id
forall a b. (a -> b) -> a -> b
$ IdK -> Id
iKName IdK
name
getName (Cstruct Bool
_ StructSubType
_ IdK
i [Id]
_ CFields
_ [CTypeclass]
_) = Id -> Either Position Id
forall a b. b -> Either a b
Right (Id -> Either Position Id) -> Id -> Either Position Id
forall a b. (a -> b) -> a -> b
$ IdK -> Id
iKName IdK
i
getName (Cclass Maybe Bool
_ [CPred]
_ IdK
i [Id]
_ CFunDeps
_ CFields
_) = Id -> Either Position Id
forall a b. b -> Either a b
Right (Id -> Either Position Id) -> Id -> Either Position Id
forall a b. (a -> b) -> a -> b
$ IdK -> Id
iKName IdK
i
getName (Cinstance CQType
qt [CDefl]
_) = Position -> Either Position Id
forall a b. a -> Either a b
Left (Position -> Either Position Id) -> Position -> Either Position Id
forall a b. (a -> b) -> a -> b
$ CQType -> Position
forall a. HasPosition a => a -> Position
getPosition CQType
qt
getName (CItype IdK
i [Id]
_ [Position]
_) = Id -> Either Position Id
forall a b. b -> Either a b
Right (Id -> Either Position Id) -> Id -> Either Position Id
forall a b. (a -> b) -> a -> b
$ IdK -> Id
iKName IdK
i
getName (CIclass Maybe Bool
_ [CPred]
_ IdK
i [Id]
_ CFunDeps
_ [Position]
_) = Id -> Either Position Id
forall a b. b -> Either a b
Right (Id -> Either Position Id) -> Id -> Either Position Id
forall a b. (a -> b) -> a -> b
$ IdK -> Id
iKName IdK
i
getName (CIinstance Id
_ CQType
qt) = Position -> Either Position Id
forall a b. a -> Either a b
Left (Position -> Either Position Id) -> Position -> Either Position Id
forall a b. (a -> b) -> a -> b
$ CQType -> Position
forall a. HasPosition a => a -> Position
getPosition CQType
qt
getName (CIValueSign Id
i CQType
_) = Id -> Either Position Id
forall a b. b -> Either a b
Right Id
i

iKName :: IdK -> Id
iKName :: IdK -> Id
iKName (IdK Id
i) = Id
i
iKName (IdKind Id
i Kind
_) = Id
i
iKName (IdPKind Id
i PartialKind
_) = Id
i