[commit: ghc] wip/orf-reboot: Successfully compiling stage 2 (f8efbff)
git at git.haskell.org
git at git.haskell.org
Fri Mar 27 15:46:03 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/orf-reboot
Link : http://ghc.haskell.org/trac/ghc/changeset/f8efbffeb293eaed322b021b5c1a589dee46af79/ghc
>---------------------------------------------------------------
commit f8efbffeb293eaed322b021b5c1a589dee46af79
Author: Adam Gundry <adam at well-typed.com>
Date: Fri Feb 20 12:57:41 2015 +0000
Successfully compiling stage 2
>---------------------------------------------------------------
f8efbffeb293eaed322b021b5c1a589dee46af79
compiler/deSugar/DsMeta.hs | 6 +++---
compiler/ghc.mk | 5 -----
compiler/hsSyn/Convert.hs | 4 ++--
compiler/typecheck/TcTyClsDecls.hs | 19 +++++--------------
4 files changed, 10 insertions(+), 24 deletions(-)
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index a496b78..72d765c 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -1864,9 +1864,9 @@ repConstr con (RecCon (L _ ips))
; rep2 recCName [unC con, unC arg_vtys] }
where
rep_ip (L _ ip) = mapM (rep_one_ip (cd_fld_type ip)) (cd_fld_names ip)
- rep_one_ip t n = do { MkC v <- lookupLOcc n
- ; MkC ty <- repBangTy t
- ; rep2 varStrictTypeName [v,ty] }
+ rep_one_ip t (L l _, Just n) = do { MkC v <- lookupLOcc $ L l n -- AMG TODO ?
+ ; MkC ty <- repBangTy t
+ ; rep2 varStrictTypeName [v,ty] }
repConstr con (InfixCon st1 st2)
= do arg1 <- repBangTy st1
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index b520fec..c8e9e4a 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -562,17 +562,12 @@ compiler_stage2_dll0_MODULES = \
Pretty \
PrimOp \
RdrName \
- RnEnv \
- RnHsDoc \
- RnNames \
Rules \
Serialized \
SrcLoc \
StaticFlags \
StringBuffer \
- TcEnv \
TcEvidence \
- TcMType \
TcRnTypes \
TcType \
TrieMap \
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 2ec1f71..629f891 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -724,7 +724,7 @@ which we don't want.
cvtFld :: (TH.Name, TH.Exp) -> CvtM (LHsRecField RdrName (LHsExpr RdrName))
cvtFld (v,e)
= do { v' <- vNameL v; e' <- cvtl e
- ; return (noLoc $ HsRecField { hsRecFieldId = v'
+ ; return (noLoc $ HsRecField { hsRecFieldLbl = v'
, hsRecFieldSel = hsRecFieldSelMissing -- AMG TODO
, hsRecFieldArg = e'
, hsRecPun = False}) }
@@ -943,7 +943,7 @@ cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField RdrName (LPat RdrName))
cvtPatFld (s,p)
= do { s' <- vNameL s; p' <- cvtPat p
- ; return (noLoc $ HsRecField { hsRecFieldId = s'
+ ; return (noLoc $ HsRecField { hsRecFieldLbl = s'
, hsRecFieldSel = hsRecFieldSelMissing -- AMG TODO
, hsRecFieldArg = p'
, hsRecPun = False}) }
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 3dfc354..70da3ad 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -1242,21 +1242,12 @@ tcConArgs new_or_data (InfixCon bty1 bty2)
tcConArgs new_or_data (RecCon fields)
= mapM (tcConArg new_or_data) btys
where
--- <<<<<<< HEAD:compiler/typecheck/TcTyClsDecls.lhs
- btys = map (cd_fld_type . unLoc) $ unLoc fields
-{-
--- AMG TODO
-||||||| merged common ancestors
- field_names = map (unLoc . cd_fld_name) fields
- btys = map cd_fld_type fields
-=======
-- We need a one-to-one mapping from field_names to btys
combined = map (\(L _ f) -> (cd_fld_names f,cd_fld_type f)) (unLoc fields)
- explode (ns,ty) = zip (map unLoc ns) (repeat ty)
+ explode (ns,ty) = zip ns (repeat ty)
exploded = concatMap explode combined
- (field_names,btys) = unzip exploded
->>>>>>> origin/master:compiler/typecheck/TcTyClsDecls.hs
--}
+ (_,btys) = unzip exploded
+
tcConArg :: NewOrData -> LHsType Name -> TcM (TcType, HsSrcBang)
tcConArg new_or_data bty
@@ -1936,10 +1927,10 @@ mkRecSelBind :: (TyCon, FieldLabel) -> (LSig Name, LHsBinds Name)
mkRecSelBind (tycon, fl)
= (L loc (IdSig sel_id), unitBag (L loc sel_bind))
where
+ loc = getSrcSpan sel_name
+ sel_id = mkExportedLocalId rec_details sel_name sel_ty
lbl = flLabel fl
sel_name = flSelector fl
- loc = getSrcSpan sel_name
- sel_id = mkExportedLocalId rec_details sel_name sel_ty
rec_details = RecSelId { sel_tycon = tycon, sel_naughty = is_naughty }
-- Find a representative constructor, con1
More information about the ghc-commits
mailing list