diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2012-12-19 17:28:35 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2012-12-19 17:28:35 +0000 |
commit | a6ab9666557d66dfb646817ac7f9ea0429fd7a9b (patch) | |
tree | 87d0de250e03bb1b8e58c6d7b8022c91fd548f19 /src/Haddock/Convert.hs | |
parent | de8476a481867f986221a1f1d6829731d293e03b (diff) |
Track changes in UNPACK pragma stuff
Diffstat (limited to 'src/Haddock/Convert.hs')
-rw-r--r-- | src/Haddock/Convert.hs | 20 |
1 files changed, 13 insertions, 7 deletions
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs index 15fba023..aca12188 100644 --- a/src/Haddock/Convert.hs +++ b/src/Haddock/Convert.hs @@ -84,13 +84,16 @@ synifyATDefault tc = noLoc (synifyAxiom ax) where Just ax = tyConFamilyCoercion_maybe tc synifyAxiom :: CoAxiom -> FamInstDecl Name -synifyAxiom (CoAxiom { co_ax_tvs = tvs, co_ax_lhs = lhs, co_ax_rhs = rhs }) +synifyAxiom (CoAxiom { co_ax_tvs = tkvs, co_ax_lhs = lhs, co_ax_rhs = rhs }) | Just (tc, args) <- tcSplitTyConApp_maybe lhs = let name = synifyName tc typats = map (synifyType WithinType) args hs_rhs_ty = synifyType WithinType rhs + (kvs, tvs) = partition isKindVar tkvs in FamInstDecl { fid_tycon = name - , fid_pats = HsWB { hswb_cts = typats, hswb_kvs = [], hswb_tvs = map tyVarName tvs } + , fid_pats = HsWB { hswb_cts = typats + , hswb_kvs = map tyVarName kvs + , hswb_tvs = map tyVarName tvs } , fid_defn = TySynonym hs_rhs_ty, fid_fvs = placeHolderNames } | otherwise = error "synifyAxiom" @@ -194,11 +197,14 @@ synifyDataCon use_gadt_syntax dc = noLoc $ linear_tys = zipWith (\ty bang -> let tySyn = synifyType WithinType ty - in case bang of - HsUnpackFailed -> noLoc $ HsBangTy HsStrict tySyn - HsNoBang -> tySyn - -- HsNoBang never appears, it's implied instead. - _ -> noLoc $ HsBangTy bang tySyn + src_bang = case bang of + HsUnpack -> HsBang True + HsStrict -> HsBang False + _ -> bang + in case src_bang of + HsNoBang -> tySyn + _ -> noLoc $ HsBangTy bang tySyn + -- HsNoBang never appears, it's implied instead. ) arg_tys (dataConStrictMarks dc) field_tys = zipWith (\field synTy -> ConDeclField |