Commit 08102b3d authored by thomie's avatar thomie Committed by Austin Seipp

Delete vestigial external core code (#9402)

Test Plan: harbormaster

Reviewers: austin

Reviewed By: austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D659

GHC Trac Issues: #9402
parent e7fab334
......@@ -395,7 +395,6 @@ data GeneralFlag
| Opt_PrintBindContents
| Opt_GenManifest
| Opt_EmbedManifest
| Opt_EmitExternalCore
| Opt_SharedImplib
| Opt_BuildingCabalPackage
| Opt_IgnoreDotGhci
......@@ -2939,8 +2938,6 @@ fFlags = [
flagSpec "error-spans" Opt_ErrorSpans,
flagSpec "excess-precision" Opt_ExcessPrecision,
flagSpec "expose-all-unfoldings" Opt_ExposeAllUnfoldings,
flagSpec' "ext-core" Opt_EmitExternalCore
(\_ -> deprecate "it has no effect, and will be removed in GHC 7.12"),
flagSpec "flat-cache" Opt_FlatCache,
flagSpec "float-in" Opt_FloatIn,
flagSpec "force-recomp" Opt_ForceRecomp,
......
......@@ -2343,14 +2343,13 @@ emptyMG = []
--
-- * A regular Haskell source module
-- * A hi-boot source module
-- * An external-core source module
--
data ModSummary
= ModSummary {
ms_mod :: Module,
-- ^ Identity of the module
ms_hsc_src :: HscSource,
-- ^ The module source either plain Haskell, hs-boot or external core
-- ^ The module source either plain Haskell or hs-boot
ms_location :: ModLocation,
-- ^ Location of the various files belonging to the module
ms_hs_date :: UTCTime,
......
......@@ -363,126 +363,6 @@ pprTy = pty
paty (TyVar tv) = tv
paty t = "(" ++ pty t ++ ")"
--
-- Generates the type environment that the stand-alone External Core tools use.
gen_ext_core_source :: [Entry] -> String
gen_ext_core_source entries =
"-----------------------------------------------------------------------\n"
++ "-- This module is automatically generated by the GHC utility\n"
++ "-- \"genprimopcode\". Do not edit!\n"
++ "-----------------------------------------------------------------------\n"
++ "module Language.Core.PrimEnv(primTcs, primVals, intLitTypes, ratLitTypes,"
++ "\n charLitTypes, stringLitTypes) where\nimport Language.Core.Core"
++ "\nimport Language.Core.Encoding\n\n"
++ "primTcs :: [(Tcon, Kind)]\n"
++ "primTcs = [\n"
++ printList tcEnt entries
++ " ]\n"
++ "primVals :: [(Var, Ty)]\n"
++ "primVals = [\n"
++ printList valEnt entries
++ "]\n"
++ "intLitTypes :: [Ty]\n"
++ "intLitTypes = [\n"
++ printList tyEnt (intLitTys entries)
++ "]\n"
++ "ratLitTypes :: [Ty]\n"
++ "ratLitTypes = [\n"
++ printList tyEnt (ratLitTys entries)
++ "]\n"
++ "charLitTypes :: [Ty]\n"
++ "charLitTypes = [\n"
++ printList tyEnt (charLitTys entries)
++ "]\n"
++ "stringLitTypes :: [Ty]\n"
++ "stringLitTypes = [\n"
++ printList tyEnt (stringLitTys entries)
++ "]\n\n"
where printList f = concat . intersperse ",\n" . filter (not . null) . map f
tcEnt (PrimTypeSpec {ty=t}) =
case t of
TyApp tc args -> parens (show tc) (tcKind tc args)
_ -> error ("tcEnt: type in PrimTypeSpec is not a type"
++ " constructor: " ++ show t)
tcEnt _ = ""
-- hack alert!
-- The primops.txt.pp format doesn't have enough information in it to
-- print out some of the information that ext-core needs (like kinds,
-- and later on in this code, module names) so we special-case. An
-- alternative would be to refer to things indirectly and hard-wire
-- certain things (e.g., the kind of the Any constructor, here) into
-- ext-core's Prims module again.
tcKind (TyCon "Any") _ = "Klifted"
tcKind tc [] | last (show tc) == '#' = "Kunlifted"
tcKind _ [] | otherwise = "Klifted"
-- assumes that all type arguments are lifted (are they?)
tcKind tc (_v:as) = "(Karrow Klifted " ++ tcKind tc as
++ ")"
valEnt (PseudoOpSpec {name=n, ty=t}) = valEntry n t
valEnt (PrimOpSpec {name=n, ty=t}) = valEntry n t
valEnt _ = ""
valEntry name' ty' = parens name' (mkForallTy (freeTvars ty') (pty ty'))
where pty (TyF t1 t2) = mkFunTy (pty t1) (pty t2)
pty (TyC t1 t2) = mkFunTy (pty t1) (pty t2)
pty (TyApp tc ts) = mkTconApp (mkTcon tc) (map pty ts)
pty (TyUTup ts) = mkUtupleTy (map pty ts)
pty (TyVar tv) = paren $ "Tvar \"" ++ tv ++ "\""
mkFunTy s1 s2 = "Tapp " ++ (paren ("Tapp (Tcon tcArrow)"
++ " " ++ paren s1))
++ " " ++ paren s2
mkTconApp tc args = foldl tapp tc args
mkTcon tc = paren $ "Tcon " ++ paren (qualify True (show tc))
mkUtupleTy args = foldl tapp (tcUTuple (length args)) args
mkForallTy [] t = t
mkForallTy vs t = foldr
(\ v s -> "Tforall " ++
(paren (quote v ++ ", " ++ vKind v)) ++ " "
++ paren s) t vs
-- hack alert!
vKind "o" = "Kopen"
vKind _ = "Klifted"
freeTvars (TyF t1 t2) = freeTvars t1 `union` freeTvars t2
freeTvars (TyC t1 t2) = freeTvars t1 `union` freeTvars t2
freeTvars (TyApp _ tys) = freeTvarss tys
freeTvars (TyVar v) = [v]
freeTvars (TyUTup tys) = freeTvarss tys
freeTvarss = nub . concatMap freeTvars
tapp s nextArg = paren $ "Tapp " ++ s ++ " " ++ paren nextArg
tcUTuple n = paren $ "Tcon " ++ paren (qualify False $ "Z"
++ show n ++ "H")
tyEnt (PrimTypeSpec {ty=(TyApp tc _args)}) = " " ++ paren ("Tcon " ++
(paren (qualify True (show tc))))
tyEnt _ = ""
-- more hacks. might be better to do this on the ext-core side,
-- as per earlier comment
qualify _ tc | tc == "Bool" = "Just boolMname" ++ ", "
++ ze True tc
qualify _ tc | tc == "()" = "Just baseMname" ++ ", "
++ ze True tc
qualify enc tc = "Just primMname" ++ ", " ++ (ze enc tc)
ze enc tc = (if enc then "zEncodeString " else "")
++ "\"" ++ tc ++ "\""
intLitTys = prefixes ["Int", "Word", "Addr", "Char"]
ratLitTys = prefixes ["Float", "Double"]
charLitTys = prefixes ["Char"]
stringLitTys = prefixes ["Addr"]
prefixes ps = filter (\ t ->
case t of
(PrimTypeSpec {ty=(TyApp tc _args)}) ->
any (\ p -> p `isPrefixOf` show tc) ps
_ -> False)
parens n ty' = " (zEncodeString \"" ++ n ++ "\", " ++ ty' ++ ")"
paren s = "(" ++ s ++ ")"
quote s = "\"" ++ s ++ "\""
gen_latex_doc :: Info -> String
gen_latex_doc (Info defaults entries)
......
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