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-07-19 18:36:04 by partain]
[ghc-hetmet.git]
/
ghc
/
compiler
/
basicTypes
/
IdUtils.lhs
diff --git
a/ghc/compiler/basicTypes/IdUtils.lhs
b/ghc/compiler/basicTypes/IdUtils.lhs
index
c1aa203
..
94703c3
100644
(file)
--- a/
ghc/compiler/basicTypes/IdUtils.lhs
+++ b/
ghc/compiler/basicTypes/IdUtils.lhs
@@
-8,19
+8,20
@@
module IdUtils ( primOpNameInfo, primOpId ) where
module IdUtils ( primOpNameInfo, primOpId ) where
-import Ubiq
-import PrelLoop -- here for paranoia checking
+IMP_Ubiq()
+IMPORT_DELOOPER(PrelLoop) -- here for paranoia checking
+IMPORT_DELOOPER(IdLoop) (SpecEnv)
import CoreSyn
import CoreSyn
-import CoreUnfold ( UnfoldingGuidance(..) )
-import Id ( mkPreludeId )
+import CoreUnfold ( UnfoldingGuidance(..), Unfolding )
+import Id ( mkImported, mkTemplateLocals )
import IdInfo -- quite a few things
import IdInfo -- quite a few things
-import Name ( mkBuiltinName )
-import PrelMods ( pRELUDE_BUILTIN )
+import Name ( mkPrimitiveName, OrigName(..) )
+import PrelMods ( gHC_BUILTINS )
import PrimOp ( primOpInfo, tagOf_PrimOp, primOp_str,
PrimOpInfo(..), PrimOpResultInfo(..) )
import RnHsSyn ( RnName(..) )
import PrimOp ( primOpInfo, tagOf_PrimOp, primOp_str,
PrimOpInfo(..), PrimOpResultInfo(..) )
import RnHsSyn ( RnName(..) )
-import Type ( mkForAllTys, mkFunTys, applyTyCon )
+import Type ( mkForAllTys, mkFunTy, mkFunTys, mkTyVarTy, applyTyCon )
import TysWiredIn ( boolTy )
import Unique ( mkPrimOpIdUnique )
import Util ( panic )
import TysWiredIn ( boolTy )
import Unique ( mkPrimOpIdUnique )
import Util ( panic )
@@
-35,35
+36,35
@@
primOpNameInfo op = (primOp_str op, WiredInId (primOpId op))
primOpId op
= case (primOpInfo op) of
Dyadic str ty ->
primOpId op
= case (primOpInfo op) of
Dyadic str ty ->
- mk_prim_Id op pRELUDE_BUILTIN str [] [ty,ty] (dyadic_fun_ty ty) 2
+ mk_prim_Id op str [] [ty,ty] (dyadic_fun_ty ty) 2
Monadic str ty ->
Monadic str ty ->
- mk_prim_Id op pRELUDE_BUILTIN str [] [ty] (monadic_fun_ty ty) 1
+ mk_prim_Id op str [] [ty] (monadic_fun_ty ty) 1
Compare str ty ->
Compare str ty ->
- mk_prim_Id op pRELUDE_BUILTIN str [] [ty,ty] (compare_fun_ty ty) 2
+ mk_prim_Id op str [] [ty,ty] (compare_fun_ty ty) 2
- Coerce str ty1 ty2 ->
- mk_prim_Id op pRELUDE_BUILTIN str [] [ty1] (mkFunTys [ty1] ty2) 1
+ Coercing str ty1 ty2 ->
+ mk_prim_Id op str [] [ty1] (ty1 `mkFunTy` ty2) 1
PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
- mk_prim_Id op pRELUDE_BUILTIN str
+ mk_prim_Id op str
tyvars
arg_tys
(mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys)))
(length arg_tys) -- arity
AlgResult str tyvars arg_tys tycon res_tys ->
tyvars
arg_tys
(mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys)))
(length arg_tys) -- arity
AlgResult str tyvars arg_tys tycon res_tys ->
- mk_prim_Id op pRELUDE_BUILTIN str
+ mk_prim_Id op str
tyvars
arg_tys
(mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys)))
(length arg_tys) -- arity
where
tyvars
arg_tys
(mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys)))
(length arg_tys) -- arity
where
- mk_prim_Id prim_op mod name tyvar_tmpls arg_tys ty arity
- = mkPreludeId (mkBuiltinName key mod name) ty
+ mk_prim_Id prim_op name tyvar_tmpls arg_tys ty arity
+ = mkImported (mkPrimitiveName key (OrigName gHC_BUILTINS name)) ty
(noIdInfo `addInfo` (mkArityInfo arity)
(noIdInfo `addInfo` (mkArityInfo arity)
- `addInfo_UF` (mkUnfolding EssentialUnfolding
+ `addInfo_UF` (mkUnfolding UnfoldAlways
(mk_prim_unfold prim_op tyvar_tmpls arg_tys)))
where
key = mkPrimOpIdUnique (IBOX(tagOf_PrimOp prim_op))
(mk_prim_unfold prim_op tyvar_tmpls arg_tys)))
where
key = mkPrimOpIdUnique (IBOX(tagOf_PrimOp prim_op))
@@
-72,7
+73,7
@@
primOpId op
\begin{code}
dyadic_fun_ty ty = mkFunTys [ty, ty] ty
\begin{code}
dyadic_fun_ty ty = mkFunTys [ty, ty] ty
-monadic_fun_ty ty = mkFunTys [ty] ty
+monadic_fun_ty ty = ty `mkFunTy` ty
compare_fun_ty ty = mkFunTys [ty, ty] boolTy
\end{code}
compare_fun_ty ty = mkFunTys [ty, ty] boolTy
\end{code}
@@
-81,15
+82,12
@@
The functions to make common unfoldings are tedious.
\begin{code}
mk_prim_unfold :: PrimOp -> [TyVar] -> [Type] -> CoreExpr{-template-}
\begin{code}
mk_prim_unfold :: PrimOp -> [TyVar] -> [Type] -> CoreExpr{-template-}
-mk_prim_unfold prim_op tvs arg_tys
- = panic "IdUtils.mk_prim_unfold"
-{-
+mk_prim_unfold prim_op tyvars arg_tys
= let
= let
- (inst_env, tyvars, tyvar_tys) = instantiateTyVars tvs (map uniqueOf tvs)
- inst_arg_tys = map (instantiateTauTy inst_env) arg_tys
- vars = mkTemplateLocals inst_arg_tys
+ vars = mkTemplateLocals arg_tys
in
in
- mkLam tyvars vars (Prim prim_op tyvar_tys [VarArg v | v <- vars])
--}
+ mkLam tyvars vars $
+ Prim prim_op
+ ([TyArg (mkTyVarTy tv) | tv <- tyvars] ++ [VarArg v | v <- vars])
\end{code}
\end{code}