[darcs-devel] [issue190] crash in function new_ur
Simon Marlow
bugs at darcs.net
Mon Jul 3 06:25:58 PDT 2006
New submission from Simon Marlow <simonmar at microsoft.com>:
We can supply failing repositories on request.
sh-2.04$ darcs --exact-version
darcs compiled on May 30 2005, at 11:54:13
# configured Mon May 30 11:48:37 USMST 2005
sh ./configure --disable-mmap --target=mingw
Context:
[update web page to reflect new stable release (1.0.3)
Tomasz Zielonka <tomasz.zielonka at gmail.com>**20050524225643]
[TAG 1.0.3
Tomasz Zielonka <tomasz.zielonka at gmail.com>**20050524215127]
sh-2.04$ darcs pull http://darcs.haskell.org/ghc
This is the GHC darcs repostory (HEAD branch)
For more information, visit the GHC developer wiki at
http://hackage.haskell.org/trac/ghc
**********************
Wed May 17 16:42:04 GMT Daylight Time 2006 simonpj at microsoft.com
* Improve pretty-printing slightly
Shall I pull this patch? (1/94) [ynWvpxqadjk], or ? for help: y
Wed May 17 16:43:04 GMT Daylight Time 2006 simonpj at microsoft.com
* Comments only
Shall I pull this patch? (2/94) [ynWvpxqadjk], or ? for help: y
Wed May 17 16:43:49 GMT Daylight Time 2006 simonpj at microsoft.com
* Improve pretty-printing
Shall I pull this patch? (3/94) [ynWvpxqadjk], or ? for help: y
Wed May 17 16:44:49 GMT Daylight Time 2006 simonpj at microsoft.com
* Retain INLINE pragma information during indirection-shorting
During indirection-shorting, we were dropping the InlinePragInfo,
although were were carefully retaining strictness info etc.
I think this is a long-standing bug.
Shall I pull this patch? (4/94) [ynWvpxqadjk], or ? for help: y
Wed May 17 16:47:10 GMT Daylight Time 2006 simonpj at microsoft.com
* Spelling correction
Shall I pull this patch? (5/94) [ynWvpxqadjk], or ? for help: a
darcs.exe: bug in darcs!
in function new_ur
Original patch:
merger 0.9 (
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 633
--- gaw 2004
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 589
- rhs = unfoldingTemplate unfold_info
- unfold_hsinfo | neverUnfold unfold_info -- The CoreTidy phase retains
unfolding info iff
- || has_worker = Nothing -- we want to expose the unfolding, taking into account
- -- unconditional NOINLINE, etc. See TidyPgm.addExternal
- | otherwise = Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
+ inline_hsinfo | isAlwaysActive inline_prag = Nothing
+ | no_unfolding && not has_worker = Nothing
+ -- If the iface file give no unfolding info, we
+ -- don't need to say when inlining is OK!
+ | otherwise = Just (HsInline inline_prag)
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 577
- unfold_info = unfoldingInfo id_info
+ unfold_info = unfoldingInfo id_info
+ rhs = unfoldingTemplate unfold_info
+ no_unfolding = neverUnfold unfold_info
+ -- The CoreTidy phase retains unfolding info iff
+ -- we want to expose the unfolding, taking into account
+ -- unconditional NOINLINE, etc. See TidyPgm.addExternal
+ unfold_hsinfo | no_unfolding = Nothing
+ | has_worker = Nothing -- Unfolding is implicit
+ | otherwise = Just (HsUnfold (toIfaceExpr ext rhs))
+
+ ------------ Inline prag --------------
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 548
- wrkr_hsinfo, unfold_hsinfo]
+ inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 580
- unfold_hsinfo | neverUnfold unfold_info
- || has_worker = Nothing
+ unfold_hsinfo | neverUnfold unfold_info -- The CoreTidy phase retains
unfolding info iff
+ || has_worker = Nothing -- we want to expose the unfolding, taking into account
+ -- unconditional NOINLINE, etc. See TidyPgm.addExternal
hunk ./compiler/iface/IfaceSyn.lhs 417
-\end{code}
-
-
-%************************************************************************
-%* *
- Converting things to their Iface equivalents
-%* *
-%************************************************************************
-
-
-\begin{code}
-tyThingToIfaceDecl :: (Name -> IfaceExtName) -> TyThing -> IfaceDecl
--- Assumption: the thing is already tidied, so that locally-bound names
--- (lambdas, for-alls) already have non-clashing OccNames
--- Reason: Iface stuff uses OccNames, and the conversion here does
--- not do tidying on the way
-tyThingToIfaceDecl ext (AnId id)
- = IfaceId { ifName = getOccName id,
- ifType = toIfaceType ext (idType id),
- ifIdInfo = info }
- where
- info = case toIfaceIdInfo ext (idInfo id) of
- [] -> NoInfo
- items -> HasInfo items
-
-tyThingToIfaceDecl ext (AClass clas)
- = IfaceClass { ifCtxt = toIfaceContext ext sc_theta,
- ifName = getOccName clas,
- ifTyVars = toIfaceTvBndrs clas_tyvars,
- ifFDs = map toIfaceFD clas_fds,
- ifSigs = map toIfaceClassOp op_stuff,
- ifRec = boolToRecFlag (isRecursiveTyCon tycon),
- ifVrcs = tyConArgVrcs tycon }
- where
- (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
- tycon = classTyCon clas
-
- toIfaceClassOp (sel_id, def_meth)
- = ASSERT(sel_tyvars == clas_tyvars)
- IfaceClassOp (getOccName sel_id) def_meth (toIfaceType ext op_ty)
- where
- -- Be careful when splitting the type, because of things
- -- like class Foo a where
- -- op :: (?x :: String) => a -> a
- -- and class Baz a where
- -- op :: (Ord a) => a -> a
- (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
- op_ty = funResultTy rho_ty
-
- toIfaceFD (tvs1, tvs2) = (map getOccName tvs1, map getOccName tvs2)
-
-tyThingToIfaceDecl ext (ATyCon tycon)
- | isSynTyCon tycon
- = IfaceSyn { ifName = getOccName tycon,
- ifTyVars = toIfaceTvBndrs tyvars,
- ifVrcs = tyConArgVrcs tycon,
- ifSynRhs = toIfaceType ext syn_ty }
-
- | isAlgTyCon tycon
- = IfaceData { ifName = getOccName tycon,
- ifTyVars = toIfaceTvBndrs tyvars,
- ifCtxt = toIfaceContext ext (tyConStupidTheta tycon),
- ifCons = ifaceConDecls (algTyConRhs tycon),
- ifRec = boolToRecFlag (isRecursiveTyCon tycon),
- ifGadtSyntax = isGadtSyntaxTyCon tycon,
- ifVrcs = tyConArgVrcs tycon,
- ifGeneric = tyConHasGenerics tycon }
-
- | isForeignTyCon tycon
- = IfaceForeign { ifName = getOccName tycon,
- ifExtName = tyConExtName tycon }
-
- | isPrimTyCon tycon || isFunTyCon tycon
- -- Needed in GHCi for ':info Int#', for example
- = IfaceData { ifName = getOccName tycon,
- ifTyVars = toIfaceTvBndrs (take (tyConArity tycon) alphaTyVars),
- ifCtxt = [],
- ifCons = IfAbstractTyCon,
- ifGadtSyntax = False,
- ifGeneric = False,
- ifRec = NonRecursive,
- ifVrcs = tyConArgVrcs tycon }
-
- | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
- where
- tyvars = tyConTyVars tycon
- syn_ty = synTyConRhs tycon
-
- ifaceConDecls (NewTyCon { data_con = con }) = IfNewTyCon (ifaceConDecl con)
- ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map
ifaceConDecl cons)
- ifaceConDecls AbstractTyCon = IfAbstractTyCon
- -- The last case happens when a TyCon has been trimmed during tidying
- -- Furthermore, tyThingToIfaceDecl is also used
- -- in TcRnDriver for GHCi, when browsing a module, in which case the
- -- AbstractTyCon case is perfectly sensible.
-
- ifaceConDecl data_con
- = IfCon { ifConOcc = getOccName (dataConName data_con),
- ifConInfix = dataConIsInfix data_con,
- ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
- ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
- ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
- ifConCtxt = toIfaceContext ext (dataConTheta data_con),
- ifConArgTys = map (toIfaceType ext) (dataConOrigArgTys data_con),
- ifConFields = map getOccName (dataConFieldLabels data_con),
- ifConStricts = dataConStrictMarks data_con }
-
- to_eq_spec spec = [(getOccName tv, toIfaceType ext ty) | (tv,ty) <- spec]
-
-tyThingToIfaceDecl ext (ADataCon dc)
- = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
-
-
---------------------------
-instanceToIfaceInst :: (Name -> IfaceExtName) -> Instance -> IfaceInst
-instanceToIfaceInst ext_lhs ispec@(Instance { is_dfun = dfun_id, is_flag = oflag,
- is_cls = cls, is_tcs = mb_tcs,
- is_orph = orph })
- = IfaceInst { ifDFun = getOccName dfun_id,
- ifOFlag = oflag,
- ifInstCls = ext_lhs cls,
- ifInstTys = map do_rough mb_tcs,
- ifInstOrph = orph }
- where
- do_rough Nothing = Nothing
- do_rough (Just n) = Just (toIfaceTyCon_name ext_lhs n)
-
---------------------------
-toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
-toIfaceIdInfo ext id_info
- = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
- wrkr_hsinfo, unfold_hsinfo]
- where
- ------------ Arity --------------
- arity_info = arityInfo id_info
- arity_hsinfo | arity_info == 0 = Nothing
- | otherwise = Just (HsArity arity_info)
-
- ------------ Caf Info --------------
- caf_info = cafInfo id_info
- caf_hsinfo = case caf_info of
- NoCafRefs -> Just HsNoCafRefs
- _other -> Nothing
-
- ------------ Strictness --------------
- -- No point in explicitly exporting TopSig
- strict_hsinfo = case newStrictnessInfo id_info of
- Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
- _other -> Nothing
-
- ------------ Worker --------------
- work_info = workerInfo id_info
- has_worker = case work_info of { HasWorker _ _ -> True; other -> False }
- wrkr_hsinfo = case work_info of
- HasWorker work_id wrap_arity ->
- Just (HsWorker (ext (idName work_id)) wrap_arity)
- NoWorker -> Nothing
-
- ------------ Unfolding --------------
- -- The unfolding is redundant if there is a worker
- unfold_info = unfoldingInfo id_info
- inline_prag = inlinePragInfo id_info
- rhs = unfoldingTemplate unfold_info
- unfold_hsinfo | neverUnfold unfold_info
- || has_worker = Nothing
- | otherwise = Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
-
---------------------------
-coreRuleToIfaceRule :: (Name -> IfaceExtName) -- For the LHS names
- -> (Name -> IfaceExtName) -- For the RHS names
- -> CoreRule -> IfaceRule
-coreRuleToIfaceRule ext_lhs ext_rhs (BuiltinRule { ru_fn = fn})
- = pprTrace "toHsRule: builtin" (ppr fn) $
- bogusIfaceRule (mkIfaceExtName fn)
-
-coreRuleToIfaceRule ext_lhs ext_rhs
- (Rule { ru_name = name, ru_fn = fn, ru_act = act, ru_bndrs = bndrs,
- ru_args = args, ru_rhs = rhs, ru_orph = orph })
- = IfaceRule { ifRuleName = name, ifActivation = act,
- ifRuleBndrs = map (toIfaceBndr ext_lhs) bndrs,
- ifRuleHead = ext_lhs fn,
- ifRuleArgs = map do_arg args,
- ifRuleRhs = toIfaceExpr ext_rhs rhs,
- ifRuleOrph = orph }
- where
- -- For type args we must remove synonyms from the outermost
- -- level. Reason: so that when we read it back in we'll
- -- construct the same ru_rough field as we have right now;
- -- see tcIfaceRule
- do_arg (Type ty) = IfaceType (toIfaceType ext_lhs (deNoteType ty))
- do_arg arg = toIfaceExpr ext_lhs arg
-
-bogusIfaceRule :: IfaceExtName -> IfaceRule
-bogusIfaceRule id_name
- = IfaceRule { ifRuleName = FSLIT("bogus"), ifActivation = NeverActive,
- ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
- ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
-
----------------------
-toIfaceExpr :: (Name -> IfaceExtName) -> CoreExpr -> IfaceExpr
-toIfaceExpr ext (Var v) = toIfaceVar ext v
-toIfaceExpr ext (Lit l) = IfaceLit l
-toIfaceExpr ext (Type ty) = IfaceType (toIfaceType ext ty)
-toIfaceExpr ext (Lam x b) = IfaceLam (toIfaceBndr ext x) (toIfaceExpr ext b)
-toIfaceExpr ext (App f a) = toIfaceApp ext f [a]
--- gaw 2004
-toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (getOccName x)
(toIfaceType ext ty) (map (toIfaceAlt ext) as)
-toIfaceExpr ext (Let b e) = IfaceLet (toIfaceBind ext b) (toIfaceExpr ext e)
-toIfaceExpr ext (Cast e co) = IfaceCast (toIfaceExpr ext e) (toIfaceType ext co)
-toIfaceExpr ext (Note n e) = IfaceNote (toIfaceNote ext n) (toIfaceExpr ext e)
-
----------------------
-toIfaceNote ext (SCC cc) = IfaceSCC cc
-toIfaceNote ext InlineCall = IfaceInlineCall
-toIfaceNote ext InlineMe = IfaceInlineMe
-toIfaceNote ext (CoreNote s) = IfaceCoreNote s
-
----------------------
-toIfaceBind ext (NonRec b r) = IfaceNonRec (toIfaceIdBndr ext b) (toIfaceExpr
ext r)
-toIfaceBind ext (Rec prs) = IfaceRec [(toIfaceIdBndr ext b, toIfaceExpr ext
r) | (b,r) <- prs]
-
----------------------
-toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map getOccName bs, toIfaceExpr ext r)
-
----------------------
-toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
- | otherwise = IfaceDataAlt (getOccName dc)
- where
- tc = dataConTyCon dc
-
-toIfaceCon (LitAlt l) = IfaceLitAlt l
-toIfaceCon DEFAULT = IfaceDefault
-
----------------------
-toIfaceApp ext (App f a) as = toIfaceApp ext f (a:as)
-toIfaceApp ext (Var v) as
- = case isDataConWorkId_maybe v of
- -- We convert the *worker* for tuples into IfaceTuples
- Just dc | isTupleTyCon tc && saturated
- -> IfaceTuple (tupleTyConBoxity tc) tup_args
- where
- val_args = dropWhile isTypeArg as
- saturated = val_args `lengthIs` idArity v
- tup_args = map (toIfaceExpr ext) val_args
- tc = dataConTyCon dc
-
- other -> mkIfaceApps ext (toIfaceVar ext v) as
-
-toIfaceApp ext e as = mkIfaceApps ext (toIfaceExpr ext e) as
-
-mkIfaceApps ext f as = foldl (\f a -> IfaceApp f (toIfaceExpr ext a)) f as
-
----------------------
-toIfaceVar :: (Name -> IfaceExtName) -> Id -> IfaceExpr
-toIfaceVar ext v
- | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType ext (idType v))
- -- Foreign calls have special syntax
- | isExternalName name = IfaceExt (ext name)
- | otherwise = IfaceLcl (nameOccName name)
- where
- name = idName v
)
)
)
)
)
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 640
---toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 640
-toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
+--toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
hunk ./compiler/iface/IfaceSyn.lhs 641
-toIfaceNote ext InlineCall = IfaceInlineCall
)
)
)
Unwound:
merger 0.9 (
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 633
--- gaw 2004
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 589
- rhs = unfoldingTemplate unfold_info
- unfold_hsinfo | neverUnfold unfold_info -- The CoreTidy phase retains
unfolding info iff
- || has_worker = Nothing -- we want to expose the unfolding, taking into account
- -- unconditional NOINLINE, etc. See TidyPgm.addExternal
- | otherwise = Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
+ inline_hsinfo | isAlwaysActive inline_prag = Nothing
+ | no_unfolding && not has_worker = Nothing
+ -- If the iface file give no unfolding info, we
+ -- don't need to say when inlining is OK!
+ | otherwise = Just (HsInline inline_prag)
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 577
- unfold_info = unfoldingInfo id_info
+ unfold_info = unfoldingInfo id_info
+ rhs = unfoldingTemplate unfold_info
+ no_unfolding = neverUnfold unfold_info
+ -- The CoreTidy phase retains unfolding info iff
+ -- we want to expose the unfolding, taking into account
+ -- unconditional NOINLINE, etc. See TidyPgm.addExternal
+ unfold_hsinfo | no_unfolding = Nothing
+ | has_worker = Nothing -- Unfolding is implicit
+ | otherwise = Just (HsUnfold (toIfaceExpr ext rhs))
+
+ ------------ Inline prag --------------
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 548
- wrkr_hsinfo, unfold_hsinfo]
+ inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 580
- unfold_hsinfo | neverUnfold unfold_info
- || has_worker = Nothing
+ unfold_hsinfo | neverUnfold unfold_info -- The CoreTidy phase retains
unfolding info iff
+ || has_worker = Nothing -- we want to expose the unfolding, taking into account
+ -- unconditional NOINLINE, etc. See TidyPgm.addExternal
hunk ./compiler/iface/IfaceSyn.lhs 417
-\end{code}
-
-
-%************************************************************************
-%* *
- Converting things to their Iface equivalents
-%* *
-%************************************************************************
-
-
-\begin{code}
-tyThingToIfaceDecl :: (Name -> IfaceExtName) -> TyThing -> IfaceDecl
--- Assumption: the thing is already tidied, so that locally-bound names
--- (lambdas, for-alls) already have non-clashing OccNames
--- Reason: Iface stuff uses OccNames, and the conversion here does
--- not do tidying on the way
-tyThingToIfaceDecl ext (AnId id)
- = IfaceId { ifName = getOccName id,
- ifType = toIfaceType ext (idType id),
- ifIdInfo = info }
- where
- info = case toIfaceIdInfo ext (idInfo id) of
- [] -> NoInfo
- items -> HasInfo items
-
-tyThingToIfaceDecl ext (AClass clas)
- = IfaceClass { ifCtxt = toIfaceContext ext sc_theta,
- ifName = getOccName clas,
- ifTyVars = toIfaceTvBndrs clas_tyvars,
- ifFDs = map toIfaceFD clas_fds,
- ifSigs = map toIfaceClassOp op_stuff,
- ifRec = boolToRecFlag (isRecursiveTyCon tycon),
- ifVrcs = tyConArgVrcs tycon }
- where
- (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
- tycon = classTyCon clas
-
- toIfaceClassOp (sel_id, def_meth)
- = ASSERT(sel_tyvars == clas_tyvars)
- IfaceClassOp (getOccName sel_id) def_meth (toIfaceType ext op_ty)
- where
- -- Be careful when splitting the type, because of things
- -- like class Foo a where
- -- op :: (?x :: String) => a -> a
- -- and class Baz a where
- -- op :: (Ord a) => a -> a
- (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
- op_ty = funResultTy rho_ty
-
- toIfaceFD (tvs1, tvs2) = (map getOccName tvs1, map getOccName tvs2)
-
-tyThingToIfaceDecl ext (ATyCon tycon)
- | isSynTyCon tycon
- = IfaceSyn { ifName = getOccName tycon,
- ifTyVars = toIfaceTvBndrs tyvars,
- ifVrcs = tyConArgVrcs tycon,
- ifSynRhs = toIfaceType ext syn_ty }
-
- | isAlgTyCon tycon
- = IfaceData { ifName = getOccName tycon,
- ifTyVars = toIfaceTvBndrs tyvars,
- ifCtxt = toIfaceContext ext (tyConStupidTheta tycon),
- ifCons = ifaceConDecls (algTyConRhs tycon),
- ifRec = boolToRecFlag (isRecursiveTyCon tycon),
- ifGadtSyntax = isGadtSyntaxTyCon tycon,
- ifVrcs = tyConArgVrcs tycon,
- ifGeneric = tyConHasGenerics tycon }
-
- | isForeignTyCon tycon
- = IfaceForeign { ifName = getOccName tycon,
- ifExtName = tyConExtName tycon }
-
- | isPrimTyCon tycon || isFunTyCon tycon
- -- Needed in GHCi for ':info Int#', for example
- = IfaceData { ifName = getOccName tycon,
- ifTyVars = toIfaceTvBndrs (take (tyConArity tycon) alphaTyVars),
- ifCtxt = [],
- ifCons = IfAbstractTyCon,
- ifGadtSyntax = False,
- ifGeneric = False,
- ifRec = NonRecursive,
- ifVrcs = tyConArgVrcs tycon }
-
- | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
- where
- tyvars = tyConTyVars tycon
- syn_ty = synTyConRhs tycon
-
- ifaceConDecls (NewTyCon { data_con = con }) = IfNewTyCon (ifaceConDecl con)
- ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map
ifaceConDecl cons)
- ifaceConDecls AbstractTyCon = IfAbstractTyCon
- -- The last case happens when a TyCon has been trimmed during tidying
- -- Furthermore, tyThingToIfaceDecl is also used
- -- in TcRnDriver for GHCi, when browsing a module, in which case the
- -- AbstractTyCon case is perfectly sensible.
-
- ifaceConDecl data_con
- = IfCon { ifConOcc = getOccName (dataConName data_con),
- ifConInfix = dataConIsInfix data_con,
- ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
- ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
- ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
- ifConCtxt = toIfaceContext ext (dataConTheta data_con),
- ifConArgTys = map (toIfaceType ext) (dataConOrigArgTys data_con),
- ifConFields = map getOccName (dataConFieldLabels data_con),
- ifConStricts = dataConStrictMarks data_con }
-
- to_eq_spec spec = [(getOccName tv, toIfaceType ext ty) | (tv,ty) <- spec]
-
-tyThingToIfaceDecl ext (ADataCon dc)
- = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
-
-
---------------------------
-instanceToIfaceInst :: (Name -> IfaceExtName) -> Instance -> IfaceInst
-instanceToIfaceInst ext_lhs ispec@(Instance { is_dfun = dfun_id, is_flag = oflag,
- is_cls = cls, is_tcs = mb_tcs,
- is_orph = orph })
- = IfaceInst { ifDFun = getOccName dfun_id,
- ifOFlag = oflag,
- ifInstCls = ext_lhs cls,
- ifInstTys = map do_rough mb_tcs,
- ifInstOrph = orph }
- where
- do_rough Nothing = Nothing
- do_rough (Just n) = Just (toIfaceTyCon_name ext_lhs n)
-
---------------------------
-toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
-toIfaceIdInfo ext id_info
- = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
- wrkr_hsinfo, unfold_hsinfo]
- where
- ------------ Arity --------------
- arity_info = arityInfo id_info
- arity_hsinfo | arity_info == 0 = Nothing
- | otherwise = Just (HsArity arity_info)
-
- ------------ Caf Info --------------
- caf_info = cafInfo id_info
- caf_hsinfo = case caf_info of
- NoCafRefs -> Just HsNoCafRefs
- _other -> Nothing
-
- ------------ Strictness --------------
- -- No point in explicitly exporting TopSig
- strict_hsinfo = case newStrictnessInfo id_info of
- Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
- _other -> Nothing
-
- ------------ Worker --------------
- work_info = workerInfo id_info
- has_worker = case work_info of { HasWorker _ _ -> True; other -> False }
- wrkr_hsinfo = case work_info of
- HasWorker work_id wrap_arity ->
- Just (HsWorker (ext (idName work_id)) wrap_arity)
- NoWorker -> Nothing
-
- ------------ Unfolding --------------
- -- The unfolding is redundant if there is a worker
- unfold_info = unfoldingInfo id_info
- inline_prag = inlinePragInfo id_info
- rhs = unfoldingTemplate unfold_info
- unfold_hsinfo | neverUnfold unfold_info
- || has_worker = Nothing
- | otherwise = Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
-
---------------------------
-coreRuleToIfaceRule :: (Name -> IfaceExtName) -- For the LHS names
- -> (Name -> IfaceExtName) -- For the RHS names
- -> CoreRule -> IfaceRule
-coreRuleToIfaceRule ext_lhs ext_rhs (BuiltinRule { ru_fn = fn})
- = pprTrace "toHsRule: builtin" (ppr fn) $
- bogusIfaceRule (mkIfaceExtName fn)
-
-coreRuleToIfaceRule ext_lhs ext_rhs
- (Rule { ru_name = name, ru_fn = fn, ru_act = act, ru_bndrs = bndrs,
- ru_args = args, ru_rhs = rhs, ru_orph = orph })
- = IfaceRule { ifRuleName = name, ifActivation = act,
- ifRuleBndrs = map (toIfaceBndr ext_lhs) bndrs,
- ifRuleHead = ext_lhs fn,
- ifRuleArgs = map do_arg args,
- ifRuleRhs = toIfaceExpr ext_rhs rhs,
- ifRuleOrph = orph }
- where
- -- For type args we must remove synonyms from the outermost
- -- level. Reason: so that when we read it back in we'll
- -- construct the same ru_rough field as we have right now;
- -- see tcIfaceRule
- do_arg (Type ty) = IfaceType (toIfaceType ext_lhs (deNoteType ty))
- do_arg arg = toIfaceExpr ext_lhs arg
-
-bogusIfaceRule :: IfaceExtName -> IfaceRule
-bogusIfaceRule id_name
- = IfaceRule { ifRuleName = FSLIT("bogus"), ifActivation = NeverActive,
- ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
- ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
-
----------------------
-toIfaceExpr :: (Name -> IfaceExtName) -> CoreExpr -> IfaceExpr
-toIfaceExpr ext (Var v) = toIfaceVar ext v
-toIfaceExpr ext (Lit l) = IfaceLit l
-toIfaceExpr ext (Type ty) = IfaceType (toIfaceType ext ty)
-toIfaceExpr ext (Lam x b) = IfaceLam (toIfaceBndr ext x) (toIfaceExpr ext b)
-toIfaceExpr ext (App f a) = toIfaceApp ext f [a]
--- gaw 2004
-toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (getOccName x)
(toIfaceType ext ty) (map (toIfaceAlt ext) as)
-toIfaceExpr ext (Let b e) = IfaceLet (toIfaceBind ext b) (toIfaceExpr ext e)
-toIfaceExpr ext (Cast e co) = IfaceCast (toIfaceExpr ext e) (toIfaceType ext co)
-toIfaceExpr ext (Note n e) = IfaceNote (toIfaceNote ext n) (toIfaceExpr ext e)
-
----------------------
-toIfaceNote ext (SCC cc) = IfaceSCC cc
-toIfaceNote ext InlineCall = IfaceInlineCall
-toIfaceNote ext InlineMe = IfaceInlineMe
-toIfaceNote ext (CoreNote s) = IfaceCoreNote s
-
----------------------
-toIfaceBind ext (NonRec b r) = IfaceNonRec (toIfaceIdBndr ext b) (toIfaceExpr
ext r)
-toIfaceBind ext (Rec prs) = IfaceRec [(toIfaceIdBndr ext b, toIfaceExpr ext
r) | (b,r) <- prs]
-
----------------------
-toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map getOccName bs, toIfaceExpr ext r)
-
----------------------
-toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
- | otherwise = IfaceDataAlt (getOccName dc)
- where
- tc = dataConTyCon dc
-
-toIfaceCon (LitAlt l) = IfaceLitAlt l
-toIfaceCon DEFAULT = IfaceDefault
-
----------------------
-toIfaceApp ext (App f a) as = toIfaceApp ext f (a:as)
-toIfaceApp ext (Var v) as
- = case isDataConWorkId_maybe v of
- -- We convert the *worker* for tuples into IfaceTuples
- Just dc | isTupleTyCon tc && saturated
- -> IfaceTuple (tupleTyConBoxity tc) tup_args
- where
- val_args = dropWhile isTypeArg as
- saturated = val_args `lengthIs` idArity v
- tup_args = map (toIfaceExpr ext) val_args
- tc = dataConTyCon dc
-
- other -> mkIfaceApps ext (toIfaceVar ext v) as
-
-toIfaceApp ext e as = mkIfaceApps ext (toIfaceExpr ext e) as
-
-mkIfaceApps ext f as = foldl (\f a -> IfaceApp f (toIfaceExpr ext a)) f as
-
----------------------
-toIfaceVar :: (Name -> IfaceExtName) -> Id -> IfaceExpr
-toIfaceVar ext v
- | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType ext (idType v))
- -- Foreign calls have special syntax
- | isExternalName name = IfaceExt (ext name)
- | otherwise = IfaceLcl (nameOccName name)
- where
- name = idName v
)
)
)
)
)
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 640
---toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 640
-toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
+--toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
hunk ./compiler/iface/IfaceSyn.lhs 641
-toIfaceNote ext InlineCall = IfaceInlineCall
)
)
)
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 633
--- gaw 2004
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 589
- rhs = unfoldingTemplate unfold_info
- unfold_hsinfo | neverUnfold unfold_info -- The CoreTidy phase retains
unfolding info iff
- || has_worker = Nothing -- we want to expose the unfolding, taking into account
- -- unconditional NOINLINE, etc. See TidyPgm.addExternal
- | otherwise = Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
+ inline_hsinfo | isAlwaysActive inline_prag = Nothing
+ | no_unfolding && not has_worker = Nothing
+ -- If the iface file give no unfolding info, we
+ -- don't need to say when inlining is OK!
+ | otherwise = Just (HsInline inline_prag)
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 577
- unfold_info = unfoldingInfo id_info
+ unfold_info = unfoldingInfo id_info
+ rhs = unfoldingTemplate unfold_info
+ no_unfolding = neverUnfold unfold_info
+ -- The CoreTidy phase retains unfolding info iff
+ -- we want to expose the unfolding, taking into account
+ -- unconditional NOINLINE, etc. See TidyPgm.addExternal
+ unfold_hsinfo | no_unfolding = Nothing
+ | has_worker = Nothing -- Unfolding is implicit
+ | otherwise = Just (HsUnfold (toIfaceExpr ext rhs))
+
+ ------------ Inline prag --------------
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 548
- wrkr_hsinfo, unfold_hsinfo]
+ inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
merger 0.0 (
hunk ./compiler/iface/IfaceSyn.lhs 580
- unfold_hsinfo | neverUnfold unfold_info
- || has_worker = Nothing
+ unfold_hsinfo | neverUnfold unfold_info -- The CoreTidy phase retains
unfolding info iff
+ || has_worker = Nothing -- we want to expose the unfolding, taking into account
+ -- unconditional NOINLINE, etc. See TidyPgm.addExternal
hunk ./compiler/iface/IfaceSyn.lhs 417
-\end{code}
-
-
-%************************************************************************
-%* *
- Converting things to their Iface equivalents
-%* *
-%************************************************************************
-
-
-\begin{code}
-tyThingToIfaceDecl :: (Name -> IfaceExtName) -> TyThing -> IfaceDecl
--- Assumption: the thing is already tidied, so that locally-bound names
--- (lambdas, for-alls) already have non-clashing OccNames
--- Reason: Iface stuff uses OccNames, and the conversion here does
--- not do tidying on the way
-tyThingToIfaceDecl ext (AnId id)
- = IfaceId { ifName = getOccName id,
- ifType = toIfaceType ext (idType id),
- ifIdInfo = info }
- where
- info = case toIfaceIdInfo ext (idInfo id) of
- [] -> NoInfo
- items -> HasInfo items
-
-tyThingToIfaceDecl ext (AClass clas)
- = IfaceClass { ifCtxt = toIfaceContext ext sc_theta,
- ifName = getOccName clas,
- ifTyVars = toIfaceTvBndrs clas_tyvars,
- ifFDs = map toIfaceFD clas_fds,
- ifSigs = map toIfaceClassOp op_stuff,
- ifRec = boolToRecFlag (isRecursiveTyCon tycon),
- ifVrcs = tyConArgVrcs tycon }
- where
- (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
- tycon = classTyCon clas
-
- toIfaceClassOp (sel_id, def_meth)
- = ASSERT(sel_tyvars == clas_tyvars)
- IfaceClassOp (getOccName sel_id) def_meth (toIfaceType ext op_ty)
- where
- -- Be careful when splitting the type, because of things
- -- like class Foo a where
- -- op :: (?x :: String) => a -> a
- -- and class Baz a where
- -- op :: (Ord a) => a -> a
- (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
- op_ty = funResultTy rho_ty
-
- toIfaceFD (tvs1, tvs2) = (map getOccName tvs1, map getOccName tvs2)
-
-tyThingToIfaceDecl ext (ATyCon tycon)
- | isSynTyCon tycon
- = IfaceSyn { ifName = getOccName tycon,
- ifTyVars = toIfaceTvBndrs tyvars,
- ifVrcs = tyConArgVrcs tycon,
- ifSynRhs = toIfaceType ext syn_ty }
-
- | isAlgTyCon tycon
- = IfaceData { ifName = getOccName tycon,
- ifTyVars = toIfaceTvBndrs tyvars,
- ifCtxt = toIfaceContext ext (tyConStupidTheta tycon),
- ifCons = ifaceConDecls (algTyConRhs tycon),
- ifRec = boolToRecFlag (isRecursiveTyCon tycon),
- ifGadtSyntax = isGadtSyntaxTyCon tycon,
- ifVrcs = tyConArgVrcs tycon,
- ifGeneric = tyConHasGenerics tycon }
-
- | isForeignTyCon tycon
- = IfaceForeign { ifName = getOccName tycon,
- ifExtName = tyConExtName tycon }
-
- | isPrimTyCon tycon || isFunTyCon tycon
- -- Needed in GHCi for ':info Int#', for example
- = IfaceData { ifName = getOccName tycon,
- ifTyVars = toIfaceTvBndrs (take (tyConArity tycon) alphaTyVars),
- ifCtxt = [],
- ifCons = IfAbstractTyCon,
- ifGadtSyntax = False,
- ifGeneric = False,
- ifRec = NonRecursive,
- ifVrcs = tyConArgVrcs tycon }
-
- | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
- where
- tyvars = tyConTyVars tycon
- syn_ty = synTyConRhs tycon
-
- ifaceConDecls (NewTyCon { data_con = con }) = IfNewTyCon (ifaceConDecl con)
- ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map
ifaceConDecl cons)
- ifaceConDecls AbstractTyCon = IfAbstractTyCon
- -- The last case happens when a TyCon has been trimmed during tidying
- -- Furthermore, tyThingToIfaceDecl is also used
- -- in TcRnDriver for GHCi, when browsing a module, in which case the
- -- AbstractTyCon case is perfectly sensible.
-
- ifaceConDecl data_con
- = IfCon { ifConOcc = getOccName (dataConName data_con),
- ifConInfix = dataConIsInfix data_con,
- ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
- ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
- ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
- ifConCtxt = toIfaceContext ext (dataConTheta data_con),
- ifConArgTys = map (toIfaceType ext) (dataConOrigArgTys data_con),
- ifConFields = map getOccName (dataConFieldLabels data_con),
- ifConStricts = dataConStrictMarks data_con }
-
- to_eq_spec spec = [(getOccName tv, toIfaceType ext ty) | (tv,ty) <- spec]
-
-tyThingToIfaceDecl ext (ADataCon dc)
- = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
-
-
---------------------------
-instanceToIfaceInst :: (Name -> IfaceExtName) -> Instance -> IfaceInst
-instanceToIfaceInst ext_lhs ispec@(Instance { is_dfun = dfun_id, is_flag = oflag,
- is_cls = cls, is_tcs = mb_tcs,
- is_orph = orph })
- = IfaceInst { ifDFun = getOccName dfun_id,
- ifOFlag = oflag,
- ifInstCls = ext_lhs cls,
- ifInstTys = map do_rough mb_tcs,
- ifInstOrph = orph }
- where
- do_rough Nothing = Nothing
- do_rough (Just n) = Just (toIfaceTyCon_name ext_lhs n)
-
---------------------------
-toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
-toIfaceIdInfo ext id_info
- = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
- wrkr_hsinfo, unfold_hsinfo]
- where
- ------------ Arity --------------
- arity_info = arityInfo id_info
- arity_hsinfo | arity_info == 0 = Nothing
- | otherwise = Just (HsArity arity_info)
-
- ------------ Caf Info --------------
- caf_info = cafInfo id_info
- caf_hsinfo = case caf_info of
- NoCafRefs -> Just HsNoCafRefs
- _other -> Nothing
-
- ------------ Strictness --------------
- -- No point in explicitly exporting TopSig
- strict_hsinfo = case newStrictnessInfo id_info of
- Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
- _other -> Nothing
-
- ------------ Worker --------------
- work_info = workerInfo id_info
- has_worker = case work_info of { HasWorker _ _ -> True; other -> False }
- wrkr_hsinfo = case work_info of
- HasWorker work_id wrap_arity ->
- Just (HsWorker (ext (idName work_id)) wrap_arity)
- NoWorker -> Nothing
-
- ------------ Unfolding --------------
- -- The unfolding is redundant if there is a worker
- unfold_info = unfoldingInfo id_info
- inline_prag = inlinePragInfo id_info
- rhs = unfoldingTemplate unfold_info
- unfold_hsinfo | neverUnfold unfold_info
- || has_worker = Nothing
- | otherwise = Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
-
---------------------------
-coreRuleToIfaceRule :: (Name -> IfaceExtName) -- For the LHS names
- -> (Name -> IfaceExtName) -- For the RHS names
- -> CoreRule -> IfaceRule
-coreRuleToIfaceRule ext_lhs ext_rhs (BuiltinRule { ru_fn = fn})
- = pprTrace "toHsRule: builtin" (ppr fn) $
- bogusIfaceRule (mkIfaceExtName fn)
-
-coreRuleToIfaceRule ext_lhs ext_rhs
- (Rule { ru_name = name, ru_fn = fn, ru_act = act, ru_bndrs = bndrs,
- ru_args = args, ru_rhs = rhs, ru_orph = orph })
- = IfaceRule { ifRuleName = name, ifActivation = act,
- ifRuleBndrs = map (toIfaceBndr ext_lhs) bndrs,
- ifRuleHead = ext_lhs fn,
- ifRuleArgs = map do_arg args,
- ifRuleRhs = toIfaceExpr ext_rhs rhs,
- ifRuleOrph = orph }
- where
- -- For type args we must remove synonyms from the outermost
- -- level. Reason: so that when we read it back in we'll
- -- construct the same ru_rough field as we have right now;
- -- see tcIfaceRule
- do_arg (Type ty) = IfaceType (toIfaceType ext_lhs (deNoteType ty))
- do_arg arg = toIfaceExpr ext_lhs arg
-
-bogusIfaceRule :: IfaceExtName -> IfaceRule
-bogusIfaceRule id_name
- = IfaceRule { ifRuleName = FSLIT("bogus"), ifActivation = NeverActive,
- ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
- ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
-
----------------------
-toIfaceExpr :: (Name -> IfaceExtName) -> CoreExpr -> IfaceExpr
-toIfaceExpr ext (Var v) = toIfaceVar ext v
-toIfaceExpr ext (Lit l) = IfaceLit l
-toIfaceExpr ext (Type ty) = IfaceType (toIfaceType ext ty)
-toIfaceExpr ext (Lam x b) = IfaceLam (toIfaceBndr ext x) (toIfaceExpr ext b)
-toIfaceExpr ext (App f a) = toIfaceApp ext f [a]
--- gaw 2004
-toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (getOccName x)
(toIfaceType ext ty) (map (toIfaceAlt ext) as)
-toIfaceExpr ext (Let b e) = IfaceLet (toIfaceBind ext b) (toIfaceExpr ext e)
-toIfaceExpr ext (Cast e co) = IfaceCast (toIfaceExpr ext e) (toIfaceType ext co)
-toIfaceExpr ext (Note n e) = IfaceNote (toIfaceNote ext n) (toIfaceExpr ext e)
-
----------------------
-toIfaceNote ext (SCC cc) = IfaceSCC cc
-toIfaceNote ext InlineCall = IfaceInlineCall
-toIfaceNote ext InlineMe = IfaceInlineMe
-toIfaceNote ext (CoreNote s) = IfaceCoreNote s
-
----------------------
-toIfaceBind ext (NonRec b r) = IfaceNonRec (toIfaceIdBndr ext b) (toIfaceExpr
ext r)
-toIfaceBind ext (Rec prs) = IfaceRec [(toIfaceIdBndr ext b, toIfaceExpr ext
r) | (b,r) <- prs]
-
----------------------
-toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map getOccName bs, toIfaceExpr ext r)
-
----------------------
-toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
- | otherwise = IfaceDataAlt (getOccName dc)
- where
- tc = dataConTyCon dc
-
-toIfaceCon (LitAlt l) = IfaceLitAlt l
-toIfaceCon DEFAULT = IfaceDefault
-
----------------------
-toIfaceApp ext (App f a) as = toIfaceApp ext f (a:as)
-toIfaceApp ext (Var v) as
- = case isDataConWorkId_maybe v of
- -- We convert the *worker* for tuples into IfaceTuples
- Just dc | isTupleTyCon tc && saturated
- -> IfaceTuple (tupleTyConBoxity tc) tup_args
- where
- val_args = dropWhile isTypeArg as
- saturated = val_args `lengthIs` idArity v
- tup_args = map (toIfaceExpr ext) val_args
- tc = dataConTyCon dc
-
- other -> mkIfaceApps ext (toIfaceVar ext v) as
-
-toIfaceApp ext e as = mkIfaceApps ext (toIfaceExpr ext e) as
-
-mkIfaceApps ext f as = foldl (\f a -> IfaceApp f (toIfaceExpr ext a)) f as
-
----------------------
-toIfaceVar :: (Name -> IfaceExtName) -> Id -> IfaceExpr
-toIfaceVar ext v
- | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType ext (idType v))
- -- Foreign calls have special syntax
- | isExternalName name = IfaceExt (ext name)
- | otherwise = IfaceLcl (nameOccName name)
- where
- name = idName v
)
)
)
)
)
hunk ./compiler/iface/IfaceSyn.lhs 633
--- gaw 2004
hunk ./compiler/iface/IfaceSyn.lhs 589
- rhs = unfoldingTemplate unfold_info
- unfold_hsinfo | neverUnfold unfold_info -- The CoreTidy phase retains
unfolding info iff
- || has_worker = Nothing -- we want to expose the unfolding, taking into account
- -- unconditional NOINLINE, etc. See TidyPgm.addExternal
- | otherwise = Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
+ inline_hsinfo | isAlwaysActive inline_prag = Nothing
+ | no_unfolding && not has_worker = Nothing
+ -- If the iface file give no unfolding info, we
+ -- don't need to say when inlining is OK!
+ | otherwise = Just (HsInline inline_prag)
hunk ./compiler/iface/IfaceSyn.lhs 577
- unfold_info = unfoldingInfo id_info
+ unfold_info = unfoldingInfo id_info
+ rhs = unfoldingTemplate unfold_info
+ no_unfolding = neverUnfold unfold_info
+ -- The CoreTidy phase retains unfolding info iff
+ -- we want to expose the unfolding, taking into account
+ -- unconditional NOINLINE, etc. See TidyPgm.addExternal
+ unfold_hsinfo | no_unfolding = Nothing
+ | has_worker = Nothing -- Unfolding is implicit
+ | otherwise = Just (HsUnfold (toIfaceExpr ext rhs))
+
+ ------------ Inline prag --------------
hunk ./compiler/iface/IfaceSyn.lhs 548
- wrkr_hsinfo, unfold_hsinfo]
+ inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
hunk ./compiler/iface/IfaceSyn.lhs 580
- unfold_hsinfo | neverUnfold unfold_info
- || has_worker = Nothing
+ unfold_hsinfo | neverUnfold unfold_info -- The CoreTidy phase retains
unfolding info iff
+ || has_worker = Nothing -- we want to expose the unfolding, taking into account
+ -- unconditional NOINLINE, etc. See TidyPgm.addExternal
hunk ./compiler/iface/IfaceSyn.lhs 650
---toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
hunk ./compiler/iface/IfaceSyn.lhs 630
-toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
+--toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
Please report this to bugs at darcs.net
If possible include the output of 'darcs --exact-version'.
sh-2.04$
----------
messages: 714
nosy: droundy, simonmar, tommy
priority: urgent
status: unread
title: crash in function new_ur
____________________________________
Darcs issue tracker <bugs at darcs.net>
<http://bugs.darcs.net/issue190>
____________________________________
More information about the darcs-devel
mailing list