[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