aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Convert.hs
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2012-12-19 17:28:35 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2012-12-19 17:28:35 +0000
commita6ab9666557d66dfb646817ac7f9ea0429fd7a9b (patch)
tree87d0de250e03bb1b8e58c6d7b8022c91fd548f19 /src/Haddock/Convert.hs
parentde8476a481867f986221a1f1d6829731d293e03b (diff)
Track changes in UNPACK pragma stuff
Diffstat (limited to 'src/Haddock/Convert.hs')
-rw-r--r--src/Haddock/Convert.hs20
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