-
-mkHsNegApp (HsLit (HsIntPrim i)) = HsLit (HsIntPrim (-i))
-mkHsNegApp (HsLit (HsFloatPrim i)) = HsLit (HsFloatPrim (-i))
-mkHsNegApp (HsLit (HsDoublePrim i)) = HsLit (HsDoublePrim (-i))
-mkHsNegApp expr = NegApp expr placeHolderName
-\end{code}
-
-A useful function for building @OpApps@. The operator is always a
-variable, and we don't know the fixity yet.
-
-\begin{code}
-mkHsOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
-\end{code}
-
-These are the bits of syntax that contain rebindable names
-See RnEnv.lookupSyntaxName
-
-\begin{code}
-mkHsIntegral i = HsIntegral i placeHolderName
-mkHsFractional f = HsFractional f placeHolderName
-mkNPlusKPat n k = NPlusKPatIn n k placeHolderName
-mkHsDo ctxt stmts loc = HsDo ctxt stmts [] placeHolderType loc
-\end{code}
-
-\begin{code}
-mkHsSplice e loc = HsSplice unqualSplice e loc
-
-unqualSplice = mkRdrUnqual (mkVarOcc FSLIT("splice"))
- -- A name (uniquified later) to
- -- identify the splice
-\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 name,
- ifType = hsIfaceType ty,
- ifIdInfo = NoInfo }
-
-hsIfaceDecl (TyClD decl@(TySynonym {}))
- = IfaceSyn { ifName = rdrNameOcc (tcdName decl),
- ifTyVars = hsIfaceTvs (tcdTyVars decl),
- ifSynRhs = hsIfaceType (tcdSynRhs decl),
- ifVrcs = [] }
-
-hsIfaceDecl (TyClD decl@(TyData {}))
- = IfaceData { ifND = tcdND decl,
- ifName = rdrNameOcc (tcdName decl),
- ifTyVars = hsIfaceTvs (tcdTyVars decl),
- ifCtxt = hsIfaceCtxt (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 (tcdCtxt decl),
- ifFDs = hsIfaceFDs (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)
-
-hsIfaceType :: HsType RdrName -> IfaceType
-hsIfaceType (HsForAllTy exp tvs cxt ty)
- = foldr (IfaceForAllTy . hsIfaceTv) rho tvs'
- where
- rho = foldr (IfaceFunTy . IfacePredTy . hsIfacePred) tau cxt
- tau = hsIfaceType ty
- tvs' = case exp of
- Explicit -> tvs
- Implicit -> map UserTyVar (extractHsRhoRdrTyVars cxt ty)
-
-hsIfaceType ty@(HsTyVar _) = hs_tc_app ty []
-hsIfaceType ty@(HsAppTy t1 t2) = hs_tc_app ty []
-hsIfaceType (HsFunTy t1 t2) = IfaceFunTy (hsIfaceType t1) (hsIfaceType t2)
-hsIfaceType (HsListTy t) = IfaceTyConApp IfaceListTc [hsIfaceType t]
-hsIfaceType (HsPArrTy t) = IfaceTyConApp IfacePArrTc [hsIfaceType t]
-hsIfaceType (HsTupleTy bx ts) = IfaceTyConApp (IfaceTupTc bx (length ts)) (hsIfaceTypes ts)
-hsIfaceType (HsOpTy t1 tc t2) = hs_tc_app (HsTyVar tc) (hsIfaceTypes [t1, t2])
-hsIfaceType (HsParTy t) = hsIfaceType t
-hsIfaceType (HsNumTy n) = panic "hsIfaceType:HsNum"
-hsIfaceType (HsPredTy p) = IfacePredTy (hsIfacePred p)
-hsIfaceType (HsKindSig t _) = hsIfaceType t
-
------------
-hsIfaceTypes tys = map hsIfaceType tys
-
------------
-hsIfaceCtxt :: [HsPred RdrName] -> [IfacePredType]
-hsIfaceCtxt ctxt = map hsIfacePred ctxt
-
------------
-hsIfacePred :: HsPred RdrName -> IfacePredType
-hsIfacePred (HsClassP cls ts) = IfaceClassP (hsIfaceName cls) (hsIfaceTypes ts)
-hsIfacePred (HsIParam ip t) = IfaceIParam (mapIPName rdrNameOcc ip) (hsIfaceType t)
-
------------
-hs_tc_app :: HsType RdrName -> [IfaceType] -> IfaceType
-hs_tc_app (HsAppTy t1 t2) args = hs_tc_app t1 (hsIfaceType 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 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 ]
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsection[rdrBinding]{Bindings straight out of the parser}
-%* *
-%************************************************************************
-
-\begin{code}
-data RdrBinding
- = -- Value bindings havn't been united with their
- -- signatures yet
- RdrBindings [RdrBinding] -- Convenience for parsing
-
- | RdrValBinding RdrNameMonoBinds
-
- -- The remainder all fit into the main HsDecl form
- | RdrHsDecl RdrNameHsDecl
-\end{code}
-
-\begin{code}
-data RdrMatch
- = RdrMatch
- [RdrNamePat]
- (Maybe RdrNameHsType)
- RdrNameGRHSs