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

1 files changed, 0 insertions, 120 deletions

diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index ed4871c5b4..7ade0b1cae 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -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)