Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
4179e02e
Commit
4179e02e
authored
Sep 15, 2008
by
simonpj@microsoft.com
Browse files
Minor refactoring to get rid of Type.splitNewTyConApp
parent
539b5729
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/deSugar/DsUtils.lhs
View file @
4179e02e
...
...
@@ -46,6 +46,7 @@ import {-# SOURCE #-} DsExpr( dsExpr )
import HsSyn
import TcHsSyn
import TcType( tcSplitTyConApp )
import CoreSyn
import DsMonad
...
...
@@ -287,7 +288,8 @@ mkCoAlgCaseMatchResult var ty match_alts
(con1, arg_ids1, match_result1) = ASSERT( notNull match_alts ) head match_alts
arg_id1 = ASSERT( notNull arg_ids1 ) head arg_ids1
var_ty = idType var
(tc, ty_args) = splitNewTyConApp var_ty
(tc, ty_args) = tcSplitTyConApp var_ty -- Don't look through newtypes
-- (not that splitTyConApp does, these days)
newtype_rhs = unwrapNewTypeBody tc ty_args (Var var)
-- Stuff for data types
...
...
compiler/ghci/RtClosureInspect.hs
View file @
4179e02e
...
...
@@ -384,7 +384,7 @@ ppr_termM1 RefWrap{} = panic "ppr_termM1 - RefWrap"
ppr_termM1
NewtypeWrap
{}
=
panic
"ppr_termM1 - NewtypeWrap"
pprNewtypeWrap
y
p
NewtypeWrap
{
ty
=
ty
,
wrapped_term
=
t
}
|
Just
(
tc
,
_
)
<-
s
plit
New
TyConApp_maybe
ty
|
Just
(
tc
,
_
)
<-
tcS
plitTyConApp_maybe
ty
,
ASSERT
(
isNewTyCon
tc
)
True
,
Just
new_dc
<-
tyConSingleDataCon_maybe
tc
=
do
real_term
<-
y
max_prec
t
...
...
@@ -679,7 +679,7 @@ cvObtainTerm hsc_env bound force mb_ty hval = runTR hsc_env $ do
let
(
t
:
tt
)
=
unpointed
in
t
:
reOrderTerms
pointed
tt
tys
expandNewtypes
t
@
Term
{
ty
=
ty
,
subTerms
=
tt
}
|
Just
(
tc
,
args
)
<-
s
plit
New
TyConApp_maybe
ty
|
Just
(
tc
,
args
)
<-
tcS
plitTyConApp_maybe
ty
,
isNewTyCon
tc
,
wrapped_type
<-
newTyConInstRhs
tc
args
,
Just
dc
<-
tyConSingleDataCon_maybe
tc
...
...
@@ -827,8 +827,8 @@ congruenceNewtypes lhs rhs
(
l1'
,
r1'
)
<-
congruenceNewtypes
l1
r1
return
(
mkFunTy
l1'
l2'
,
mkFunTy
r1'
r2'
)
-- TyconApp Inductive case; this is the interesting bit.
|
Just
(
tycon_l
,
_
)
<-
s
plit
New
TyConApp_maybe
lhs
,
Just
(
tycon_r
,
_
)
<-
s
plit
New
TyConApp_maybe
rhs
|
Just
(
tycon_l
,
_
)
<-
tcS
plitTyConApp_maybe
lhs
,
Just
(
tycon_r
,
_
)
<-
tcS
plitTyConApp_maybe
rhs
,
tycon_l
/=
tycon_r
=
do
rhs'
<-
upgrade
tycon_l
rhs
return
(
lhs
,
rhs'
)
...
...
compiler/types/Type.lhs
View file @
4179e02e
...
...
@@ -36,7 +36,6 @@ module Type (
mkTyConApp, mkTyConTy,
tyConAppTyCon, tyConAppArgs,
splitTyConApp_maybe, splitTyConApp,
splitNewTyConApp_maybe, splitNewTyConApp,
mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
applyTy, applyTys, applyTysD, isForAllTy, dropForAlls,
...
...
@@ -534,20 +533,6 @@ splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
splitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res])
splitTyConApp_maybe _ = Nothing
-- | Sometimes we do NOT want to look through a @newtype@. When case matching
-- on a newtype we want a convenient way to access the arguments of a @newtype@
-- constructor so as to properly form a coercion, and so we use 'splitNewTyConApp'
-- instead of 'splitTyConApp_maybe'
splitNewTyConApp :: Type -> (TyCon, [Type])
splitNewTyConApp ty = case splitNewTyConApp_maybe ty of
Just stuff -> stuff
Nothing -> pprPanic "splitNewTyConApp" (ppr ty)
splitNewTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
splitNewTyConApp_maybe ty | Just ty' <- tcView ty = splitNewTyConApp_maybe ty'
splitNewTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
splitNewTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res])
splitNewTyConApp_maybe _ = Nothing
newTyConInstRhs :: TyCon -> [Type] -> Type
-- ^ Unwrap one 'layer' of newtype on a type constructor and it's arguments, using an
-- eta-reduced version of the @newtype@ if possible
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment