WIP open recursion for typewip/open-recursion-type

6 files changed, 319 insertions, 139 deletions

diff --git a/compiler/GHC/Core/TyCo/Rep.hs b/compiler/GHC/Core/TyCo/Rep.hs
index fae7c7de19..3cfe193420 100644
--- a/compiler/GHC/Core/TyCo/Rep.hs
+++ b/compiler/GHC/Core/TyCo/Rep.hs
@@ -1,5 +1,5 @@
-
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 {-# OPTIONS_HADDOCK not-home #-}
 
@@ -26,7 +26,19 @@ Note [The Type-related module hierarchy]
 module GHC.Core.TyCo.Rep (
 
         -- * Types
-        Type(..),
+        module GHC.Core.TyCo.Rep.Open,
+        Type0,
+        Type
+          ( Type'
+          , TyVarTy
+          , AppTy
+          , TyConApp
+          , ForAllTy
+          , FunTy, ft_af, ft_mult, ft_arg, ft_res
+          , LitTy
+          , CastTy
+          , CoercionTy
+          ),
 
         TyLit(..),
         KindOrType, Kind,
@@ -80,6 +92,9 @@ import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprType, pprCo, pprTyLit )
 
    -- Transitively pulls in a LOT of stuff, better to break the loop
 
+-- open abstract:
+import GHC.Core.TyCo.Rep.Open
+
 -- friends:
 import GHC.Iface.Type
 import GHC.Types.Var
@@ -113,72 +128,55 @@ type KindOrType = Type -- See Note [Arguments to type constructors]
 -- | The key type representing kinds in the compiler.
 type Kind = Type
 
--- If you edit this type, you may need to update the GHC formalism
--- See Note [GHC Formalism] in GHC.Core.Lint
-data Type
-  -- See Note [Non-trivial definitional equality]
-  = TyVarTy Var -- ^ Vanilla type or kind variable (*never* a coercion variable)
-
-  | AppTy
-        Type
-        Type            -- ^ Type application to something other than a 'TyCon'. Parameters:
-                        --
-                        --  1) Function: must /not/ be a 'TyConApp' or 'CastTy',
-                        --     must be another 'AppTy', or 'TyVarTy'
-                        --     See Note [Respecting definitional equality] \(EQ1) about the
-                        --     no 'CastTy' requirement
-                        --
-                        --  2) Argument type
-
-  | TyConApp
-        TyCon
-        [KindOrType]    -- ^ Application of a 'TyCon', including newtypes /and/ synonyms.
-                        -- Invariant: saturated applications of 'FunTyCon' must
-                        -- use 'FunTy' and saturated synonyms must use their own
-                        -- constructors. However, /unsaturated/ 'FunTyCon's
-                        -- do appear as 'TyConApp's.
-                        -- Parameters:
-                        --
-                        -- 1) Type constructor being applied to.
-                        --
-                        -- 2) Type arguments. Might not have enough type arguments
-                        --    here to saturate the constructor.
-                        --    Even type synonyms are not necessarily saturated;
-                        --    for example unsaturated type synonyms
-                        --    can appear as the right hand side of a type synonym.
-
-  | ForAllTy
-        {-# UNPACK #-} !TyCoVarBinder
-        Type            -- ^ A Π type.
-             -- INVARIANT: If the binder is a coercion variable, it must
-             -- be mentioned in the Type. See
-             -- Note [Unused coercion variable in ForAllTy]
-
-  | FunTy      -- ^ FUN m t1 t2   Very common, so an important special case
-                -- See Note [Function types]
-     { ft_af  :: AnonArgFlag    -- Is this (->) or (=>)?
-     , ft_mult :: Mult          -- Multiplicity
-     , ft_arg :: Type           -- Argument type
-     , ft_res :: Type }         -- Result type
-
-  | LitTy TyLit     -- ^ Type literals are similar to type constructors.
-
-  | CastTy
-        Type
-        KindCoercion  -- ^ A kind cast. The coercion is always nominal.
-                      -- INVARIANT: The cast is never reflexive \(EQ2)
-                      -- INVARIANT: The Type is not a CastTy (use TransCo instead) \(EQ3)
-                      -- INVARIANT: The Type is not a ForAllTy over a tyvar \(EQ4)
-                      -- See Note [Respecting definitional equality]
-
-  | CoercionTy
-        Coercion    -- ^ Injection of a Coercion into a type
-                    -- This should only ever be used in the RHS of an AppTy,
-                    -- in the list of a TyConApp, when applying a promoted
-                    -- GADT data constructor
+-- | Haskell Type abstract syntax layer
+--
+-- The "mostly saturated" tycon is useful in a few places.
+type Type0 t = TypeF Var TyCoVar TyCon TyLit Coercion KindCoercion t [t] t
 
+-- | Haskell Type abstract syntax
+-- TODO rename "Type'", a crude way to get around core conflict
+newtype Type = Type' (Type0 Type)
   deriving Data.Data
 
+{-# COMPLETE TyVarTy, AppTy, TyConApp, ForAllTy, FunTy, LitTy, CastTy, CoercionTy #-}
+
+pattern TyVarTy :: Var -> Type
+pattern TyVarTy v = Type' (TyVarTyF v)
+
+pattern AppTy :: Type -> Type -> Type
+pattern AppTy f a = Type' (AppTyF f a)
+
+pattern TyConApp:: TyCon -> [Type] -> Type
+pattern TyConApp f as = Type' (TyConAppF f as)
+
+pattern ForAllTy :: TyCoVarBinder -> Type -> Type
+pattern ForAllTy b t = Type' (ForAllTyF b t)
+
+pattern FunTy :: AnonArgFlag -> Mult -> Type -> Type -> Type
+-- | Is this (->) or (=>)?
+ft_af :: _
+-- | Multiplicity
+ft_mult :: _
+-- | Argument type
+ft_arg :: _
+-- | Result type
+ft_res :: _
+pattern FunTy { ft_af, ft_mult, ft_arg, ft_res } = Type'
+  (FunTyF { ftf_af = ft_af
+          , ftf_mult = ft_mult
+          , ftf_arg = ft_arg
+          , ftf_res = ft_res
+          }) 
+
+pattern LitTy :: TyLit -> Type
+pattern LitTy l = Type' (LitTyF l)
+
+pattern CastTy :: Type -> Coercion -> Type
+pattern CastTy t c = Type' (CastTyF t c)
+
+pattern CoercionTy :: KindCoercion -> Type
+pattern CoercionTy kc = Type' (CoercionTyF kc)
+
 instance Outputable Type where
   ppr = pprType
 
@@ -1047,6 +1045,7 @@ mkForAllTy tv vis ty = ForAllTy (Bndr tv vis) ty
 
 -- | Wraps foralls over the type using the provided 'TyCoVar's from left to right
 mkForAllTys :: [TyCoVarBinder] -> Type -> Type
+
 mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
 
 -- | Wraps foralls over the type using the provided 'InvisTVBinder's from left to right
diff --git a/compiler/GHC/Core/TyCo/Rep/Open.hs b/compiler/GHC/Core/TyCo/Rep/Open.hs
new file mode 100644
index 0000000000..a997b27df9
--- /dev/null
+++ b/compiler/GHC/Core/TyCo/Rep/Open.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE LambdaCase #-}
+module GHC.Core.TyCo.Rep.Open
+  ( TypeF
+      ( TyVarTyF
+      , AppTyF
+      , TyConAppF
+      , ForAllTyF
+      , LitTyF
+      , CastTyF
+      , CoercionTyF
+      , FunTyF
+      , ftf_af
+      , ftf_mult
+      , ftf_arg
+      , ftf_res
+      )  -- Export the type synonym FunTy too
+  ) where
+
+import GHC.Prelude
+
+-- GHC
+import GHC.Types.Var.ArgFlag
+import GHC.Types.Var.Binder
+
+import Data.Bifunctor
+import Data.Bifoldable
+import Data.Bitraversable
+import Data.Functor.Identity
+import qualified Data.Data as Data hiding ( TyCon )
+
+-- | Parametized single layer of type abstract syntax.
+--
+-- With different paramters, it is the "true" abstract syntax, a component of
+-- some serialization formats, and perhaps other uses. Were we every to
+-- distinguish between HsSyn and Core types, that might be another bunch of parameters.
+--
+-- If you edit this type, you may need to update the GHC formalism
+-- See Note [GHC Formalism] in GHC.Core.Lint
+--
+-- @argTyp@ means the same as @type@, but is different for (de)serialization purposes.
+-- See Note [Efficient serialization of redundant type info]
+data TypeF tyVar tyCoVar tyCon tyLit coercion kindCoercion argTys conArgTys ty
+  -- See Note [Non-trivial definitional equality]
+
+  -- | Vanilla type or kind variable (*never* a coercion variable)
+  = TyVarTyF tyVar
+
+  -- | Type application to something other than a 'TyCon'.
+  | AppTyF
+        ty
+        argTys          -- ^ Type application to something other than a 'TyCon'. Parameters:
+                        --
+                        --  1) Function: must /not/ be a 'TyConApp' or 'CastTy',
+                        --     must be another 'AppTy', or 'TyVarTy'
+                        --     See Note [Respecting definitional equality] \(EQ1) about the
+                        --     no 'CastTy' requirement
+                        --
+                        --  2) Argument type
+
+  | TyConAppF
+        tyCon
+        conArgTys       -- ^ Application of a 'TyCon', including newtypes /and/ synonyms.
+                        -- Invariant: saturated applications of 'FunTyCon' must
+                        -- use 'FunTy' and saturated synonyms must use their own
+                        -- constructors. However, /unsaturated/ 'FunTyCon's
+                        -- do appear as 'TyConApp's.
+                        -- Parameters:
+                        --
+                        -- 1) Type constructor being applied to.
+                        --
+                        -- 2) Type arguments. Might not have enough type arguments
+                        --    here to saturate the constructor.
+                        --    Even type synonyms are not necessarily saturated;
+                        --    for example unsaturated type synonyms
+                        --    can appear as the right hand side of a type synonym.
+
+  | ForAllTyF
+        {-# UNPACK #-} !(VarBndr tyCoVar ArgFlag)
+        ty              -- ^ A Π type.
+             -- INVARIANT: If the binder is a coercion variable, it must
+             -- be mentioned in the Type. See
+             -- Note [Unused coercion variable in ForAllTy]
+
+  | FunTyF      -- ^ FUN m t1 t2   Very common, so an important special case
+                -- See Note [Function types]
+     { ftf_af  :: AnonArgFlag    -- Is this (->) or (=>)?
+     , ftf_mult :: ty {- mult -} -- Multiplicity
+     , ftf_arg :: ty             -- Argument type
+     , ftf_res :: ty             -- Result type
+     }
+
+  | LitTyF tyLit      -- ^ Type literals are similar to type constructors.
+
+  | CastTyF
+        ty
+        kindCoercion  -- ^ A kind cast. The coercion is always nominal.
+                      -- INVARIANT: The cast is never reflexive \(EQ2)
+                      -- INVARIANT: The Type is not a CastTy (use TransCo instead) \(EQ3)
+                      -- INVARIANT: The Type is not a ForAllTy over a tyvar \(EQ4)
+                      -- See Note [Respecting definitional equality]
+
+  | CoercionTyF
+        coercion    -- ^ Injection of a Coercion into a type
+                    -- This should only ever be used in the RHS of an AppTy,
+                    -- in the list of a TyConApp, when applying a promoted
+                    -- GADT data constructor
+
+  deriving ( Eq, Data.Data
+           , Functor, Foldable, Traversable
+           )
+
+instance Bifunctor (TypeF tyVar tyCoVar tyCon tyLit coercion kindCoercion argTys) where
+  bimap f g = runIdentity . bitraverse (Identity . f) (Identity . g)
+
+instance Bifoldable (TypeF tyVar tyCoVar tyCon tyLit coercion kindCoercion argTys) where
+  bifoldMap = bifoldMapDefault
+
+instance Bitraversable (TypeF tyVar tyCoVar tyCon tyLit coercion kindCoercion argTys) where
+  bitraverse f g = \case
+    TyVarTyF v -> pure $ TyVarTyF v
+    AppTyF tf a -> flip AppTyF a <$> g tf
+    TyConAppF tf a -> TyConAppF tf <$> f a
+    ForAllTyF b t -> ForAllTyF b <$> g t
+    FunTyF flag m i o -> FunTyF flag <$> g m <*> g i <*> g o
+    LitTyF l -> pure $ LitTyF l
+    CastTyF t co -> flip CastTyF co <$> g t
+    CoercionTyF kc -> pure $ CoercionTyF kc
diff --git a/compiler/GHC/Iface/Ext/Types.hs b/compiler/GHC/Iface/Ext/Types.hs
index a0a8a41ece..848fa5e37b 100644
--- a/compiler/GHC/Iface/Ext/Types.hs
+++ b/compiler/GHC/Iface/Ext/Types.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveTraversable          #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE PatternSynonyms            #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
@@ -11,11 +12,11 @@ Types for the .hie file format are defined here.
 
 For more information see https://gitlab.haskell.org/ghc/ghc/wikis/hie-files
 -}
-
 module GHC.Iface.Ext.Types where
 
 import GHC.Prelude
 
+import GHC.Core.TyCo.Rep.Open
 import GHC.Settings.Config
 import GHC.Utils.Binary
 import GHC.Data.FastString
@@ -27,6 +28,7 @@ import GHC.Utils.Outputable hiding ( (<>) )
 import GHC.Types.SrcLoc
 import GHC.Types.Avail
 import GHC.Types.Unique
+import GHC.Types.Var.Binder
 import qualified GHC.Utils.Outputable as O ( (<>) )
 import GHC.Utils.Misc
 import GHC.Utils.Panic
@@ -34,14 +36,19 @@ import GHC.Utils.Panic
 import qualified Data.Array as A
 import qualified Data.Map as M
 import qualified Data.Set as S
+import Data.Bifunctor
+import Data.Bitraversable
 import Data.ByteString            ( ByteString )
 import Data.Data                  ( Typeable, Data )
 import Data.Semigroup             ( Semigroup(..) )
 import Data.Word                  ( Word8 )
+import Data.Traversable           ( foldMapDefault )
 import Control.Applicative        ( (<|>) )
-import Data.Coerce                ( coerce  )
+import Data.Coerce                ( coerce )
 import Data.Function              ( on )
 
+import Language.Haskell.Syntax.Extension ( NoExtField(..) )
+
 type Span = RealSrcSpan
 
 -- | Current version of @.hie@ files
@@ -136,20 +143,74 @@ form with sharing of subtrees.
 
 type TypeIndex = Int
 
+type HieType0 a = TypeF
+  Name (Name, a) IfaceTyCon IfaceTyLit NoExtField NoExtField
+  (HieArgs a) (HieArgs a) a
+
 -- | A flattened version of 'Type'.
 --
 -- See Note [Efficient serialization of redundant type info]
-data HieType a
-  = HTyVarTy Name
-  | HAppTy a (HieArgs a)
-  | HTyConApp IfaceTyCon (HieArgs a)
-  | HForAllTy ((Name, a),ArgFlag) a
-  | HFunTy a a a
-  | HQualTy a a           -- ^ type with constraint: @t1 => t2@ (see 'IfaceDFunTy')
-  | HLitTy IfaceTyLit
-  | HCastTy a
-  | HCoercionTy
-    deriving (Functor, Foldable, Traversable, Eq)
+newtype HieType a = HieType {
+    unHieType :: HieType0 a
+  } deriving Eq
+
+{-# COMPLETE HTyVarTy, HAppTy, HTyConApp, HForAllTy, HFunTy', HLitTy, HCastTy, HCoercionTy #-}
+{-# COMPLETE HTyVarTy, HAppTy, HTyConApp, HForAllTy, HFunTy, HQualTy, HLitTy, HCastTy, HCoercionTy #-}
+
+pattern HTyVarTy :: Name -> HieType a
+pattern HTyVarTy v = HieType (TyVarTyF v)
+
+pattern HAppTy :: a -> HieArgs a -> HieType a
+pattern HAppTy f a = HieType (AppTyF f a)
+
+pattern HTyConApp:: IfaceTyCon -> HieArgs a -> HieType a
+pattern HTyConApp f as = HieType (TyConAppF f as)
+
+pattern HForAllTy :: VarBndr (Name, a) ArgFlag -> a -> HieType a
+pattern HForAllTy b t = HieType (ForAllTyF b t)
+
+pattern HFunTy' :: AnonArgFlag -> a -> a -> a -> HieType a
+pattern HFunTy' f m a r = HieType (FunTyF f m a r)
+
+pattern HFunTy :: a -> a -> a -> HieType a
+pattern HFunTy w a r = HFunTy' VisArg w a r
+
+pattern HQualTy :: a -> a -> a -> HieType a
+pattern HQualTy w a r = HFunTy' InvisArg w a r
+
+pattern HLitTy :: IfaceTyLit -> HieType a
+pattern HLitTy l = HieType (LitTyF l)
+
+pattern HCastTy :: a -> HieType a
+pattern HCastTy t = HieType (CastTyF t NoExtField)
+
+pattern HCoercionTy :: HieType a
+pattern HCoercionTy = HieType (CoercionTyF NoExtField)
+
+instance Functor HieType where
+  fmap f = \case
+    HTyVarTy n -> HTyVarTy n
+    HAppTy a xs -> HAppTy (f a) (fmap f xs)
+    HTyConApp n xs -> HTyConApp n $ fmap f xs
+    HForAllTy bndr a -> HForAllTy ((first . second) f bndr) $ f a
+    HFunTy' isConstraint m a b -> HFunTy' isConstraint (f m) (f a) (f b)
+    HLitTy l -> HLitTy l
+    HCastTy a -> HCastTy $ f a
+    HCoercionTy -> HCoercionTy
+
+instance Foldable HieType where
+  foldMap = foldMapDefault
+
+instance Traversable HieType where
+  traverse f = \case
+    HTyVarTy n -> pure $ HTyVarTy n
+    HAppTy a xs -> HAppTy <$> f a <*> traverse f xs
+    HTyConApp n xs -> HTyConApp n <$> traverse f xs
+    HForAllTy bndr a -> HForAllTy <$> (flip bitraverse pure . traverse) f bndr <*> f a
+    HFunTy' isConstraint m a b -> HFunTy' isConstraint <$> f a <*> f m <*> f b
+    HLitTy l -> pure $ HLitTy l
+    HCastTy a -> HCastTy <$> f a
+    HCoercionTy -> pure $ HCoercionTy
 
 type HieTypeFlat = HieType TypeIndex
 
@@ -158,56 +219,53 @@ newtype HieTypeFix = Roll (HieType (HieTypeFix))
   deriving Eq
 
 instance Binary (HieType TypeIndex) where
-  put_ bh (HTyVarTy n) = do
-    putByte bh 0
-    put_ bh n
-  put_ bh (HAppTy a b) = do
-    putByte bh 1
-    put_ bh a
-    put_ bh b
-  put_ bh (HTyConApp n xs) = do
-    putByte bh 2
-    put_ bh n
-    put_ bh xs
-  put_ bh (HForAllTy bndr a) = do
-    putByte bh 3
-    put_ bh bndr
-    put_ bh a
-  put_ bh (HFunTy w a b) = do
-    putByte bh 4
-    put_ bh w
-    put_ bh a
-    put_ bh b
-  put_ bh (HQualTy a b) = do
-    putByte bh 5
-    put_ bh a
-    put_ bh b
-  put_ bh (HLitTy l) = do
-    putByte bh 6
-    put_ bh l
-  put_ bh (HCastTy a) = do
-    putByte bh 7
-    put_ bh a
-  put_ bh (HCoercionTy) = putByte bh 8
-
-  get bh = do
+  put_ bh = (coerce :: forall a x. (HieType0 a -> x) -> (HieType a -> x)) $ \case
+    TyVarTyF n -> do
+      putByte bh 0
+      put_ bh n
+    AppTyF a b -> do
+      putByte bh 1
+      put_ bh a
+      put_ bh b
+    TyConAppF n xs -> do
+      putByte bh 2
+      put_ bh n
+      put_ bh xs
+    ForAllTyF bndr a -> do
+      putByte bh 3
+      put_ bh bndr
+      put_ bh a
+    FunTyF flag mult a b -> do
+      putByte bh 4
+      put_ bh flag
+      put_ bh mult
+      put_ bh a
+      put_ bh b
+    LitTyF l -> do
+      putByte bh 5
+      put_ bh l
+    CastTyF a NoExtField -> do
+      putByte bh 6
+      put_ bh a
+    CoercionTyF NoExtField -> putByte bh 7
+
+  get bh = fmap HieType $ do
     (t :: Word8) <- get bh
     case t of
-      0 -> HTyVarTy <$> get bh
-      1 -> HAppTy <$> get bh <*> get bh
-      2 -> HTyConApp <$> get bh <*> get bh
-      3 -> HForAllTy <$> get bh <*> get bh
-      4 -> HFunTy <$> get bh <*> get bh <*> get bh
-      5 -> HQualTy <$> get bh <*> get bh
-      6 -> HLitTy <$> get bh
-      7 -> HCastTy <$> get bh
-      8 -> return HCoercionTy
+      0 -> TyVarTyF <$> get bh
+      1 -> AppTyF <$> get bh <*> get bh
+      2 -> TyConAppF <$> get bh <*> get bh
+      3 -> ForAllTyF <$> get bh <*> get bh
+      4 -> FunTyF <$> get bh <*> get bh <*> get bh <*> get bh
+      5 -> LitTyF <$> get bh
+      6 -> flip CastTyF NoExtField <$> get bh
+      7 -> return $ CoercionTyF NoExtField
       _ -> panic "Binary (HieArgs Int): invalid tag"
 
 
 -- | A list of type arguments along with their respective visibilities (ie. is
 -- this an argument that would return 'True' for 'isVisibleArgFlag'?).
-newtype HieArgs a = HieArgs [(Bool,a)]
+newtype HieArgs a = HieArgs { unHieArgs :: [(ArgFlag, a)] }
   deriving (Functor, Foldable, Traversable, Eq)
 
 instance Binary (HieArgs TypeIndex) where
diff --git a/compiler/GHC/Iface/Ext/Utils.hs b/compiler/GHC/Iface/Ext/Utils.hs
index 20d047d150..5d4868b227 100644
--- a/compiler/GHC/Iface/Ext/Utils.hs
+++ b/compiler/GHC/Iface/Ext/Utils.hs
@@ -13,7 +13,6 @@ import GHC.Driver.Session    ( DynFlags )
 import GHC.Driver.Ppr
 import GHC.Data.FastString   ( FastString, mkFastString )
 import GHC.Iface.Type
-import GHC.Core.Multiplicity
 import GHC.Types.Name hiding (varName)
 import GHC.Types.Name.Set
 import GHC.Utils.Outputable hiding ( (<>) )
@@ -59,7 +58,7 @@ generateReferencesMap = foldr (\ast m -> M.unionWith (++) (go ast) m) M.empty
 renderHieType :: DynFlags -> HieTypeFix -> String
 renderHieType dflags ht = showSDoc dflags (ppr $ hieTypeToIface ht)
 
-resolveVisibility :: Type -> [Type] -> [(Bool,Type)]
+resolveVisibility :: Type -> [Type] -> [(ArgFlag, Type)]
 resolveVisibility kind ty_args
   = go (mkEmptyTCvSubst in_scope) kind ty_args
   where
@@ -69,18 +68,16 @@ resolveVisibility kind ty_args
     go env ty                  ts
       | Just ty' <- coreView ty
       = go env ty' ts
-    go env (ForAllTy (Bndr tv vis) res) (t:ts)
-      | isVisibleArgFlag vis = (True , t) : ts'
-      | otherwise            = (False, t) : ts'
+    go env (ForAllTy (Bndr tv vis) res) (t:ts) = (vis , t) : ts'
       where
         ts' = go (extendTvSubst env tv t) res ts
 
     go env (FunTy { ft_res = res }) (t:ts) -- No type-class args in tycon apps
-      = (True,t) : (go env res ts)
+      = (Required, t) : (go env res ts)
 
     go env (TyVarTy tv) ts
       | Just ki <- lookupTyVar env tv = go env ki ts
-    go env kind (t:ts) = (True, t) : (go env kind ts) -- Ill-kinded
+    go env kind (t:ts) = (Required, t) : (go env kind ts) -- Ill-kinded
 
 foldType :: (HieType a -> a) -> HieTypeFix -> a
 foldType f (Roll t) = f $ fmap (foldType f) t
@@ -158,21 +155,17 @@ hieTypeToIface = foldType go
     go (HTyVarTy n) = IfaceTyVar $ occNameFS $ getOccName n
     go (HAppTy a b) = IfaceAppTy a (hieToIfaceArgs b)
     go (HLitTy l) = IfaceLitTy l
-    go (HForAllTy ((n,k),af) t) = let b = (occNameFS $ getOccName n, k)
-                                  in IfaceForAllTy (Bndr (IfaceTvBndr b) af) t
-    go (HFunTy w a b)   = IfaceFunTy VisArg   w       a    b
-    go (HQualTy pred b) = IfaceFunTy InvisArg many_ty pred b
+    go (HForAllTy (Bndr (n, k) af) t) =
+      IfaceForAllTy (Bndr (IfaceTvBndr b) af) t
+      where b = (occNameFS $ getOccName n, k)
+    go (HFunTy' isConstraint w a b) = IfaceFunTy isConstraint w a b
     go (HCastTy a) = a
     go HCoercionTy = IfaceTyVar "<coercion type>"
     go (HTyConApp a xs) = IfaceTyConApp a (hieToIfaceArgs xs)
 
     -- This isn't fully faithful - we can't produce the 'Inferred' case
     hieToIfaceArgs :: HieArgs IfaceType -> IfaceAppArgs
-    hieToIfaceArgs (HieArgs xs) = go' xs
-      where
-        go' [] = IA_Nil
-        go' ((True ,x):xs) = IA_Arg x Required $ go' xs
-        go' ((False,x):xs) = IA_Arg x Specified $ go' xs
+    hieToIfaceArgs = foldr (\(flag, x) rest -> IA_Arg x flag rest) IA_Nil . unHieArgs
 
 data HieTypeState
   = HTS
@@ -235,13 +228,13 @@ getTypeIndex t
     go (ForAllTy (Bndr v a) t) = do
       k <- getTypeIndex (varType v)
       i <- getTypeIndex t
-      return $ HForAllTy ((varName v,k),a) i
+      return $ HForAllTy (Bndr (varName v, k) a) i
     go (FunTy { ft_af = af, ft_mult = w, ft_arg = a, ft_res = b }) = do
       ai <- getTypeIndex a
       bi <- getTypeIndex b
       wi <- getTypeIndex w
       return $ case af of
-                 InvisArg -> case w of Many -> HQualTy ai bi; _ -> error "Unexpected non-unrestricted predicate"
+                 InvisArg -> HQualTy wi ai bi
                  VisArg   -> HFunTy wi ai bi
     go (LitTy a) = return $ HLitTy $ toIfaceTyLit a
     go (CastTy t _) = do
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index ded25bdd14..2bdbb239c0 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -330,6 +330,7 @@ Library
         GHC.Core.TyCon.Set
         GHC.Core.TyCo.Ppr
         GHC.Core.TyCo.Rep
+        GHC.Core.TyCo.Rep.Open
         GHC.Core.TyCo.Subst
         GHC.Core.TyCo.Tidy
         GHC.Core.Type
diff --git a/utils/haddock b/utils/haddock
-Subproject 5d14361971ec6e6c3dfca282e4b80b307087afe
+Subproject 26f48fecd0b66a612b856bdf7ba0f5b8bb33498