projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 1996-05-06 11:01:29 by partain]
[ghc-hetmet.git]
/
ghc
/
compiler
/
deSugar
/
DsBinds.lhs
diff --git
a/ghc/compiler/deSugar/DsBinds.lhs
b/ghc/compiler/deSugar/DsBinds.lhs
index
c2c23ae
..
a4d6dda
100644
(file)
--- a/
ghc/compiler/deSugar/DsBinds.lhs
+++ b/
ghc/compiler/deSugar/DsBinds.lhs
@@
-16,9
+16,12
@@
import Ubiq
import DsLoop -- break dsExpr-ish loop
import HsSyn -- lots of things
import DsLoop -- break dsExpr-ish loop
import HsSyn -- lots of things
+ hiding ( collectBinders{-also in CoreSyn-} )
import CoreSyn -- lots of things
import TcHsSyn ( TypecheckedHsBinds(..), TypecheckedHsExpr(..),
import CoreSyn -- lots of things
import TcHsSyn ( TypecheckedHsBinds(..), TypecheckedHsExpr(..),
- TypecheckedBind(..), TypecheckedMonoBinds(..) )
+ TypecheckedBind(..), TypecheckedMonoBinds(..),
+ TypecheckedPat(..)
+ )
import DsHsSyn ( collectTypedBinders, collectTypedPatBinders )
import DsMonad
import DsHsSyn ( collectTypedBinders, collectTypedPatBinders )
import DsMonad
@@
-33,14
+36,17
@@
import ListSetOps ( minusList, intersectLists )
import PprType ( GenType )
import PprStyle ( PprStyle(..) )
import Pretty ( ppShow )
import PprType ( GenType )
import PprStyle ( PprStyle(..) )
import Pretty ( ppShow )
-import Type ( mkTyVarTys, splitSigmaTy,
+import Type ( mkTyVarTys, mkForAllTys, splitSigmaTy,
tyVarsOfType, tyVarsOfTypes
)
import TyVar ( tyVarSetToList, GenTyVar{-instance Eq-} )
tyVarsOfType, tyVarsOfTypes
)
import TyVar ( tyVarSetToList, GenTyVar{-instance Eq-} )
-import Util ( isIn, panic )
+import Util ( isIn, panic, pprTrace{-ToDo:rm-} )
+import PprCore--ToDo:rm
+import PprType ( GenTyVar ) --ToDo:rm
+import Usage--ToDo:rm
+import Unique--ToDo:rm
isDictTy = panic "DsBinds.isDictTy"
isDictTy = panic "DsBinds.isDictTy"
-quantifyTy = panic "DsBinds.quantifyTy"
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-154,7
+160,7
@@
dsBinds (AbsBinds tyvars [] local_global_prs inst_binds val_binds)
-- local_global_prs.
private_binders = binders `minusList` [local | (local,_) <- local_global_prs]
binders = collectTypedBinders val_binds
-- local_global_prs.
private_binders = binders `minusList` [local | (local,_) <- local_global_prs]
binders = collectTypedBinders val_binds
- mk_poly_private_binder id = newSysLocalDs (snd (quantifyTy tyvars (idType id)))
+ mk_poly_private_binder id = newSysLocalDs (mkForAllTys tyvars (idType id))
tyvar_tys = mkTyVarTys tyvars
\end{code}
tyvar_tys = mkTyVarTys tyvars
\end{code}
@@
-244,7
+250,7
@@
dsBinds (AbsBinds all_tyvars dicts local_global_prs dict_binds val_binds)
non_overloaded_tyvars = all_tyvars `minusList` (tyVarSetToList{-????-} overloaded_tyvars)
binders = collectTypedBinders val_binds
non_overloaded_tyvars = all_tyvars `minusList` (tyVarSetToList{-????-} overloaded_tyvars)
binders = collectTypedBinders val_binds
- mk_binder id = newSysLocalDs (snd (quantifyTy non_overloaded_tyvars (idType id)))
+ mk_binder id = newSysLocalDs (mkForAllTys non_overloaded_tyvars (idType id))
\end{code}
@mkSatTyApp id tys@ constructs an expression whose value is (id tys).
\end{code}
@mkSatTyApp id tys@ constructs an expression whose value is (id tys).
@@
-343,8
+349,8
@@
dsInstBinds tyvars ((inst, expr) : bs)
where
inst_ty = idType inst
abs_tyvars = tyVarSetToList{-???sigh-} (tyVarsOfType inst_ty) `intersectLists` tyvars
where
inst_ty = idType inst
abs_tyvars = tyVarSetToList{-???sigh-} (tyVarsOfType inst_ty) `intersectLists` tyvars
- abs_tys = mkTyVarTys abs_tyvars
- (_, poly_inst_ty) = quantifyTy abs_tyvars inst_ty
+ abs_tys = mkTyVarTys abs_tyvars
+ poly_inst_ty = mkForAllTys abs_tyvars inst_ty
------------------------
-- Wrap a desugared expression in `_scc_ "DICT" <expr>' if
------------------------
-- Wrap a desugared expression in `_scc_ "DICT" <expr>' if
@@
-470,7
+476,7
@@
dsMonoBinds is_rec tyvars dicts binder_subst (VarMonoBind var expr)
\end{code}
\begin{code}
\end{code}
\begin{code}
-dsMonoBinds is_rec tyvars dicts binder_subst (FunMonoBind fun matches locn)
+dsMonoBinds is_rec tyvars dicts binder_subst (FunMonoBind fun _ matches locn)
= putSrcLocDs locn $
let
new_fun = binder_subst fun
= putSrcLocDs locn $
let
new_fun = binder_subst fun
@@
-541,6
+547,8
@@
dsMonoBinds is_rec tyvars [] binder_subst (PatMonoBind pat grhss_and_binds locn)
-- we can just use the rhs directly
else
-}
-- we can just use the rhs directly
else
-}
+ pprTrace "dsMonoBinds:PatMonoBind:" (ppr PprDebug body_expr) $
+
mkSelectorBinds tyvars pat
[(binder, binder_subst binder) | binder <- pat_binders]
body_expr
mkSelectorBinds tyvars pat
[(binder, binder_subst binder) | binder <- pat_binders]
body_expr