[commit: haddock] wip/orf-reboot: Merge remote-tracking branch 'github/ghc-head' into wip/orf-reboot (8474fd9)

git at git.haskell.org git at git.haskell.org
Mon Nov 20 20:55:44 UTC 2017


Repository : ssh://git@git.haskell.org/haddock

On branch  : wip/orf-reboot
Link       : http://git.haskell.org/haddock.git/commitdiff/8474fd968d676539dd4a558c539e1b1d0c1eca7c

>---------------------------------------------------------------

commit 8474fd968d676539dd4a558c539e1b1d0c1eca7c
Merge: eb0a6a5 5890a2d
Author: Adam Gundry <adam at well-typed.com>
Date:   Fri Oct 2 16:29:45 2015 +0100

    Merge remote-tracking branch 'github/ghc-head' into wip/orf-reboot
    
    Conflicts:
    	haddock-api/src/Haddock/Convert.hs



>---------------------------------------------------------------

8474fd968d676539dd4a558c539e1b1d0c1eca7c
 ghc.mk                                         |  4 +-
 haddock-api/src/Haddock/Backends/LaTeX.hs      |  7 +--
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 37 +++++++++++---
 haddock-api/src/Haddock/Convert.hs             | 69 +++++++++++++++-----------
 haddock-api/src/Haddock/Interface/Create.hs    | 11 ++--
 haddock-api/src/Haddock/Interface/Rename.hs    | 34 ++++++++++---
 6 files changed, 111 insertions(+), 51 deletions(-)

diff --cc haddock-api/src/Haddock/Convert.hs
index 11e2039,3fd783a..f0fc108
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@@ -28,11 -28,9 +28,10 @@@ import DataCo
  import FamInstEnv
  import Haddock.Types
  import HsSyn
- import Kind ( splitKindFunTys, synTyConResKind, isKind )
+ import Kind ( splitKindFunTys, tyConResKind, isKind )
  import Name
 +import RdrName ( mkVarUnqual )
  import PatSyn
- import PrelNames (ipClassName)
  import SrcLoc ( Located, noLoc, unLoc, noSrcSpan )
  import TcType ( tcSplitSigmaTy )
  import TyCon
@@@ -267,24 -285,17 +286,18 @@@ synifyDataCon use_gadt_syntax dc 
    -- skip any EqTheta, use 'orig'inal syntax
    ctx = synifyCtx theta
  
-   linear_tys = zipWith (\ty bang ->
-             let tySyn = synifyType WithinType ty
-                 src_bang = case bang of
-                              HsUnpack {} -> HsSrcBang Nothing (Just True) True
-                              HsStrict    -> HsSrcBang Nothing (Just False) True
-                              _           -> bang
-             in case src_bang of
-                  HsNoBang -> tySyn
-                  _        -> noLoc $ HsBangTy bang tySyn
-             -- HsNoBang never appears, it's implied instead.
-           )
-           arg_tys (dataConSrcBangs dc)
+   linear_tys =
+     zipWith (\ty bang ->
+                let tySyn = synifyType WithinType ty
+                in case bang of
+                     (HsSrcBang _ NoSrcUnpack NoSrcStrict) -> tySyn
+                     bang' -> noLoc $ HsBangTy bang' tySyn)
+             arg_tys (dataConSrcBangs dc)
  
 -  field_tys = zipWith (\field synTy -> noLoc $ ConDeclField
 -                                               [synifyName field] synTy Nothing)
 -                (dataConFieldLabels dc) linear_tys
 +  field_tys = zipWith con_decl_field (dataConFieldLabels dc) linear_tys
 +  con_decl_field fl synTy = noLoc $
 +    ConDeclField [noLoc $ FieldOcc (mkVarUnqual $ flLabel fl) (flSelector fl)] synTy
 +                 Nothing
- 
    hs_arg_tys = case (use_named_field_syntax, use_infix_syntax) of
            (True,True) -> Left "synifyDataCon: contradiction!"
            (True,False) -> return $ RecCon (noLoc field_tys)



More information about the ghc-commits mailing list