Delete vestigial external core code (#9402)
authorThomas Miedema <thomasmiedema@gmail.com>
Tue, 17 Feb 2015 14:39:43 +0000 (08:39 -0600)
committerAustin Seipp <austin@well-typed.com>
Tue, 17 Feb 2015 15:06:11 +0000 (09:06 -0600)
Test Plan: harbormaster

Reviewers: austin

Reviewed By: austin

Subscribers: thomie

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

GHC Trac Issues: #9402

compiler/main/DynFlags.hs
compiler/main/HscTypes.hs
utils/genprimopcode/Main.hs

index eccb14e..de768c0 100644 (file)
@@ -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,
index 067e9a9..2f63530 100644 (file)
@@ -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,
index ed4871c..7ade0b1 100644 (file)
@@ -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)