Commit 322c1391 authored by Yuras's avatar Yuras Committed by Austin Seipp

remove old .NET related code

Summary: It seems to be dead anyway. Also update Haddock submodule.

Test Plan: validate

Reviewers: austin

Reviewed By: austin

Subscribers: thomie, goldfire, carter, simonmar

Differential Revision: https://phabricator.haskell.org/D357
parent 4667fb52
......@@ -456,12 +456,7 @@ type LTyClDecl name = Located (TyClDecl name)
-- | A type or class declaration.
data TyClDecl name
= ForeignType {
tcdLName :: Located name,
tcdExtName :: Maybe FastString
}
| -- | @type/data family T :: *->*@
= -- | @type/data family T :: *->*@
FamDecl { tcdFam :: FamilyDecl name }
| -- | @type@ declaration
......@@ -606,7 +601,6 @@ tcdName :: TyClDecl name -> name
tcdName = unLoc . tyClDeclLName
tyClDeclTyVars :: OutputableBndr name => TyClDecl name -> LHsTyVarBndrs name
tyClDeclTyVars decl@(ForeignType {}) = pprPanic "tyClDeclTyVars" (ppr decl)
tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
tyClDeclTyVars d = tcdTyVars d
\end{code}
......@@ -630,7 +624,6 @@ countTyClDecls decls
-- | Does this declaration have a complete, user-supplied kind signature?
-- See Note [Complete user-supplied kind signatures]
hsDeclHasCusk :: TyClDecl name -> Bool
hsDeclHasCusk (ForeignType {}) = True
hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) = famDeclHasCusk fam_decl
hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
= hsTvbAllKinded tyvars && rhs_annotated rhs
......@@ -678,9 +671,6 @@ variables and its return type are annotated.
instance OutputableBndr name
=> Outputable (TyClDecl name) where
ppr (ForeignType {tcdLName = ltycon})
= hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
ppr (FamDecl { tcdFam = decl }) = ppr decl
ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdRhs = rhs })
= hang (ptext (sLit "type") <+>
......@@ -756,7 +746,6 @@ pp_fam_inst_lhs thing (HsWB { hswb_cts = typats }) context -- explicit type patt
pprTyClDeclFlavour :: TyClDecl a -> SDoc
pprTyClDeclFlavour (ClassDecl {}) = ptext (sLit "class")
pprTyClDeclFlavour (SynDecl {}) = ptext (sLit "type")
pprTyClDeclFlavour (ForeignType {}) = ptext (sLit "foreign type")
pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
= pprFlavour info
pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
......
......@@ -765,7 +765,6 @@ hsLTyClDeclBinders :: Eq name => Located (TyClDecl name) -> [Located name]
hsLTyClDeclBinders (L loc (FamDecl { tcdFam = FamilyDecl { fdLName = L _ name } }))
= [L loc name]
hsLTyClDeclBinders (L loc (ForeignType { tcdLName = L _ name })) = [L loc name]
hsLTyClDeclBinders (L loc (SynDecl { tcdLName = L _ name })) = [L loc name]
hsLTyClDeclBinders (L loc (ClassDecl { tcdLName = L _ cls_name
, tcdSigs = sigs, tcdATs = ats }))
......
......@@ -125,10 +125,6 @@ data IfaceDecl
ifAxBranches :: [IfaceAxBranch] -- Branches
}
| IfaceForeign { ifName :: IfaceTopBndr, -- Needs expanding when we move
-- beyond .NET
ifExtName :: Maybe FastString }
| IfacePatSyn { ifName :: IfaceTopBndr, -- Name of the pattern synonym
ifPatIsInfix :: Bool,
ifPatMatcher :: IfExtName,
......@@ -790,9 +786,6 @@ pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
, ppShowIface ss (ppr details)
, ppShowIface ss (ppr info) ]
pprIfaceDecl _ (IfaceForeign {ifName = tycon})
= hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
pprIfaceDecl _ (IfaceAxiom { ifName = name, ifTyCon = tycon
, ifAxBranches = branches })
= hang (ptext (sLit "axiom") <+> ppr name <> dcolon)
......@@ -1118,8 +1111,6 @@ freeNamesIfDecl (IfaceId _s t d i) =
freeNamesIfType t &&&
freeNamesIfIdInfo i &&&
freeNamesIfIdDetails d
freeNamesIfDecl IfaceForeign{} =
emptyNameSet
freeNamesIfDecl d@IfaceData{} =
freeNamesIfTvBndrs (ifTyVars d) &&&
freeNamesIfaceTyConParent (ifParent d) &&&
......@@ -1386,9 +1377,6 @@ instance Binary IfaceDecl where
put_ bh details
put_ bh idinfo
put_ _ (IfaceForeign _ _) =
error "Binary.put_(IfaceDecl): IfaceForeign"
put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
putByte bh 2
put_ bh (occNameFS a1)
......
......@@ -1624,10 +1624,6 @@ tyConToIfaceDecl env tycon
ifPromotable = isJust (promotableTyCon_maybe tycon),
ifParent = parent })
| isForeignTyCon tycon
= (env, IfaceForeign { ifName = getOccName tycon,
ifExtName = tyConExtName tycon })
| otherwise -- FunTyCon, PrimTyCon, promoted TyCon/DataCon
-- For pretty printing purposes only.
= ( env
......
......@@ -567,11 +567,6 @@ tc_iface_decl _parent ignore_prags
; tvs2' <- mapM tcIfaceTyVar tvs2
; return (tvs1', tvs2') }
tc_iface_decl _ _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
= do { name <- lookupIfaceTop rdr_name
; return (ATyCon (mkForeignTyCon name ext_name
liftedTypeKind)) }
tc_iface_decl _ _ (IfaceAxiom { ifName = ax_occ, ifTyCon = tc
, ifAxBranches = branches, ifRole = role })
= do { tc_name <- lookupIfaceTop ax_occ
......
......@@ -343,10 +343,6 @@ basicKnownKeyNames
-- Plugins
, pluginTyConName
-- dotnet interop
, objectTyConName, marshalObjectName, unmarshalObjectName
, marshalStringName, unmarshalStringName, checkDotnetResName
-- Generics
, genClassName, gen1ClassName
, datatypeClassName, constructorClassName, selectorClassName
......@@ -394,7 +390,7 @@ gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
gHC_ST, gHC_ARR, gHC_STABLE, gHC_PTR, gHC_ERR, gHC_REAL,
gHC_FLOAT, gHC_TOP_HANDLER, sYSTEM_IO, dYNAMIC,
tYPEABLE, tYPEABLE_INTERNAL, gENERICS,
dOTNET, rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, mONAD_ZIP,
rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, mONAD_ZIP,
aRROW, cONTROL_APPLICATIVE, gHC_DESUGAR, rANDOM, gHC_EXTS,
cONTROL_EXCEPTION_BASE, gHC_TYPELITS, gHC_IP :: Module
......@@ -435,7 +431,6 @@ dYNAMIC = mkBaseModule (fsLit "Data.Dynamic")
tYPEABLE = mkBaseModule (fsLit "Data.Typeable")
tYPEABLE_INTERNAL = mkBaseModule (fsLit "Data.Typeable.Internal")
gENERICS = mkBaseModule (fsLit "Data.Data")
dOTNET = mkBaseModule (fsLit "GHC.Dotnet")
rEAD_PREC = mkBaseModule (fsLit "Text.ParserCombinators.ReadPrec")
lEX = mkBaseModule (fsLit "Text.Read.Lex")
gHC_INT = mkBaseModule (fsLit "GHC.Int")
......@@ -1163,21 +1158,6 @@ knownSymbolClassName = clsQual gHC_TYPELITS (fsLit "KnownSymbol") knownSymbolCl
ipClassName :: Name
ipClassName = clsQual gHC_IP (fsLit "IP") ipClassNameKey
-- dotnet interop
objectTyConName :: Name
objectTyConName = tcQual dOTNET (fsLit "Object") objectTyConKey
-- objectTyConName was "wTcQual", but that's gone now, and
-- I can't see why it was wired in anyway...
unmarshalObjectName, marshalObjectName, marshalStringName,
unmarshalStringName, checkDotnetResName :: Name
unmarshalObjectName = varQual dOTNET (fsLit "unmarshalObject") unmarshalObjectIdKey
marshalObjectName = varQual dOTNET (fsLit "marshalObject") marshalObjectIdKey
marshalStringName = varQual dOTNET (fsLit "marshalString") marshalStringIdKey
unmarshalStringName = varQual dOTNET (fsLit "unmarshalString") unmarshalStringIdKey
checkDotnetResName = varQual dOTNET (fsLit "checkResult") checkDotnetResNameIdKey
-- plugins
cORE_MONAD :: Module
cORE_MONAD = mkThisGhcModule (fsLit "CoreMonad")
......
......@@ -937,10 +937,6 @@ rnTyClDecls extra_deps tycl_ds
rnTyClDecl :: TyClDecl RdrName
-> RnM (TyClDecl Name, FreeVars)
rnTyClDecl (ForeignType {tcdLName = name, tcdExtName = ext_name})
= do { name' <- lookupLocatedTopBndrRn name
; return (ForeignType {tcdLName = name', tcdExtName = ext_name},
emptyFVs) }
-- All flavours of type family declarations ("type family", "newtype family",
-- and "data family"), both top level and (for an associated type)
......
......@@ -888,10 +888,6 @@ checkBootTyCon tc1 tc2
eqListBy (eqPredX env) (tyConStupidTheta tc1) (tyConStupidTheta tc2) &&
eqAlgRhs (algTyConRhs tc1) (algTyConRhs tc2)
| isForeignTyCon tc1 && isForeignTyCon tc2
= eqKind (tyConKind tc1) (tyConKind tc2) &&
tyConExtName tc1 == tyConExtName tc2
| otherwise = False
where
roles1 = tyConRoles tc1
......
......@@ -325,9 +325,6 @@ kcTyClGroup (TyClGroup { group_tyclds = decls })
= do { res <- generaliseFamDecl kind_env fam
; return [res] }
| ForeignType {} <- decl
= pprPanic "generaliseTCD" (ppr decl)
| otherwise
= do { res <- generalise kind_env (tcdName decl)
; return [res] }
......@@ -398,9 +395,6 @@ getInitialKind decl@(DataDecl { tcdLName = L _ name
getInitialKind (FamDecl { tcdFam = decl })
= getFamDeclInitialKind decl
getInitialKind (ForeignType { tcdLName = L _ name })
= return [(name, AThing liftedTypeKind)]
getInitialKind decl@(SynDecl {})
= pprPanic "getInitialKind" (ppr decl)
......@@ -495,8 +489,6 @@ kcTyClDecl (ClassDecl { tcdLName = L _ name, tcdTyVars = hs_tvs
kc_sig (GenericSig _ op_ty) = discardResult (tcHsLiftedType op_ty)
kc_sig _ = return ()
kcTyClDecl (ForeignType {}) = return ()
-- closed type families look at their equations, but other families don't
-- do anything here
kcTyClDecl (FamDecl (FamilyDecl { fdLName = L _ fam_tc_name
......@@ -671,10 +663,6 @@ tcTyClDecl1 _parent rec_info
; case getTyVar_maybe ty of
Just tv' -> return tv'
Nothing -> pprPanic "tc_fd_tyvar" (ppr name $$ ppr tv $$ ppr ty) }
tcTyClDecl1 _ _
(ForeignType {tcdLName = L _ tc_name, tcdExtName = tc_ext_name})
= return [ATyCon (mkForeignTyCon tc_name tc_ext_name liftedTypeKind)]
\end{code}
\begin{code}
......
......@@ -25,7 +25,6 @@ module TyCon(
mkLiftedPrimTyCon,
mkTupleTyCon,
mkSynTyCon,
mkForeignTyCon,
mkPromotedDataCon,
mkPromotedTyCon,
......@@ -37,7 +36,6 @@ module TyCon(
isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon,
isSynTyCon, isTypeSynonymTyCon,
isDecomposableTyCon,
isForeignTyCon,
isPromotedDataCon, isPromotedTyCon,
isPromotedDataCon_maybe, isPromotedTyCon_maybe,
promotableTyCon_maybe, promoteTyCon,
......@@ -71,7 +69,6 @@ module TyCon(
tyConTuple_maybe, tyConClass_maybe,
tyConFamInst_maybe, tyConFamInstSig_maybe, tyConFamilyCoercion_maybe,
synTyConDefn_maybe, synTyConRhs_maybe,
tyConExtName, -- External name for foreign types
algTyConRhs,
newTyConRhs, newTyConEtadArity, newTyConEtadRhs,
unwrapNewTyCon_maybe, unwrapNewTyConEtad_maybe,
......@@ -109,7 +106,6 @@ import CoAxiom
import PrelNames
import Maybes
import Outputable
import FastString
import Constants
import Util
import qualified Data.Data as Data
......@@ -431,12 +427,10 @@ data TyCon
-- holds that information.
-- Only relevant if tc_kind = *
isUnLifted :: Bool, -- ^ Most primitive tycons are unlifted
isUnLifted :: Bool -- ^ Most primitive tycons are unlifted
-- (may not contain bottom)
-- but foreign-imported ones may be lifted
tyConExtName :: Maybe FastString -- ^ @Just e@ for foreign-imported types,
-- holds the name of the imported thing
-- but other are lifted,
-- e.g. @RealWorld@
}
-- | Represents promoted data constructor.
......@@ -985,27 +979,6 @@ mkTupleTyCon name kind arity tyvars con sort prom_tc
tcPromoted = prom_tc
}
-- ^ Foreign-imported (.NET) type constructors are represented
-- as primitive, but /lifted/, 'TyCons' for now. They are lifted
-- because the Haskell type @T@ representing the (foreign) .NET
-- type @T@ is actually implemented (in ILX) as a @thunk<T>@
mkForeignTyCon :: Name
-> Maybe FastString -- ^ Name of the foreign imported thing, maybe
-> Kind
-> TyCon
mkForeignTyCon name ext_name kind
= PrimTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tc_kind = kind,
tyConArity = 0,
tc_roles = [],
primTyConRep = PtrRep, -- they all do
isUnLifted = False,
tyConExtName = ext_name
}
-- | Create an unlifted primitive 'TyCon', such as @Int#@
mkPrimTyCon :: Name -> Kind -> [Role] -> PrimRep -> TyCon
mkPrimTyCon name kind roles rep
......@@ -1030,8 +1003,7 @@ mkPrimTyCon' name kind roles rep is_unlifted
tyConArity = length roles,
tc_roles = roles,
primTyConRep = rep,
isUnLifted = is_unlifted,
tyConExtName = Nothing
isUnLifted = is_unlifted
}
-- | Create a type synonym 'TyCon'
......@@ -1348,11 +1320,6 @@ promoteTyCon tc = case promotableTyCon_maybe tc of
Just prom_tc -> prom_tc
Nothing -> pprPanic "promoteTyCon" (ppr tc)
-- | Is this the 'TyCon' of a foreign-imported type constructor?
isForeignTyCon :: TyCon -> Bool
isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
isForeignTyCon _ = False
-- | Is this a PromotedTyCon?
isPromotedTyCon :: TyCon -> Bool
isPromotedTyCon (PromotedTyCon {}) = True
......
......@@ -1159,8 +1159,6 @@ isStrictType = isUnLiftedType
\begin{code}
isPrimitiveType :: Type -> Bool
-- ^ Returns true of types that are opaque to Haskell.
-- Most of these are unlifted, but now that we interact with .NET, we
-- may have primtive (foreign-imported) types that are lifted
isPrimitiveType ty = case splitTyConApp_maybe ty of
Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
isPrimTyCon tc
......
Subproject commit 3937a98afe1bf1a215fd9115051af388e45b7299
Subproject commit 5a79e5b25a1e628f7d1d9f4bf97ccd9e30242c6a
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment