- f expr = NegApp (L loc e) placeHolderName
-\end{code}
-
-%************************************************************************
-%* *
- Hi-boot files
-%* *
-%************************************************************************
-
-mkBootIface, and its boring helper functions, have two purposes:
-a) HsSyn to IfaceSyn. The parser parses the former, but we're reading
- an hi-boot file, and interfaces consist of the latter
-b) Convert unqualifed names from the "current module" to qualified Orig
- names. E.g.
- module This where
- foo :: GHC.Base.Int -> GHC.Base.Int
- becomes
- This.foo :: GHC.Base.Int -> GHC.Base.Int
-
-It assumes that everything is well kinded, of course.
-
-\begin{code}
-mkBootIface :: ModuleName -> [HsDecl RdrName] -> ModIface
--- Make the ModIface for a hi-boot file
--- The decls are of very limited form
-mkBootIface mod decls
- = (emptyModIface opt_InPackage mod) {
- mi_boot = True,
- mi_exports = [(mod, map mk_export decls')],
- mi_decls = decls_w_vers,
- mi_ver_fn = mkIfaceVerCache decls_w_vers }
- where
- decls' = map hsIfaceDecl decls
- decls_w_vers = repeat initialVersion `zip` decls'
-
- -- hi-boot declarations don't (currently)
- -- expose constructors or class methods
- mk_export decl | isValOcc occ = Avail occ
- | otherwise = AvailTC occ [occ]
- where
- occ = ifName decl
-
-
-hsIfaceDecl :: HsDecl RdrName -> IfaceDecl
- -- Change to Iface syntax, and replace unqualified names with
- -- qualified Orig names from this module. Reason: normal
- -- iface files have everything fully qualified, so it's convenient
- -- for hi-boot files to look the same
- --
- -- NB: no constructors or class ops to worry about
-hsIfaceDecl (SigD (Sig name ty))
- = IfaceId { ifName = rdrNameOcc (unLoc name),
- ifType = hsIfaceLType ty,
- ifIdInfo = NoInfo }
-
-hsIfaceDecl (TyClD decl@(TySynonym {}))
- = IfaceSyn { ifName = rdrNameOcc (tcdName decl),
- ifTyVars = hsIfaceTvs (tcdTyVars decl),
- ifSynRhs = hsIfaceLType (tcdSynRhs decl),
- ifVrcs = [] }
-
-hsIfaceDecl (TyClD decl@(TyData {}))
- = IfaceData { ifND = tcdND decl,
- ifName = rdrNameOcc (tcdName decl),
- ifTyVars = hsIfaceTvs (tcdTyVars decl),
- ifCtxt = hsIfaceCtxt (unLoc (tcdCtxt decl)),
- ifCons = Unknown, ifRec = NonRecursive,
- ifVrcs = [], ifGeneric = False }
- -- I'm not sure that [] is right for ifVrcs, but
- -- since we don't use them I'm not going to fiddle
-
-hsIfaceDecl (TyClD decl@(ClassDecl {}))
- = IfaceClass { ifName = rdrNameOcc (tcdName decl),
- ifTyVars = hsIfaceTvs (tcdTyVars decl),
- ifCtxt = hsIfaceCtxt (unLoc (tcdCtxt decl)),
- ifFDs = hsIfaceFDs (map unLoc (tcdFDs decl)),
- ifSigs = [], -- Is this right??
- ifRec = NonRecursive, ifVrcs = [] }
-
-hsIfaceDecl decl = pprPanic "hsIfaceDecl" (ppr decl)
-
-hsIfaceName rdr_name -- Qualify unqualifed occurrences
- -- with the module name
- | isUnqual rdr_name = LocalTop (rdrNameOcc rdr_name)
- | otherwise = ExtPkg (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
-
-hsIfaceLType :: LHsType RdrName -> IfaceType
-hsIfaceLType = hsIfaceType . unLoc
-
-hsIfaceType :: HsType RdrName -> IfaceType
-hsIfaceType (HsForAllTy exp tvs cxt ty)
- = foldr (IfaceForAllTy . hsIfaceTv) rho tvs'
- where
- rho = foldr (IfaceFunTy . IfacePredTy . hsIfaceLPred) tau (unLoc cxt)
- tau = hsIfaceLType ty
- tvs' = case exp of
- Explicit -> map unLoc tvs
- Implicit -> map (UserTyVar . unLoc) (extractHsRhoRdrTyVars cxt ty)
-
-hsIfaceType ty@(HsTyVar _) = hs_tc_app ty []
-hsIfaceType ty@(HsAppTy t1 t2) = hs_tc_app ty []
-hsIfaceType (HsFunTy t1 t2) = IfaceFunTy (hsIfaceLType t1) (hsIfaceLType t2)
-hsIfaceType (HsListTy t) = IfaceTyConApp IfaceListTc [hsIfaceLType t]
-hsIfaceType (HsPArrTy t) = IfaceTyConApp IfacePArrTc [hsIfaceLType t]
-hsIfaceType (HsTupleTy bx ts) = IfaceTyConApp (IfaceTupTc bx (length ts)) (hsIfaceLTypes ts)
-hsIfaceType (HsOpTy t1 tc t2) = hs_tc_app (HsTyVar (unLoc tc)) (hsIfaceLTypes [t1, t2])
-hsIfaceType (HsParTy t) = hsIfaceLType t
-hsIfaceType (HsPredTy p) = IfacePredTy (hsIfaceLPred p)
-hsIfaceType (HsKindSig t _) = hsIfaceLType t
-hsIfaceType (HsNumTy n) = panic "hsIfaceType:HsNum"
-hsIfaceType (HsSpliceTy _) = panic "hsIfaceType:HsSpliceTy"
-
------------
-hsIfaceLTypes tys = map (hsIfaceType.unLoc) tys
-
------------
-hsIfaceCtxt :: [LHsPred RdrName] -> [IfacePredType]
-hsIfaceCtxt ctxt = map hsIfaceLPred ctxt
-
------------
-hsIfaceLPred :: LHsPred RdrName -> IfacePredType
-hsIfaceLPred = hsIfacePred . unLoc
-
-hsIfacePred :: HsPred RdrName -> IfacePredType
-hsIfacePred (HsClassP cls ts) = IfaceClassP (hsIfaceName cls) (hsIfaceLTypes ts)
-hsIfacePred (HsIParam ip t) = IfaceIParam (mapIPName rdrNameOcc ip) (hsIfaceLType t)
-
------------
-hs_tc_app :: HsType RdrName -> [IfaceType] -> IfaceType
-hs_tc_app (HsAppTy t1 t2) args = hs_tc_app (unLoc t1) (hsIfaceLType t2 : args)
-hs_tc_app (HsTyVar n) args
- | isTcOcc (rdrNameOcc n) = IfaceTyConApp (IfaceTc (hsIfaceName n)) args
- | otherwise = foldl IfaceAppTy (IfaceTyVar (rdrNameOcc n)) args
-hs_tc_app ty args = foldl IfaceAppTy (hsIfaceType ty) args
-
------------
-hsIfaceTvs tvs = map (hsIfaceTv.unLoc) tvs
-
------------
-hsIfaceTv (UserTyVar n) = (rdrNameOcc n, IfaceLiftedTypeKind)
-hsIfaceTv (KindedTyVar n k) = (rdrNameOcc n, toIfaceKind k)
-
------------
-hsIfaceFDs :: [([RdrName], [RdrName])] -> [([OccName], [OccName])]
-hsIfaceFDs fds = [ (map rdrNameOcc xs, map rdrNameOcc ys)
- | (xs,ys) <- fds ]