Re: [GHC] #9582: Associated Type Synonyms do not unfold in InstanceSigs

27 Sep 2014

      #9582: Associated Type Synonyms do not unfold in InstanceSigs
-------------------------------------+-------------------------------------
              Reporter:              |            Owner:
  andreas.abel                       |           Status:  patch
                  Type:  bug         |        Milestone:
              Priority:  normal      |          Version:  7.8.3
             Component:  Compiler    |         Keywords:  InstanceSigs
  (Type checker)                     |  TypeFamilies
            Resolution:              |     Architecture:  Unknown/Multiple
      Operating System:              |       Difficulty:  Unknown
  Unknown/Multiple                   |       Blocked By:
       Type of failure:              |  Related Tickets:
  None/Unknown                       |
             Test Case:              |
              Blocking:              |
Differential Revisions:              |
-------------------------------------+-------------------------------------

Comment (by andreas.abel):

 Agreed on the horror of the hack! I implemented your suggestion to change
 the interface of `tcSubType`, see:
 https://github.com/andreasabel/ghc/commit/e43d6f1f90f8d395fb21696c5f8a1641a7...
 Instead of `CtOrigin`, it takes a `SwapFlag`.  Note that it has to pass an
 `origin` to `deeplyInstantiate`, and as the original origin is no more
 communicated to tcSubType, it uses a standard `TypeEqOrigin` now.  Whether
 this has any negative impact is yours to judge...
 {{{#!hs
 tcSubType :: SwapFlag -> UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM
 HsWrapper
 -- Check that ty_actual is more polymorphic than ty_expected
 -- Both arguments might be polytypes, so we must instantiate and skolemise
 -- Returns a wrapper of shape   ty_actual ~ ty_expected
 tcSubType swap ctxt ty_actual ty_expected
   | isSigmaTy ty_actual
   = do { (sk_wrap, inst_wrap)
             <- tcGen ctxt ty_expected $ \ _ sk_rho -> do
             { (in_wrap, in_rho) <- deeplyInstantiate i_origin ty_actual
             ; cow <- unify in_rho sk_rho
             ; return (coToHsWrapper cow <.> in_wrap) }
        ; return (sk_wrap <.> inst_wrap) }

   | otherwise   -- Urgh!  It seems deeply weird to have equality
                 -- when actual is not a polytype, and it makes a big
                 -- difference e.g. tcfail104
   = do { cow <- unify ty_actual ty_expected
        ; return (coToHsWrapper cow) }
   where
     -- E.g., in the case of patterns and instance signatures,
     -- we call tcSubType with (expected, actual)
     -- rather than (actual, expected).   To get error messages the
     -- right way round we create the appropriate origin.
     unify  ty1 ty2 = uType (origin ty1 ty2) ty1 ty2
     origin ty1 ty2 =
       if isSwapped swap
         then TypeEqOrigin { uo_actual = ty2, uo_expected = ty1 }
         else TypeEqOrigin { uo_actual = ty1, uo_expected = ty2 }
     i_origin = origin ty_actual ty_expected
 }}}
 Being fine with the reported type errors, we still have a problem for the
 successful test.
 {{{#!hs
 {-# LANGUAGE InstanceSigs, TypeFamilies #-}

 class C a where
   type T a
   m :: T a

 instance C Int where
   type T Int = String

   -- The following type signature for m should be valid.
   m :: String
   m = "bla"

 main :: IO ()
 main = return ()
 }}}
 Running the test suite `Core Lint` complains about a type mismatch:
 {{{
 *** Core Lint errors : in result of Desugar (after optimization) ***
 {-# LINE 15 "T9582.hs #-}: Warning:
     [RHS of $cm_amh :: Main.T GHC.Types.Int]
     The type of this binder doesn't match the type of its RHS: $cm_amh
     Binder's type: Main.T GHC.Types.Int
     Rhs type: [GHC.Types.Char]
 *** Offending Program ***
 $cm_amh :: Main.T GHC.Types.Int
 [LclId, Str=DmdType]
 $cm_amh = GHC.CString.unpackCString# "bla"#

 Main.$fCInt [InlPrag=INLINE (sat-args=0)] :: Main.C GHC.Types.Int
 [LclIdX[DFunId(nt)],
  Str=DmdType,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=False, ConLike=False,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True)
          Tmpl= $cm_amh
                `cast` (Sym (Main.NTCo:C[0] <GHC.Types.Int>_N)
                        :: Main.T GHC.Types.Int ~R# Main.C GHC.Types.Int)}]
 Main.$fCInt =
   $cm_amh
   `cast` (Sym (Main.NTCo:C[0] <GHC.Types.Int>_N)
           :: Main.T GHC.Types.Int ~R# Main.C GHC.Types.Int)
 ...
 *** End of Offense ***
 }}}
 Sounds like we cannot throw away the cast after all!?  [The type synonym T
 Int = String does not seem to make it down to this level!?]
 We could return a cast from `check_inst_sig`. However, `TcSigInfo` which
 is produced by `mkMethIds`, does not provide for the storage of a
 coercion...

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/9582#comment:9>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler