{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Language.Bluespec.Classic.AST.Type
( Type(..)
, TyVar(..)
, TyCon(..)
, TISort(..)
, StructSubType(..)
, CType
, Kind(..)
, PartialKind(..)
, CTypeclass(..)
, CPred(..)
, CQType(..)
, baseKVar
, cTNum
, isTConArrow
, isTConPair
, leftCon
) where
import Data.Char (chr)
import Text.PrettyPrint.HughesPJClass
import Language.Bluespec.Classic.AST.Builtin.Ids
import Language.Bluespec.Classic.AST.FString
import Language.Bluespec.Classic.AST.Id
import Language.Bluespec.Classic.AST.Position
import Language.Bluespec.Classic.AST.Pragma
import Language.Bluespec.Prelude
import Language.Bluespec.Pretty
import Language.Bluespec.Util
data Type = TVar TyVar
| TCon TyCon
| TAp Type Type
| TGen Position Int
| TDefMonad Position
deriving Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Type -> ShowS
showsPrec :: Int -> Type -> ShowS
$cshow :: Type -> String
show :: Type -> String
$cshowList :: [Type] -> ShowS
showList :: [Type] -> ShowS
Show
instance Eq Type where
Type
x == :: Type -> Type -> Bool
== Type
y = Type -> Type -> Ordering
cmp Type
x Type
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
instance Ord Type where
compare :: Type -> Type -> Ordering
compare Type
x Type
y = Type -> Type -> Ordering
cmp Type
x Type
y
instance Pretty Type where
pPrintPrec :: PrettyLevel -> Rational -> Type -> Doc
pPrintPrec PrettyLevel
_d Rational
_p (TCon (TyCon Id
unit Maybe Kind
_ TISort
_)) | Id
unit Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
idPrimUnit = String -> Doc
text String
"()"
pPrintPrec PrettyLevel
d Rational
_p (TCon TyCon
c) = PrettyLevel -> Rational -> TyCon -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 TyCon
c
pPrintPrec PrettyLevel
d Rational
_p (TVar TyVar
i) = PrettyLevel -> Rational -> TyVar -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 TyVar
i
pPrintPrec PrettyLevel
d Rational
p (TAp (TAp (TCon TyCon
pair) Type
a) Type
b) | TyCon -> Bool
isTConPair TyCon
pair =
Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
0) ([Doc] -> Doc
sep [PrettyLevel -> Rational -> Type -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 Type
a Doc -> Doc -> Doc
<> String -> Doc
text String
",", PrettyLevel -> Rational -> Type -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d (-Rational
1) Type
b])
pPrintPrec PrettyLevel
d Rational
p (TAp (TAp (TCon TyCon
arr) Type
a) Type
r) | TyCon -> Bool
isTConArrow TyCon
arr =
Bool -> Doc -> Doc
pparen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
8) ([Doc] -> Doc
sep [PrettyLevel -> Rational -> Type -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
9 Type
a Doc -> Doc -> Doc
<+> String -> Doc
text String
"->", PrettyLevel -> Rational -> Type -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
8 Type
r])
pPrintPrec PrettyLevel
d Rational
p (TAp Type
e Type
e') = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
9) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
sep [PrettyLevel -> Rational -> Type -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
9 Type
e, PrettyLevel -> Rational -> Type -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
10 Type
e']
pPrintPrec PrettyLevel
_d Rational
_p (TDefMonad Position
_) = String -> Doc
text (String
"TDefMonad")
pPrintPrec PrettyLevel
d Rational
p (TGen Position
_ Int
n) = Bool -> Doc -> Doc
pparen Bool
True (String -> Doc
text String
"TGen" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> Int -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p Int
n)
instance HasPosition Type where
getPosition :: Type -> Position
getPosition (TVar TyVar
var) = TyVar -> Position
forall a. HasPosition a => a -> Position
getPosition TyVar
var
getPosition (TCon TyCon
con) = TyCon -> Position
forall a. HasPosition a => a -> Position
getPosition TyCon
con
getPosition (TAp Type
f Type
a) = Type -> Position
forall a. HasPosition a => a -> Position
getPosition Type
f Position -> Position -> Position
`bestPosition` Type -> Position
forall a. HasPosition a => a -> Position
getPosition Type
a
getPosition (TGen Position
pos Int
_) = Position
pos
getPosition (TDefMonad Position
pos) = Position
pos
cTNum :: Integer -> Position -> CType
cTNum :: Integer -> Position -> Type
cTNum Integer
n Position
pos = TyCon -> Type
TCon (Integer -> Position -> TyCon
TyNum Integer
n Position
pos)
isTConArrow :: TyCon -> Bool
isTConArrow :: TyCon -> Bool
isTConArrow (TyCon Id
i Maybe Kind
_ TISort
_) = Id
i Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Position -> Id
idArrow Position
noPosition
isTConArrow TyCon
t = String -> Bool
forall a. HasCallStack => String -> a
error(String
"isTConArrow: not TCon " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TyCon -> String
forall a. Show a => a -> String
show TyCon
t)
isTConPair :: TyCon -> Bool
isTConPair :: TyCon -> Bool
isTConPair (TyCon Id
i Maybe Kind
_ TISort
_) = Id
i Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
idPrimPair
isTConPair TyCon
t = String -> Bool
forall a. HasCallStack => String -> a
error(String
"isTConPair: not TCon " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TyCon -> String
forall a. Show a => a -> String
show TyCon
t)
cmp :: Type -> Type -> Ordering
cmp :: Type -> Type -> Ordering
cmp (TAp Type
f1 Type
a1) (TAp Type
f2 Type
a2) = (Type, Type) -> (Type, Type) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Type
f1, Type
a1) (Type
f2, Type
a2)
cmp (TAp Type
_ Type
_) Type
_ = Ordering
LT
cmp (TCon TyCon
c1) (TCon TyCon
c2) = TyCon -> TyCon -> Ordering
forall a. Ord a => a -> a -> Ordering
compare TyCon
c1 TyCon
c2
cmp (TCon TyCon
_) (TAp Type
_ Type
_) = Ordering
GT
cmp (TCon TyCon
_) Type
_ = Ordering
LT
cmp (TVar TyVar
_) (TCon TyCon
_) = Ordering
GT
cmp (TVar TyVar
_) (TAp Type
_ Type
_) = Ordering
GT
cmp (TVar TyVar
v1) (TVar TyVar
v2) = TyVar -> TyVar -> Ordering
forall a. Ord a => a -> a -> Ordering
compare TyVar
v1 TyVar
v2
cmp (TVar TyVar
_) Type
_ = Ordering
LT
cmp (TGen Position
_ Int
i1) (TGen Position
_ Int
i2) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i1 Int
i2
cmp (TGen Position
_ Int
_) (TDefMonad Position
_) = Ordering
LT
cmp (TGen Position
_ Int
_) Type
_ = Ordering
GT
cmp (TDefMonad Position
_) (TDefMonad Position
_) = Ordering
EQ
cmp (TDefMonad Position
_) Type
_ = Ordering
GT
data TyVar = TyVar { TyVar -> Id
tv_name :: Id
, TyVar -> Int
tv_num :: Int
, TyVar -> Kind
tv_kind :: Kind
}
deriving Int -> TyVar -> ShowS
[TyVar] -> ShowS
TyVar -> String
(Int -> TyVar -> ShowS)
-> (TyVar -> String) -> ([TyVar] -> ShowS) -> Show TyVar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TyVar -> ShowS
showsPrec :: Int -> TyVar -> ShowS
$cshow :: TyVar -> String
show :: TyVar -> String
$cshowList :: [TyVar] -> ShowS
showList :: [TyVar] -> ShowS
Show
instance Eq TyVar where
TyVar Id
i Int
n Kind
_ == :: TyVar -> TyVar -> Bool
== TyVar Id
i' Int
n' Kind
_ = (Int
n, Id
i) (Int, Id) -> (Int, Id) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
n', Id
i')
instance Ord TyVar where
TyVar Id
i Int
n Kind
_ <= :: TyVar -> TyVar -> Bool
<= TyVar Id
i' Int
n' Kind
_ = (Int
n, Id
i) (Int, Id) -> (Int, Id) -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int
n', Id
i')
TyVar Id
i Int
n Kind
_ < :: TyVar -> TyVar -> Bool
< TyVar Id
i' Int
n' Kind
_ = (Int
n, Id
i) (Int, Id) -> (Int, Id) -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
n', Id
i')
TyVar Id
i Int
n Kind
_ >= :: TyVar -> TyVar -> Bool
>= TyVar Id
i' Int
n' Kind
_ = (Int
n, Id
i) (Int, Id) -> (Int, Id) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
n', Id
i')
TyVar Id
i Int
n Kind
_ > :: TyVar -> TyVar -> Bool
> TyVar Id
i' Int
n' Kind
_ = (Int
n, Id
i) (Int, Id) -> (Int, Id) -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
n', Id
i')
TyVar Id
i Int
n Kind
_ compare :: TyVar -> TyVar -> Ordering
`compare` TyVar Id
i' Int
n' Kind
_ = (Int
n, Id
i) (Int, Id) -> (Int, Id) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Int
n', Id
i')
instance Pretty TyVar where
pPrintPrec :: PrettyLevel -> Rational -> TyVar -> Doc
pPrintPrec PrettyLevel
d Rational
_ (TyVar Id
i Int
_ Kind
_) = PrettyLevel -> Id -> Doc
ppVarId PrettyLevel
d Id
i
instance HasPosition TyVar where
getPosition :: TyVar -> Position
getPosition (TyVar Id
name Int
_ Kind
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
name
data TyCon =
TyCon { TyCon -> Id
tcon_name :: Id
, TyCon -> Maybe Kind
tcon_kind :: (Maybe Kind)
, TyCon -> TISort
tcon_sort :: TISort
}
| TyNum { TyCon -> Integer
tynum_value :: Integer
, TyCon -> Position
tynum_pos :: Position
}
| TyStr { TyCon -> FString
tystr_value :: FString
, TyCon -> Position
tystr_pos :: Position
}
deriving Int -> TyCon -> ShowS
[TyCon] -> ShowS
TyCon -> String
(Int -> TyCon -> ShowS)
-> (TyCon -> String) -> ([TyCon] -> ShowS) -> Show TyCon
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TyCon -> ShowS
showsPrec :: Int -> TyCon -> ShowS
$cshow :: TyCon -> String
show :: TyCon -> String
$cshowList :: [TyCon] -> ShowS
showList :: [TyCon] -> ShowS
Show
instance Eq TyCon where
TyCon Id
i Maybe Kind
k TISort
_ == :: TyCon -> TyCon -> Bool
== TyCon Id
i' Maybe Kind
k' TISort
_ = Id -> Id -> Bool
qualEq Id
i Id
i' Bool -> Bool -> Bool
&& Maybe Kind
k Maybe Kind -> Maybe Kind -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Kind
k'
TyNum Integer
i Position
_ == TyNum Integer
i' Position
_ = Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
i'
TyStr FString
s Position
_ == TyStr FString
s' Position
_ = FString
s FString -> FString -> Bool
forall a. Eq a => a -> a -> Bool
== FString
s'
TyCon
_ == TyCon
_ = Bool
False
instance Ord TyCon where
TyCon Id
i Maybe Kind
k TISort
_ compare :: TyCon -> TyCon -> Ordering
`compare` TyCon Id
i' Maybe Kind
k' TISort
_ = (Id -> FString
getIdBase Id
i, Id -> FString
getIdQual Id
i, Maybe Kind
k) (FString, FString, Maybe Kind)
-> (FString, FString, Maybe Kind) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Id -> FString
getIdBase Id
i', Id -> FString
getIdQual Id
i', Maybe Kind
k')
TyCon Id
_ Maybe Kind
_ TISort
_ `compare` TyNum Integer
_ Position
_ = Ordering
LT
TyCon Id
_ Maybe Kind
_ TISort
_ `compare` TyStr FString
_ Position
_ = Ordering
LT
TyNum Integer
_ Position
_ `compare` TyCon Id
_ Maybe Kind
_ TISort
_ = Ordering
GT
TyNum Integer
i Position
_ `compare` TyNum Integer
i' Position
_ = Integer
i Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Integer
i'
TyNum Integer
_ Position
_ `compare` TyStr FString
_ Position
_ = Ordering
LT
TyStr FString
_ Position
_ `compare` TyCon Id
_ Maybe Kind
_ TISort
_ = Ordering
GT
TyStr FString
_ Position
_ `compare` TyNum Integer
_ Position
_ = Ordering
GT
TyStr FString
s Position
_ `compare` TyStr FString
s' Position
_ = FString
s FString -> FString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` FString
s'
instance Pretty TyCon where
pPrintPrec :: PrettyLevel -> Rational -> TyCon -> Doc
pPrintPrec PrettyLevel
d Rational
_ (TyCon Id
i Maybe Kind
_ TISort
_) = PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
i
pPrintPrec PrettyLevel
_d Rational
_ (TyNum Integer
i Position
_) = String -> Doc
text (Integer -> String
forall a. ToString a => a -> String
itos Integer
i)
pPrintPrec PrettyLevel
_d Rational
_ (TyStr FString
s Position
_) = String -> Doc
text (FString -> String
forall a. Show a => a -> String
show FString
s)
instance HasPosition TyCon where
getPosition :: TyCon -> Position
getPosition (TyCon Id
name Maybe Kind
_k TISort
_) = Id -> Position
forall a. HasPosition a => a -> Position
getPosition Id
name
getPosition (TyNum Integer
_ Position
pos) = Position
pos
getPosition (TyStr FString
_ Position
pos) = Position
pos
data TISort
=
TItype Integer Type
| TIdata { TISort -> [Id]
tidata_cons :: [Id]
, TISort -> Bool
tidata_enum :: Bool
}
| TIstruct StructSubType [Id]
| TIabstract
deriving (TISort -> TISort -> Bool
(TISort -> TISort -> Bool)
-> (TISort -> TISort -> Bool) -> Eq TISort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TISort -> TISort -> Bool
== :: TISort -> TISort -> Bool
$c/= :: TISort -> TISort -> Bool
/= :: TISort -> TISort -> Bool
Eq, Eq TISort
Eq TISort =>
(TISort -> TISort -> Ordering)
-> (TISort -> TISort -> Bool)
-> (TISort -> TISort -> Bool)
-> (TISort -> TISort -> Bool)
-> (TISort -> TISort -> Bool)
-> (TISort -> TISort -> TISort)
-> (TISort -> TISort -> TISort)
-> Ord TISort
TISort -> TISort -> Bool
TISort -> TISort -> Ordering
TISort -> TISort -> TISort
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 :: TISort -> TISort -> Ordering
compare :: TISort -> TISort -> Ordering
$c< :: TISort -> TISort -> Bool
< :: TISort -> TISort -> Bool
$c<= :: TISort -> TISort -> Bool
<= :: TISort -> TISort -> Bool
$c> :: TISort -> TISort -> Bool
> :: TISort -> TISort -> Bool
$c>= :: TISort -> TISort -> Bool
>= :: TISort -> TISort -> Bool
$cmax :: TISort -> TISort -> TISort
max :: TISort -> TISort -> TISort
$cmin :: TISort -> TISort -> TISort
min :: TISort -> TISort -> TISort
Ord, Int -> TISort -> ShowS
[TISort] -> ShowS
TISort -> String
(Int -> TISort -> ShowS)
-> (TISort -> String) -> ([TISort] -> ShowS) -> Show TISort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TISort -> ShowS
showsPrec :: Int -> TISort -> ShowS
$cshow :: TISort -> String
show :: TISort -> String
$cshowList :: [TISort] -> ShowS
showList :: [TISort] -> ShowS
Show)
instance Pretty TISort where
pPrintPrec :: PrettyLevel -> Rational -> TISort -> Doc
pPrintPrec PrettyLevel
d Rational
p (TItype Integer
n Type
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
$ String -> Doc
text String
"TItype" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> Integer -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 Integer
n Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> Type -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
1 Type
t
pPrintPrec PrettyLevel
d Rational
p (TIdata [Id]
is Bool
enum) = 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
text (if Bool
enum then String
"TIdata (enum)" else String
"TIdata") Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> [Id] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
1 [Id]
is
pPrintPrec PrettyLevel
d Rational
p (TIstruct StructSubType
ss [Id]
is) = 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
text String
"TIstruct" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> StructSubType -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
1 StructSubType
ss Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> [Id] -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
1 [Id]
is
pPrintPrec PrettyLevel
_d Rational
_p (TISort
TIabstract) = String -> Doc
text String
"TIabstract"
data StructSubType
= SStruct
| SClass
| SDataCon { StructSubType -> Id
sdatacon_id :: Id
, StructSubType -> Bool
sdatacon_named_fields :: Bool
}
| SInterface [IfcPragma]
| SPolyWrap { StructSubType -> Id
spolywrap_id :: Id
, StructSubType -> Maybe Id
spolywrap_ctor :: Maybe Id
, StructSubType -> Id
spolywrap_field :: Id
}
deriving (StructSubType -> StructSubType -> Bool
(StructSubType -> StructSubType -> Bool)
-> (StructSubType -> StructSubType -> Bool) -> Eq StructSubType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StructSubType -> StructSubType -> Bool
== :: StructSubType -> StructSubType -> Bool
$c/= :: StructSubType -> StructSubType -> Bool
/= :: StructSubType -> StructSubType -> Bool
Eq, Eq StructSubType
Eq StructSubType =>
(StructSubType -> StructSubType -> Ordering)
-> (StructSubType -> StructSubType -> Bool)
-> (StructSubType -> StructSubType -> Bool)
-> (StructSubType -> StructSubType -> Bool)
-> (StructSubType -> StructSubType -> Bool)
-> (StructSubType -> StructSubType -> StructSubType)
-> (StructSubType -> StructSubType -> StructSubType)
-> Ord StructSubType
StructSubType -> StructSubType -> Bool
StructSubType -> StructSubType -> Ordering
StructSubType -> StructSubType -> StructSubType
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 :: StructSubType -> StructSubType -> Ordering
compare :: StructSubType -> StructSubType -> Ordering
$c< :: StructSubType -> StructSubType -> Bool
< :: StructSubType -> StructSubType -> Bool
$c<= :: StructSubType -> StructSubType -> Bool
<= :: StructSubType -> StructSubType -> Bool
$c> :: StructSubType -> StructSubType -> Bool
> :: StructSubType -> StructSubType -> Bool
$c>= :: StructSubType -> StructSubType -> Bool
>= :: StructSubType -> StructSubType -> Bool
$cmax :: StructSubType -> StructSubType -> StructSubType
max :: StructSubType -> StructSubType -> StructSubType
$cmin :: StructSubType -> StructSubType -> StructSubType
min :: StructSubType -> StructSubType -> StructSubType
Ord, Int -> StructSubType -> ShowS
[StructSubType] -> ShowS
StructSubType -> String
(Int -> StructSubType -> ShowS)
-> (StructSubType -> String)
-> ([StructSubType] -> ShowS)
-> Show StructSubType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StructSubType -> ShowS
showsPrec :: Int -> StructSubType -> ShowS
$cshow :: StructSubType -> String
show :: StructSubType -> String
$cshowList :: [StructSubType] -> ShowS
showList :: [StructSubType] -> ShowS
Show)
instance Pretty StructSubType where
pPrintPrec :: PrettyLevel -> Rational -> StructSubType -> Doc
pPrintPrec PrettyLevel
_ Rational
_ StructSubType
ss = String -> Doc
text (StructSubType -> String
forall a. Show a => a -> String
show StructSubType
ss)
type CType = Type
leftCon :: CType -> Maybe Id
leftCon :: Type -> Maybe Id
leftCon (TAp Type
f Type
_) = Type -> Maybe Id
leftCon Type
f
leftCon (TCon (TyCon Id
i Maybe Kind
_ TISort
_)) = Id -> Maybe Id
forall a. a -> Maybe a
Just Id
i
leftCon Type
_ = Maybe Id
forall a. Maybe a
Nothing
data Kind = KStar
| KNum
| KStr
| Kfun Kind Kind
| KVar Int
deriving (Kind -> Kind -> Bool
(Kind -> Kind -> Bool) -> (Kind -> Kind -> Bool) -> Eq Kind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Kind -> Kind -> Bool
== :: Kind -> Kind -> Bool
$c/= :: Kind -> Kind -> Bool
/= :: Kind -> Kind -> Bool
Eq, Eq Kind
Eq Kind =>
(Kind -> Kind -> Ordering)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Kind)
-> (Kind -> Kind -> Kind)
-> Ord Kind
Kind -> Kind -> Bool
Kind -> Kind -> Ordering
Kind -> Kind -> Kind
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 :: Kind -> Kind -> Ordering
compare :: Kind -> Kind -> Ordering
$c< :: Kind -> Kind -> Bool
< :: Kind -> Kind -> Bool
$c<= :: Kind -> Kind -> Bool
<= :: Kind -> Kind -> Bool
$c> :: Kind -> Kind -> Bool
> :: Kind -> Kind -> Bool
$c>= :: Kind -> Kind -> Bool
>= :: Kind -> Kind -> Bool
$cmax :: Kind -> Kind -> Kind
max :: Kind -> Kind -> Kind
$cmin :: Kind -> Kind -> Kind
min :: Kind -> Kind -> Kind
Ord, Int -> Kind -> ShowS
[Kind] -> ShowS
Kind -> String
(Int -> Kind -> ShowS)
-> (Kind -> String) -> ([Kind] -> ShowS) -> Show Kind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Kind -> ShowS
showsPrec :: Int -> Kind -> ShowS
$cshow :: Kind -> String
show :: Kind -> String
$cshowList :: [Kind] -> ShowS
showList :: [Kind] -> ShowS
Show)
instance Pretty Kind where
pPrintPrec :: PrettyLevel -> Rational -> Kind -> Doc
pPrintPrec PrettyLevel
_ Rational
_ Kind
KStar = String -> Doc
text String
"*"
pPrintPrec PrettyLevel
_ Rational
_ Kind
KNum = String -> Doc
text String
"#"
pPrintPrec PrettyLevel
_ Rational
_ Kind
KStr = String -> Doc
text String
"$"
pPrintPrec PrettyLevel
d Rational
p (Kfun Kind
l Kind
r) = Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
9) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Rational -> Kind -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
10 Kind
l Doc -> Doc -> Doc
<+> String -> Doc
text String
"->" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> Kind -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
9 Kind
r
pPrintPrec PrettyLevel
_ Rational
_ (KVar Int
i) = String -> Doc
text (Int -> String
showKVar Int
i)
baseKVar :: Int
baseKVar :: Int
baseKVar = Int
1000
showKVar :: Int -> String
showKVar :: Int -> String
showKVar Int
v =
let
makeDigit :: Int -> Char
makeDigit Int
x = Int -> Char
chr (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
97)
showDigits :: Int -> String
showDigits :: Int -> String
showDigits Int
x | (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
26) = [Int -> Char
makeDigit Int
x]
showDigits Int
x = (Int -> String
showDigits (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
26)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int -> Char
makeDigit (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
26)]
in
if (Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
baseKVar)
then (Int -> String
forall a. ToString a => a -> String
itos Int
v)
else (Int -> String
showDigits (Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
baseKVar))
data PartialKind
= PKNoInfo
| PKStar
| PKNum
| PKStr
| PKfun PartialKind PartialKind
deriving (PartialKind -> PartialKind -> Bool
(PartialKind -> PartialKind -> Bool)
-> (PartialKind -> PartialKind -> Bool) -> Eq PartialKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PartialKind -> PartialKind -> Bool
== :: PartialKind -> PartialKind -> Bool
$c/= :: PartialKind -> PartialKind -> Bool
/= :: PartialKind -> PartialKind -> Bool
Eq, Eq PartialKind
Eq PartialKind =>
(PartialKind -> PartialKind -> Ordering)
-> (PartialKind -> PartialKind -> Bool)
-> (PartialKind -> PartialKind -> Bool)
-> (PartialKind -> PartialKind -> Bool)
-> (PartialKind -> PartialKind -> Bool)
-> (PartialKind -> PartialKind -> PartialKind)
-> (PartialKind -> PartialKind -> PartialKind)
-> Ord PartialKind
PartialKind -> PartialKind -> Bool
PartialKind -> PartialKind -> Ordering
PartialKind -> PartialKind -> PartialKind
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 :: PartialKind -> PartialKind -> Ordering
compare :: PartialKind -> PartialKind -> Ordering
$c< :: PartialKind -> PartialKind -> Bool
< :: PartialKind -> PartialKind -> Bool
$c<= :: PartialKind -> PartialKind -> Bool
<= :: PartialKind -> PartialKind -> Bool
$c> :: PartialKind -> PartialKind -> Bool
> :: PartialKind -> PartialKind -> Bool
$c>= :: PartialKind -> PartialKind -> Bool
>= :: PartialKind -> PartialKind -> Bool
$cmax :: PartialKind -> PartialKind -> PartialKind
max :: PartialKind -> PartialKind -> PartialKind
$cmin :: PartialKind -> PartialKind -> PartialKind
min :: PartialKind -> PartialKind -> PartialKind
Ord, Int -> PartialKind -> ShowS
[PartialKind] -> ShowS
PartialKind -> String
(Int -> PartialKind -> ShowS)
-> (PartialKind -> String)
-> ([PartialKind] -> ShowS)
-> Show PartialKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PartialKind -> ShowS
showsPrec :: Int -> PartialKind -> ShowS
$cshow :: PartialKind -> String
show :: PartialKind -> String
$cshowList :: [PartialKind] -> ShowS
showList :: [PartialKind] -> ShowS
Show)
instance Pretty PartialKind where
pPrintPrec :: PrettyLevel -> Rational -> PartialKind -> Doc
pPrintPrec PrettyLevel
_ Rational
_ PartialKind
PKNoInfo = String -> Doc
text String
"?"
pPrintPrec PrettyLevel
_ Rational
_ PartialKind
PKStar = String -> Doc
text String
"*"
pPrintPrec PrettyLevel
_ Rational
_ PartialKind
PKNum = String -> Doc
text String
"#"
pPrintPrec PrettyLevel
_ Rational
_ PartialKind
PKStr = String -> Doc
text String
"$"
pPrintPrec PrettyLevel
d Rational
p (PKfun PartialKind
l PartialKind
r) =
Bool -> Doc -> Doc
pparen (Rational
pRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
9) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ PrettyLevel -> Rational -> PartialKind -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
10 PartialKind
l Doc -> Doc -> Doc
<+> String -> Doc
text String
"->" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> PartialKind -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
9 PartialKind
r
newtype CTypeclass = CTypeclass Id
deriving (CTypeclass -> CTypeclass -> Bool
(CTypeclass -> CTypeclass -> Bool)
-> (CTypeclass -> CTypeclass -> Bool) -> Eq CTypeclass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CTypeclass -> CTypeclass -> Bool
== :: CTypeclass -> CTypeclass -> Bool
$c/= :: CTypeclass -> CTypeclass -> Bool
/= :: CTypeclass -> CTypeclass -> Bool
Eq, Eq CTypeclass
Eq CTypeclass =>
(CTypeclass -> CTypeclass -> Ordering)
-> (CTypeclass -> CTypeclass -> Bool)
-> (CTypeclass -> CTypeclass -> Bool)
-> (CTypeclass -> CTypeclass -> Bool)
-> (CTypeclass -> CTypeclass -> Bool)
-> (CTypeclass -> CTypeclass -> CTypeclass)
-> (CTypeclass -> CTypeclass -> CTypeclass)
-> Ord CTypeclass
CTypeclass -> CTypeclass -> Bool
CTypeclass -> CTypeclass -> Ordering
CTypeclass -> CTypeclass -> CTypeclass
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 :: CTypeclass -> CTypeclass -> Ordering
compare :: CTypeclass -> CTypeclass -> Ordering
$c< :: CTypeclass -> CTypeclass -> Bool
< :: CTypeclass -> CTypeclass -> Bool
$c<= :: CTypeclass -> CTypeclass -> Bool
<= :: CTypeclass -> CTypeclass -> Bool
$c> :: CTypeclass -> CTypeclass -> Bool
> :: CTypeclass -> CTypeclass -> Bool
$c>= :: CTypeclass -> CTypeclass -> Bool
>= :: CTypeclass -> CTypeclass -> Bool
$cmax :: CTypeclass -> CTypeclass -> CTypeclass
max :: CTypeclass -> CTypeclass -> CTypeclass
$cmin :: CTypeclass -> CTypeclass -> CTypeclass
min :: CTypeclass -> CTypeclass -> CTypeclass
Ord, Int -> CTypeclass -> ShowS
[CTypeclass] -> ShowS
CTypeclass -> String
(Int -> CTypeclass -> ShowS)
-> (CTypeclass -> String)
-> ([CTypeclass] -> ShowS)
-> Show CTypeclass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CTypeclass -> ShowS
showsPrec :: Int -> CTypeclass -> ShowS
$cshow :: CTypeclass -> String
show :: CTypeclass -> String
$cshowList :: [CTypeclass] -> ShowS
showList :: [CTypeclass] -> ShowS
Show, PrettyLevel -> [CTypeclass] -> Doc
PrettyLevel -> Rational -> CTypeclass -> Doc
CTypeclass -> Doc
(PrettyLevel -> Rational -> CTypeclass -> Doc)
-> (CTypeclass -> Doc)
-> (PrettyLevel -> [CTypeclass] -> Doc)
-> Pretty CTypeclass
forall a.
(PrettyLevel -> Rational -> a -> Doc)
-> (a -> Doc) -> (PrettyLevel -> [a] -> Doc) -> Pretty a
$cpPrintPrec :: PrettyLevel -> Rational -> CTypeclass -> Doc
pPrintPrec :: PrettyLevel -> Rational -> CTypeclass -> Doc
$cpPrint :: CTypeclass -> Doc
pPrint :: CTypeclass -> Doc
$cpPrintList :: PrettyLevel -> [CTypeclass] -> Doc
pPrintList :: PrettyLevel -> [CTypeclass] -> Doc
Pretty, CTypeclass -> Position
(CTypeclass -> Position) -> HasPosition CTypeclass
forall a. (a -> Position) -> HasPosition a
$cgetPosition :: CTypeclass -> Position
getPosition :: CTypeclass -> Position
HasPosition)
data CPred = CPred { CPred -> CTypeclass
cpred_tc :: CTypeclass
, CPred -> [Type]
cpred_args :: [CType]
}
deriving (CPred -> CPred -> Bool
(CPred -> CPred -> Bool) -> (CPred -> CPred -> Bool) -> Eq CPred
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CPred -> CPred -> Bool
== :: CPred -> CPred -> Bool
$c/= :: CPred -> CPred -> Bool
/= :: CPred -> CPred -> Bool
Eq, Eq CPred
Eq CPred =>
(CPred -> CPred -> Ordering)
-> (CPred -> CPred -> Bool)
-> (CPred -> CPred -> Bool)
-> (CPred -> CPred -> Bool)
-> (CPred -> CPred -> Bool)
-> (CPred -> CPred -> CPred)
-> (CPred -> CPred -> CPred)
-> Ord CPred
CPred -> CPred -> Bool
CPred -> CPred -> Ordering
CPred -> CPred -> CPred
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 :: CPred -> CPred -> Ordering
compare :: CPred -> CPred -> Ordering
$c< :: CPred -> CPred -> Bool
< :: CPred -> CPred -> Bool
$c<= :: CPred -> CPred -> Bool
<= :: CPred -> CPred -> Bool
$c> :: CPred -> CPred -> Bool
> :: CPred -> CPred -> Bool
$c>= :: CPred -> CPred -> Bool
>= :: CPred -> CPred -> Bool
$cmax :: CPred -> CPred -> CPred
max :: CPred -> CPred -> CPred
$cmin :: CPred -> CPred -> CPred
min :: CPred -> CPred -> CPred
Ord, Int -> CPred -> ShowS
[CPred] -> ShowS
CPred -> String
(Int -> CPred -> ShowS)
-> (CPred -> String) -> ([CPred] -> ShowS) -> Show CPred
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CPred -> ShowS
showsPrec :: Int -> CPred -> ShowS
$cshow :: CPred -> String
show :: CPred -> String
$cshowList :: [CPred] -> ShowS
showList :: [CPred] -> ShowS
Show)
instance Pretty CPred where
pPrintPrec :: PrettyLevel -> Rational -> CPred -> Doc
pPrintPrec PrettyLevel
d Rational
_p (CPred (CTypeclass Id
c) []) = PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
c
pPrintPrec PrettyLevel
d Rational
_p (CPred (CTypeclass Id
c) [Type]
ts) = PrettyLevel -> Id -> Doc
ppConId PrettyLevel
d Id
c Doc -> Doc -> Doc
<+> [Doc] -> Doc
sep ((Type -> Doc) -> [Type] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> Type -> 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
maxPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))) [Type]
ts)
instance HasPosition CPred where
getPosition :: CPred -> Position
getPosition (CPred CTypeclass
c [Type]
ts) = (CTypeclass, [Type]) -> Position
forall a. HasPosition a => a -> Position
getPosition (CTypeclass
c, [Type]
ts)
data CQType = CQType [CPred] CType
deriving (CQType -> CQType -> Bool
(CQType -> CQType -> Bool)
-> (CQType -> CQType -> Bool) -> Eq CQType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CQType -> CQType -> Bool
== :: CQType -> CQType -> Bool
$c/= :: CQType -> CQType -> Bool
/= :: CQType -> CQType -> Bool
Eq, Eq CQType
Eq CQType =>
(CQType -> CQType -> Ordering)
-> (CQType -> CQType -> Bool)
-> (CQType -> CQType -> Bool)
-> (CQType -> CQType -> Bool)
-> (CQType -> CQType -> Bool)
-> (CQType -> CQType -> CQType)
-> (CQType -> CQType -> CQType)
-> Ord CQType
CQType -> CQType -> Bool
CQType -> CQType -> Ordering
CQType -> CQType -> CQType
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 :: CQType -> CQType -> Ordering
compare :: CQType -> CQType -> Ordering
$c< :: CQType -> CQType -> Bool
< :: CQType -> CQType -> Bool
$c<= :: CQType -> CQType -> Bool
<= :: CQType -> CQType -> Bool
$c> :: CQType -> CQType -> Bool
> :: CQType -> CQType -> Bool
$c>= :: CQType -> CQType -> Bool
>= :: CQType -> CQType -> Bool
$cmax :: CQType -> CQType -> CQType
max :: CQType -> CQType -> CQType
$cmin :: CQType -> CQType -> CQType
min :: CQType -> CQType -> CQType
Ord, Int -> CQType -> ShowS
[CQType] -> ShowS
CQType -> String
(Int -> CQType -> ShowS)
-> (CQType -> String) -> ([CQType] -> ShowS) -> Show CQType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CQType -> ShowS
showsPrec :: Int -> CQType -> ShowS
$cshow :: CQType -> String
show :: CQType -> String
$cshowList :: [CQType] -> ShowS
showList :: [CQType] -> ShowS
Show)
instance Pretty CQType where
pPrintPrec :: PrettyLevel -> Rational -> CQType -> Doc
pPrintPrec PrettyLevel
d Rational
p (CQType [] Type
ct) = PrettyLevel -> Rational -> Type -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
p Type
ct
pPrintPrec PrettyLevel
d Rational
_p (CQType [CPred]
preds Type
ct) = [Doc] -> Doc
sep [String -> Doc
text 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
text String
",") Doc -> Doc -> Doc
<> String -> Doc
text String
")" Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>", PrettyLevel -> Rational -> Type -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
d Rational
0 Type
ct]
instance HasPosition CQType where
getPosition :: CQType -> Position
getPosition (CQType [CPred]
ps Type
t) = Type -> Position
forall a. HasPosition a => a -> Position
getPosition Type
t Position -> Position -> Position
`bestPosition` [CPred] -> Position
forall a. HasPosition a => a -> Position
getPosition [CPred]
ps