Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC

Commits:

10 changed files:

Changes:

  • compiler/GHC/Tc/Solver/Equality.hs
    ... ... @@ -532,6 +532,8 @@ can_eq_nc_forall ev eq_rel s1 s2
    532 532 
                                         unifyForAllBody ev (eqRelRole eq_rel) $ \uenv ->
    533 533 
                                         go uenv skol_tvs init_subst2 bndrs1 bndrs2
    534 534
    535 
    +      -- Solve the implication right away, using `trySolveImplication`
    536 
    +      -- See (SF6) in Note [Solving forall equalities]
    535 537 
           ; traceTcS "Trying to solve the implication" (ppr s1 $$ ppr s2 $$ ppr wanteds)
    536 538 
           ; ev_binds_var <- newNoTcEvBinds
    537 539 
           ; solved <- trySolveImplication $
    ... ... @@ -620,6 +622,21 @@ There are lots of wrinkles of course:
    620 622 
        especially Refl ones.  We use the `unifyForAllBody` wrapper for `uType`,
    621 623 
        because we want to /gather/ the equality constraint (to put in the implication)
    622 624 
        rather than /emit/ them into the monad, as `wrapUnifierTcS` does.
    625 
    +
    626 
    +(SF6) We solve the implication on the spot, using `trySolveImplication`.  In
    627 
    +   the past we instead generated an `Implication` to be solved later.  Nice in
    628 
    +   some ways but it added complexity:
    629 
    +      - We needed a `wl_implics` field of `WorkList` to collect
    630 
    +        these emitted implications
    631 
    +      - The types of `solveSimpleWanteds` and friends were more complicated
    632 
    +      - Trickily, an `EvFun` had to contain an `EvBindsVar` ref-cell, which made
    633 
    +        `evVarsOfTerm` harder.  Now an `EvFun` just contains the bindings.
    634 
    +   The disadvantage of solve-on-the-spot is that if we fail we are simply
    635 
    +   left with an unsolved (forall a. blah) ~ (forall b. blah), and it may
    636 
    +   not be clear /why we couldn't solve it.  But on balance the error messages
    637 
    +   improve: it is easier to undertand that
    638 
    +       (forall a. a->a) ~ (forall b. b->Int)
    639 
    +   is insoluble than it is to understand a message about matching `a` with `Int`.
    623 640 
     -}
    624 641
    625 642 
     {- Note [Unwrap newtypes first]
    ... ... @@ -2706,7 +2723,7 @@ tryInertEqs :: EqCt -> SolverStage ()
    2706 2723 
     tryInertEqs work_item@(EqCt { eq_ev = ev, eq_eq_rel = eq_rel })
    2707 2724 
       = Stage $
    2708 2725 
         do { inerts <- getInertCans
    2709 
    -       ; if | Just (ev_i, swapped) <- inertsCanDischarge inerts work_item
    2726 
    +       ; if | Just (ev_i, swapped) <- inertsEqsCanDischarge inerts work_item
    2710 2727 
                 -> do { setEvBindIfWanted ev EvCanonical $
    2711 2728 
                         evCoercion (maybeSymCo swapped $
    2712 2729 
                                     downgradeRole (eqRelRole eq_rel)
    ... ... @@ -2717,10 +2734,10 @@ tryInertEqs work_item@(EqCt { eq_ev = ev, eq_eq_rel = eq_rel })
    2717 2734 
                 | otherwise
    2718 2735 
                 -> continueWith () }
    2719 2736
    2720 
    -inertsCanDischarge :: InertCans -> EqCt
    2721 
    -                   -> Maybe ( CtEvidence  -- The evidence for the inert
    2722 
    -                            , SwapFlag )  -- Whether we need mkSymCo
    2723 
    -inertsCanDischarge inerts (EqCt { eq_lhs = lhs_w, eq_rhs = rhs_w
    2737 
    +inertsEqsCanDischarge :: InertCans -> EqCt
    2738 
    +                      -> Maybe ( CtEvidence  -- The evidence for the inert
    2739 
    +                               , SwapFlag )  -- Whether we need mkSymCo
    2740 
    +inertsEqsCanDischarge inerts (EqCt { eq_lhs = lhs_w, eq_rhs = rhs_w
    2724 2741 
                                     , eq_ev = ev_w, eq_eq_rel = eq_rel })
    2725 2742 
       | (ev_i : _) <- [ ev_i | EqCt { eq_ev = ev_i, eq_rhs = rhs_i
    2726 2743 
                                     , eq_eq_rel = eq_rel }
    ... ... @@ -2766,7 +2783,7 @@ inertsCanDischarge inerts (EqCt { eq_lhs = lhs_w, eq_rhs = rhs_w
    2766 2783 
                  -- Prefer the one that has no rewriters
    2767 2784 
                  -- See (CE4) in Note [Combining equalities]
    2768 2785
    2769 
    -inertsCanDischarge _ _ = Nothing
    2786 
    +inertsEqsCanDischarge _ _ = Nothing
    2770 2787
    2771 2788
    2772 2789

  • compiler/GHC/Tc/Solver/InertSet.hs
    ... ... @@ -1960,6 +1960,9 @@ solveOneFromTheOther :: Ct -- Inert (Dict or Irred)
    1960 1960 
     -- We can always solve one from the other: even if both are wanted,
    1961 1961 
     -- although we don't rewrite wanteds with wanteds, we can combine
    1962 1962 
     -- two wanteds into one by solving one from the other
    1963 
    +--
    1964 
    +-- Compare the corresponding function for equalities:
    1965 
    +--      GHC.Tc.Solver.Equality.inertEqsCanDischarge
    1963 1966
    1964 1967 
     solveOneFromTheOther ct_i ct_w
    1965 1968 
       | CtWanted {} <- ev_w
    ... ... @@ -1968,32 +1971,37 @@ solveOneFromTheOther ct_i ct_w
    1968 1971 
       = -- Inert must be Given
    1969 1972 
         KeepWork
    1970 1973
    1971 
    -  | CtWanted {} <- ev_w
    1974 
    +  | CtWanted (WantedCt { ctev_rewriters = rw_w }) <- ev_w
    1972 1975 
       = -- Inert is Given or Wanted
    1973 1976 
         case ev_i of
    1974 1977 
           CtGiven {} -> KeepInert
    1975 1978 
             -- work is Wanted; inert is Given: easy choice.
    1976 1979
    1977 
    -      CtWanted {} -- Both are Wanted
    1980 
    +      CtWanted (WantedCt { ctev_rewriters = rw_i }) -- Both are Wanted
    1978 1981 
             -- If only one has no pending superclasses, use it
    1979 1982 
             -- Otherwise we can get infinite superclass expansion (#22516)
    1980 1983 
             -- in silly cases like   class C T b => C a b where ...
    1981 
    -        | not is_psc_i, is_psc_w     -> KeepInert
    1982 
    -        | is_psc_i,     not is_psc_w -> KeepWork
    1984 
    +        | Just res <- better (not is_psc_i) (not is_psc_w)
    1985 
    +        -> res
    1986 
    +
    1987 
    +        -- If only one has an empty rewriter set, use it
    1988 
    +        | Just res <- better (isEmptyRewriterSet rw_i) (isEmptyRewriterSet rw_w)
    1989 
    +        -> res
    1983 1990
    1984 1991 
             -- If only one is a WantedSuperclassOrigin (arising from expanding
    1985 1992 
             -- a Wanted class constraint), keep the other: wanted superclasses
    1986 1993 
             -- may be unexpected by users
    1987 
    -        | not is_wsc_orig_i, is_wsc_orig_w     -> KeepInert
    1988 
    -        | is_wsc_orig_i,     not is_wsc_orig_w -> KeepWork
    1994 
    +        | Just res <- better (not is_wsc_orig_i) (not is_wsc_orig_w)
    1995 
    +        -> res
    1989 1996
    1990 
    -        -- otherwise, just choose the lower span
    1997 
    +        -- Otherwise, just choose the lower span
    1991 1998 
             -- reason: if we have something like (abs 1) (where the
    1992 1999 
             -- Num constraint cannot be satisfied), it's better to
    1993 2000 
             -- get an error about abs than about 1.
    1994 2001 
             -- This test might become more elaborate if we see an
    1995 2002 
             -- opportunity to improve the error messages
    1996 2003 
             | ((<) `on` ctLocSpan) loc_i loc_w -> KeepInert
    2004 
    +
    1997 2005 
             | otherwise                        -> KeepWork
    1998 2006
    1999 2007 
       -- From here on the work-item is Given
    ... ... @@ -2016,6 +2024,15 @@ solveOneFromTheOther ct_i ct_w
    2016 2024 
       | otherwise   -- Both are Given, levels differ
    2017 2025 
       = different_level_strategy
    2018 2026 
       where
    2027 
    +     better :: Bool -> Bool -> Maybe InteractResult
    2028 
    +     -- (better inert-is-good wanted-is-good) returns
    2029 
    +     --   Just KeepWork  if wanted is strictly better than inert
    2030 
    +     --   Just KeepInert if inert is strictly better than wanted
    2031 
    +     --   Nothing if they are the same
    2032 
    +     better True False = Just KeepInert
    2033 
    +     better False True = Just KeepWork
    2034 
    +     better _     _    = Nothing
    2035 
    +
    2019 2036 
          ev_i  = ctEvidence ct_i
    2020 2037 
          ev_w  = ctEvidence ct_w
    2021 2038

  • testsuite/tests/deriving/should_fail/T12768.stderr
    1 
    -T12768.hs:9:33: error: [GHC-39999]
    2 
    -    • Could not deduce ‘D [a]’
    3 
    -        arising from the head of a quantified constraint
    1 
    +T12768.hs:9:33: error: [GHC-05617]
    2 
    +    • Could not deduce ‘D (N a) =>
    3 
    +                        (Coercible ([a] -> [a]) (N a -> N a), D [a])’
    4 4 
             arising from the coercion of the method ‘op’
    5 5 
               from type ‘D [a] => [a] -> [a]’ to type ‘D (N a) => N a -> N a’
    6 6 
           from the context: C a
    7 7 
             bound by the deriving clause for ‘C (N a)’ at T12768.hs:9:33
    8 
    -      or from: D (N a) bound by a quantified context at T12768.hs:9:33
    9 8 
         • When deriving the instance for (C (N a))
    10 9

  • testsuite/tests/deriving/should_fail/T1496.stderr
    1 
    -T1496.hs:10:32: error: [GHC-18872]
    2 
    -    • Couldn't match representation of type: c Int
    3 
    -                               with that of: c Moo
    4 
    -        arising from the head of a quantified constraint
    1 
    +T1496.hs:10:32: error: [GHC-05617]
    2 
    +    • Could not solve: ‘forall (c :: * -> *).
    3 
    +                        Coercible (c Int -> c Int) (c Int -> c Moo)’
    5 4 
             arising from the coercion of the method ‘isInt’
    6 5 
               from type ‘forall (c :: * -> *). c Int -> c Int’
    7 6 
                 to type ‘forall (c :: * -> *). c Int -> c Moo’
    8 
    -      Note: We cannot know what roles the parameters to ‘c’ have;
    9 
    -            we must assume that the role is nominal.
    10 7 
         • When deriving the instance for (IsInt Moo)
    11 8

  • testsuite/tests/deriving/should_fail/T5498.stderr
    1 
    -T5498.hs:30:39: error: [GHC-18872]
    2 
    -    • Couldn't match representation of type: c a
    3 
    -                               with that of: c (Down a)
    4 
    -        arising from the head of a quantified constraint
    1 
    +T5498.hs:30:39: error: [GHC-05617]
    2 
    +    • Could not deduce ‘forall (c :: * -> *).
    3 
    +                        Coercible (c a -> c Int) (c (Down a) -> c Int)’
    5 4 
             arising from the coercion of the method ‘intIso’
    6 5 
               from type ‘forall (c :: * -> *). c a -> c Int’
    7 6 
                 to type ‘forall (c :: * -> *). c (Down a) -> c Int’
    8 
    -      Note: We cannot know what roles the parameters to ‘c’ have;
    9 
    -            we must assume that the role is nominal.
    7 
    +      from the context: IntIso a
    8 
    +        bound by the deriving clause for ‘IntIso (Down a)’
    9 
    +        at T5498.hs:30:39-44
    10 10 
         • When deriving the instance for (IntIso (Down a))
    11 11

  • testsuite/tests/deriving/should_fail/T7148.stderr
    1 
    -T7148.hs:27:40: error: [GHC-25897]
    2 
    -    • Couldn't match type ‘b’ with ‘Tagged a b’
    3 
    -        arising from the head of a quantified constraint
    4 
    -        arising from the coercion of the method ‘iso2’
    5 
    -          from type ‘forall b1. SameType b1 () -> SameType b1 b’
    6 
    -            to type ‘forall b1. SameType b1 () -> SameType b1 (Tagged a b)’
    7 
    -      ‘b’ is a rigid type variable bound by
    8 
    -        the deriving clause for ‘IsoUnit (Tagged a b)’
    9 
    -        at T7148.hs:27:40-46
    10 
    -    • When deriving the instance for (IsoUnit (Tagged a b))
    11 
    -
    12 
    -T7148.hs:27:40: error: [GHC-25897]
    13 
    -    • Couldn't match type ‘b’ with ‘Tagged a b’
    14 
    -        arising from the head of a quantified constraint
    1 
    +T7148.hs:27:40: error: [GHC-05617]
    2 
    +    • Could not deduce ‘forall b1.
    3 
    +                        Coercible
    4 
    +                          (SameType () b1 -> SameType b b1)
    5 
    +                          (SameType () b1 -> SameType (Tagged a b) b1)’
    15 6 
             arising from the coercion of the method ‘iso1’
    16 7 
               from type ‘forall b1. SameType () b1 -> SameType b b1’
    17 8 
                 to type ‘forall b1. SameType () b1 -> SameType (Tagged a b) b1’
    18 
    -      ‘b’ is a rigid type variable bound by
    19 
    -        the deriving clause for ‘IsoUnit (Tagged a b)’
    9 
    +      from the context: IsoUnit b
    10 
    +        bound by the deriving clause for ‘IsoUnit (Tagged a b)’
    20 11 
             at T7148.hs:27:40-46
    21 12 
         • When deriving the instance for (IsoUnit (Tagged a b))
    22 13

  • testsuite/tests/deriving/should_fail/T7148a.stderr
    1 
    -T7148a.hs:19:50: error: [GHC-10283]
    2 
    -    • Couldn't match representation of type ‘b’
    3 
    -                               with that of ‘Result a b’
    4 
    -        arising from the head of a quantified constraint
    1 
    +T7148a.hs:19:50: error: [GHC-05617]
    2 
    +    • Could not deduce ‘forall b.
    3 
    +                        Coercible
    4 
    +                          (Proxy b -> a -> Result a b) (Proxy b -> IS_NO_LONGER a -> b)’
    5 5 
             arising from the coercion of the method ‘coerce’
    6 6 
               from type ‘forall b. Proxy b -> a -> Result a b’
    7 7 
                 to type ‘forall b.
    8 8 
                          Proxy b -> IS_NO_LONGER a -> Result (IS_NO_LONGER a) b’
    9 
    -      ‘b’ is a rigid type variable bound by
    10 
    -        a quantified context
    9 
    +      from the context: Convert a
    10 
    +        bound by the deriving clause for ‘Convert (IS_NO_LONGER a)’
    11 11 
             at T7148a.hs:19:50-56
    12 12 
         • When deriving the instance for (Convert (IS_NO_LONGER a))
    13 13

  • testsuite/tests/roles/should_fail/RolesIArray.stderr
    1 
    -RolesIArray.hs:10:13: error: [GHC-18872]
    2 
    -    • Couldn't match type ‘Word64’ with ‘N’
    3 
    -        arising from the head of a quantified constraint
    4 
    -        arising from the coercion of the method ‘Data.Array.Base.unsafeAccumArray’
    5 
    -          from type ‘forall i e'.
    6 
    -                     Ix i =>
    7 
    -                     (Word64 -> e' -> Word64)
    8 
    -                     -> Word64 -> (i, i) -> [(Int, e')] -> UArray i Word64’
    9 
    -            to type ‘forall i e'.
    10 
    -                     Ix i =>
    11 
    -                     (N -> e' -> N) -> N -> (i, i) -> [(Int, e')] -> UArray i N’
    12 
    -    • When deriving the instance for (IArray UArray N)
    13 
    -
    14 
    -RolesIArray.hs:10:13: error: [GHC-18872]
    15 
    -    • Couldn't match type ‘Word64’ with ‘N’
    16 
    -        arising from the head of a quantified constraint
    17 
    -        arising from the coercion of the method ‘Data.Array.Base.unsafeAccum’
    18 
    -          from type ‘forall i e'.
    19 
    -                     Ix i =>
    20 
    -                     (Word64 -> e' -> Word64)
    21 
    -                     -> UArray i Word64 -> [(Int, e')] -> UArray i Word64’
    22 
    -            to type ‘forall i e'.
    23 
    -                     Ix i =>
    24 
    -                     (N -> e' -> N) -> UArray i N -> [(Int, e')] -> UArray i N’
    25 
    -    • When deriving the instance for (IArray UArray N)
    26 
    -
    27 
    -RolesIArray.hs:10:13: error: [GHC-18872]
    28 
    -    • Couldn't match type ‘Word64’ with ‘N’
    29 
    -        arising from the head of a quantified constraint
    30 
    -        arising from the coercion of the method ‘Data.Array.Base.unsafeReplace’
    31 
    -          from type ‘forall i.
    32 
    -                     Ix i =>
    33 
    -                     UArray i Word64 -> [(Int, Word64)] -> UArray i Word64’
    34 
    -            to type ‘forall i. Ix i => UArray i N -> [(Int, N)] -> UArray i N’
    35 
    -    • When deriving the instance for (IArray UArray N)
    36 
    -
    37 
    -RolesIArray.hs:10:13: error: [GHC-18872]
    38 
    -    • Couldn't match type ‘Word64’ with ‘N’
    39 
    -        arising from the head of a quantified constraint
    40 
    -        arising from the coercion of the method ‘Data.Array.Base.unsafeAt’
    41 
    -          from type ‘forall i. Ix i => UArray i Word64 -> Int -> Word64’
    42 
    -            to type ‘forall i. Ix i => UArray i N -> Int -> N’
    43 
    -    • When deriving the instance for (IArray UArray N)
    44 
    -
    45 
    -RolesIArray.hs:10:13: error: [GHC-18872]
    46 
    -    • Couldn't match type ‘Word64’ with ‘N’
    47 
    -        arising from the head of a quantified constraint
    48 
    -        arising from the coercion of the method ‘Data.Array.Base.unsafeArray’
    49 
    -          from type ‘forall i.
    50 
    -                     Ix i =>
    51 
    -                     (i, i) -> [(Int, Word64)] -> UArray i Word64’
    52 
    -            to type ‘forall i. Ix i => (i, i) -> [(Int, N)] -> UArray i N’
    53 
    -    • When deriving the instance for (IArray UArray N)
    54 
    -
    55 
    -RolesIArray.hs:10:13: error: [GHC-18872]
    56 
    -    • Couldn't match type ‘Word64’ with ‘N’
    57 
    -        arising from the head of a quantified constraint
    58 
    -        arising from the coercion of the method ‘Data.Array.Base.numElements’
    59 
    -          from type ‘forall i. Ix i => UArray i Word64 -> Int’
    60 
    -            to type ‘forall i. Ix i => UArray i N -> Int’
    61 
    -    • When deriving the instance for (IArray UArray N)
    62 
    -
    63 
    -RolesIArray.hs:10:13: error: [GHC-18872]
    64 
    -    • Couldn't match type ‘Word64’ with ‘N’
    65 
    -        arising from the head of a quantified constraint
    1 
    +RolesIArray.hs:10:13: error: [GHC-05617]
    2 
    +    • Could not solve: ‘forall i.
    3 
    +                        Ix i =>
    4 
    +                        (Coercible (UArray i Word64 -> (i, i)) (UArray i N -> (i, i)),
    5 
    +                         Ix i)’
    66 6 
             arising from the coercion of the method ‘bounds’
    67 7 
               from type ‘forall i. Ix i => UArray i Word64 -> (i, i)’
    68 8 
                 to type ‘forall i. Ix i => UArray i N -> (i, i)’

  • testsuite/tests/simplCore/should_compile/T2117.hs
    1 
    +{-# LANGUAGE UndecidableInstances, TypeFamilies #-}
    2 
    +
    3 
    +module T26117 where
    4 
    +
    5 
    +type family F a
    6 
    +type instance F Int = Bool
    7 
    +
    8 
    +class Eq (F a) => D a b where {  dop1, dop2 :: a -> b -> b }
    9 
    +
    10 
    +class C a b where { op1,op2 :: F a -> a -> b -> Int }
    11 
    +
    12 
    +instance (Eq (F a), D a b) => C a [b] where
    13 
    +  op1 x _ _ | x==x      = 3
    14 
    +            | otherwise = 4
    15 
    +  {-# SPECIALISE instance D Int b => C Int [b] #-}

  • testsuite/tests/simplCore/should_compile/T26117.stderr
    1 
    +T26117.hs:17:10: warning: [GHC-06201] [-Wmissing-methods (in -Wdefault)]
    2 
    +    • No explicit implementation for
    3 
    +        ‘op2’
    4 
    +    • In the instance declaration for ‘C a [b]’
    5 
    +
    6 
    +
    7 
    +==================== Tidy Core ====================
    8 
    +Result size of Tidy Core
    9 
    +  = {terms: 196, types: 296, coercions: 2, joins: 0/0}
    10 
    +
    11 
    +-- RHS size: {terms: 7, types: 18, coercions: 0, joins: 0/0}
    12 
    +op1 [InlPrag=[~]] :: forall a b. C a b => F a -> a -> b -> Int
    13 
    +[GblId[ClassOp],
    14 
    + Arity=1,
    15 
    + Str=<S!P(SL,A)>,
    16 
    + Unf=Unf{Src=StableSystem, TopLvl=True,
    17 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    18 
    +         Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False)
    19 
    +         Tmpl= \ (@a) (@b) (v [Occ=Once1!] :: C a b) ->
    20 
    +                 case v of { T26117.C:C v2 [Occ=Once1] _ [Occ=Dead] -> v2 }}]
    21 
    +op1
    22 
    +  = \ (@a) (@b) (v :: C a b) ->
    23 
    +      case v of v1 { T26117.C:C v2 v3 -> v2 }
    24 
    +
    25 
    +-- RHS size: {terms: 7, types: 18, coercions: 0, joins: 0/0}
    26 
    +op2 [InlPrag=[~]] :: forall a b. C a b => F a -> a -> b -> Int
    27 
    +[GblId[ClassOp],
    28 
    + Arity=1,
    29 
    + Str=<S!P(A,SL)>,
    30 
    + Unf=Unf{Src=StableSystem, TopLvl=True,
    31 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    32 
    +         Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False)
    33 
    +         Tmpl= \ (@a) (@b) (v [Occ=Once1!] :: C a b) ->
    34 
    +                 case v of { T26117.C:C _ [Occ=Dead] v3 [Occ=Once1] -> v3 }}]
    35 
    +op2
    36 
    +  = \ (@a) (@b) (v :: C a b) ->
    37 
    +      case v of v1 { T26117.C:C v2 v3 -> v3 }
    38 
    +
    39 
    +-- RHS size: {terms: 7, types: 17, coercions: 0, joins: 0/0}
    40 
    +T26117.$p1D [InlPrag=[~]] :: forall a b. D a b => Eq (F a)
    41 
    +[GblId[ClassOp],
    42 
    + Arity=1,
    43 
    + Str=<S!P(SL,A,A)>,
    44 
    + Unf=Unf{Src=StableSystem, TopLvl=True,
    45 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    46 
    +         Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False)
    47 
    +         Tmpl= \ (@a) (@b) (v [Occ=Once1!] :: D a b) ->
    48 
    +                 case v of { T26117.C:D v2 [Occ=Once1] _ [Occ=Dead] _ [Occ=Dead] ->
    49 
    +                 v2
    50 
    +                 }}]
    51 
    +T26117.$p1D
    52 
    +  = \ (@a) (@b) (v :: D a b) ->
    53 
    +      case v of v1 { T26117.C:D v2 v3 v4 -> v2 }
    54 
    +
    55 
    +-- RHS size: {terms: 7, types: 17, coercions: 0, joins: 0/0}
    56 
    +dop1 [InlPrag=[~]] :: forall a b. D a b => a -> b -> b
    57 
    +[GblId[ClassOp],
    58 
    + Arity=1,
    59 
    + Str=<S!P(A,SL,A)>,
    60 
    + Unf=Unf{Src=StableSystem, TopLvl=True,
    61 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    62 
    +         Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False)
    63 
    +         Tmpl= \ (@a) (@b) (v [Occ=Once1!] :: D a b) ->
    64 
    +                 case v of { T26117.C:D _ [Occ=Dead] v3 [Occ=Once1] _ [Occ=Dead] ->
    65 
    +                 v3
    66 
    +                 }}]
    67 
    +dop1
    68 
    +  = \ (@a) (@b) (v :: D a b) ->
    69 
    +      case v of v1 { T26117.C:D v2 v3 v4 -> v3 }
    70 
    +
    71 
    +-- RHS size: {terms: 7, types: 17, coercions: 0, joins: 0/0}
    72 
    +dop2 [InlPrag=[~]] :: forall a b. D a b => a -> b -> b
    73 
    +[GblId[ClassOp],
    74 
    + Arity=1,
    75 
    + Str=<S!P(A,A,SL)>,
    76 
    + Unf=Unf{Src=StableSystem, TopLvl=True,
    77 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    78 
    +         Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False)
    79 
    +         Tmpl= \ (@a) (@b) (v [Occ=Once1!] :: D a b) ->
    80 
    +                 case v of { T26117.C:D _ [Occ=Dead] _ [Occ=Dead] v4 [Occ=Once1] ->
    81 
    +                 v4
    82 
    +                 }}]
    83 
    +dop2
    84 
    +  = \ (@a) (@b) (v :: D a b) ->
    85 
    +      case v of v1 { T26117.C:D v2 v3 v4 -> v4 }
    86 
    +
    87 
    +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
    88 
    +T26117.$fCaList1 :: GHC.Internal.Prim.Addr#
    89 
    +[GblId,
    90 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    91 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    92 
    +         Guidance=IF_ARGS [] 70 0}]
    93 
    +T26117.$fCaList1 = "T26117.hs:17:10-37|\CANop2\EM"#
    94 
    +
    95 
    +-- RHS size: {terms: 6, types: 15, coercions: 0, joins: 0/0}
    96 
    +T26117.$fCaList_$cop2 [InlPrag=[2]]
    97 
    +  :: forall a b. (Eq (F a), D a b) => F a -> a -> [b] -> Int
    98 
    +[GblId,
    99 
    + Arity=2,
    100 
    + Str=<B><B>b,
    101 
    + Cpr=b,
    102 
    + Unf=Unf{Src=StableSystem, TopLvl=True,
    103 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    104 
    +         Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True)
    105 
    +         Tmpl= \ (@a) (@b) _ [Occ=Dead] _ [Occ=Dead] ->
    106 
    +                 GHC.Internal.Control.Exception.Base.noMethodBindingError
    107 
    +                   @GHC.Internal.Types.LiftedRep
    108 
    +                   @(F a -> a -> [b] -> Int)
    109 
    +                   T26117.$fCaList1}]
    110 
    +T26117.$fCaList_$cop2
    111 
    +  = \ (@a) (@b) _ [Occ=Dead] _ [Occ=Dead] ->
    112 
    +      GHC.Internal.Control.Exception.Base.noMethodBindingError
    113 
    +        @GHC.Internal.Types.LiftedRep
    114 
    +        @(F a -> a -> [b] -> Int)
    115 
    +        T26117.$fCaList1
    116 
    +
    117 
    +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
    118 
    +T26117.$fCaList3 :: Int
    119 
    +[GblId,
    120 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    121 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    122 
    +         Guidance=IF_ARGS [] 10 10}]
    123 
    +T26117.$fCaList3 = GHC.Internal.Types.I# 4#
    124 
    +
    125 
    +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
    126 
    +T26117.$fCaList2 :: Int
    127 
    +[GblId,
    128 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    129 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    130 
    +         Guidance=IF_ARGS [] 10 10}]
    131 
    +T26117.$fCaList2 = GHC.Internal.Types.I# 3#
    132 
    +
    133 
    +-- RHS size: {terms: 8, types: 7, coercions: 2, joins: 0/0}
    134 
    +lvl :: forall b. F Int -> Int -> [b] -> Int
    135 
    +[GblId, Arity=3, Str=<1A><A><A>, Cpr=1, Unf=OtherCon []]
    136 
    +lvl
    137 
    +  = \ (@b) (x :: F Int) _ [Occ=Dead] _ [Occ=Dead] ->
    138 
    +      case x `cast` (Sub T26117.D:R:FInt :: F Int ~R# Bool) of lwild
    139 
    +      { __DEFAULT ->
    140 
    +      T26117.$fCaList2
    141 
    +      }
    142 
    +
    143 
    +-- RHS size: {terms: 3, types: 8, coercions: 0, joins: 0/0}
    144 
    +lvl1 :: forall b. F Int -> Int -> [b] -> Int
    145 
    +[GblId, Str=b, Cpr=b]
    146 
    +lvl1
    147 
    +  = \ (@b) ->
    148 
    +      GHC.Internal.Control.Exception.Base.noMethodBindingError
    149 
    +        @GHC.Internal.Types.LiftedRep
    150 
    +        @(F Int -> Int -> [b] -> Int)
    151 
    +        T26117.$fCaList1
    152 
    +
    153 
    +-- RHS size: {terms: 4, types: 6, coercions: 0, joins: 0/0}
    154 
    +lvl2 :: forall b. C Int [b]
    155 
    +[GblId, Unf=OtherCon []]
    156 
    +lvl2 = \ (@b) -> T26117.C:C @Int @[b] (lvl @b) (lvl1 @b)
    157 
    +
    158 
    +-- RHS size: {terms: 3, types: 5, coercions: 0, joins: 0/0}
    159 
    +T26117.$fCaList_$s$fCaList [InlPrag=CONLIKE]
    160 
    +  :: forall b. D Int b => C Int [b]
    161 
    +[GblId[DFunId],
    162 
    + Arity=1,
    163 
    + Str=<A>,
    164 
    + Unf=DFun: \ (@b) ($dD :: D Int b) ->
    165 
    +       T26117.C:C TYPE: Int
    166 
    +                  TYPE: [b]
    167 
    +                  \ (x :: F Int) _ [Occ=Dead] _ [Occ=Dead] ->
    168 
    +                    case GHC.Internal.Prim.dataToTagSmall#
    169 
    +                           @GHC.Internal.Types.Lifted
    170 
    +                           @Bool
    171 
    +                           (x `cast` (Sub T26117.D:R:FInt :: F Int ~R# Bool))
    172 
    +                    of a# [Occ=Once1]
    173 
    +                    { __DEFAULT ->
    174 
    +                    case GHC.Internal.Prim.dataToTagSmall#
    175 
    +                           @GHC.Internal.Types.Lifted
    176 
    +                           @Bool
    177 
    +                           (x `cast` (Sub T26117.D:R:FInt :: F Int ~R# Bool))
    178 
    +                    of b# [Occ=Once1]
    179 
    +                    { __DEFAULT ->
    180 
    +                    case GHC.Internal.Prim.==# a# b# of {
    181 
    +                      __DEFAULT -> GHC.Internal.Types.I# 4#;
    182 
    +                      1# -> GHC.Internal.Types.I# 3#
    183 
    +                    }
    184 
    +                    }
    185 
    +                    }
    186 
    +                  GHC.Internal.Control.Exception.Base.noMethodBindingError
    187 
    +                    @GHC.Internal.Types.LiftedRep
    188 
    +                    @(F Int -> Int -> [b] -> Int)
    189 
    +                    "T26117.hs:17:10-37|\CANop2\EM"#]
    190 
    +T26117.$fCaList_$s$fCaList = \ (@b) _ [Occ=Dead] -> lvl2 @b
    191 
    +
    192 
    +-- RHS size: {terms: 4, types: 9, coercions: 0, joins: 0/0}
    193 
    +lvl3 :: forall b a. F a -> a -> [b] -> Int
    194 
    +[GblId, Str=b, Cpr=b]
    195 
    +lvl3
    196 
    +  = \ (@b) (@a) ->
    197 
    +      GHC.Internal.Control.Exception.Base.noMethodBindingError
    198 
    +        @GHC.Internal.Types.LiftedRep
    199 
    +        @(F a -> a -> [b] -> Int)
    200 
    +        T26117.$fCaList1
    201 
    +
    202 
    +-- RHS size: {terms: 18, types: 21, coercions: 0, joins: 0/0}
    203 
    +T26117.$fCaList [InlPrag=CONLIKE]
    204 
    +  :: forall a b. (Eq (F a), D a b) => C a [b]
    205 
    +[GblId[DFunId],
    206 
    + Arity=2,
    207 
    + Str=<LP(SC(S,C(1,L)),A)><A>,
    208 
    + Unf=DFun: \ (@a) (@b) (v :: Eq (F a)) (v1 :: D a b) ->
    209 
    +       T26117.C:C TYPE: a
    210 
    +                  TYPE: [b]
    211 
    +                  \ (x :: F a) _ [Occ=Dead] _ [Occ=Dead] ->
    212 
    +                    case == @(F a) v x x of {
    213 
    +                      False -> T26117.$fCaList3;
    214 
    +                      True -> T26117.$fCaList2
    215 
    +                    }
    216 
    +                  T26117.$fCaList_$cop2 @a @b v v1]
    217 
    +T26117.$fCaList
    218 
    +  = \ (@a) (@b) ($dEq :: Eq (F a)) _ [Occ=Dead] ->
    219 
    +      T26117.C:C
    220 
    +        @a
    221 
    +        @[b]
    222 
    +        (\ (x :: F a) _ [Occ=Dead] _ [Occ=Dead] ->
    223 
    +           case == @(F a) $dEq x x of {
    224 
    +             False -> T26117.$fCaList3;
    225 
    +             True -> T26117.$fCaList2
    226 
    +           })
    227 
    +        (lvl3 @b @a)
    228 
    +
    229 
    +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
    230 
    +T26117.$trModule4 :: GHC.Internal.Prim.Addr#
    231 
    +[GblId,
    232 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    233 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    234 
    +         Guidance=IF_ARGS [] 20 0}]
    235 
    +T26117.$trModule4 = "main"#
    236 
    +
    237 
    +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
    238 
    +T26117.$trModule3 :: GHC.Internal.Types.TrName
    239 
    +[GblId,
    240 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    241 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    242 
    +         Guidance=IF_ARGS [] 10 10}]
    243 
    +T26117.$trModule3 = GHC.Internal.Types.TrNameS T26117.$trModule4
    244 
    +
    245 
    +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
    246 
    +T26117.$trModule2 :: GHC.Internal.Prim.Addr#
    247 
    +[GblId,
    248 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    249 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    250 
    +         Guidance=IF_ARGS [] 30 0}]
    251 
    +T26117.$trModule2 = "T26117"#
    252 
    +
    253 
    +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
    254 
    +T26117.$trModule1 :: GHC.Internal.Types.TrName
    255 
    +[GblId,
    256 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    257 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    258 
    +         Guidance=IF_ARGS [] 10 10}]
    259 
    +T26117.$trModule1 = GHC.Internal.Types.TrNameS T26117.$trModule2
    260 
    +
    261 
    +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
    262 
    +T26117.$trModule :: GHC.Internal.Types.Module
    263 
    +[GblId,
    264 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    265 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    266 
    +         Guidance=IF_ARGS [] 10 10}]
    267 
    +T26117.$trModule
    268 
    +  = GHC.Internal.Types.Module T26117.$trModule3 T26117.$trModule1
    269 
    +
    270 
    +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
    271 
    +$krep :: GHC.Internal.Types.KindRep
    272 
    +[GblId, Unf=OtherCon []]
    273 
    +$krep
    274 
    +  = GHC.Internal.Types.KindRepFun
    275 
    +      GHC.Internal.Types.krep$* GHC.Internal.Types.krep$Constraint
    276 
    +
    277 
    +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
    278 
    +T26117.$tcC1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
    279 
    +[GblId, Unf=OtherCon []]
    280 
    +T26117.$tcC1
    281 
    +  = GHC.Internal.Types.KindRepFun GHC.Internal.Types.krep$* $krep
    282 
    +
    283 
    +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
    284 
    +$krep1 :: GHC.Internal.Types.KindRep
    285 
    +[GblId, Unf=OtherCon []]
    286 
    +$krep1 = GHC.Internal.Types.KindRepVar 1#
    287 
    +
    288 
    +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
    289 
    +$krep2 :: GHC.Internal.Types.KindRep
    290 
    +[GblId, Unf=OtherCon []]
    291 
    +$krep2 = GHC.Internal.Types.KindRepFun $krep1 $krep1
    292 
    +
    293 
    +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
    294 
    +$krep3 :: GHC.Internal.Types.KindRep
    295 
    +[GblId, Unf=OtherCon []]
    296 
    +$krep3 = GHC.Internal.Types.KindRepVar 0#
    297 
    +
    298 
    +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
    299 
    +$krep4 :: GHC.Internal.Types.KindRep
    300 
    +[GblId, Unf=OtherCon []]
    301 
    +$krep4 = GHC.Internal.Types.KindRepFun $krep3 $krep2
    302 
    +
    303 
    +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
    304 
    +T26117.$tcD2 :: GHC.Internal.Prim.Addr#
    305 
    +[GblId,
    306 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    307 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    308 
    +         Guidance=IF_ARGS [] 20 0}]
    309 
    +T26117.$tcD2 = "D"#
    310 
    +
    311 
    +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
    312 
    +T26117.$tcD1 :: GHC.Internal.Types.TrName
    313 
    +[GblId,
    314 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    315 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    316 
    +         Guidance=IF_ARGS [] 10 10}]
    317 
    +T26117.$tcD1 = GHC.Internal.Types.TrNameS T26117.$tcD2
    318 
    +
    319 
    +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
    320 
    +T26117.$tcD :: GHC.Internal.Types.TyCon
    321 
    +[GblId,
    322 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    323 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    324 
    +         Guidance=IF_ARGS [] 10 10}]
    325 
    +T26117.$tcD
    326 
    +  = GHC.Internal.Types.TyCon
    327 
    +      18427868686024955676#Word64
    328 
    +      4087453451394481638#Word64
    329 
    +      T26117.$trModule
    330 
    +      T26117.$tcD1
    331 
    +      0#
    332 
    +      T26117.$tcC1
    333 
    +
    334 
    +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
    335 
    +$krep5 :: [GHC.Internal.Types.KindRep]
    336 
    +[GblId, Unf=OtherCon []]
    337 
    +$krep5
    338 
    +  = GHC.Internal.Types.:
    339 
    +      @GHC.Internal.Types.KindRep
    340 
    +      $krep1
    341 
    +      (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep)
    342 
    +
    343 
    +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
    344 
    +$krep6 :: [GHC.Internal.Types.KindRep]
    345 
    +[GblId, Unf=OtherCon []]
    346 
    +$krep6
    347 
    +  = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep3 $krep5
    348 
    +
    349 
    +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
    350 
    +$krep7 :: GHC.Internal.Types.KindRep
    351 
    +[GblId, Unf=OtherCon []]
    352 
    +$krep7 = GHC.Internal.Types.KindRepTyConApp T26117.$tcD $krep6
    353 
    +
    354 
    +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
    355 
    +$krep8 :: GHC.Internal.Types.KindRep
    356 
    +[GblId, Unf=OtherCon []]
    357 
    +$krep8 = GHC.Internal.Types.KindRepFun $krep4 $krep7
    358 
    +
    359 
    +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
    360 
    +T26117.$tc'C:D1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
    361 
    +[GblId, Unf=OtherCon []]
    362 
    +T26117.$tc'C:D1 = GHC.Internal.Types.KindRepFun $krep4 $krep8
    363 
    +
    364 
    +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
    365 
    +T26117.$tc'C:D3 :: GHC.Internal.Prim.Addr#
    366 
    +[GblId,
    367 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    368 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    369 
    +         Guidance=IF_ARGS [] 20 0}]
    370 
    +T26117.$tc'C:D3 = "'C:D"#
    371 
    +
    372 
    +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
    373 
    +T26117.$tc'C:D2 :: GHC.Internal.Types.TrName
    374 
    +[GblId,
    375 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    376 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    377 
    +         Guidance=IF_ARGS [] 10 10}]
    378 
    +T26117.$tc'C:D2 = GHC.Internal.Types.TrNameS T26117.$tc'C:D3
    379 
    +
    380 
    +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
    381 
    +T26117.$tc'C:D :: GHC.Internal.Types.TyCon
    382 
    +[GblId,
    383 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    384 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    385 
    +         Guidance=IF_ARGS [] 10 10}]
    386 
    +T26117.$tc'C:D
    387 
    +  = GHC.Internal.Types.TyCon
    388 
    +      14714477993590114477#Word64
    389 
    +      17388374250742016296#Word64
    390 
    +      T26117.$trModule
    391 
    +      T26117.$tc'C:D2
    392 
    +      2#
    393 
    +      T26117.$tc'C:D1
    394 
    +
    395 
    +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
    396 
    +T26117.$tcC3 :: GHC.Internal.Prim.Addr#
    397 
    +[GblId,
    398 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    399 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    400 
    +         Guidance=IF_ARGS [] 20 0}]
    401 
    +T26117.$tcC3 = "C"#
    402 
    +
    403 
    +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
    404 
    +T26117.$tcC2 :: GHC.Internal.Types.TrName
    405 
    +[GblId,
    406 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    407 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    408 
    +         Guidance=IF_ARGS [] 10 10}]
    409 
    +T26117.$tcC2 = GHC.Internal.Types.TrNameS T26117.$tcC3
    410 
    +
    411 
    +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
    412 
    +T26117.$tcC :: GHC.Internal.Types.TyCon
    413 
    +[GblId,
    414 
    + Unf=Unf{Src=<vanilla>, TopLvl=True,
    415 
    +         Value=True, ConLike=True, WorkFree=True, Expandable=True,
    416 
    +         Guidance=IF_ARGS [] 10 10}]
    417 
    +T26117.$tcC
    418 
    +  = GHC.Internal.Types.TyCon
    419 
    +      6116531860557468422#Word64
    420 
    +      17953227584944457497#Word64
    421 
    +      T26117.$trModule
    422 
    +      T26117.$tcC2
    423 
    +      0#
    424 
    +      T26117.$tcC1
    425 
    +
    426 
    +
    427 
    +------ Local rules for imported ids --------
    428 
    +"USPEC $fCaList @Int @_"
    429 
    +    forall (@b) ($dD :: D Int b) ($dEq :: Eq (F Int)).
    430 
    +      T26117.$fCaList @Int @b $dEq $dD
    431 
    +      = T26117.$fCaList_$s$fCaList @b $dD
    432 
    +
    433 
    +

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help