Skip to content

GitLab

Commit 08cc34f2 authored by Fredrik Wieczerkowski's avatar Fredrik Wieczerkowski
Browse files
Options

Revert everything since 'higher-rank-polymorphism' (!14)

parent 83978093
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 8132 additions and 11096 deletions
CHANGELOG.md
View file @ 08cc34f2
Change log for curry-frontend
=============================
Version 2.0.0
=============
* Implemented the "MonadFail-Proposal" for curry
(see <https://wiki.haskell.org/MonadFail_Proposal>)
* Data class (see <https://arxiv.org/abs/1908.10607>)
* RankNTypes
* Fixed bug with partially imported Typeclasses
* Fixed bug with parsing of empty blocks
* Fixed bug with re-export of record labels
Version 1.0.4
=============
* Fixed bug in type checking of instances
* Fixed bugs in deriving of `Bounded` instances.
Version 1.0.3
=============
......
data/currysource.css
View file @ 08cc34f2
:root {
--link-bg-color: lightyellow;
--line-number-color: grey;
--pragma-color: green;
--comment-color: green;
--keyword-color: blue;
--symbol-color: red;
--type-color: orange;
--cons-color: magenta;
--label-color: darkgreen;
--func-color: purple;
--ident-color: black;
--module-color: brown;
--number-color: teal;
--string-color: maroon;
--char-color: maroon;
color-scheme: light dark;
}
/* Use always white background */
body {
background : white;
color : black;
font-family: monospace;
text-size-adjust: none;
-moz-text-size-adjust: none;
-ms-text-size-adjust: none;
-webkit-text-size-adjust: none;
}
table {
border-collapse: collapse;
}
/* Hyperlinks */
a:link,
a:visited,
a:active {
background: var(--link-bg-color);
/* Show hyperlinks without text decoration, but in light yellow */
a:visited, a:link, a:active {
text-decoration: none;
background : lightyellow;
}
/* Line numbers */
.line-numbers {
border-right: 1px solid var(--line-number-color);
color: var(--line-number-color);
min-width: 5ch;
padding-right: 1em;
text-align: right;
.linenumbers {
width : 40px;
text-align : right;
color : grey;
padding-right: 10px;
border-right : 1px solid grey;
}
/* Source code */
.source-code {
padding-left: 1em;
.sourcecode {
padding-left: 10px;
}
/* Code highlighting */
.pragma { color: var(--pragma-color) }
.comment { color: var(--comment-color) }
.keyword { color: var(--keyword-color) }
.symbol { color: var(--symbol-color) }
.type { color: var(--type-color) }
.cons { color: var(--cons-color) }
.label { color: var(--label-color) }
.func { color: var(--func-color) }
.ident { color: var(--ident-color) }
.module { color: var(--module-color) }
.number { color: var(--number-color) }
.string { color: var(--string-color) }
.char { color: var(--char-color) }
@supports not (color-scheme: light dark) {
@media (prefers-color-scheme: dark) {
html {
background: hsl(0, 0%, 12%);
color: white;
}
}
}
@media (prefers-color-scheme: dark) {
:root {
--link-bg-color: hsl(0, 0%, 17%);
--pragma-color: hsl(0, 0%, 60%);
--comment-color: hsl(0, 0%, 60%);
--keyword-color: hsl(300, 66%, 70%);
--symbol-color: hsl(0, 66%, 70%);
--type-color: hsl(60, 66%, 70%);
--cons-color: hsl(330, 66%, 70%);
--label-color: hsl(240, 66%, 70%);
--func-color: hsl(200, 66%, 70%);
--ident-color: hsl(0, 0%, 85%);
--module-color: hsl(20, 66%, 70%);
--number-color: hsl(180, 66%, 70%);
--string-color: hsl(120, 66%, 70%);
--char-color: hsl(120, 66%, 70%);
}
}
.pragma { color : green }
.comment { color : green }
.keyword { color : blue }
.symbol { color : red }
.type { color : orange }
.cons { color : magenta }
.label { color : darkgreen }
.func { color : purple }
.ident { color : black }
.module { color : brown }
.number { color : teal }
.string { color : maroon }
.char { color : maroon }
src/Base/AnnotExpr.hs
View file @ 08cc34f2
......@@ -33,11 +33,11 @@ class QualAnnotExpr e where
-- variables cannot be computed independently for each declaration.
instance QualAnnotExpr Decl where
qafv m (FunctionDecl _ _ _ eqs) = concatMap (qafv m) eqs
qafv m (PatternDecl _ _ rhs) = qafv m rhs
qafv m (ClassDecl _ _ _ _ _ ds) = concatMap (qafv m) ds
qafv m (InstanceDecl _ _ _ _ _ ds) = concatMap (qafv m) ds
qafv _ _ = []
qafv m (FunctionDecl _ _ _ eqs) = concatMap (qafv m) eqs
qafv m (PatternDecl _ _ rhs) = qafv m rhs
qafv m (ClassDecl _ _ _ _ ds) = concatMap (qafv m) ds
qafv m (InstanceDecl _ _ _ _ ds) = concatMap (qafv m) ds
qafv _ _ = []
instance QualAnnotExpr Equation where
qafv m (Equation _ lhs rhs) = filterBv lhs $ qafv m lhs ++ qafv m rhs
......@@ -46,8 +46,8 @@ instance QualAnnotExpr Lhs where
qafv m = concatMap (qafv m) . snd . flatLhs
instance QualAnnotExpr Rhs where
qafv m (SimpleRhs _ _ e ds) = filterBv ds $ qafv m e ++ concatMap (qafv m) ds
qafv m (GuardedRhs _ _ es ds) =
qafv m (SimpleRhs _ e ds) = filterBv ds $ qafv m e ++ concatMap (qafv m) ds
qafv m (GuardedRhs _ es ds) =
filterBv ds $ concatMap (qafv m) es ++ concatMap (qafv m) ds
instance QualAnnotExpr CondExpr where
......@@ -75,11 +75,11 @@ instance QualAnnotExpr Expression where
qafv m (LeftSection _ e op) = qafv m op ++ qafv m e
qafv m (RightSection _ op e) = qafv m op ++ qafv m e
qafv m (Lambda _ ts e) = filterBv ts $ qafv m e
qafv m (Let _ _ ds e) =
qafv m (Let _ ds e) =
filterBv ds $ concatMap (qafv m) ds ++ qafv m e
qafv m (Do _ _ sts e) = foldr (qafvStmt m) (qafv m e) sts
qafv m (Do _ sts e) = foldr (qafvStmt m) (qafv m e) sts
qafv m (IfThenElse _ e1 e2 e3) = qafv m e1 ++ qafv m e2 ++ qafv m e3
qafv m (Case _ _ _ e alts) = qafv m e ++ concatMap (qafv m) alts
qafv m (Case _ _ e alts) = qafv m e ++ concatMap (qafv m) alts
qafvField :: QualAnnotExpr e => ModuleIdent -> Field (e Type) -> [(Type, Ident)]
qafvField m (Field _ _ t) = qafv m t
......@@ -88,9 +88,9 @@ qafvStmt :: ModuleIdent -> Statement Type -> [(Type, Ident)] -> [(Type, Ident)]
qafvStmt m st fvs = qafv m st ++ filterBv st fvs
instance QualAnnotExpr Statement where
qafv m (StmtExpr _ e) = qafv m e
qafv m (StmtDecl _ _ ds) = filterBv ds $ concatMap (qafv m) ds
qafv m (StmtBind _ _ e) = qafv m e
qafv m (StmtExpr _ e) = qafv m e
qafv m (StmtDecl _ ds) = filterBv ds $ concatMap (qafv m) ds
qafv m (StmtBind _ _ e) = qafv m e
instance QualAnnotExpr Alt where
qafv m (Alt _ t rhs) = filterBv t $ qafv m rhs
......
src/Base/CurryKinds.hs
View file @ 08cc34f2
......@@ -19,9 +19,9 @@ module Base.CurryKinds
( toKind, toKind', fromKind, fromKind', ppKind
) where
import Curry.Base.Pretty (Doc)
import Curry.Syntax.Pretty (pPrintPrec)
import Curry.Syntax.Type (KindExpr (..))
import Curry.Base.Pretty (Doc)
import Curry.Syntax.Pretty (ppKindExpr)
import Curry.Syntax.Type (KindExpr (..))
import Base.Kinds
......@@ -42,4 +42,4 @@ fromKind' k n | k == simpleKind n = Nothing
| otherwise = Just (fromKind k)
ppKind :: Kind -> Doc
ppKind = pPrintPrec 0 . fromKind
ppKind = ppKindExpr 0 . fromKind
src/Base/CurryTypes.hs
View file @ 08cc34f2
......@@ -30,7 +30,7 @@ module Base.CurryTypes
, fromType, fromQualType
, fromPred, fromQualPred, fromPredSet, fromQualPredSet, fromPredType
, fromQualPredType
, ppType, ppPred, ppPredSet, ppPredType
, ppType, ppPred, ppPredType, ppTypeScheme
) where
import Data.List (nub)
......@@ -38,10 +38,10 @@ import qualified Data.Map as Map (Map, fromList, lookup)
import qualified Data.Set as Set
import Curry.Base.Ident
import Curry.Base.Pretty (Doc, list, parens)
import Curry.Base.Pretty (Doc)
import Curry.Base.SpanInfo
import qualified Curry.Syntax as CS
import Curry.Syntax.Pretty (pPrint, pPrintPrec)
import Curry.Syntax.Pretty (ppConstraint, ppTypeExpr, ppQualTypeExpr)
import Base.Expr
import Base.Messages (internalError)
......@@ -76,11 +76,6 @@ toType' tvs (CS.ArrowType _ ty1 ty2) tys
| null tys = TypeArrow (toType' tvs ty1 []) (toType' tvs ty2 [])
| otherwise = internalError "Base.CurryTypes.toType': arrow type application"
toType' tvs (CS.ParenType _ ty) tys = toType' tvs ty tys
toType' tvs (CS.ContextType _ cx ty) tys
| null cx = toType' tvs ty tys
| otherwise = applyType (TypeContext (toPredSet' tvs cx)
(toType' tvs ty []))
tys
toType' tvs (CS.ForallType _ tvs' ty) tys
| null tvs' = toType' tvs ty tys
| otherwise = applyType (TypeForall (map (toVar tvs) tvs')
......@@ -116,41 +111,47 @@ toPredSet' tvs = Set.fromList . map (toPred' tvs)
toQualPredSet :: ModuleIdent -> [Ident] -> CS.Context -> PredSet
toQualPredSet m tvs = qualifyPredSet m . toPredSet tvs
toPredType :: [Ident] -> CS.TypeExpr -> Type
toPredType tvs ty = toPredType' (enumTypeVars tvs ty) ty
toPredType :: [Ident] -> CS.QualTypeExpr -> PredType
toPredType tvs qty = toPredType' (enumTypeVars tvs qty) qty
toPredType' :: Map.Map Ident Int -> CS.TypeExpr -> Type
toPredType' tvs (CS.ContextType _ cx ty) =
TypeContext (toPredSet' tvs cx) (toType' tvs ty [])
toPredType' tvs ty = TypeContext (toPredSet' tvs []) (toType' tvs ty [])
toPredType' :: Map.Map Ident Int -> CS.QualTypeExpr -> PredType
toPredType' tvs (CS.QualTypeExpr _ cx ty) =
PredType (toPredSet' tvs cx) (toType' tvs ty [])
toQualPredType :: ModuleIdent -> [Ident] -> CS.TypeExpr -> Type
toQualPredType m tvs = qualifyType m . toPredType tvs
toQualPredType :: ModuleIdent -> [Ident] -> CS.QualTypeExpr -> PredType
toQualPredType m tvs = qualifyPredType m . toPredType tvs
-- The function 'toConstrType' returns the type of a data or newtype
-- constructor. Hereby, it restricts the context to those type variables
-- which are free in the argument types.
toConstrType :: QualIdent -> [Ident] -> [CS.TypeExpr] -> Type
toConstrType tc tvs tys = toPredType tvs $
CS.ContextType NoSpanInfo [] ty'
where ty' = foldr (CS.ArrowType NoSpanInfo) ty0 tys
toConstrType :: QualIdent -> [Ident] -> CS.Context -> [CS.TypeExpr] -> PredType
toConstrType tc tvs cx tys = toPredType tvs $
CS.QualTypeExpr NoSpanInfo cx' ty'
where tvs' = nub (fv tys)
cx' = restrictContext tvs' cx
ty' = foldr (CS.ArrowType NoSpanInfo) ty0 tys
ty0 = foldl (CS.ApplyType NoSpanInfo)
(CS.ConstructorType NoSpanInfo tc)
(map (CS.VariableType NoSpanInfo) tvs)
restrictContext :: [Ident] -> CS.Context -> CS.Context
restrictContext tvs cx =
[CS.Constraint spi cls ty
| CS.Constraint spi cls ty <- cx, classVar ty `elem` tvs]
where classVar (CS.VariableType _ tv) = tv
classVar (CS.ApplyType _ ty _) = classVar ty
classVar _ = internalError "Base.CurryTypes.restrictContext.classVar"
-- The function 'toMethodType' returns the type of a type class method.
-- It adds the implicit type class constraint to the method's type signature
-- and ensures that the class' type variable is always assigned index 0.
toMethodType :: QualIdent -> Ident -> CS.TypeExpr -> Type
toMethodType qcls clsvar (CS.ContextType spi cx ty) =
toPredType [clsvar] (CS.ContextType spi cx' ty)
toMethodType :: QualIdent -> Ident -> CS.QualTypeExpr -> PredType
toMethodType qcls clsvar (CS.QualTypeExpr spi cx ty) =
toPredType [clsvar] (CS.QualTypeExpr spi cx' ty)
where cx' = CS.Constraint NoSpanInfo qcls
(CS.VariableType NoSpanInfo clsvar) : cx
toMethodType qcls clsvar ty =
toPredType [clsvar] (CS.ContextType NoSpanInfo cx' ty)
where cx' = [CS.Constraint NoSpanInfo qcls (CS.VariableType NoSpanInfo clsvar)]
fromType :: [Ident] -> Type -> CS.TypeExpr
fromType tvs ty = fromType' tvs ty []
......@@ -172,10 +173,9 @@ fromType' tvs (TypeArrow ty1 ty2) tys =
foldl (CS.ApplyType NoSpanInfo)
(CS.ArrowType NoSpanInfo (fromType tvs ty1) (fromType tvs ty2)) tys
fromType' tvs (TypeConstrained tys _) tys' = fromType' tvs (head tys) tys'
fromType' tvs (TypeContext ps ty) tys
= foldl (CS.ApplyType NoSpanInfo)
(CS.ContextType NoSpanInfo (fromPredSet tvs ps) (fromType tvs ty))
tys
fromType' _ (TypeSkolem k) tys =
foldl (CS.ApplyType NoSpanInfo)
(CS.VariableType NoSpanInfo $ mkIdent $ "_?" ++ show k) tys
fromType' tvs (TypeForall tvs' ty) tys
| null tvs' = fromType' tvs ty tys
| otherwise = foldl (CS.ApplyType NoSpanInfo)
......@@ -204,24 +204,23 @@ fromPredSet tvs = map (fromPred tvs) . Set.toAscList
fromQualPredSet :: ModuleIdent -> [Ident] -> PredSet -> CS.Context
fromQualPredSet m tvs = fromPredSet tvs . unqualifyPredSet m
fromPredType :: [Ident] -> Type -> CS.TypeExpr
fromPredType tvs (TypeContext ps ty) =
CS.ContextType NoSpanInfo (fromPredSet tvs ps) (fromType tvs ty)
fromPredType tvs ty = fromType tvs ty
fromPredType :: [Ident] -> PredType -> CS.QualTypeExpr
fromPredType tvs (PredType ps ty) =
CS.QualTypeExpr NoSpanInfo (fromPredSet tvs ps) (fromType tvs ty)
fromQualPredType :: ModuleIdent -> [Ident] -> Type -> CS.TypeExpr
fromQualPredType m tvs = fromPredType tvs . unqualifyType m
fromQualPredType :: ModuleIdent -> [Ident] -> PredType -> CS.QualTypeExpr
fromQualPredType m tvs = fromPredType tvs . unqualifyPredType m
-- The following functions implement pretty-printing for types.
ppType :: ModuleIdent -> Type -> Doc
ppType m = pPrintPrec 0 . fromQualType m identSupply
ppType m = ppTypeExpr 0 . fromQualType m identSupply
ppPred :: ModuleIdent -> Pred -> Doc
ppPred m = pPrint . fromQualPred m identSupply
ppPred m = ppConstraint . fromQualPred m identSupply
ppPredSet :: ModuleIdent -> PredSet -> Doc
ppPredSet m = parens . list . map (ppPred m) . Set.toList
ppPredType :: ModuleIdent -> PredType -> Doc
ppPredType m = ppQualTypeExpr . fromQualPredType m identSupply
ppPredType :: ModuleIdent -> Type -> Doc
ppPredType m = pPrintPrec 0 . fromQualPredType m identSupply
ppTypeScheme :: ModuleIdent -> TypeScheme -> Doc
ppTypeScheme m (ForAll _ pty) = ppPredType m pty
src/Base/Expr.hs
View file @ 08cc34f2
......@@ -58,20 +58,20 @@ instance QuantExpr e => QuantExpr [e] where
-- variables cannot be computed independently for each declaration.
instance QualExpr (Decl a) where
qfv m (FunctionDecl _ _ _ eqs) = qfv m eqs
qfv m (PatternDecl _ _ rhs) = qfv m rhs
qfv m (ClassDecl _ _ _ _ _ ds) = qfv m ds
qfv m (InstanceDecl _ _ _ _ _ ds) = qfv m ds
qfv _ _ = []
qfv m (FunctionDecl _ _ _ eqs) = qfv m eqs
qfv m (PatternDecl _ _ rhs) = qfv m rhs
qfv m (ClassDecl _ _ _ _ ds) = qfv m ds
qfv m (InstanceDecl _ _ _ _ ds) = qfv m ds
qfv _ _ = []
instance QuantExpr (Decl a) where
bv (TypeSig _ vs _) = vs
bv (FunctionDecl _ _ f _) = [f]
bv (ExternalDecl _ vs) = bv vs
bv (PatternDecl _ t _) = bv t
bv (FreeDecl _ vs) = bv vs
bv (ClassDecl _ _ _ _ _ ds) = concatMap methods ds
bv _ = []
bv (TypeSig _ vs _) = vs
bv (FunctionDecl _ _ f _) = [f]
bv (ExternalDecl _ vs) = bv vs
bv (PatternDecl _ t _) = bv t
bv (FreeDecl _ vs) = bv vs
bv (ClassDecl _ _ _ _ ds) = concatMap methods ds
bv _ = []
instance QualExpr (Equation a) where
qfv m (Equation _ lhs rhs) = filterBv lhs $ qfv m lhs ++ qfv m rhs
......@@ -83,8 +83,8 @@ instance QualExpr (Lhs a) where
qfv m lhs = qfv m $ snd $ flatLhs lhs
instance QualExpr (Rhs a) where
qfv m (SimpleRhs _ _ e ds) = filterBv ds $ qfv m e ++ qfv m ds
qfv m (GuardedRhs _ _ es ds) = filterBv ds $ qfv m es ++ qfv m ds
qfv m (SimpleRhs _ e ds) = filterBv ds $ qfv m e ++ qfv m ds
qfv m (GuardedRhs _ es ds) = filterBv ds $ qfv m es ++ qfv m ds
instance QualExpr (CondExpr a) where
qfv m (CondExpr _ g e) = qfv m g ++ qfv m e
......@@ -110,18 +110,18 @@ instance QualExpr (Expression a) where
qfv m (LeftSection _ e op) = qfv m op ++ qfv m e
qfv m (RightSection _ op e) = qfv m op ++ qfv m e
qfv m (Lambda _ ts e) = filterBv ts $ qfv m e
qfv m (Let _ _ ds e) = filterBv ds $ qfv m ds ++ qfv m e
qfv m (Do _ _ sts e) = foldr (qfvStmt m) (qfv m e) sts
qfv m (Let _ ds e) = filterBv ds $ qfv m ds ++ qfv m e
qfv m (Do _ sts e) = foldr (qfvStmt m) (qfv m e) sts
qfv m (IfThenElse _ e1 e2 e3) = qfv m e1 ++ qfv m e2 ++ qfv m e3
qfv m (Case _ _ _ e alts) = qfv m e ++ qfv m alts
qfv m (Case _ _ e alts) = qfv m e ++ qfv m alts
qfvStmt :: ModuleIdent -> (Statement a) -> [Ident] -> [Ident]
qfvStmt m st fvs = qfv m st ++ filterBv st fvs
instance QualExpr (Statement a) where
qfv m (StmtExpr _ e) = qfv m e
qfv m (StmtDecl _ _ ds) = filterBv ds $ qfv m ds
qfv m (StmtBind _ _ e) = qfv m e
qfv m (StmtExpr _ e) = qfv m e
qfv m (StmtDecl _ ds) = filterBv ds $ qfv m ds
qfv m (StmtBind _ _ e) = qfv m e
instance QualExpr (Alt a) where
qfv m (Alt _ t rhs) = filterBv t $ qfv m rhs
......@@ -136,9 +136,9 @@ instance QualExpr a => QualExpr (Field a) where
qfv m (Field _ _ t) = qfv m t
instance QuantExpr (Statement a) where
bv (StmtExpr _ _) = []
bv (StmtBind _ t _) = bv t
bv (StmtDecl _ _ ds) = bv ds
bv (StmtExpr _ _) = []
bv (StmtBind _ t _) = bv t
bv (StmtDecl _ ds) = bv ds
instance QualExpr (InfixOp a) where
qfv m (InfixOp a op) = qfv m $ Variable NoSpanInfo a op
......@@ -182,6 +182,12 @@ instance Expr Constraint where
instance QuantExpr Constraint where
bv _ = []
instance Expr QualTypeExpr where
fv (QualTypeExpr _ _ ty) = fv ty
instance QuantExpr QualTypeExpr where
bv (QualTypeExpr _ _ ty) = bv ty
instance Expr TypeExpr where
fv (ConstructorType _ _) = []
fv (ApplyType _ ty1 ty2) = fv ty1 ++ fv ty2
......@@ -190,7 +196,6 @@ instance Expr TypeExpr where
fv (ListType _ ty) = fv ty
fv (ArrowType _ ty1 ty2) = fv ty1 ++ fv ty2
fv (ParenType _ ty) = fv ty
fv (ContextType _ _ ty) = fv ty
fv (ForallType _ vs ty) = filter (`notElem` vs) $ fv ty
instance QuantExpr TypeExpr where
......@@ -201,7 +206,6 @@ instance QuantExpr TypeExpr where
bv (ListType _ ty) = bv ty
bv (ArrowType _ ty1 ty2) = bv ty1 ++ bv ty2
bv (ParenType _ ty) = bv ty
bv (ContextType _ _ ty) = bv ty
bv (ForallType _ tvs ty) = tvs ++ bv ty
filterBv :: QuantExpr e => e -> [Ident] -> [Ident]
......
src/Base/PrettyKinds.hs
View file @ 08cc34f2
......@@ -10,7 +10,7 @@
TODO
-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Base.PrettyKinds where
import Curry.Base.Pretty
......
src/Base/PrettyTypes.hs
View file @ 08cc34f2
......@@ -10,33 +10,39 @@
TODO
-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP #-}
module Base.PrettyTypes where
#if __GLASGOW_HASKELL__ >= 804
import Prelude hiding ((<>))
#endif
import Data.Maybe (fromMaybe)
import qualified Data.Set as Set (Set, toAscList)
import Curry.Base.Ident (identSupply)
import Curry.Base.Ident (identSupply)
import Curry.Base.Pretty
import Curry.Syntax.Pretty ()
import Curry.Syntax.Pretty
import Base.CurryTypes
import Base.Types
instance Pretty Type where
pPrint = pPrintPrec 0 . fromType identSupply
pPrint = ppTypeExpr 0 . fromType identSupply
instance Pretty Pred where
pPrint = pPrint . fromPred identSupply
pPrint = ppConstraint . fromPred identSupply
instance Pretty a => Pretty (Set.Set a) where
pPrint = parens . list . map pPrint . Set.toAscList
instance Pretty PredType where
pPrint = ppQualTypeExpr . fromPredType identSupply
instance Pretty DataConstr where
pPrint (DataConstr i tys) = pPrint i <+> hsep (map pPrint tys)
pPrint (RecordConstr i ls tys) = pPrint i
<+> braces (hsep (punctuate comma pLs))
pPrint (DataConstr i _ _ tys) = pPrint i <+> hsep (map pPrint tys)
pPrint (RecordConstr i _ _ ls tys) = pPrint i
<+> braces (hsep (punctuate comma pLs))
where
pLs = zipWith (\l ty -> pPrint l <+> colon <> colon <+> pPrint ty) ls tys
......@@ -44,3 +50,9 @@ instance Pretty ClassMethod where
pPrint (ClassMethod f mar pty) = pPrint f
<> text "/" <> int (fromMaybe 0 mar)
<+> colon <> colon <+> pPrint pty
instance Pretty TypeScheme where
pPrint (ForAll _ ty) = pPrint ty
instance Pretty ExistTypeScheme where
pPrint (ForAllExist _ _ ty) = pPrint ty
src/Base/Subst.hs
View file @ 08cc34f2
......@@ -19,7 +19,7 @@
module Base.Subst
( Subst (..), IntSubst (..), idSubst, singleSubst, bindSubst, unbindSubst
, substToList, compose, lookupSubst, substVar', isubstVar, restrictSubstTo
, substToList, compose, substVar', isubstVar, restrictSubstTo
) where
import qualified Data.Map as Map
......@@ -48,9 +48,6 @@ bindSubst v e (Subst comp sigma) = Subst comp $ Map.insert v e sigma
unbindSubst :: Ord v => v -> Subst v e -> Subst v e
unbindSubst v (Subst comp sigma) = Subst comp $ Map.delete v sigma