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
6601043c
Commit
6601043c
authored
Dec 03, 2004
by
simonpj
Browse files
[project @ 2004-12-03 13:47:22 by simonpj]
TH refication for primitive TyCons
parent
2153d073
Changes
1
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/typecheck/TcSplice.lhs
View file @
6601043c
...
...
@@ -45,7 +45,8 @@ import TcRnMonad
import IfaceEnv ( lookupOrig )
import Class ( Class, classExtraBigSig )
import TyCon ( TyCon, AlgTyConRhs(..), tyConTyVars, getSynTyConDefn,
isSynTyCon, isNewTyCon, tyConDataCons, algTyConRhs )
isSynTyCon, isNewTyCon, tyConDataCons, algTyConRhs, isPrimTyCon, isFunTyCon,
tyConArity, isUnLiftedTyCon )
import DataCon ( DataCon, dataConTyCon, dataConOrigArgTys, dataConStrictMarks,
dataConName, dataConFieldLabels, dataConWrapId, dataConIsInfix,
isVanillaDataCon )
...
...
@@ -540,8 +541,8 @@ reifyThing (AGlobal (AnId id))
other -> return (TH.VarI v ty Nothing fix)
}
reifyThing (AGlobal (ATyCon tc))
=
do { dec <-
reifyTyCon tc
; return (TH.TyConI dec) }
reifyThing (AGlobal (AClass cls))
=
do { dec <-
reifyClass cls
; return (TH.ClassI dec) }
reifyThing (AGlobal (ATyCon tc)) = reifyTyCon tc
reifyThing (AGlobal (AClass cls)) = reifyClass cls
reifyThing (AGlobal (ADataCon dc))
= do { let name = dataConName dc
; ty <- reifyType (idType (dataConWrapId dc))
...
...
@@ -561,25 +562,27 @@ reifyThing (ATyVar tv)
; return (TH.TyVarI (reifyName tv) ty2) }
------------------------------
reifyTyCon :: TyCon -> TcM TH.
Dec
reifyTyCon :: TyCon -> TcM TH.
Info
reifyTyCon tc
| isFunTyCon tc = return (TH.PrimTyConI (reifyName tc) 2 False)
| isPrimTyCon tc = return (TH.PrimTyConI (reifyName tc) (tyConArity tc) (isUnLiftedTyCon tc))
| isSynTyCon tc
= do { let (tvs, rhs) = getSynTyConDefn tc
; rhs' <- reifyType rhs
; return (TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') }
; return (
TH.TyConI $
TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') }
reifyTyCon tc
= case algTyConRhs tc of
NewTyCon data_con _ _
-> do { con <- reifyDataCon data_con
; return (TH.NewtypeD [] (reifyName tc) (reifyTyVars (tyConTyVars tc))
con [{- Don't know about deriving -}]) }
; return (
TH.TyConI $
TH.NewtypeD [] (reifyName tc) (reifyTyVars (tyConTyVars tc))
con [{- Don't know about deriving -}]) }
DataTyCon mb_cxt cons _
-> do { cxt <- reifyCxt (mb_cxt `orElse` [])
; cons <- mapM reifyDataCon (tyConDataCons tc)
; return (TH.DataD cxt (reifyName tc) (reifyTyVars (tyConTyVars tc))
cons [{- Don't know about deriving -}]) }
; return (
TH.TyConI $
TH.DataD cxt (reifyName tc) (reifyTyVars (tyConTyVars tc))
cons [{- Don't know about deriving -}]) }
reifyDataCon :: DataCon -> TcM TH.Con
reifyDataCon dc
...
...
@@ -604,11 +607,11 @@ reifyDataCon dc
<+> quotes (ppr dc))
------------------------------
reifyClass :: Class -> TcM TH.
Dec
reifyClass :: Class -> TcM TH.
Info
reifyClass cls
= do { cxt <- reifyCxt theta
; ops <- mapM reify_op op_stuff
; return (TH.ClassD cxt (reifyName cls) (reifyTyVars tvs) fds' ops) }
; return (
TH.ClassI $
TH.ClassD cxt (reifyName cls) (reifyTyVars tvs) fds' ops) }
where
(tvs, fds, theta, _, op_stuff) = classExtraBigSig cls
fds' = map reifyFunDep fds
...
...
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