From 4852a59875f1dc89c1821871fdabd6fda65b4534 Mon Sep 17 00:00:00 2001 From: Austin Seipp Date: Sun, 27 Apr 2014 21:11:23 -0500 Subject: Remove external core Signed-off-by: Austin Seipp --- aclocal.m4 | 2 +- compiler/coreSyn/ExternalCore.lhs | 118 -- compiler/coreSyn/MkExternalCore.lhs | 360 ------ compiler/coreSyn/PprExternalCore.lhs | 260 ---- compiler/ghc.cabal.in | 6 - compiler/hsSyn/HsSyn.lhs | 12 +- compiler/iface/TcIface.lhs | 35 +- compiler/main/DriverPhases.hs | 16 +- compiler/main/DriverPipeline.hs | 26 +- compiler/main/DynFlags.hs | 3 +- compiler/main/GHC.hs | 40 +- compiler/main/Hooks.lhs | 2 +- compiler/main/HscMain.hs | 36 +- compiler/parser/LexCore.hs | 115 -- compiler/parser/ParserCore.y | 397 ------ compiler/parser/ParserCoreUtils.hs | 77 -- compiler/typecheck/TcRnDriver.lhs | 129 +- compiler/typecheck/TcRnMonad.lhs | 11 - docs/users_guide/external_core.xml | 1804 ---------------------------- docs/users_guide/flags.xml | 2 +- docs/users_guide/glasgow_exts.xml | 63 - docs/users_guide/ug-book.xml.in | 1 - docs/users_guide/ug-ent.xml.in | 1 - docs/users_guide/using.xml | 38 - ghc.mk | 1 - mk/config.mk.in | 19 - testsuite/config/ghc | 7 +- testsuite/driver/testlib.py | 95 -- testsuite/tests/codeGen/should_run/all.T | 4 +- testsuite/tests/ext-core/Makefile | 29 - testsuite/tests/ext-core/T7239.hs | 8 - testsuite/tests/ext-core/all.T | 3 - testsuite/tests/ffi/should_compile/all.T | 21 +- testsuite/tests/ffi/should_run/all.T | 30 +- testsuite/tests/typecheck/should_run/all.T | 7 +- utils/genprimopcode/Main.hs | 6 +- 36 files changed, 51 insertions(+), 3733 deletions(-) delete mode 100644 compiler/coreSyn/ExternalCore.lhs delete mode 100644 compiler/coreSyn/MkExternalCore.lhs delete mode 100644 compiler/coreSyn/PprExternalCore.lhs delete mode 100644 compiler/parser/LexCore.hs delete mode 100644 compiler/parser/ParserCore.y delete mode 100644 compiler/parser/ParserCoreUtils.hs delete mode 100644 docs/users_guide/external_core.xml delete mode 100644 testsuite/tests/ext-core/Makefile delete mode 100644 testsuite/tests/ext-core/T7239.hs delete mode 100644 testsuite/tests/ext-core/all.T diff --git a/aclocal.m4 b/aclocal.m4 index f9b574b360..5923e9716b 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -875,7 +875,7 @@ else fi; changequote([, ])dnl ]) -if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs || test ! -f compiler/parser/ParserCore.hs +if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs then FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19], [AC_MSG_ERROR([Happy version 1.19 or later is required to compile GHC.])])[] diff --git a/compiler/coreSyn/ExternalCore.lhs b/compiler/coreSyn/ExternalCore.lhs deleted file mode 100644 index ecc24b1155..0000000000 --- a/compiler/coreSyn/ExternalCore.lhs +++ /dev/null @@ -1,118 +0,0 @@ -% -% (c) The University of Glasgow 2001-2006 -% -\begin{code} -module ExternalCore where - -import Data.Word - -data Module - = Module Mname [Tdef] [Vdefg] - -data Tdef - = Data (Qual Tcon) [Tbind] [Cdef] - | Newtype (Qual Tcon) (Qual Tcon) [Tbind] Ty - -data Cdef - = Constr (Qual Dcon) [Tbind] [Ty] - | GadtConstr (Qual Dcon) Ty - -data Vdefg - = Rec [Vdef] - | Nonrec Vdef - --- Top-level bindings are qualified, so that the printer doesn't have to pass --- around the module name. -type Vdef = (Bool,Qual Var,Ty,Exp) - -data Exp - = Var (Qual Var) - | Dcon (Qual Dcon) - | Lit Lit - | App Exp Exp - | Appt Exp Ty - | Lam Bind Exp - | Let Vdefg Exp - | Case Exp Vbind Ty [Alt] {- non-empty list -} - | Cast Exp Coercion - | Tick String Exp {- XXX probably wrong -} - | External String String Ty {- target name, convention, and type -} - | DynExternal String Ty {- convention and type (incl. Addr# of target as first arg) -} - | Label String - -data Bind - = Vb Vbind - | Tb Tbind - -data Alt - = Acon (Qual Dcon) [Tbind] [Vbind] Exp - | Alit Lit Exp - | Adefault Exp - -type Vbind = (Var,Ty) -type Tbind = (Tvar,Kind) - -data Ty - = Tvar Tvar - | Tcon (Qual Tcon) - | Tapp Ty Ty - | Tforall Tbind Ty - -data Coercion --- We distinguish primitive coercions because External Core treats --- them specially, so we have to print them out with special syntax. - = ReflCoercion Role Ty - | SymCoercion Coercion - | TransCoercion Coercion Coercion - | TyConAppCoercion Role (Qual Tcon) [Coercion] - | AppCoercion Coercion Coercion - | ForAllCoercion Tbind Coercion - | CoVarCoercion Var - | UnivCoercion Role Ty Ty - | InstCoercion Coercion Ty - | NthCoercion Int Coercion - | AxiomCoercion (Qual Tcon) Int [Coercion] - | LRCoercion LeftOrRight Coercion - | SubCoercion Coercion - -data Role = Nominal | Representational | Phantom - -data LeftOrRight = CLeft | CRight - -data Kind - = Klifted - | Kunlifted - | Kunboxed - | Kopen - | Karrow Kind Kind - -data Lit - = Lint Integer Ty - | Lrational Rational Ty - | Lchar Char Ty - | Lstring [Word8] Ty - - -type Mname = Id -type Var = Id -type Tvar = Id -type Tcon = Id -type Dcon = Id - -type Qual t = (Mname,t) - -type Id = String - -primMname :: Mname --- For truly horrible reasons, this must be z-encoded. --- With any hope, the z-encoding will die soon. -primMname = "ghczmprim:GHCziPrim" - -tcArrow :: Qual Tcon -tcArrow = (primMname, "(->)") - -\end{code} - - - - diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs deleted file mode 100644 index 6a6f0551ed..0000000000 --- a/compiler/coreSyn/MkExternalCore.lhs +++ /dev/null @@ -1,360 +0,0 @@ - -% (c) The University of Glasgow 2001-2006 -% -\begin{code} -module MkExternalCore ( - emitExternalCore -) where - -#include "HsVersions.h" - -import qualified ExternalCore as C -import Module -import CoreSyn -import HscTypes -import TyCon -import CoAxiom --- import Class -import TypeRep -import Type -import Kind -import PprExternalCore () -- Instances -import DataCon -import Coercion -import Var -import IdInfo -import Literal -import Name -import Outputable -import Encoding -import ForeignCall -import DynFlags -import FastString -import Exception - -import Control.Applicative (Applicative(..)) -import Control.Monad -import qualified Data.ByteString as BS -import Data.Char -import System.IO - -emitExternalCore :: DynFlags -> FilePath -> CgGuts -> IO () -emitExternalCore dflags extCore_filename cg_guts - | gopt Opt_EmitExternalCore dflags - = (do handle <- openFile extCore_filename WriteMode - hPutStrLn handle (show (mkExternalCore dflags cg_guts)) - hClose handle) - `catchIO` (\_ -> pprPanic "Failed to open or write external core output file" - (text extCore_filename)) -emitExternalCore _ _ _ - | otherwise - = return () - --- Reinventing the Reader monad; whee. -newtype CoreM a = CoreM (CoreState -> (CoreState, a)) -data CoreState = CoreState { - cs_dflags :: DynFlags, - cs_module :: Module - } - -instance Functor CoreM where - fmap = liftM - -instance Applicative CoreM where - pure = return - (<*>) = ap - -instance Monad CoreM where - (CoreM m) >>= f = CoreM (\ s -> case m s of - (s',r) -> case f r of - CoreM f' -> f' s') - return x = CoreM (\ s -> (s, x)) -runCoreM :: CoreM a -> CoreState -> a -runCoreM (CoreM f) s = snd $ f s -ask :: CoreM CoreState -ask = CoreM (\ s -> (s,s)) - -instance HasDynFlags CoreM where - getDynFlags = liftM cs_dflags ask - -mkExternalCore :: DynFlags -> CgGuts -> C.Module --- The ModGuts has been tidied, but the implicit bindings have --- not been injected, so we have to add them manually here --- We don't include the strange data-con *workers* because they are --- implicit in the data type declaration itself -mkExternalCore dflags (CgGuts {cg_module=this_mod, cg_tycons = tycons, - cg_binds = binds}) -{- Note that modules can be mutually recursive, but even so, we - print out dependency information within each module. -} - = C.Module (mname dflags) tdefs (runCoreM (mapM (make_vdef True) binds) initialState) - where - initialState = CoreState { - cs_dflags = dflags, - cs_module = this_mod - } - mname dflags = make_mid dflags this_mod - tdefs = foldr (collect_tdefs dflags) [] tycons - -collect_tdefs :: DynFlags -> TyCon -> [C.Tdef] -> [C.Tdef] -collect_tdefs dflags tcon tdefs - | isAlgTyCon tcon = tdef: tdefs - where - tdef | isNewTyCon tcon = - C.Newtype (qtc dflags tcon) - (qcc dflags (newTyConCo tcon)) - (map make_tbind tyvars) - (make_ty dflags (snd (newTyConRhs tcon))) - | otherwise = - C.Data (qtc dflags tcon) (map make_tbind tyvars) - (map (make_cdef dflags) (tyConDataCons tcon)) - tyvars = tyConTyVars tcon - -collect_tdefs _ _ tdefs = tdefs - -qtc :: DynFlags -> TyCon -> C.Qual C.Tcon -qtc dflags = make_con_qid dflags . tyConName - -qcc :: DynFlags -> CoAxiom br -> C.Qual C.Tcon -qcc dflags = make_con_qid dflags . co_ax_name - -make_cdef :: DynFlags -> DataCon -> C.Cdef -make_cdef dflags dcon = C.Constr dcon_name existentials tys - where - dcon_name = make_qid dflags False False (dataConName dcon) - existentials = map make_tbind ex_tyvars - ex_tyvars = dataConExTyVars dcon - tys = map (make_ty dflags) (dataConRepArgTys dcon) - -make_tbind :: TyVar -> C.Tbind -make_tbind tv = (make_var_id (tyVarName tv), make_kind (tyVarKind tv)) - -make_vbind :: DynFlags -> Var -> C.Vbind -make_vbind dflags v = (make_var_id (Var.varName v), make_ty dflags (varType v)) - -make_vdef :: Bool -> CoreBind -> CoreM C.Vdefg -make_vdef topLevel b = - case b of - NonRec v e -> f (v,e) >>= (return . C.Nonrec) - Rec ves -> mapM f ves >>= (return . C.Rec) - where - f :: (CoreBndr,CoreExpr) -> CoreM C.Vdef - f (v,e) = do - localN <- isALocal vName - let local = not topLevel || localN - rhs <- make_exp e - -- use local flag to determine where to add the module name - dflags <- getDynFlags - return (local, make_qid dflags local True vName, make_ty dflags (varType v),rhs) - where vName = Var.varName v - -make_exp :: CoreExpr -> CoreM C.Exp -make_exp (Var v) = do - let vName = Var.varName v - isLocal <- isALocal vName - dflags <- getDynFlags - return $ - case idDetails v of - FCallId (CCall (CCallSpec (StaticTarget nm _ True) callconv _)) - -> C.External (unpackFS nm) (showPpr dflags callconv) (make_ty dflags (varType v)) - FCallId (CCall (CCallSpec (StaticTarget _ _ False) _ _)) -> - panic "make_exp: FFI values not supported" - FCallId (CCall (CCallSpec DynamicTarget callconv _)) - -> C.DynExternal (showPpr dflags callconv) (make_ty dflags (varType v)) - -- Constructors are always exported, so make sure to declare them - -- with qualified names - DataConWorkId _ -> C.Var (make_var_qid dflags False vName) - DataConWrapId _ -> C.Var (make_var_qid dflags False vName) - _ -> C.Var (make_var_qid dflags isLocal vName) -make_exp (Lit (MachLabel s _ _)) = return $ C.Label (unpackFS s) -make_exp (Lit l) = do dflags <- getDynFlags - return $ C.Lit (make_lit dflags l) -make_exp (App e (Type t)) = do b <- make_exp e - dflags <- getDynFlags - return $ C.Appt b (make_ty dflags t) -make_exp (App _e (Coercion _co)) = error "make_exp (App _ (Coercion _))" -- TODO -make_exp (App e1 e2) = do - rator <- make_exp e1 - rand <- make_exp e2 - return $ C.App rator rand -make_exp (Lam v e) | isTyVar v = make_exp e >>= (\ b -> - return $ C.Lam (C.Tb (make_tbind v)) b) -make_exp (Lam v e) | otherwise = do b <- make_exp e - dflags <- getDynFlags - return $ C.Lam (C.Vb (make_vbind dflags v)) b -make_exp (Cast e co) = do b <- make_exp e - dflags <- getDynFlags - return $ C.Cast b (make_co dflags co) -make_exp (Let b e) = do - vd <- make_vdef False b - body <- make_exp e - return $ C.Let vd body -make_exp (Case e v ty alts) = do - scrut <- make_exp e - newAlts <- mapM make_alt alts - dflags <- getDynFlags - return $ C.Case scrut (make_vbind dflags v) (make_ty dflags ty) newAlts -make_exp (Tick _ e) = make_exp e >>= (return . C.Tick "SCC") -- temporary -make_exp _ = error "MkExternalCore died: make_exp" - -make_alt :: CoreAlt -> CoreM C.Alt -make_alt (DataAlt dcon, vs, e) = do - newE <- make_exp e - dflags <- getDynFlags - return $ C.Acon (make_con_qid dflags (dataConName dcon)) - (map make_tbind tbs) - (map (make_vbind dflags) vbs) - newE - where (tbs,vbs) = span isTyVar vs -make_alt (LitAlt l,_,e) = do x <- make_exp e - dflags <- getDynFlags - return $ C.Alit (make_lit dflags l) x -make_alt (DEFAULT,[],e) = make_exp e >>= (return . C.Adefault) --- This should never happen, as the DEFAULT alternative binds no variables, --- but we might as well check for it: -make_alt a@(DEFAULT,_ ,_) = pprPanic ("MkExternalCore: make_alt: DEFAULT " - ++ "alternative had a non-empty var list") (ppr a) - - -make_lit :: DynFlags -> Literal -> C.Lit -make_lit dflags l = - case l of - -- Note that we need to check whether the character is "big". - -- External Core only allows character literals up to '\xff'. - MachChar i | i <= chr 0xff -> C.Lchar i t - -- For a character bigger than 0xff, we represent it in ext-core - -- as an int lit with a char type. - MachChar i -> C.Lint (fromIntegral $ ord i) t - MachStr s -> C.Lstring (BS.unpack s) t - MachNullAddr -> C.Lint 0 t - MachInt i -> C.Lint i t - MachInt64 i -> C.Lint i t - MachWord i -> C.Lint i t - MachWord64 i -> C.Lint i t - MachFloat r -> C.Lrational r t - MachDouble r -> C.Lrational r t - LitInteger i _ -> C.Lint i t - _ -> pprPanic "MkExternalCore died: make_lit" (ppr l) - where - t = make_ty dflags (literalType l) - --- Expand type synonyms, then convert. -make_ty :: DynFlags -> Type -> C.Ty -- Be sure to expand types recursively! - -- example: FilePath ~> String ~> [Char] -make_ty dflags t | Just expanded <- tcView t = make_ty dflags expanded -make_ty dflags t = make_ty' dflags t - --- note calls to make_ty so as to expand types recursively -make_ty' :: DynFlags -> Type -> C.Ty -make_ty' _ (TyVarTy tv) = C.Tvar (make_var_id (tyVarName tv)) -make_ty' dflags (AppTy t1 t2) = C.Tapp (make_ty dflags t1) (make_ty dflags t2) -make_ty' dflags (FunTy t1 t2) = make_ty dflags (TyConApp funTyCon [t1,t2]) -make_ty' dflags (ForAllTy tv t) = C.Tforall (make_tbind tv) (make_ty dflags t) -make_ty' dflags (TyConApp tc ts) = make_tyConApp dflags tc ts -make_ty' _ (LitTy {}) = panic "MkExernalCore can't do literal types yet" - --- Newtypes are treated just like any other type constructor; not expanded --- Reason: predTypeRep does substitution and, while substitution deals --- correctly with name capture, it's only correct if you see the uniques! --- If you just see occurrence names, name capture may occur. --- Example: newtype A a = A (forall b. b -> a) --- test :: forall q b. q -> A b --- test _ = undefined --- Here the 'a' gets substituted by 'b', which is captured. --- Another solution would be to expand newtypes before tidying; but that would --- expose the representation in interface files, which definitely isn't right. --- Maybe CoreTidy should know whether to expand newtypes or not? - -make_tyConApp :: DynFlags -> TyCon -> [Type] -> C.Ty -make_tyConApp dflags tc ts = - foldl C.Tapp (C.Tcon (qtc dflags tc)) - (map (make_ty dflags) ts) - -make_kind :: Kind -> C.Kind -make_kind (FunTy k1 k2) = C.Karrow (make_kind k1) (make_kind k2) -make_kind k - | isLiftedTypeKind k = C.Klifted - | isUnliftedTypeKind k = C.Kunlifted - | isOpenTypeKind k = C.Kopen -make_kind _ = error "MkExternalCore died: make_kind" - -{- Id generation. -} - -make_id :: Bool -> Name -> C.Id --- include uniques for internal names in order to avoid name shadowing -make_id _is_var nm = ((occNameString . nameOccName) nm) - ++ (if isInternalName nm then (show . nameUnique) nm else "") - -make_var_id :: Name -> C.Id -make_var_id = make_id True - --- It's important to encode the module name here, because in External Core, --- base:GHC.Base => base:GHCziBase --- We don't do this in pprExternalCore because we --- *do* want to keep the package name (we don't want baseZCGHCziBase, --- because that would just be ugly.) --- SIGH. --- We encode the package name as well. -make_mid :: DynFlags -> Module -> C.Id --- Super ugly code, but I can't find anything else that does quite what I --- want (encodes the hierarchical module name without encoding the colon --- that separates the package name from it.) -make_mid dflags m - = showSDoc dflags $ - (text $ zEncodeString $ packageIdString $ modulePackageId m) - <> text ":" - <> (pprEncoded $ pprModuleName $ moduleName m) - where pprEncoded = pprCode CStyle - -make_qid :: DynFlags -> Bool -> Bool -> Name -> C.Qual C.Id -make_qid dflags force_unqual is_var n = (mname,make_id is_var n) - where mname = - case nameModule_maybe n of - Just m | not force_unqual -> make_mid dflags m - _ -> "" - -make_var_qid :: DynFlags -> Bool -> Name -> C.Qual C.Id -make_var_qid dflags force_unqual = make_qid dflags force_unqual True - -make_con_qid :: DynFlags -> Name -> C.Qual C.Id -make_con_qid dflags = make_qid dflags False False - -make_co :: DynFlags -> Coercion -> C.Coercion -make_co dflags (Refl r ty) = C.ReflCoercion (make_role r) $ make_ty dflags ty -make_co dflags (TyConAppCo r tc cos) = C.TyConAppCoercion (make_role r) (qtc dflags tc) (map (make_co dflags) cos) -make_co dflags (AppCo c1 c2) = C.AppCoercion (make_co dflags c1) (make_co dflags c2) -make_co dflags (ForAllCo tv co) = C.ForAllCoercion (make_tbind tv) (make_co dflags co) -make_co _ (CoVarCo cv) = C.CoVarCoercion (make_var_id (coVarName cv)) -make_co dflags (AxiomInstCo cc ind cos) = C.AxiomCoercion (qcc dflags cc) ind (map (make_co dflags) cos) -make_co dflags (UnivCo r t1 t2) = C.UnivCoercion (make_role r) (make_ty dflags t1) (make_ty dflags t2) -make_co dflags (SymCo co) = C.SymCoercion (make_co dflags co) -make_co dflags (TransCo c1 c2) = C.TransCoercion (make_co dflags c1) (make_co dflags c2) -make_co dflags (NthCo d co) = C.NthCoercion d (make_co dflags co) -make_co dflags (LRCo lr co) = C.LRCoercion (make_lr lr) (make_co dflags co) -make_co dflags (InstCo co ty) = C.InstCoercion (make_co dflags co) (make_ty dflags ty) -make_co dflags (SubCo co) = C.SubCoercion (make_co dflags co) -make_co _ (AxiomRuleCo {}) = panic "make_co AxiomRuleCo: not yet implemented" - - -make_lr :: LeftOrRight -> C.LeftOrRight -make_lr CLeft = C.CLeft -make_lr CRight = C.CRight - -make_role :: Role -> C.Role -make_role Nominal = C.Nominal -make_role Representational = C.Representational -make_role Phantom = C.Phantom - -------- -isALocal :: Name -> CoreM Bool -isALocal vName = do - modName <- liftM cs_module ask - return $ case nameModule_maybe vName of - -- Not sure whether isInternalName corresponds to "local"ness - -- in the External Core sense; need to re-read the spec. - Just m | m == modName -> isInternalName vName - _ -> False -\end{code} - - - - diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs deleted file mode 100644 index 7fd3ac1d65..0000000000 --- a/compiler/coreSyn/PprExternalCore.lhs +++ /dev/null @@ -1,260 +0,0 @@ -% -% (c) The University of Glasgow 2001-2006 -% - -\begin{code} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module PprExternalCore () where - -import Encoding -import ExternalCore - -import Pretty -import Data.Char -import Data.Ratio - -instance Show Module where - showsPrec _ m = shows (pmodule m) - -instance Show Tdef where - showsPrec _ t = shows (ptdef t) - -instance Show Cdef where - showsPrec _ c = shows (pcdef c) - -instance Show Vdefg where - showsPrec _ v = shows (pvdefg v) - -instance Show Exp where - showsPrec _ e = shows (pexp e) - -instance Show Alt where - showsPrec _ a = shows (palt a) - -instance Show Ty where - showsPrec _ t = shows (pty t) - -instance Show Kind where - showsPrec _ k = shows (pkind k) - -instance Show Lit where - showsPrec _ l = shows (plit l) - - -indent :: Doc -> Doc -indent = nest 2 - -pmodule :: Module -> Doc -pmodule (Module mname tdefs vdefgs) = - (text "%module" <+> text mname) - $$ indent ((vcat (map ((<> char ';') . ptdef) tdefs)) - $$ (vcat (map ((<> char ';') . pvdefg) vdefgs))) - -ptdef :: Tdef -> Doc -ptdef (Data tcon tbinds cdefs) = - (text "%data" <+> pqname tcon <+> (hsep (map ptbind tbinds)) <+> char '=') - $$ indent (braces ((vcat (punctuate (char ';') (map pcdef cdefs))))) - -ptdef (Newtype tcon coercion tbinds rep) = - text "%newtype" <+> pqname tcon <+> pqname coercion - <+> (hsep (map ptbind tbinds)) $$ indent repclause - where repclause = char '=' <+> pty rep - -pcdef :: Cdef -> Doc -pcdef (Constr dcon tbinds tys) = - (pqname dcon) <+> (sep [hsep (map pattbind tbinds),sep (map paty tys)]) -pcdef (GadtConstr dcon ty) = - (pqname dcon) <+> text "::" <+> pty ty - -pname :: Id -> Doc -pname id = text (zEncodeString id) - -pqname :: Qual Id -> Doc -pqname ("",id) = pname id -pqname (m,id) = text m <> char '.' <> pname id - -ptbind, pattbind :: Tbind -> Doc -ptbind (t,Klifted) = pname t -ptbind (t,k) = parens (pname t <> text "::" <> pkind k) - -pattbind (t,k) = char '@' <> ptbind (t,k) - -pakind, pkind :: Kind -> Doc -pakind (Klifted) = char '*' -pakind (Kunlifted) = char '#' -pakind (Kopen) = char '?' -pakind k = parens (pkind k) - -pkind (Karrow k1 k2) = parens (pakind k1 <> text "->" <> pkind k2) -pkind k = pakind k - -paty, pbty, pty :: Ty -> Doc --- paty: print in parens, if non-atomic (like a name) --- pbty: print in parens, if arrow (used only for lhs of arrow) --- pty: not in parens -paty (Tvar n) = pname n -paty (Tcon c) = pqname c -paty t = parens (pty t) - -pbty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = parens(fsep [pbty t1, text "->",pty t2]) -pbty t = paty t - -pty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = fsep [pbty t1, text "->",pty t2] -pty (Tforall tb t) = text "%forall" <+> pforall [tb] t -pty ty@(Tapp {}) = pappty ty [] -pty ty@(Tvar {}) = paty ty -pty ty@(Tcon {}) = paty ty - -pappty :: Ty -> [Ty] -> Doc -pappty (Tapp t1 t2) ts = pappty t1 (t2:ts) -pappty t ts = sep (map paty (t:ts)) - -pforall :: [Tbind] -> Ty -> Doc -pforall tbs (Tforall tb t) = pforall (tbs ++ [tb]) t -pforall tbs t = hsep (map ptbind tbs) <+> char '.' <+> pty t - -paco, pbco, pco :: Coercion -> Doc -paco (ReflCoercion r ty) = char '<' <> pty ty <> text ">_" <> prole r -paco (TyConAppCoercion r qtc []) = pqname qtc <> char '_' <> prole r -paco (AxiomCoercion qtc i []) = pqname qtc <> char '[' <> int i <> char ']' -paco (CoVarCoercion cv) = pname cv -paco c = parens (pco c) - -pbco (TyConAppCoercion _ arr [co1, co2]) - | arr == tcArrow - = parens (fsep [pbco co1, text "->", pco co2]) -pbco co = paco co - -pco c@(ReflCoercion {}) = paco c -pco (SymCoercion co) = sep [text "%sub", paco co] -pco (TransCoercion co1 co2) = sep [text "%trans", paco co1, paco co2] -pco (TyConAppCoercion _ arr [co1, co2]) - | arr == tcArrow = fsep [pbco co1, text "->", pco co2] -pco (TyConAppCoercion r qtc cos) = parens (pqname qtc <+> sep (map paco cos)) <> char '_' <> prole r -pco co@(AppCoercion {}) = pappco co [] -pco (ForAllCoercion tb co) = text "%forall" <+> pforallco [tb] co -pco co@(CoVarCoercion {}) = paco co -pco (UnivCoercion r ty1 ty2) = sep [text "%univ", prole r, paty ty1, paty ty2] -pco (InstCoercion co ty) = sep [text "%inst", paco co, paty ty] -pco (NthCoercion i co) = sep [text "%nth", int i, paco co] -pco (AxiomCoercion qtc i cos) = pqname qtc <> char '[' <> int i <> char ']' <+> sep (map paco cos) -pco (LRCoercion CLeft co) = sep [text "%left", paco co] -pco (LRCoercion CRight co) = sep [text "%right", paco co] -pco (SubCoercion co) = sep [text "%sub", paco co] - -pappco :: Coercion -> [Coercion ] -> Doc -pappco (AppCoercion co1 co2) cos = pappco co1 (co2:cos) -pappco co cos = sep (map paco (co:cos)) - -pforallco :: [Tbind] -> Coercion -> Doc -pforallco tbs (ForAllCoercion tb co) = pforallco (tbs ++ [tb]) co -pforallco tbs co = hsep (map ptbind tbs) <+> char '.' <+> pco co - -prole :: Role -> Doc -prole Nominal = char 'N' -prole Representational = char 'R' -prole Phantom = char 'P' - -pvdefg :: Vdefg -> Doc -pvdefg (Rec vdefs) = text "%rec" $$ braces (indent (vcat (punctuate (char ';') (map pvdef vdefs)))) -pvdefg (Nonrec vdef) = pvdef vdef - -pvdef :: Vdef -> Doc --- TODO: Think about whether %local annotations are actually needed. --- Right now, the local flag is never used, because the Core doc doesn't --- explain the meaning of %local. -pvdef (_l,v,t,e) = sep [(pqname v <+> text "::" <+> pty t <+> char '='), - indent (pexp e)] - -paexp, pfexp, pexp :: Exp -> Doc -paexp (Var x) = pqname x -paexp (Dcon x) = pqname x -paexp (Lit l) = plit l -paexp e = parens(pexp e) - -plamexp :: [Bind] -> Exp -> Doc -plamexp bs (Lam b e) = plamexp (bs ++ [b]) e -plamexp bs e = sep [sep (map pbind bs) <+> text "->", - indent (pexp e)] - -pbind :: Bind -> Doc -pbind (Tb tb) = char '@' <+> ptbind tb -pbind (Vb vb) = pvbind vb - -pfexp (App e1 e2) = pappexp e1 [Left e2] -pfexp (Appt e t) = pappexp e [Right t] -pfexp e = paexp e - -pappexp :: Exp -> [Either Exp Ty] -> Doc -pappexp (App e1 e2) as = pappexp e1 (Left e2:as) -pappexp (Appt e t) as = pappexp e (Right t:as) -pappexp e as = fsep (paexp e : map pa as) - where pa (Left e) = paexp e - pa (Right t) = char '@' <+> paty t - -pexp (Lam b e) = char '\\' <+> plamexp [b] e -pexp (Let vd e) = (text "%let" <+> pvdefg vd) $$ (text "%in" <+> pexp e) -pexp (Case e vb ty alts) = sep [text "%case" <+> paty ty <+> paexp e, - text "%of" <+> pvbind vb] - $$ (indent (braces (vcat (punctuate (char ';') (map palt alts))))) -pexp (Cast e co) = (text "%cast" <+> parens (pexp e)) $$ paco co -pexp (Tick s e) = (text "%source" <+> pstring s) $$ pexp e -pexp (External n cc t) = (text "%external" <+> text cc <+> pstring n) $$ paty t -pexp (DynExternal cc t) = (text "%dynexternal" <+> text cc) $$ paty t -pexp (Label n) = (text "%label" <+> pstring n) -pexp e = pfexp e - -pvbind :: Vbind -> Doc -pvbind (x,t) = parens(pname x <> text "::" <> pty t) - -palt :: Alt -> Doc -palt (Acon c tbs vbs e) = - sep [pqname c, - sep (map pattbind tbs), - sep (map pvbind vbs) <+> text "->"] - $$ indent (pexp e) -palt (Alit l e) = - (plit l <+> text "->") - $$ indent (pexp e) -palt (Adefault e) = - (text "%_ ->") - $$ indent (pexp e) - -plit :: Lit -> Doc -plit (Lint i t) = parens (integer i <> text "::" <> pty t) --- we use (text (show (numerator r))) (and the same for denominator) --- because "(rational r)" was printing out things like "2.0e-2" (which --- isn't External Core), and (text (show r)) was printing out things --- like "((-1)/5)" which isn't either (it should be "(-1/5)"). -plit (Lrational r t) = parens (text (show (numerator r)) <+> char '%' - <+> text (show (denominator r)) <> text "::" <> pty t) -plit (Lchar c t) = parens (text ("\'" ++ escape [c] ++ "\'") <> text "::" <> pty t) --- This is a little messy. We shouldn't really be going via String. -plit (Lstring bs t) = parens (pstring str <> text "::" <> pty t) - where str = map (chr . fromIntegral) bs - -pstring :: String -> Doc -pstring s = doubleQuotes(text (escape s)) - -escape :: String -> String -escape s = foldr f [] (map ord s) - where - f cv rest - | cv > 0xFF = '\\':'x':hs ++ rest - | (cv < 0x20 || cv > 0x7e || cv == 0x22 || cv == 0x27 || cv == 0x5c) = - '\\':'x':h1:h0:rest - where (q1,r1) = quotRem cv 16 - h1 = intToDigit q1 - h0 = intToDigit r1 - hs = dropWhile (=='0') $ reverse $ mkHex cv - mkHex 0 = "" - mkHex cv = intToDigit r : mkHex q - where (q,r) = quotRem cv 16 - f cv rest = (chr cv):rest - -\end{code} - - - - diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index bf62ac3996..1b160aced7 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -232,11 +232,8 @@ Library CoreTidy CoreUnfold CoreUtils - ExternalCore MkCore - MkExternalCore PprCore - PprExternalCore Check Coverage Desugar @@ -303,12 +300,9 @@ Library TidyPgm Ctype HaddockUtils - LexCore Lexer OptCoercion Parser - ParserCore - ParserCoreUtils RdrHsSyn ForeignCall PrelInfo diff --git a/compiler/hsSyn/HsSyn.lhs b/compiler/hsSyn/HsSyn.lhs index e9c3a5eeee..72cbac1487 100644 --- a/compiler/hsSyn/HsSyn.lhs +++ b/compiler/hsSyn/HsSyn.lhs @@ -23,7 +23,7 @@ module HsSyn ( module HsDoc, Fixity, - HsModule(..), HsExtCore(..), + HsModule(..) ) where -- friends: @@ -40,10 +40,9 @@ import HsDoc -- others: import OccName ( HasOccName ) -import IfaceSyn ( IfaceBinding ) import Outputable import SrcLoc -import Module ( Module, ModuleName ) +import Module ( ModuleName ) import FastString -- libraries: @@ -77,13 +76,6 @@ data HsModule name hsmodHaddockModHeader :: Maybe LHsDocString -- ^ Haddock module info and description, unparsed } deriving (Data, Typeable) - -data HsExtCore name -- Read from Foo.hcr - = HsExtCore - Module - [TyClDecl name] -- Type declarations only; just as in Haskell source, - -- so that we can infer kinds etc - [IfaceBinding] -- And the bindings \end{code} diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index cc45648ea2..01a2114b74 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -12,8 +12,7 @@ module TcIface ( tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, tcIfaceVectInfo, tcIfaceAnnotations, tcIfaceExpr, -- Desired by HERMIT (Trac #7683) - tcIfaceGlobal, - tcExtCoreBindings + tcIfaceGlobal ) where #include "HsVersions.h" @@ -1251,30 +1250,6 @@ tcIfaceDataAlt con inst_tys arg_strs rhs \end{code} -\begin{code} -tcExtCoreBindings :: [IfaceBinding] -> IfL CoreProgram -- Used for external core -tcExtCoreBindings [] = return [] -tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs) - -do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind] -do_one (IfaceNonRec bndr rhs) thing_inside - = do { rhs' <- tcIfaceExpr rhs - ; bndr' <- newExtCoreBndr bndr - ; extendIfaceIdEnv [bndr'] $ do - { core_binds <- thing_inside - ; return (NonRec bndr' rhs' : core_binds) }} - -do_one (IfaceRec pairs) thing_inside - = do { bndrs' <- mapM newExtCoreBndr bndrs - ; extendIfaceIdEnv bndrs' $ do - { rhss' <- mapM tcIfaceExpr rhss - ; core_binds <- thing_inside - ; return (Rec (bndrs' `zip` rhss') : core_binds) }} - where - (bndrs,rhss) = unzip pairs -\end{code} - - %************************************************************************ %* * IdInfo @@ -1518,14 +1493,6 @@ bindIfaceBndrs (b:bs) thing_inside bindIfaceBndrs bs $ \ bs' -> thing_inside (b':bs') ------------------------ -newExtCoreBndr :: IfaceLetBndr -> IfL Id -newExtCoreBndr (IfLetBndr var ty _) -- Ignoring IdInfo for now - = do { mod <- getIfModule - ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan - ; ty' <- tcIfaceType ty - ; return (mkLocalId name ty') } - ----------------------- bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a bindIfaceTyVar (occ,kind) thing_inside diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs index 2981269d54..8c69d4ece4 100644 --- a/compiler/main/DriverPhases.hs +++ b/compiler/main/DriverPhases.hs @@ -18,7 +18,6 @@ module DriverPhases ( isHaskellSrcSuffix, isObjectSuffix, isCishSuffix, - isExtCoreSuffix, isDynLibSuffix, isHaskellUserSrcSuffix, isSourceSuffix, @@ -27,7 +26,6 @@ module DriverPhases ( isHaskellSrcFilename, isObjectFilename, isCishFilename, - isExtCoreFilename, isDynLibFilename, isHaskellUserSrcFilename, isSourceFilename @@ -56,7 +54,7 @@ import System.FilePath -} data HscSource - = HsSrcFile | HsBootFile | ExtCoreFile + = HsSrcFile | HsBootFile deriving( Eq, Ord, Show ) -- Ord needed for the finite maps we build in CompManager @@ -64,7 +62,6 @@ data HscSource hscSourceString :: HscSource -> String hscSourceString HsSrcFile = "" hscSourceString HsBootFile = "[boot]" -hscSourceString ExtCoreFile = "[ext core]" isHsBoot :: HscSource -> Bool isHsBoot HsBootFile = True @@ -175,7 +172,6 @@ startPhase "hs" = Cpp HsSrcFile startPhase "hs-boot" = Cpp HsBootFile startPhase "hscpp" = HsPp HsSrcFile startPhase "hspp" = Hsc HsSrcFile -startPhase "hcr" = Hsc ExtCoreFile startPhase "hc" = HCc startPhase "c" = Cc startPhase "cpp" = Ccpp @@ -202,7 +198,6 @@ startPhase _ = StopLn -- all unknown file types phaseInputExt :: Phase -> String phaseInputExt (Unlit HsSrcFile) = "lhs" phaseInputExt (Unlit HsBootFile) = "lhs-boot" -phaseInputExt (Unlit ExtCoreFile) = "lhcr" phaseInputExt (Cpp _) = "lpp" -- intermediate only phaseInputExt (HsPp _) = "hscpp" -- intermediate only phaseInputExt (Hsc _) = "hspp" -- intermediate only @@ -227,13 +222,12 @@ phaseInputExt MergeStub = "o" phaseInputExt StopLn = "o" haskellish_src_suffixes, haskellish_suffixes, cish_suffixes, - extcoreish_suffixes, haskellish_user_src_suffixes + haskellish_user_src_suffixes :: [String] haskellish_src_suffixes = haskellish_user_src_suffixes ++ [ "hspp", "hscpp", "hcr", "cmm", "cmmcpp" ] haskellish_suffixes = haskellish_src_suffixes ++ ["hc", "raw_s"] cish_suffixes = [ "c", "cpp", "C", "cc", "cxx", "s", "S", "ll", "bc", "lm_s", "m", "M", "mm" ] -extcoreish_suffixes = [ "hcr" ] -- Will not be deleted as temp files: haskellish_user_src_suffixes = [ "hs", "lhs", "hs-boot", "lhs-boot" ] @@ -250,13 +244,12 @@ dynlib_suffixes platform = case platformOS platform of OSDarwin -> ["dylib", "so"] _ -> ["so"] -isHaskellishSuffix, isHaskellSrcSuffix, isCishSuffix, isExtCoreSuffix, +isHaskellishSuffix, isHaskellSrcSuffix, isCishSuffix, isHaskellUserSrcSuffix :: String -> Bool isHaskellishSuffix s = s `elem` haskellish_suffixes isHaskellSrcSuffix s = s `elem` haskellish_src_suffixes isCishSuffix s = s `elem` cish_suffixes -isExtCoreSuffix s = s `elem` extcoreish_suffixes isHaskellUserSrcSuffix s = s `elem` haskellish_user_src_suffixes isObjectSuffix, isDynLibSuffix :: Platform -> String -> Bool @@ -267,13 +260,12 @@ isSourceSuffix :: String -> Bool isSourceSuffix suff = isHaskellishSuffix suff || isCishSuffix suff isHaskellishFilename, isHaskellSrcFilename, isCishFilename, - isExtCoreFilename, isHaskellUserSrcFilename, isSourceFilename + isHaskellUserSrcFilename, isSourceFilename :: FilePath -> Bool -- takeExtension return .foo, so we drop 1 to get rid of the . isHaskellishFilename f = isHaskellishSuffix (drop 1 $ takeExtension f) isHaskellSrcFilename f = isHaskellSrcSuffix (drop 1 $ takeExtension f) isCishFilename f = isCishSuffix (drop 1 $ takeExtension f) -isExtCoreFilename f = isExtCoreSuffix (drop 1 $ takeExtension f) isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (drop 1 $ takeExtension f) isSourceFilename f = isSourceSuffix (drop 1 $ takeExtension f) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index b93cef1fba..762f4da422 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -54,7 +54,6 @@ import Util import StringBuffer ( hGetStringBuffer ) import BasicTypes ( SuccessFlag(..) ) import Maybes ( expectJust ) -import ParserCoreUtils ( getCoreModuleName ) import SrcLoc import FastString import LlvmCodeGen ( llvmFixupAsm ) @@ -169,8 +168,6 @@ compileOne' m_tc_result mHscMessage output_fn <- getOutputFilename next_phase Temporary basename dflags next_phase (Just location) - let extCore_filename = basename ++ ".hcr" - -- -fforce-recomp should also work with --make let force_recomp = gopt Opt_ForceRecomp dflags source_modified @@ -207,7 +204,7 @@ compileOne' m_tc_result mHscMessage hm_linkable = maybe_old_linkable }) _ -> do guts0 <- hscDesugar hsc_env summary tc_result guts <- hscSimplify hsc_env guts0 - (iface, _changed, details, cgguts) <- hscNormalIface hsc_env extCore_filename guts mb_old_hash + (iface, _changed, details, cgguts) <- hscNormalIface hsc_env guts mb_old_hash (hasStub, comp_bc, modBreaks) <- hscInteractive hsc_env cgguts summary stub_o <- case hasStub of @@ -251,7 +248,7 @@ compileOne' m_tc_result mHscMessage _ -> do guts0 <- hscDesugar hsc_env summary tc_result guts <- hscSimplify hsc_env guts0 - (iface, changed, details, cgguts) <- hscNormalIface hsc_env extCore_filename guts mb_old_hash + (iface, changed, details, cgguts) <- hscNormalIface hsc_env guts mb_old_hash hscWriteIface dflags iface changed summary -- We're in --make mode: finish the compilation pipeline. @@ -892,16 +889,11 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0 setDynFlags dflags -- gather the imports and module name - (hspp_buf,mod_name,imps,src_imps) <- liftIO $ - case src_flavour of - ExtCoreFile -> do -- no explicit imports in ExtCore input. - m <- getCoreModuleName input_fn - return (Nothing, mkModuleName m, [], []) - - _ -> do - buf <- hGetStringBuffer input_fn - (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff) - return (Just buf, mod_name, imps, src_imps) + (hspp_buf,mod_name,imps,src_imps) <- liftIO $ do + do + buf <- hGetStringBuffer input_fn + (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff) + return (Just buf, mod_name, imps, src_imps) -- Take -o into account if present -- Very like -ohi, but we must *only* do this if we aren't linking @@ -936,8 +928,6 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0 then return SourceUnmodified else return SourceModified - let extCore_filename = basename ++ ".hcr" - PipeState{hsc_env=hsc_env'} <- getPipeState -- Tell the finder cache about this module @@ -957,7 +947,7 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0 ms_srcimps = src_imps } -- run the compiler! - result <- liftIO $ hscCompileOneShot hsc_env' extCore_filename + result <- liftIO $ hscCompileOneShot hsc_env' mod_summary source_unchanged return (HscOut src_flavour mod_name result, diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 72ebb38fc2..7d24785c63 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2685,7 +2685,8 @@ fFlags = [ ( "fun-to-thunk", Opt_FunToThunk, nop ), ( "gen-manifest", Opt_GenManifest, nop ), ( "embed-manifest", Opt_EmbedManifest, nop ), - ( "ext-core", Opt_EmitExternalCore, nop ), + ( "ext-core", Opt_EmitExternalCore, + \_ -> deprecate "it has no effect, and will be removed in GHC 7.12" ), ( "shared-implib", Opt_SharedImplib, nop ), ( "ghci-sandbox", Opt_GhciSandbox, nop ), ( "ghci-history", Opt_GhciHistory, nop ), diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 7694bc9821..6576a501ab 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -53,7 +53,6 @@ module GHC ( -- ** Compiling to Core CoreModule(..), compileToCoreModule, compileToCoreSimplified, - compileCoreToObj, -- * Inspecting the module structure of the program ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..), @@ -310,7 +309,7 @@ import FastString import qualified Parser import Lexer -import System.Directory ( doesFileExist, getCurrentDirectory ) +import System.Directory ( doesFileExist ) import Data.Maybe import Data.List ( find ) import Data.Time @@ -925,43 +924,6 @@ compileToCoreModule = compileCore False -- as to return simplified and tidied Core. compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule compileToCoreSimplified = compileCore True --- | Takes a CoreModule and compiles the bindings therein --- to object code. The first argument is a bool flag indicating --- whether to run the simplifier. --- The resulting .o, .hi, and executable files, if any, are stored in the --- current directory, and named according to the module name. --- This has only so far been tested with a single self-contained module. -compileCoreToObj :: GhcMonad m - => Bool -> CoreModule -> FilePath -> FilePath -> m () -compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) - output_fn extCore_filename = do - dflags <- getSessionDynFlags - currentTime <- liftIO $ getCurrentTime - cwd <- liftIO $ getCurrentDirectory - modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd - ((moduleNameSlashes . moduleName) mName) - - let modSum = ModSummary { ms_mod = mName, - ms_hsc_src = ExtCoreFile, - ms_location = modLocation, - -- By setting the object file timestamp to Nothing, - -- we always force recompilation, which is what we - -- want. (Thus it doesn't matter what the timestamp - -- for the (nonexistent) source file is.) - ms_hs_date = currentTime, - ms_obj_date = Nothing, - -- Only handling the single-module case for now, so no imports. - ms_srcimps = [], - ms_textual_imps = [], - -- No source file - ms_hspp_file = "", - ms_hspp_opts = dflags, - ms_hspp_buf = Nothing - } - - hsc_env <- getSession - liftIO $ hscCompileCore hsc_env simplify (cm_safe cm) modSum (cm_binds cm) output_fn extCore_filename - compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule compileCore simplify fn = do diff --git a/compiler/main/Hooks.lhs b/compiler/main/Hooks.lhs index 3bd9643dc6..63aaafa2a7 100644 --- a/compiler/main/Hooks.lhs +++ b/compiler/main/Hooks.lhs @@ -63,7 +63,7 @@ data Hooks = Hooks , tcForeignImportsHook :: Maybe ([LForeignDecl Name] -> TcM ([Id], [LForeignDecl Id], Bag GlobalRdrElt)) , tcForeignExportsHook :: Maybe ([LForeignDecl Name] -> TcM (LHsBinds TcId, [LForeignDecl TcId], Bag GlobalRdrElt)) , hscFrontendHook :: Maybe (ModSummary -> Hsc TcGblEnv) - , hscCompileOneShotHook :: Maybe (HscEnv -> FilePath -> ModSummary -> SourceModified -> IO HscStatus) + , hscCompileOneShotHook :: Maybe (HscEnv -> ModSummary -> SourceModified -> IO HscStatus) , hscCompileCoreExprHook :: Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO HValue) , ghcPrimIfaceHook :: Maybe ModIface , runPhaseHook :: Maybe (PhasePlus -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath)) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 748f7480ec..475b124dd3 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -146,7 +146,6 @@ import ErrUtils import Outputable import HscStats ( ppSourceStats ) import HscTypes -import MkExternalCore ( emitExternalCore ) import FastString import UniqFM ( emptyUFM ) import UniqSupply @@ -580,31 +579,25 @@ genericHscFrontend mod_summary = getHooked hscFrontendHook genericHscFrontend' >>= ($ mod_summary) genericHscFrontend' :: ModSummary -> Hsc TcGblEnv -genericHscFrontend' mod_summary - | ExtCoreFile <- ms_hsc_src mod_summary = - panic "GHC does not currently support reading External Core files" - | otherwise = - hscFileFrontEnd mod_summary +genericHscFrontend' mod_summary = hscFileFrontEnd mod_summary -------------------------------------------------------------- -- Compilers -------------------------------------------------------------- hscCompileOneShot :: HscEnv - -> FilePath -> ModSummary -> SourceModified -> IO HscStatus hscCompileOneShot env = lookupHook hscCompileOneShotHook hscCompileOneShot' (hsc_dflags env) env --- Compile Haskell, boot and extCore in OneShot mode. +-- Compile Haskell/boot in OneShot mode. hscCompileOneShot' :: HscEnv - -> FilePath -> ModSummary -> SourceModified -> IO HscStatus -hscCompileOneShot' hsc_env extCore_filename mod_summary src_changed +hscCompileOneShot' hsc_env mod_summary src_changed = do -- One-shot mode needs a knot-tying mutable variable for interface -- files. See TcRnTypes.TcGblEnv.tcg_type_env_var. @@ -633,7 +626,7 @@ hscCompileOneShot' hsc_env extCore_filename mod_summary src_changed return HscUpdateBoot _ -> do guts <- hscSimplify' guts0 - (iface, changed, _details, cgguts) <- hscNormalIface' extCore_filename guts mb_old_hash + (iface, changed, _details, cgguts) <- hscNormalIface' guts mb_old_hash liftIO $ hscWriteIface dflags iface changed mod_summary return $ HscRecomp cgguts mod_summary @@ -1070,18 +1063,16 @@ hscSimpleIface' tc_result mb_old_iface = do return (new_iface, no_change, details) hscNormalIface :: HscEnv - -> FilePath -> ModGuts -> Maybe Fingerprint -> IO (ModIface, Bool, ModDetails, CgGuts) -hscNormalIface hsc_env extCore_filename simpl_result mb_old_iface = - runHsc hsc_env $ hscNormalIface' extCore_filename simpl_result mb_old_iface +hscNormalIface hsc_env simpl_result mb_old_iface = + runHsc hsc_env $ hscNormalIface' simpl_result mb_old_iface -hscNormalIface' :: FilePath - -> ModGuts +hscNormalIface' :: ModGuts -> Maybe Fingerprint -> Hsc (ModIface, Bool, ModDetails, CgGuts) -hscNormalIface' extCore_filename simpl_result mb_old_iface = do +hscNormalIface' simpl_result mb_old_iface = do hsc_env <- getHscEnv (cg_guts, details) <- {-# SCC "CoreTidy" #-} liftIO $ tidyProgram hsc_env simpl_result @@ -1096,11 +1087,6 @@ hscNormalIface' extCore_filename simpl_result mb_old_iface = do ioMsgMaybe $ mkIface hsc_env mb_old_iface details simpl_result - -- Emit external core - -- This should definitely be here and not after CorePrep, - -- because CorePrep produces unqualified constructor wrapper declarations, - -- so its output isn't valid External Core (without some preprocessing). - liftIO $ emitExternalCore (hsc_dflags hsc_env) extCore_filename cg_guts liftIO $ dumpIfaceStats hsc_env -- Return the prepared code. @@ -1533,11 +1519,11 @@ hscParseThingWithLocation source linenumber parser str return thing hscCompileCore :: HscEnv -> Bool -> SafeHaskellMode -> ModSummary - -> CoreProgram -> FilePath -> FilePath -> IO () -hscCompileCore hsc_env simplify safe_mode mod_summary binds output_filename extCore_filename + -> CoreProgram -> FilePath -> IO () +hscCompileCore hsc_env simplify safe_mode mod_summary binds output_filename = runHsc hsc_env $ do guts <- maybe_simplify (mkModGuts (ms_mod mod_summary) safe_mode binds) - (iface, changed, _details, cgguts) <- hscNormalIface' extCore_filename guts Nothing + (iface, changed, _details, cgguts) <- hscNormalIface' guts Nothing liftIO $ hscWriteIface (hsc_dflags hsc_env) iface changed mod_summary _ <- liftIO $ hscGenHardCode hsc_env cgguts mod_summary output_filename return () diff --git a/compiler/parser/LexCore.hs b/compiler/parser/LexCore.hs deleted file mode 100644 index 861fffb7f6..0000000000 --- a/compiler/parser/LexCore.hs +++ /dev/null @@ -1,115 +0,0 @@ -module LexCore where - -import ParserCoreUtils -import Panic -import Data.Char -import Numeric - -isNameChar :: Char -> Bool -isNameChar c = isAlpha c || isDigit c || (c == '_') || (c == '\'') - || (c == '$') || (c == '-') || (c == '.') - -isKeywordChar :: Char -> Bool -isKeywordChar c = isAlpha c || (c == '_') - -lexer :: (Token -> P a) -> P a -lexer cont [] = cont TKEOF [] -lexer cont ('\n':cs) = \line -> lexer cont cs (line+1) -lexer cont ('-':'>':cs) = cont TKrarrow cs - -lexer cont (c:cs) - | isSpace c = lexer cont cs - | isLower c || (c == '_') = lexName cont TKname (c:cs) - | isUpper c = lexName cont TKcname (c:cs) - | isDigit c || (c == '-') = lexNum cont (c:cs) - -lexer cont ('%':cs) = lexKeyword cont cs -lexer cont ('\'':cs) = lexChar cont cs -lexer cont ('\"':cs) = lexString [] cont cs -lexer cont ('#':cs) = cont TKhash cs -lexer cont ('(':cs) = cont TKoparen cs -lexer cont (')':cs) = cont TKcparen cs -lexer cont ('{':cs) = cont TKobrace cs -lexer cont ('}':cs) = cont TKcbrace cs -lexer cont ('=':cs) = cont TKeq cs -lexer cont (':':'=':':':cs) = cont TKcoloneqcolon cs -lexer cont (':':':':cs) = cont TKcoloncolon cs -lexer cont ('*':cs) = cont TKstar cs -lexer cont ('.':cs) = cont TKdot cs -lexer cont ('\\':cs) = cont TKlambda cs -lexer cont ('@':cs) = cont TKat cs -lexer cont ('?':cs) = cont TKquestion cs -lexer cont (';':cs) = cont TKsemicolon cs --- 20060420 GHC spits out constructors with colon in them nowadays. jds --- 20061103 but it's easier to parse if we split on the colon, and treat them --- as several tokens -lexer cont (':':cs) = cont TKcolon cs --- 20060420 Likewise does it create identifiers starting with dollar. jds -lexer cont ('$':cs) = lexName cont TKname ('$':cs) -lexer _ (c:_) = failP "invalid character" [c] - -lexChar :: (Token -> String -> Int -> ParseResult a) -> String -> Int - -> ParseResult a -lexChar cont ('\\':'x':h1:h0:'\'':cs) - | isHexEscape [h1,h0] = cont (TKchar (hexToChar h1 h0)) cs -lexChar _ ('\\':cs) = failP "invalid char character" ('\\':(take 10 cs)) -lexChar _ ('\'':_) = failP "invalid char character" ['\''] -lexChar _ ('\"':_) = failP "invalid char character" ['\"'] -lexChar cont (c:'\'':cs) = cont (TKchar c) cs -lexChar _ cs = panic ("lexChar: " ++ show cs) - -lexString :: String -> (Token -> [Char] -> Int -> ParseResult a) - -> String -> Int -> ParseResult a -lexString s cont ('\\':'x':h1:h0:cs) - | isHexEscape [h1,h0] = lexString (s++[hexToChar h1 h0]) cont cs -lexString _ _ ('\\':_) = failP "invalid string character" ['\\'] -lexString _ _ ('\'':_) = failP "invalid string character" ['\''] -lexString s cont ('\"':cs) = cont (TKstring s) cs -lexString s cont (c:cs) = lexString (s++[c]) cont cs -lexString _ _ [] = panic "lexString []" - -isHexEscape :: String -> Bool -isHexEscape = all (\c -> isHexDigit c && (isDigit c || isLower c)) - -hexToChar :: Char -> Char -> Char -hexToChar h1 h0 = chr (digitToInt h1 * 16 + digitToInt h0) - -lexNum :: (Token -> String -> a) -> String -> a -lexNum cont cs = - case cs of - ('-':cs) -> f (-1) cs - _ -> f 1 cs - where f sgn cs = - case span isDigit cs of - (digits,'.':c:rest) - | isDigit c -> cont (TKrational (fromInteger sgn * r)) rest' - where ((r,rest'):_) = readFloat (digits ++ ('.':c:rest)) - -- When reading a floating-point number, which is - -- a bit complicated, use the standard library function - -- "readFloat" - (digits,rest) -> cont (TKinteger (sgn * (read digits))) rest - -lexName :: (a -> String -> b) -> (String -> a) -> String -> b -lexName cont cstr cs = cont (cstr name) rest - where (name,rest) = span isNameChar cs - -lexKeyword :: (Token -> [Char] -> Int -> ParseResult a) -> String -> Int - -> ParseResult a -lexKeyword cont cs = - case span isKeywordChar cs of - ("module",rest) -> cont TKmodule rest - ("data",rest) -> cont TKdata rest - ("newtype",rest) -> cont TKnewtype rest - ("forall",rest) -> cont TKforall rest - ("rec",rest) -> cont TKrec rest - ("let",rest) -> cont TKlet rest - ("in",rest) -> cont TKin rest - ("case",rest) -> cont TKcase rest - ("of",rest) -> cont TKof rest - ("cast",rest) -> cont TKcast rest - ("note",rest) -> cont TKnote rest - ("external",rest) -> cont TKexternal rest - ("local",rest) -> cont TKlocal rest - ("_",rest) -> cont TKwild rest - _ -> failP "invalid keyword" ('%':cs) - diff --git a/compiler/parser/ParserCore.y b/compiler/parser/ParserCore.y deleted file mode 100644 index 4e7f48c6fc..0000000000 --- a/compiler/parser/ParserCore.y +++ /dev/null @@ -1,397 +0,0 @@ -{ -{-# LANGUAGE BangPatterns #-} -- required for versions of Happy before 1.18.6 -{-# OPTIONS -Wwarn -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - -module ParserCore ( parseCore ) where - -import IfaceSyn -import ForeignCall -import RdrHsSyn -import HsSyn hiding (toHsType, toHsKind) -import RdrName -import OccName -import TypeRep ( TyThing(..) ) -import Type ( Kind, - liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon, - mkTyConApp - ) -import Kind( mkArrowKind ) -import Name( Name, nameOccName, nameModule, mkExternalName, wiredInNameTyThing_maybe ) -import Module -import ParserCoreUtils -import LexCore -import Literal -import SrcLoc -import PrelNames -import TysPrim -import TyCon ( TyCon, tyConName ) -import FastString -import Outputable -import Data.Char -import Unique - -#include "../HsVersions.h" - -} - -%name parseCore -%expect 0 -%tokentype { Token } - -%token - '%module' { TKmodule } - '%data' { TKdata } - '%newtype' { TKnewtype } - '%forall' { TKforall } - '%rec' { TKrec } - '%let' { TKlet } - '%in' { TKin } - '%case' { TKcase } - '%of' { TKof } - '%cast' { TKcast } - '%note' { TKnote } - '%external' { TKexternal } - '%local' { TKlocal } - '%_' { TKwild } - '(' { TKoparen } - ')' { TKcparen } - '{' { TKobrace } - '}' { TKcbrace } - '#' { TKhash} - '=' { TKeq } - ':' { TKcolon } - '::' { TKcoloncolon } - ':=:' { TKcoloneqcolon } - '*' { TKstar } - '->' { TKrarrow } - '\\' { TKlambda} - '@' { TKat } - '.' { TKdot } - '?' { TKquestion} - ';' { TKsemicolon } - NAME { TKname $$ } - CNAME { TKcname $$ } - INTEGER { TKinteger $$ } - RATIONAL { TKrational $$ } - STRING { TKstring $$ } - CHAR { TKchar $$ } - -%monad { P } { thenP } { returnP } -%lexer { lexer } { TKEOF } - -%% - -module :: { HsExtCore RdrName } - -- : '%module' modid tdefs vdefgs { HsExtCore $2 $3 $4 } - : '%module' modid tdefs vdefgs { HsExtCore $2 [] [] } - - -------------------------------------------------------------- --- Names: the trickiest bit in here - --- A name of the form A.B.C could be: --- module A.B.C --- dcon C in module A.B --- tcon C in module A.B -modid :: { Module } - : NAME ':' mparts { undefined } - -q_dc_name :: { Name } - : NAME ':' mparts { undefined } - -q_tc_name :: { Name } - : NAME ':' mparts { undefined } - -q_var_occ :: { Name } - : NAME ':' vparts { undefined } - -mparts :: { [String] } - : CNAME { [$1] } - | CNAME '.' mparts { $1:$3 } - -vparts :: { [String] } - : var_occ { [$1] } - | CNAME '.' vparts { $1:$3 } - -------------------------------------------------------------- --- Type and newtype declarations are in HsSyn syntax - -tdefs :: { [TyClDecl RdrName] } - : {- empty -} {[]} - | tdef tdefs {$1:$2} - -tdef :: { TyClDecl RdrName } - : '%data' q_tc_name tv_bndrs '=' '{' cons '}' ';' - { DataDecl { tcdLName = noLoc (ifaceExtRdrName $2) - , tcdTyVars = mkHsQTvs (map toHsTvBndr $3) - , tcdDataDefn = HsDataDefn { dd_ND = DataType, dd_ctxt = noLoc [] - , dd_kindSig = Nothing - , dd_cons = $6, dd_derivs = Nothing } } } - | '%newtype' q_tc_name tv_bndrs trep ';' - { let tc_rdr = ifaceExtRdrName $2 in - DataDecl { tcdLName = noLoc tc_rdr - , tcdTyVars = mkHsQTvs (map toHsTvBndr $3) - , tcdDataDefn = HsDataDefn { dd_ND = NewType, dd_ctxt = noLoc [] - , dd_kindSig = Nothing - , dd_cons = $4 (rdrNameOcc tc_rdr), dd_derivs = Nothing } } } - --- For a newtype we have to invent a fake data constructor name --- It doesn't matter what it is, because it won't be used -trep :: { OccName -> [LConDecl RdrName] } - : {- empty -} { (\ tc_occ -> []) } - | '=' ty { (\ tc_occ -> let { dc_name = mkRdrUnqual (setOccNameSpace dataName tc_occ) ; - con_info = PrefixCon [toHsType $2] } - in [noLoc $ mkSimpleConDecl (noLoc dc_name) [] - (noLoc []) con_info]) } - -cons :: { [LConDecl RdrName] } - : {- empty -} { [] } -- 20060420 Empty data types allowed. jds - | con { [$1] } - | con ';' cons { $1:$3 } - -con :: { LConDecl RdrName } - : d_pat_occ attv_bndrs hs_atys - { noLoc $ mkSimpleConDecl (noLoc (mkRdrUnqual $1)) $2 (noLoc []) (PrefixCon $3) } --- ToDo: parse record-style declarations - -attv_bndrs :: { [LHsTyVarBndr RdrName] } - : {- empty -} { [] } - | '@' tv_bndr attv_bndrs { toHsTvBndr $2 : $3 } - -hs_atys :: { [LHsType RdrName] } - : atys { map toHsType $1 } - - ---------------------------------------- --- Types ---------------------------------------- - -atys :: { [IfaceType] } - : {- empty -} { [] } - | aty atys { $1:$2 } - -aty :: { IfaceType } - : fs_var_occ { IfaceTyVar $1 } - | q_tc_name { IfaceTyConApp (IfaceTc $1) [] } - | '(' ty ')' { $2 } - -bty :: { IfaceType } - : fs_var_occ atys { foldl IfaceAppTy (IfaceTyVar $1) $2 } - | q_var_occ atys { undefined } - | q_tc_name atys { IfaceTyConApp (IfaceTc $1) $2 } - | '(' ty ')' { $2 } - -ty :: { IfaceType } - : bty { $1 } - | bty '->' ty { IfaceFunTy $1 $3 } - | '%forall' tv_bndrs '.' ty { foldr IfaceForAllTy $4 $2 } - ----------------------------------------------- --- Bindings are in Iface syntax - -vdefgs :: { [IfaceBinding] } - : {- empty -} { [] } - | let_bind ';' vdefgs { $1 : $3 } - -let_bind :: { IfaceBinding } - : '%rec' '{' vdefs1 '}' { IfaceRec $3 } -- Can be empty. Do we care? - | vdef { let (b,r) = $1 - in IfaceNonRec b r } - -vdefs1 :: { [(IfaceLetBndr, IfaceExpr)] } - : vdef { [$1] } - | vdef ';' vdefs1 { $1:$3 } - -vdef :: { (IfaceLetBndr, IfaceExpr) } - : fs_var_occ '::' ty '=' exp { (IfLetBndr $1 $3 NoInfo, $5) } - | '%local' vdef { $2 } - - -- NB: qd_occ includes data constructors, because - -- we allow data-constructor wrappers at top level - -- But we discard the module name, because it must be the - -- same as the module being compiled, and Iface syntax only - -- has OccNames in binding positions. Ah, but it has Names now! - ---------------------------------------- --- Binders -bndr :: { IfaceBndr } - : '@' tv_bndr { IfaceTvBndr $2 } - | id_bndr { IfaceIdBndr $1 } - -bndrs :: { [IfaceBndr] } - : bndr { [$1] } - | bndr bndrs { $1:$2 } - -id_bndr :: { IfaceIdBndr } - : '(' fs_var_occ '::' ty ')' { ($2,$4) } - -tv_bndr :: { IfaceTvBndr } - : fs_var_occ { ($1, ifaceLiftedTypeKind) } - | '(' fs_var_occ '::' akind ')' { ($2, $4) } - -tv_bndrs :: { [IfaceTvBndr] } - : {- empty -} { [] } - | tv_bndr tv_bndrs { $1:$2 } - -akind :: { IfaceKind } - : '*' { ifaceLiftedTypeKind } - | '#' { ifaceUnliftedTypeKind } - | '?' { ifaceOpenTypeKind } - | '(' kind ')' { $2 } - -kind :: { IfaceKind } - : akind { $1 } - | akind '->' kind { ifaceArrow $1 $3 } - ------------------------------------------ --- Expressions - -aexp :: { IfaceExpr } - : fs_var_occ { IfaceLcl $1 } - | q_var_occ { IfaceExt $1 } - | q_dc_name { IfaceExt $1 } - | lit { IfaceLit $1 } - | '(' exp ')' { $2 } - -fexp :: { IfaceExpr } - : fexp aexp { IfaceApp $1 $2 } - | fexp '@' aty { IfaceApp $1 (IfaceType $3) } - | aexp { $1 } - -exp :: { IfaceExpr } - : fexp { $1 } - | '\\' bndrs '->' exp { foldr IfaceLam $4 $2 } - | '%let' let_bind '%in' exp { IfaceLet $2 $4 } --- gaw 2004 - | '%case' '(' ty ')' aexp '%of' id_bndr - '{' alts1 '}' { IfaceCase $5 (fst $7) $9 } --- The following line is broken and is hard to fix. Not fixing now --- because this whole parser is bitrotten anyway. --- Richard Eisenberg, July 2013 --- | '%cast' aexp aty { IfaceCast $2 $3 } --- No InlineMe any more --- | '%note' STRING exp --- { case $2 of --- --"SCC" -> IfaceNote (IfaceSCC "scc") $3 --- "InlineMe" -> IfaceNote IfaceInlineMe $3 --- } - | '%external' STRING aty { IfaceFCall (ForeignCall.CCall - (CCallSpec (StaticTarget (mkFastString $2) Nothing True) - CCallConv PlaySafe)) - $3 } - -alts1 :: { [IfaceAlt] } - : alt { [$1] } - | alt ';' alts1 { $1:$3 } - -alt :: { IfaceAlt } - : q_dc_name bndrs '->' exp - { (IfaceDataAlt $1, map ifaceBndrName $2, $4) } - -- The external syntax currently includes the types of the - -- the args, but they aren't needed internally - -- Nor is the module qualifier - | q_dc_name '->' exp - { (IfaceDataAlt $1, [], $3) } - | lit '->' exp - { (IfaceLitAlt $1, [], $3) } - | '%_' '->' exp - { (IfaceDefault, [], $3) } - -lit :: { Literal } - : '(' INTEGER '::' aty ')' { convIntLit $2 $4 } - | '(' RATIONAL '::' aty ')' { convRatLit $2 $4 } - | '(' CHAR '::' aty ')' { MachChar $2 } - | '(' STRING '::' aty ')' { MachStr (fastStringToByteString (mkFastString $2)) } - -fs_var_occ :: { FastString } - : NAME { mkFastString $1 } - -var_occ :: { String } - : NAME { $1 } - - --- Data constructor in a pattern or data type declaration; use the dataName, --- because that's what we expect in Core case patterns -d_pat_occ :: { OccName } - : CNAME { mkOccName dataName $1 } - -{ - -ifaceKind kc = IfaceTyConApp kc [] - -ifaceBndrName (IfaceIdBndr (n,_)) = n -ifaceBndrName (IfaceTvBndr (n,_)) = n - -convIntLit :: Integer -> IfaceType -> Literal -convIntLit i (IfaceTyConApp tc []) - | tc `eqTc` intPrimTyCon = MachInt i - | tc `eqTc` wordPrimTyCon = MachWord i - | tc `eqTc` charPrimTyCon = MachChar (chr (fromInteger i)) - | tc `eqTc` addrPrimTyCon && i == 0 = MachNullAddr -convIntLit i aty - = pprPanic "Unknown integer literal type" (ppr aty) - -convRatLit :: Rational -> IfaceType -> Literal -convRatLit r (IfaceTyConApp tc []) - | tc `eqTc` floatPrimTyCon = MachFloat r - | tc `eqTc` doublePrimTyCon = MachDouble r -convRatLit i aty - = pprPanic "Unknown rational literal type" (ppr aty) - -eqTc :: IfaceTyCon -> TyCon -> Bool -- Ugh! -eqTc (IfaceTc name) tycon = name == tyConName tycon - --- Tiresomely, we have to generate both HsTypes (in type/class decls) --- and IfaceTypes (in Core expressions). So we parse them as IfaceTypes, --- and convert to HsTypes here. But the IfaceTypes we can see here --- are very limited (see the productions for 'ty'), so the translation --- isn't hard -toHsType :: IfaceType -> LHsType RdrName -toHsType (IfaceTyVar v) = noLoc $ HsTyVar (mkRdrUnqual (mkTyVarOccFS v)) -toHsType (IfaceAppTy t1 t2) = noLoc $ HsAppTy (toHsType t1) (toHsType t2) -toHsType (IfaceFunTy t1 t2) = noLoc $ HsFunTy (toHsType t1) (toHsType t2) -toHsType (IfaceTyConApp (IfaceTc tc) ts) = foldl mkHsAppTy (noLoc $ HsTyVar (ifaceExtRdrName tc)) (map toHsType ts) -toHsType (IfaceForAllTy tv t) = add_forall (toHsTvBndr tv) (toHsType t) - --- Only a limited form of kind will be encountered... hopefully -toHsKind :: IfaceKind -> LHsKind RdrName --- IA0_NOTE: Shouldn't we add kind variables? -toHsKind (IfaceFunTy ifK1 ifK2) = noLoc $ HsFunTy (toHsKind ifK1) (toHsKind ifK2) -toHsKind (IfaceTyConApp ifKc []) = noLoc $ HsTyVar (nameRdrName (tyConName (toKindTc ifKc))) -toHsKind other = pprPanic "toHsKind" (ppr other) - -toKindTc :: IfaceTyCon -> TyCon -toKindTc (IfaceTc n) | Just (ATyCon tc) <- wiredInNameTyThing_maybe n = tc -toKindTc other = pprPanic "toKindTc" (ppr other) - -ifaceTcType ifTc = IfaceTyConApp ifTc [] - -ifaceLiftedTypeKind = ifaceTcType (IfaceTc liftedTypeKindTyConName) -ifaceOpenTypeKind = ifaceTcType (IfaceTc openTypeKindTyConName) -ifaceUnliftedTypeKind = ifaceTcType (IfaceTc unliftedTypeKindTyConName) - -ifaceArrow ifT1 ifT2 = IfaceFunTy ifT1 ifT2 - -toHsTvBndr :: IfaceTvBndr -> LHsTyVarBndr RdrName -toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual (mkTyVarOccFS tv)) bsig - where - bsig = toHsKind k - -ifaceExtRdrName :: Name -> RdrName -ifaceExtRdrName name = mkOrig (nameModule name) (nameOccName name) -ifaceExtRdrName other = pprPanic "ParserCore.ifaceExtRdrName" (ppr other) - -add_forall tv (L _ (HsForAllTy exp tvs cxt t)) - = noLoc $ HsForAllTy exp (mkHsQTvs (tv : hsQTvBndrs tvs)) cxt t -add_forall tv t - = noLoc $ HsForAllTy Explicit (mkHsQTvs [tv]) (noLoc []) t - -happyError :: P a -happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l -} - diff --git a/compiler/parser/ParserCoreUtils.hs b/compiler/parser/ParserCoreUtils.hs deleted file mode 100644 index 8f67d96239..0000000000 --- a/compiler/parser/ParserCoreUtils.hs +++ /dev/null @@ -1,77 +0,0 @@ -module ParserCoreUtils where - -import Exception -import System.IO - -data ParseResult a = OkP a | FailP String -type P a = String -> Int -> ParseResult a - -thenP :: P a -> (a -> P b) -> P b -m `thenP` k = \ s l -> - case m s l of - OkP a -> k a s l - FailP s -> FailP s - -returnP :: a -> P a -returnP m _ _ = OkP m - -failP :: String -> P a -failP s s' _ = FailP (s ++ ":" ++ s') - -getCoreModuleName :: FilePath -> IO String -getCoreModuleName fpath = - catchIO (do - h <- openFile fpath ReadMode - ls <- hGetContents h - let mo = findMod (words ls) - -- make sure we close up the file right away. - (length mo) `seq` return () - hClose h - return mo) - (\ _ -> return "Main") - where - findMod [] = "Main" - -- TODO: this should just return the module name, without the package name - findMod ("%module":m:_) = m - findMod (_:xs) = findMod xs - - -data Token = - TKmodule - | TKdata - | TKnewtype - | TKforall - | TKrec - | TKlet - | TKin - | TKcase - | TKof - | TKcast - | TKnote - | TKexternal - | TKlocal - | TKwild - | TKoparen - | TKcparen - | TKobrace - | TKcbrace - | TKhash - | TKeq - | TKcolon - | TKcoloncolon - | TKcoloneqcolon - | TKstar - | TKrarrow - | TKlambda - | TKat - | TKdot - | TKquestion - | TKsemicolon - | TKname String - | TKcname String - | TKinteger Integer - | TKrational Rational - | TKstring String - | TKchar Char - | TKEOF - diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 5b39132254..26e83cd071 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -18,8 +18,7 @@ module TcRnDriver ( tcRnLookupName, tcRnGetInfo, tcRnModule, tcRnModuleTcRnM, - tcTopSrcDecls, - tcRnExtCore + tcTopSrcDecls ) where #ifdef GHCI @@ -58,8 +57,6 @@ import LoadIface import RnNames import RnEnv import RnSource -import PprCore -import CoreSyn import ErrUtils import Id import VarEnv @@ -82,7 +79,6 @@ import CoAxiom import Inst ( tcGetInstEnvs ) import Annotations import Data.List ( sortBy ) -import Data.IORef ( readIORef ) import Data.Ord #ifdef GHCI import BasicTypes hiding( SuccessFlag(..) ) @@ -304,107 +300,6 @@ tcRnImports hsc_env import_decls \end{code} -%************************************************************************ -%* * - Type-checking external-core modules -%* * -%************************************************************************ - -\begin{code} -tcRnExtCore :: HscEnv - -> HsExtCore RdrName - -> IO (Messages, Maybe ModGuts) - -- Nothing => some error occurred - -tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds) - -- The decls are IfaceDecls; all names are original names - = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ; - - initTc hsc_env ExtCoreFile False this_mod $ do { - - let { ldecls = map noLoc decls } ; - - -- Bring the type and class decls into scope - -- ToDo: check that this doesn't need to extract the val binds. - -- It seems that only the type and class decls need to be in scope below because - -- (a) tcTyAndClassDecls doesn't need the val binds, and - -- (b) tcExtCoreBindings doesn't need anything - -- (in fact, it might not even need to be in the scope of - -- this tcg_env at all) - (tc_envs, _bndrs) <- getLocalNonValBinders emptyFsEnv {- no fixity decls -} - (mkFakeGroup ldecls) ; - setEnvs tc_envs $ do { - - (rn_decls, _fvs) <- checkNoErrs $ rnTyClDecls [] [mkTyClGroup ldecls] ; - -- The empty list is for extra dependencies coming from .hs-boot files - -- See Note [Extra dependencies from .hs-boot files] in RnSource - - -- Dump trace of renaming part - rnDump (ppr rn_decls) ; - - -- Typecheck them all together so that - -- any mutually recursive types are done right - -- Just discard the auxiliary bindings; they are generated - -- only for Haskell source code, and should already be in Core - tcg_env <- tcTyAndClassDecls emptyModDetails rn_decls ; - safe_mode <- liftIO $ finalSafeMode (hsc_dflags hsc_env) tcg_env ; - dep_files <- liftIO $ readIORef (tcg_dependent_files tcg_env) ; - - setGblEnv tcg_env $ do { - -- Make the new type env available to stuff slurped from interface files - - -- Now the core bindings - core_binds <- initIfaceExtCore (tcExtCoreBindings src_binds) ; - - - -- Wrap up - let { - bndrs = bindersOfBinds core_binds ; - my_exports = map (Avail . idName) bndrs ; - -- ToDo: export the data types also? - - mod_guts = ModGuts { mg_module = this_mod, - mg_boot = False, - mg_used_names = emptyNameSet, -- ToDo: compute usage - mg_used_th = False, - mg_dir_imps = emptyModuleEnv, -- ?? - mg_deps = noDependencies, -- ?? - mg_exports = my_exports, - mg_tcs = tcg_tcs tcg_env, - mg_insts = tcg_insts tcg_env, - mg_fam_insts = tcg_fam_insts tcg_env, - mg_inst_env = tcg_inst_env tcg_env, - mg_fam_inst_env = tcg_fam_inst_env tcg_env, - mg_patsyns = [], -- TODO - mg_rules = [], - mg_vect_decls = [], - mg_anns = [], - mg_binds = core_binds, - - -- Stubs - mg_rdr_env = emptyGlobalRdrEnv, - mg_fix_env = emptyFixityEnv, - mg_warns = NoWarnings, - mg_foreign = NoStubs, - mg_hpc_info = emptyHpcInfo False, - mg_modBreaks = emptyModBreaks, - mg_vect_info = noVectInfo, - mg_safe_haskell = safe_mode, - mg_trust_pkg = False, - mg_dependent_files = dep_files - } } ; - - tcCoreDump mod_guts ; - - return mod_guts - }}}} - -mkFakeGroup :: [LTyClDecl a] -> HsGroup a -mkFakeGroup decls -- Rather clumsy; lots of unused fields - = emptyRdrGroup { hs_tyclds = [mkTyClGroup decls] } -\end{code} - - %************************************************************************ %* * Type-checking the top level of a module @@ -1864,17 +1759,6 @@ tcDump env -- NB: foreign x-d's have undefined's in their types; -- hence can't show the tc_fords -tcCoreDump :: ModGuts -> TcM () -tcCoreDump mod_guts - = do { dflags <- getDynFlags ; - when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags) - (dumpTcRn (pprModGuts mod_guts)) ; - - -- Dump bindings if -ddump-tc - dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump) } - where - full_dump = pprCoreBindings (mg_binds mod_guts) - -- It's unpleasant having both pprModGuts and pprModDetails here pprTcGblEnv :: TcGblEnv -> SDoc pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, @@ -1900,12 +1784,6 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, `thenCmp` (is_boot1 `compare` is_boot2) -pprModGuts :: ModGuts -> SDoc -pprModGuts (ModGuts { mg_tcs = tcs - , mg_rules = rules }) - = vcat [ ppr_types [] (mkTypeEnv (map ATyCon tcs)), - ppr_rules rules ] - ppr_types :: [ClsInst] -> TypeEnv -> SDoc ppr_types insts type_env = text "TYPE SIGNATURES" $$ nest 2 (ppr_sigs ids) @@ -1960,9 +1838,4 @@ ppr_tydecls tycons -- Temporarily print the kind signature too , ppr (tyThingToIfaceDecl (ATyCon tycon)) ] -ppr_rules :: [CoreRule] -> SDoc -ppr_rules [] = empty -ppr_rules rs = vcat [ptext (sLit "{-# RULES"), - nest 2 (pprRules rs), - ptext (sLit "#-}")] \end{code} diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 01c9d36cf3..0fc4d6ba9a 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -1245,17 +1245,6 @@ initIfaceTcRn thing_inside ; get_type_env = readTcRef (tcg_type_env_var tcg_env) } ; setEnvs (if_env, ()) thing_inside } -initIfaceExtCore :: IfL a -> TcRn a -initIfaceExtCore thing_inside - = do { tcg_env <- getGblEnv - ; let { mod = tcg_mod tcg_env - ; doc = ptext (sLit "External Core file for") <+> quotes (ppr mod) - ; if_env = IfGblEnv { - if_rec_types = Just (mod, return (tcg_type_env tcg_env)) } - ; if_lenv = mkIfLclEnv mod doc - } - ; setEnvs (if_env, if_lenv) thing_inside } - initIfaceCheck :: HscEnv -> IfG a -> IO a -- Used when checking the up-to-date-ness of the old Iface -- Initialise the environment with no useful info at all diff --git a/docs/users_guide/external_core.xml b/docs/users_guide/external_core.xml deleted file mode 100644 index e4354410ef..0000000000 --- a/docs/users_guide/external_core.xml +++ /dev/null @@ -1,1804 +0,0 @@ - - - - - - - - - An External Representation for the GHC Core Language (For GHC 6.10) - - Andrew Tolmach, Tim Chevalier ({apt,tjc}@cs.pdx.edu) and The GHC Team - - This chapter provides a precise definition for the GHC Core - language, so that it can be used to communicate between GHC and new - stand-alone compilation tools such as back-ends or - optimizers. - This is a draft document, which attempts - to describe GHC’s current behavior as precisely as possible. Working - notes scattered throughout indicate areas where further work is - needed. Constructive comments are very welcome, both on the - presentation, and on ways in which GHC could be improved in order to - simplify the Core story. - - Support for generating external Core (post-optimization) was - originally introduced in GHC 5.02. The definition of external Core in - this document reflects the version of external Core generated by the - HEAD (unstable) branch of GHC as of May 3, 2008 (version 6.9), using - the compiler flag -fext-core. We expect that GHC 6.10 will be - consistent with this definition. - - The definition includes a formal grammar and an informal semantics. - An executable typechecker and interpreter (in Haskell), which - formally embody the static and dynamic semantics, are available - separately. - -
- Introduction - - The Glasgow Haskell Compiler (GHC) uses an intermediate language, - called Core, as its internal program representation within the - compiler’s simplification phase. Core resembles a subset of - Haskell, but with explicit type annotations in the style of the - polymorphic lambda calculus (Fω). - - GHC’s front-end translates full Haskell 98 (plus some extensions) - into Core. The GHC optimizer then repeatedly transforms Core - programs while preserving their meaning. A Core Lint pass in GHC - typechecks Core in between transformation passes (at least when - the user enables linting by setting a compiler flag), verifying - that transformations preserve type-correctness. Finally, GHC’s - back-end translates Core into STG-machine code stg-machine and then into C - or native code. - - Two existing papers discuss the original rationale for the design - and use of Core ghc-inliner,comp-by-trans-scp, although the (two different) idealized - versions of Core described therein differ in significant ways from - the actual Core language in current GHC. In particular, with the - advent of GHC support for generalized algebraic datatypes (GADTs) - gadts Core was extended beyond its previous - Fω-style incarnation to support type - equality constraints and safe coercions, and is now based on a - system known as FC system-fc. - - Researchers interested in writing just part of a Haskell compiler, - such as a new back-end or a new optimizer pass, might like to use - GHC to provide the other parts of the compiler. For example, they - might like to use GHC’s front-end to parse, desugar, and - type-check source Haskell, then feeding the resulting code to - their own back-end tool. As another example, they might like to - use Core as the target language for a front-end compiler of their - own design, feeding externally synthesized Core into GHC in order - to take advantage of GHC’s optimizer, code generator, and run-time - system. Without external Core, there are two ways for compiler - writers to do this: they can link their code into the GHC - executable, which is an arduous process, or they can use the GHC - API ghc-api to do the same task more cleanly. Both ways require new - code to be written in Haskell. - - We present a precisely specified external format for Core files. - The external format is text-based and human-readable, to promote - interoperability and ease of use. We hope this format will make it - easier for external developers to use GHC in a modular way. - - It has long been true that GHC prints an ad-hoc textual - representation of Core if you set certain compiler flags. But this - representation is intended to be read by people who are debugging - the compiler, not by other programs. Making Core into a - machine-readable, bi-directional communication format requires: - - - - precisely specifying the external format of Core; - - - modifying GHC to generate external Core files - (post-simplification; as always, users can control the exact - transformations GHC does with command-line flags); - - - modifying GHC to accept external Core files in place of - Haskell source files (users will also be able to control what - GHC does to those files with command-line flags). - - - - - The first two facilities will let developers couple GHC’s - front-end (parser, type-checker, desugarer), and optionally its - optimizer, with new back-end tools. The last facility will let - developers write new Core-to-Core transformations as an external - tool and integrate them into GHC. It will also allow new - front-ends to generate Core that can be fed into GHC’s optimizer - or back-end. - - However, because there are many (undocumented) idiosyncracies in - the way GHC produces Core from source Haskell, it will be hard for - an external tool to produce Core that can be integrated with - GHC-produced Core (e.g., for the Prelude), and we don’t aim to - support this. Indeed, for the time being, we aim to support only - the first two facilities and not the third: we define and - implement Core as an external format that GHC can use to - communicate with external back-end tools, and defer the larger - task of extending GHC to support reading this external format back - in. - - This document addresses the first requirement, a formal Core - definition, by proposing a formal grammar for an - external representation of Core, - and an informal semantics. - - GHC supports many type system extensions; the External Core - printer built into GHC only supports some of them. However, - External Core should be capable of representing any Haskell 98 - program, and may be able to represent programs that require - certain type system extensions as well. If a program uses - unsupported features, GHC may fail to compile it to Core when the - -fext-core flag is set, or GHC may successfully compile it to - Core, but the external tools will not be able to typecheck or - interpret it. - - Formal static and dynamic semantics in the form of an executable - typechecker and interpreter are available separately in the GHC - source tree - http://git.haskell.org/ghc.git - under utils/ext-core. - -
-
- External Grammar of Core - - In designing the external grammar, we have tried to strike a - balance among a number of competing goals, including easy - parseability by machines, easy readability by humans, and adequate - structural simplicity to allow straightforward presentations of - the semantics. Thus, we had to make some compromises. - Specifically: - - - In order to avoid explosion of parentheses, we support - standard precedences and short-cuts for expressions, types, - and kinds. Thus we had to introduce multiple non-terminals for - each of these syntactic categories, and as a result, the - concrete grammar is longer and more complex than the - underlying abstract syntax. - - On the other hand, we have kept the grammar simpler by - avoiding special syntax for tuple types and terms. Tuples - (both boxed and unboxed) are treated as ordinary constructors. - - All type abstractions and applications are given in full, even - though some of them (e.g., for tuples) could be reconstructed; - this means a parser for Core does not have to reconstruct - types. - These choices are certainly debatable. In - particular, keeping type applications on tuples and case arms - considerably increases the size of Core files and makes them less - human-readable, though it allows a Core parser to be simpler. - - - The syntax of identifiers is heavily restricted (to just - alphanumerics and underscores); this again makes Core easier - to parse but harder to read. - - - We use the following notational conventions for syntax: - - - - - - [ pat ] - optional - - - - { pat } - zero or more repetitions - - - - - { pat }+ - - one or more repetitions - - - - - pat1 ∣ pat2 - - choice - - - - - fibonacci - - terminal syntax in typewriter font - - - - - - - - - - - - - - - - Module - module - → - - %module mident { tdef ; }{ vdefg ; } - - - - - - Type defn. - tdef - → - - %data qtycon { tbind } = { [ cdef {; cdef } ] } - - algebraic type - - - ∣ - - %newtype qtycon qtycon { tbind } = ty - - newtype - - - - Constr. defn. - cdef - → - - qdcon { @ tbind }{ aty }+ - - - - - Value defn. - vdefg - → - %rec { vdef { ; vdef } } - recursive - - - - ∣ - vdef - non-recursive - - - - vdef - → - qvar :: ty = exp - - - - - Atomic expr. - aexp - → - qvar - variable - - - - ∣ - qdcon - data constructor - - - - ∣ - lit - literal - - - - ∣ - ( exp ) - nested expr. - - - - Expression - exp - → - aexp - atomic expresion - - - - ∣ - aexp { arg }+ - application - - - - ∣ - \ { binder }+ &arw; exp - abstraction - - - - ∣ - %let vdefg %in exp - local definition - - - - ∣ - %case ( aty ) exp %of vbind { alt { ; alt } } - case expression - - - - ∣ - %cast exp aty - type coercion - - - - ∣ - %note " { char } " exp - expression note - - - - ∣ - %external ccall " { char } " aty - external reference - - - - ∣ - %dynexternal ccall aty - external reference (dynamic) - - - - ∣ - %label " { char } " - external label - - - - Argument - arg - → - @ aty - type argument - - - - ∣ - aexp - value argument - - - - Case alt. - alt - → - qdcon { @ tbind }{ vbind } &arw; exp - constructor alternative - - - - ∣ - lit &arw; exp - literal alternative - - - - ∣ - %_ &arw; exp - default alternative - - - - Binder - binder - → - @ tbind - type binder - - - - ∣ - vbind - value binder - - - - Type binder - tbind - → - tyvar - implicitly of kind * - - - - ∣ - ( tyvar :: kind ) - explicitly kinded - - - - Value binder - vbind - → - ( var :: ty ) - - - - - Literal - lit - → - ( [-] { digit }+ :: ty ) - integer - - - - ∣ - ( [-] { digit }+ % { digit }+ :: ty ) - rational - - - - ∣ - ( ' char ' :: ty ) - character - - - - ∣ - ( " { char } " :: ty ) - string - - - - Character - char - → - any ASCII character in range 0x20-0x7E except 0x22,0x27,0x5c - - - - ∣ - \x hex hex - ASCII code escape sequence - - - - hex - → - 0∣…∣9 ∣a ∣…∣f - - - - - Atomic type - aty - → - tyvar - type variable - - - - ∣ - qtycon - type constructor - - - - ∣ - ( ty ) - nested type - - - - Basic type - bty - → - aty - atomic type - - - - ∣ - bty aty - type application - - - - ∣ - %trans aty aty - transitive coercion - - - - ∣ - %sym aty - symmetric coercion - - - - ∣ - %unsafe aty aty - unsafe coercion - - - - ∣ - %left aty - left coercion - - - - ∣ - %right aty - right coercion - - - - ∣ - %inst aty aty - instantiation coercion - - - - Type - ty - → - bty - basic type - - - - ∣ - %forall { tbind }+ . ty - type abstraction - - - - ∣ - bty &arw; ty - arrow type construction - - - - Atomic kind - akind - → - * - lifted kind - - - - ∣ - # - unlifted kind - - - - ∣ - ? - open kind - - - - ∣ - bty :=: bty - equality kind - - - - ∣ - ( kind ) - nested kind - - - - Kind - kind - → - akind - atomic kind - - - - ∣ - akind &arw; kind - arrow kind - - - - Identifier - mident - → - pname : uname - module - - - - tycon - → - uname - type constr. - - - - qtycon - → - mident . tycon - qualified type constr. - - - - tyvar - → - lname - type variable - - - - dcon - → - uname - data constr. - - - - qdcon - → - mident . dcon - qualified data constr. - - - - var - → - lname - variable - - - - qvar - → - [ mident . ] var - optionally qualified variable - - - - Name - lname - → - lower { namechar } - - - - - uname - → - upper { namechar } - - - - - pname - → - { namechar }+ - - - - - namechar - → - lower ∣ upper ∣ digit - - - - - lower - → - a ∣ b ∣ … ∣ z ∣ _ - - - - - upper - → - A ∣ B ∣ … ∣ Z - - - - - digit - → - 0 ∣ 1 ∣ … ∣ 9 - - - - - -
- -
- Informal Semantics - - At the term level, Core resembles a explicitly-typed polymorphic - lambda calculus (Fω), with the addition of - local let bindings, algebraic type definitions, constructors, and - case expressions, and primitive types, literals and operators. Its - type system is richer than that of System F, supporting explicit - type equality coercions and type functions.system-fc - - In this section we concentrate on the less obvious points about - Core. - -
- Program Organization and Modules - - Core programs are organized into modules, corresponding directly - to source-level Haskell modules. Each module has a identifying - name mident. A module identifier consists of a package name - followed by a module name, which may be hierarchical: for - example, base:GHC.Base is the module identifier for GHC’s Base - module. Its name is Base, and it lives in the GHC hierarchy - within the base package. Section 5.8 of the GHC users’ guide - explains package names ghc-user-guide. In particular, note that a Core - program may contain multiple modules with the same (possibly - hierarchical) module name that differ in their package names. In - some of the code examples that follow, we will omit package - names and possibly full hierarchical module names from - identifiers for brevity, but be aware that they are always - required. - A possible improvement to the Core syntax - would be to add explicit import lists to Core modules, which could be - used to specify abbrevations for long qualified names. This would make - the code more human-readable. - - - Each module may contain the following kinds of top-level - declarations: - - - - Algebraic data type declarations, each defining a type - constructor and one or more data constructors; - - - Newtype declarations, corresponding to Haskell newtype - declarations, each defining a type constructor and a - coercion name; and - - - Value declarations, defining the types and values of - top-level variables. - - - - - No type constructor, data constructor, or top-level value may be - declared more than once within a given module. All the type - declarations are (potentially) mutually recursive. Value - declarations must be in dependency order, with explicit grouping - of potentially mutually recursive declarations. - - Identifiers defined in top-level declarations may be external or - internal. External identifiers can be referenced from any other - module in the program, using conventional dot notation (e.g., - base:GHC.Base.Bool, base:GHC.Base.True). Internal identifiers - are visible only within the defining module. All type and data - constructors are external, and are always defined and referenced - using fully qualified names (with dots). - - A top-level value is external if it is defined and referenced - using a fully qualified name with a dot (e.g., main:MyModule.foo = ...); - otherwise, it is internal (e.g., bar = ...). Note that - Core’s notion of an external identifier does not necessarily - coincide with that of exported identifier in a Haskell source - module. An identifier can be an external identifier in Core, but - not be exported by the original Haskell source - module. - Two examples of such identifiers are: data - constructors, and values that potentially appear in an unfolding. For an - example of the latter, consider Main.foo = ... Main.bar ..., where - Main.foo is inlineable. Since bar appears in foo’s unfolding, it is - defined and referenced with an external name, even if bar was not - exported by the original source module. - - However, if an identifier was exported by the Haskell source - module, it will appear as an external name in Core. - - Core modules have no explicit import or export lists. Modules - may be mutually recursive. Note that because of the latter fact, - GHC currently prints out the top-level bindings for every module - as a single recursive group, in order to avoid keeping track of - dependencies between top-level values within a module. An - external Core tool could reconstruct dependencies later, of - course. - - There is also an implicitly-defined module ghc-prim:GHC.Prim, - which exports the built-in types and values that must be - provided by any implementation of Core (including GHC). Details - of this module are in the Primitive Module section. - - A Core program is a collection of distinctly-named modules that - includes a module called main:Main having an exported value - called main:ZCMain.main of type base:GHC.IOBase.IO a (for some - type a). (Note that the strangely named wrapper for main is the - one exception to the rule that qualified names defined within a - module m must have module name m.) - - Many Core programs will contain library modules, such as - base:GHC.Base, which implement parts of the Haskell standard - library. In principle, these modules are ordinary Haskell - modules, with no special status. In practice, the requirement on - the type of main:Main.main implies that every program will - contain a large subset of the standard library modules. - -
-
- Namespaces - - There are five distinct namespaces: - - module identifiers (mident), - type constructors (tycon), - type variables (tyvar), - data constructors (dcon), - term variables (var). - - - - Spaces (1), (2+3), and (4+5) can be distinguished from each - other by context. To distinguish (2) from (3) and (4) from (5), - we require that data and type constructors begin with an - upper-case character, and that term and type variables begin - with a lower-case character. - - Primitive types and operators are not syntactically - distinguished. - - Primitive coercion operators, of which there are six, are - syntactically distinguished in the grammar. This is because - these coercions must be fully applied, and because - distinguishing their applications in the syntax makes - typechecking easier. - - A given variable (type or term) may have multiple definitions - within a module. However, definitions of term variables never - shadow one another: the scope of the definition of a given - variable never contains a redefinition of the same variable. - Type variables may be shadowed. Thus, if a term variable has - multiple definitions within a module, all those definitions must - be local (let-bound). The only exception to this rule is that - (necessarily closed) types labelling %external expressions may - contain tyvar bindings that shadow outer bindings. - - Core generated by GHC makes heavy use of encoded names, in which - the characters Z and z are used to introduce escape sequences - for non-alphabetic characters such as dollar sign $ (zd), hash # - (zh), plus + (zp), etc. This is the same encoding used in .hi - files and in the back-end of GHC itself, except that we - sometimes change an initial z to Z, or vice-versa, in order to - maintain case distinctions. - - Finally, note that hierarchical module names are z-encoded in - Core: for example, base:GHC.Base.foo is rendered as - base:GHCziBase.foo. A parser may reconstruct the module - hierarchy, or regard GHCziBase as a flat name. - -
-
- Types and Kinds - - In Core, all type abstractions and applications are explicit. - This make it easy to typecheck any (closed) fragment of Core - code. An full executable typechecker is available separately. - -
- Types - - Types are described by type expressions, which are built from - named type constructors and type variables using type - application and universal quantification. Each type - constructor has a fixed arity ≥ 0. Because it is so widely - used, there is special infix syntax for the fully-applied - function type constructor (&arw;). (The prefix identifier for - this constructor is ghc-prim:GHC.Prim.ZLzmzgZR; this should - only appear in unapplied or partially applied form.) - - There are also a number of other primitive type constructors - (e.g., Intzh) that are predefined in the GHC.Prim module, but - have no special syntax. %data and %newtype declarations - introduce additional type constructors, as described below. - Type constructors are distinguished solely by name. - -
-
- Coercions - - A type may also be built using one of the primitive coercion - operators, as described in the Namespaces section. For details on the - meanings of these operators, see the System FC paper system-fc. Also - see the Newtypes section for - examples of how GHC uses coercions in Core code. - -
-
- Kinds - As described in the Haskell definition, it is necessary to - distinguish well-formed type-expressions by classifying them - into different kinds haskell98, p. 41. In particular, Core - explicitly records the kind of every bound type variable. - - In addition, Core’s kind system includes equality kinds, as in - System FC system-fc. An application of a built-in coercion, or of a - user-defined coercion as introduced by a newtype declaration, - has an equality kind. - -
-
- Lifted and Unlifted Types - - Semantically, a type is lifted if and only if it has bottom as - an element. We need to distinguish them because operationally, - terms with lifted types may be represented by closures; terms - with unlifted types must not be represented by closures, which - implies that any unboxed value is necessarily unlifted. We - distinguish between lifted and unlifted types by ascribing - them different kinds. - - Currently, all the primitive types are unlifted (including a - few boxed primitive types such as ByteArrayzh). Peyton-Jones - and Launchbury pj:unboxed described the ideas behind unboxed and - unlifted types. - -
-
- Type Constructors; Base Kinds and Higher Kinds - - Every type constructor has a kind, depending on its arity and - whether it or its arguments are lifted. - - Term variables can only be assigned types that have base - kinds: the base kinds are *, #, and ?. The three base kinds - distinguish the liftedness of the types they classify: * - represents lifted types; # represents unlifted types; and ? is - the open kind, representing a type that may be either lifted - or unlifted. Of these, only * ever appears in Core type - declarations generated from user code; the other two are - needed to describe certain types in primitive (or otherwise - specially-generated) code (which, after optimization, could - potentially appear anywhere). - - In particular, no top-level identifier (except in - ghc-prim:GHC.Prim) has a type of kind # or ?. - - Nullary type constructors have base kinds: for example, the - type Int has kind *, and Int# has kind #. - - Non-nullary type constructors have higher kinds: kinds that - have the form - k1&arw;k2, where - k1 and k2 are - kinds. For example, the function type constructor &arw; has - kind * &arw; (* &arw; *). Since Haskell allows abstracting - over type constructors, type variables may have higher kinds; - however, much more commonly they have kind *, so that is the - default if a type binder omits a kind. - -
- -
- Type Synonyms and Type Equivalence - - There is no mechanism for defining type synonyms - (corresponding to Haskell type declarations). - - Type equivalence is just syntactic equivalence on type - expressions (of base kinds) modulo: - - - alpha-renaming of variables bound in %forall types; - the identity a &arw; b ≡ ghc-prim:GHC.Prim.ZLzmzgZR a b - - -
-
-
- Algebraic data types - - Each data declaration introduces a new type constructor and a - set of one or more data constructors, normally corresponding - directly to a source Haskell data declaration. For example, the - source declaration - - -data Bintree a = - Fork (Bintree a) (Bintree a) - | Leaf a - - - might induce the following Core declaration - - -%data Bintree a = { - Fork (Bintree a) (Bintree a); - Leaf a)} - - - which introduces the unary type constructor Bintree of kind - *&arw;* and two data constructors with types - - -Fork :: %forall a . Bintree a &arw; Bintree a &arw; Bintree a -Leaf :: %forall a . a &arw; Bintree a - - - We define the arity of each data constructor to be the number of - value arguments it takes; e.g. Fork has arity 2 and Leaf has - arity 1. - - For a less conventional example illustrating the possibility of - higher-order kinds, the Haskell source declaration - - -data A f a = MkA (f a) - - - might induce the Core declaration - - -%data A (f::*&arw;*) a = { MkA (f a) } - - - which introduces the constructor - - -MkA :: %forall (f::*&arw;*) a . (f a) &arw; (A f) a - - - GHC (like some other Haskell implementations) supports an - extension to Haskell98 for existential types such as - - -data T = forall a . MkT a (a &arw; Bool) - - - This is represented by the Core declaration - - -%data T = {MkT @a a (a &arw; Bool)} - - - which introduces the nullary type constructor T and the data - constructor - - -MkT :: %forall a . a &arw; (a &arw; Bool) &arw; T - - - In general, existentially quantified variables appear as extra - universally quantified variables in the data contructor types. An - example of how to construct and deconstruct values of type T is - shown in the Expression Forms section. - -
-
- Newtypes - - Each Core %newtype declaration introduces a new type constructor - and an associated representation type, corresponding to a source - Haskell newtype declaration. However, unlike in source Haskell, - a %newtype declaration does not introduce any data constructors. - - Each %newtype declaration also introduces a new coercion - (syntactically, just another type constructor) that implies an - axiom equating the type constructor, applied to any type - variables bound by the %newtype, to the representation type. - - For example, the Haskell fragment - - -newtype U = MkU Bool -u = MkU True -v = case u of - MkU b &arw; not b - - - might induce the Core fragment - - -%newtype U ZCCoU = Bool; -u :: U = %cast (True) - ((%sym ZCCoU)); -v :: Bool = not (%cast (u) ZCCoU); - - - The newtype declaration implies that the types U and Bool have - equivalent representations, and the coercion axiom ZCCoU - provides evidence that U is equivalent to Bool. Notice that in - the body of u, the boolean value True is cast to type U using - the primitive symmetry rule applied to ZCCoU: that is, using a - coercion of kind Bool :=: U. And in the body of v, u is cast - back to type Bool using the axiom ZCCoU. - - Notice that the case in the Haskell source code above translates - to a cast in the corresponding Core code. That is because - operationally, a case on a value whose type is declared by a - newtype declaration is a no-op. Unlike a case on any other - value, such a case does no evaluation: its only function is to - coerce its scrutinee’s type. - - Also notice that unlike in a previous draft version of External - Core, there is no need to handle recursive newtypes specially. - -
- -
- Expression Forms - - Variables and data constructors are straightforward. - - Literal (lit) expressions consist of a literal value, in one of - four different formats, and a (primitive) type annotation. Only - certain combinations of format and type are permitted; - see the Primitive Module section. - The character and string formats can describe only 8-bit ASCII characters. - - Moreover, because the operational semantics for Core interprets - strings as C-style null-terminated strings, strings should not - contain embedded nulls. - - In Core, value applications, type applications, value - abstractions, and type abstractions are all explicit. To tell - them apart, type arguments in applications and formal type - arguments in abstractions are preceded by an @ symbol. (In - abstractions, the @ plays essentially the same role as the more - usual Λ symbol.) For example, the Haskell source declaration - - -f x = Leaf (Leaf x) - - - might induce the Core declaration - - -f :: %forall a . a &arw; BinTree (BinTree a) = - \ @a (x::a) &arw; Leaf @(Bintree a) (Leaf @a x) - - - Value applications may be of user-defined functions, data - constructors, or primitives. None of these sorts of applications - are necessarily saturated. - - Note that the arguments of type applications are not always of - kind *. For example, given our previous definition of type A: - - -data A f a = MkA (f a) - - - the source code - - -MkA (Leaf True) - - - becomes - - -(MkA @Bintree @Bool) (Leaf @Bool True) - - - Local bindings, of a single variable or of a set of mutually - recursive variables, are represented by %let expressions in the - usual way. - - By far the most complicated expression form is %case. %case - expressions are permitted over values of any type, although they - will normally be algebraic or primitive types (with literal - values). Evaluating a %case forces the evaluation of the - expression being tested (the scrutinee). The value of the - scrutinee is bound to the variable following the %of keyword, - which is in scope in all alternatives; this is useful when the - scrutinee is a non-atomic expression (see next example). The - scrutinee is preceded by the type of the entire %case - expression: that is, the result type that all of the %case - alternatives have (this is intended to make type reconstruction - easier in the presence of type equality coercions). - - In an algebraic %case, all the case alternatives must be labeled - with distinct data constructors from the algebraic type, - followed by any existential type variable bindings (see below), - and typed term variable bindings corresponding to the data - constructor’s arguments. The number of variables must match the - data constructor’s arity. - - For example, the following Haskell source expression - - -case g x of - Fork l r &arw; Fork r l - t@(Leaf v) &arw; Fork t t - - - might induce the Core expression - - -%case ((Bintree a)) g x %of (t::Bintree a) - Fork (l::Bintree a) (r::Bintree a) &arw; - Fork @a r l - Leaf (v::a) &arw; - Fork @a t t - - - When performing a %case over a value of an - existentially-quantified algebraic type, the alternative must - include extra local type bindings for the - existentially-quantified variables. For example, given - - -data T = forall a . MkT a (a &arw; Bool) - - - the source - - -case x of - MkT w g &arw; g w - - - becomes - - -%case x %of (x’::T) - MkT @b (w::b) (g::b&arw;Bool) &arw; g w - - - In a %case over literal alternatives, all the case alternatives - must be distinct literals of the same primitive type. - - The list of alternatives may begin with a default alternative - labeled with an underscore (%_), whose right-hand side will be - evaluated if none of the other alternatives match. The default - is optional except for in a case over a primitive type, or when - there are no other alternatives. If the case is over neither an - algebraic type nor a primitive type, then the list of - alternatives must contain a default alternative and nothing - else. For algebraic cases, the set of alternatives need not be - exhaustive, even if no default is given; if alternatives are - missing, this implies that GHC has deduced that they cannot - occur. - - %cast is used to manipulate newtypes, as described in - the Newtype section. The %cast expression - takes an expression and a coercion: syntactically, the coercion - is an arbitrary type, but it must have an equality kind. In an - expression (cast e co), if e :: T and co has kind T :=: U, then - the overall expression has type U ghc-fc-commentary. Here, co must be a - coercion whose left-hand side is T. - - Note that unlike the %coerce expression that existed in previous - versions of Core, this means that %cast is (almost) type-safe: - the coercion argument provides evidence that can be verified by - a typechecker. There are still unsafe %casts, corresponding to - the unsafe %coerce construct that existed in old versions of - Core, because there is a primitive unsafe coercion type that can - be used to cast arbitrary types to each other. GHC uses this for - such purposes as coercing the return type of a function (such as - error) which is guaranteed to never return: - - -case (error "") of - True &arw; 1 - False &arw; 2 - - - becomes: - - -%cast (error @ Bool (ZMZN @ Char)) -(%unsafe Bool Integer); - - - %cast has no operational meaning and is only used in - typechecking. - - A %note expression carries arbitrary internal information that - GHC finds interesting. The information is encoded as a string. - Expression notes currently generated by GHC include the inlining - pragma (InlineMe) and cost-center labels for profiling. - - A %external expression denotes an external identifier, which has - the indicated type (always expressed in terms of Haskell - primitive types). External Core supports two kinds of external - calls: %external and %dynexternal. Only the former is supported - by the current set of stand-alone Core tools. In addition, there - is a %label construct which GHC may generate but which the Core - tools do not support. - - The present syntax for externals is sufficient for describing C - functions and labels. Interfacing to other languages may require - additional information or a different interpretation of the name - string. - -
- -
- Expression Evaluation - The dynamic semantics of Core are defined on the type-erasure of - the program: for example, we ignore all type abstractions and - applications. The denotational semantics of the resulting - type-free program are just the conventional ones for a - call-by-name language, in which expressions are only evaluated - on demand. But Core is intended to be a call-by-need language, - in which expressions are only evaluated once. To express the - sharing behavior of call-by-need, we give an operational model - in the style of Launchbury launchbury93natural. - - This section describes the model informally; a more formal - semantics is separately available as an executable interpreter. - - To simplify the semantics, we consider only well-behaved Core - programs in which constructor and primitive applications are - fully saturated, and in which non-trivial expresssions of - unlifted kind (#) appear only as scrutinees in %case - expressions. Any program can easily be put into this form; a - separately available preprocessor illustrates how. In the - remainder of this section, we use Core to mean well-behaved - Core. - - Evaluating a Core expression means reducing it to weak-head normal form (WHNF), - i.e., a primitive value, lambda abstraction, - or fully-applied data constructor. Evaluating a program means - evaluating the expression main:ZCMain.main. - - To make sure that expression evaluation is shared, we make use - of a heap, which contains heap entries. A heap entry can be: - - - - A thunk, representing an unevaluated expression, also known - as a suspension. - - - A WHNF, representing an evaluated expression. The result of - evaluating a thunk is a WHNF. A WHNF is always a closure - (corresponding to a lambda abstraction in the source - program) or a data constructor application: computations - over primitive types are never suspended. - - - - Heap pointers point to heap entries: at different times, the - same heap pointer can point to either a thunk or a WHNF, because - the run-time system overwrites thunks with WHNFs as computation - proceeds. - - The suspended computation that a thunk represents might - represent evaluating one of three different kinds of expression. - The run-time system allocates a different kind of thunk - depending on what kind of expression it is: - - - - A thunk for a value definition has a group of suspended - defining expressions, along with a list of bindings between - defined names and heap pointers to those suspensions. (A - value definition may be a recursive group of definitions or - a single non-recursive definition, and it may be top-level - (global) or let-bound (local)). - - - A thunk for a function application (where the function is - user-defined) has a suspended actual argument expression, - and a binding between the formal argument and a heap pointer - to that suspension. - - - A thunk for a constructor application has a suspended actual - argument expression; the entire constructed value has a heap - pointer to that suspension embedded in it. - - - - As computation proceeds, copies of the heap pointer for a given - thunk propagate through the executing program. When another - computation demands the result of that thunk, the thunk is - forced: the run-time system computes the thunk’s result, - yielding a WHNF, and overwrites the heap entry for the thunk - with the WHNF. Now, all copies of the heap pointer point to the - new heap entry: a WHNF. Forcing occurs only in the context of - - - evaluating the operator expression of an application; - evaluating the scrutinee of a case expression; or - evaluating an argument to a primitive or external function application - - - - When no pointers to a heap entry (whether it is a thunk or WHNF) - remain, the garbage collector can reclaim the space it uses. We - assume this happens implicitly. - - With the exception of functions, arrays, and mutable variables, - we intend that values of all primitive types should be held - unboxed: they should not be heap-allocated. This does not - violate call-by-need semantics: all primitive types are - unlifted, which means that values of those types must be - evaluated strictly. Unboxed tuple types are not heap-allocated - either. - - Certain primitives and %external functions cause side-effects to - state threads or to the real world. Where the ordering of these - side-effects matters, Core already forces this order with data - dependencies on the pseudo-values representing the threads. - - An implementation must specially support the raisezh and - handlezh primitives: for example, by using a handler stack. - Again, real-world threading guarantees that they will execute in - the correct order. - -
-
-
- Primitive Module - - The semantics of External Core rely on the contents and informal - semantics of the primitive module ghc-prim:GHC.Prim. Nearly all - the primitives are required in order to cover GHC’s implementation - of the Haskell98 standard prelude; the only operators that can be - completely omitted are those supporting the byte-code interpreter, - parallelism, and foreign objects. Some of the concurrency - primitives are needed, but can be given degenerate implementations - if it desired to target a purely sequential backend (see Section - the Non-concurrent Back End section). - - In addition to these primitives, a large number of C library - functions are required to implement the full standard Prelude, - particularly to handle I/O and arithmetic on less usual types. - - For a full listing of the names and types of the primitive - operators, see the GHC library documentation ghcprim. - -
- Non-concurrent Back End - - The Haskell98 standard prelude doesn’t include any concurrency - support, but GHC’s implementation of it relies on the existence - of some concurrency primitives. However, it never actually forks - multiple threads. Hence, the concurrency primitives can be given - degenerate implementations that will work in a non-concurrent - setting, as follows: - - - - ThreadIdzh can be represented by a singleton type, whose - (unique) value is returned by myThreadIdzh. - - - forkzh can just die with an unimplemented message. - - - killThreadzh and yieldzh can also just die unimplemented - since in a one-thread world, the only thread a thread can - kill is itself, and if a thread yields the program hangs. - - - MVarzh a can be represented by MutVarzh (Maybe a); where a - concurrent implementation would block, the sequential - implementation can just die with a suitable message (since - no other thread exists to unblock it). - - - waitReadzh and waitWritezh can be implemented using a select - with no timeout. - - -
- -
- Literals - - Only the following combination of literal forms and types are - permitted: - - - - - - - - - Literal form - Type - Description - - - - - integer - Intzh - Int - - - Wordzh - Word - - - Addrzh - Address - - - Charzh - Unicode character code - - - - rational - Floatzh - Float - - - Doublezh - Double - - - - character - Charzh - Unicode character specified by ASCII character - - - - string - Addrzh - Address of specified C-format string - - - - -
-
- - - - - - References - - - ghc-user-guide - - The GHC Team - - The Glorious Glasgow Haskell Compilation System User's Guide, Version 6.8.2 - 2008 - http://www.haskell.org/ghc/docs/latest/html/users_guide/index.html - - - - ghc-fc-commentary - - GHC Wiki - - System FC: equality constraints and coercions - 2006 - http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/FC - - - - ghc-api - - Haskell Wiki - - Using GHC as a library - 2007 - http://haskell.org/haskellwiki/GHC/As_a_library - - - - haskell98 - - SimonPeyton-Jones - - Haskell 98 Language and Libraries: The Revised Report - - Cambridge University Press -
- Cambridge> - UK -
- - 2003 - - - - system-fc - - MartinSulzmann - Manuel M.T.Chakravarty - SimonPeyton-Jones - KevinDonnelly - - System F with type equality coercions - - ACM -
- New York - NY - USA -
- - 53-66 - 2007 - http://portal.acm.org/citation.cfm?id=1190324 - - - - - gadts - - SimonPeyton-Jones - DimitriosVytiniotis - StephanieWeirich - GeoffreyWashburn - - Simple unification-based type inference for GADTs - - ACM -
- New York - NY - USA -
- - 50-61 - 2006 - http://research.microsoft.com/Users/simonpj/papers/gadt/index.htm - - - - Launchbury94 - - JohnLaunchbury - Simon L.Peyton-Jones - - Lazy Functional State Threads - 24-35 - 1994 - http://citeseer.ist.psu.edu/article/launchbury93lazy.html - - - - - pj:unboxed - - Simon L.Peyton-Jones - JohnLaunchbury - J.Hughes - - Unboxed Values as First Class Citizens in a Non-strict Functional Language - - Springer-Verlag LNCS523 -
- Cambridge - Massachussetts - USA -
- - 636-666 - 1991, August 26-28 - http://citeseer.ist.psu.edu/jones91unboxed.html - - - - - ghc-inliner - - SimonPeyton-Jones - SimonMarlow - - Secrets of the Glasgow Haskell Compiler inliner - 1999 -
- Paris - France -
- http://research.microsoft.com/Users/simonpj/Papers/inlining/inline.pdf - - - - - comp-by-trans-scp - - Simon L.Peyton-Jones - A. L. M.Santos - - A transformation-based optimiser for Haskell - Science of Computer Programming - 32 - 1-3 - 3-47 - 1998 - http://citeseer.ist.psu.edu/peytonjones98transformationbased.html - - - - stg-machine - - Simon L.Peyton-Jones - - Implementing Lazy Functional Languages on Stock Hardware: The Spineless Tagless G-Machine - Journal of Functional Programming - 2 - 2 - 127-202 - 1992 - http://citeseer.ist.psu.edu/peytonjones92implementing.html - - - - launchbury93natural - - JohnLaunchbury - - A Natural Semantics for Lazy Evaluation - 144-154 -
- Charleston - South Carolina -
- 1993 - http://citeseer.ist.psu.edu/launchbury93natural.html - - - - - ghcprim - - The GHC Team - - Library documentation: GHC.Prim - 2008 - http://www.haskell.org/ghc/docs/latest/html/libraries/base/GHC-Prim.html - - - - diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 593bf4b1ef..dc7644a5d6 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -2624,7 +2624,7 @@ - Generate .hcr external Core files + (deprecated) Generate .hcr external Core files dynamic - diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index acc796371a..dc381a4daa 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -11257,69 +11257,6 @@ program even if fusion doesn't happen. More rules in GHC/List.lhs - - CORE pragma - - CORE pragma - pragma, CORE - core, annotation - - - The external core format supports Note annotations; - the CORE pragma gives a way to specify what these - should be in your Haskell source code. Syntactically, core - annotations are attached to expressions and take a Haskell string - literal as an argument. The following function definition shows an - example: - - -f x = ({-# CORE "foo" #-} show) ({-# CORE "bar" #-} x) - - - Semantically, this is equivalent to: - - -g x = show x - - - - - However, when external core is generated (via - ), there will be Notes attached to the - expressions show and x. - The core function declaration for f is: - - - - f :: %forall a . GHCziShow.ZCTShow a -> - a -> GHCziBase.ZMZN GHCziBase.Char = - \ @ a (zddShow::GHCziShow.ZCTShow a) (eta::a) -> - (%note "foo" - %case zddShow %of (tpl::GHCziShow.ZCTShow a) - {GHCziShow.ZCDShow - (tpl1::GHCziBase.Int -> - a -> - GHCziBase.ZMZN GHCziBase.Char -> GHCziBase.ZMZN GHCziBase.Cha -r) - (tpl2::a -> GHCziBase.ZMZN GHCziBase.Char) - (tpl3::GHCziBase.ZMZN a -> - GHCziBase.ZMZN GHCziBase.Char -> GHCziBase.ZMZN GHCziBase.Cha -r) -> - tpl2}) - (%note "bar" - eta); - - - - Here, we can see that the function show (which - has been expanded out to a case expression over the Show dictionary) - has a %note attached to it, as does the - expression eta (which used to be called - x). - - - - diff --git a/docs/users_guide/ug-book.xml.in b/docs/users_guide/ug-book.xml.in index dc5d4f7c35..b87563ac3b 100644 --- a/docs/users_guide/ug-book.xml.in +++ b/docs/users_guide/ug-book.xml.in @@ -17,7 +17,6 @@ &lang-features; &ffi-chap; &extending-ghc; -&external-core; &wrong; &utils; &win32-dll; diff --git a/docs/users_guide/ug-ent.xml.in b/docs/users_guide/ug-ent.xml.in index ce87089f24..a4ed036c3a 100644 --- a/docs/users_guide/ug-ent.xml.in +++ b/docs/users_guide/ug-ent.xml.in @@ -12,7 +12,6 @@ - diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index 8d8211eb5a..1c3e20c041 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -2967,44 +2967,6 @@ data D = D !C &runtime; - - - Generating and compiling External Core Files - - intermediate code generation - - GHC can dump its optimized intermediate code (said to be in “Core” format) - to a file as a side-effect of compilation. Non-GHC back-end tools can read and process Core files; these files have the suffix - .hcr. The Core format is described in - An External Representation for the GHC Core Language, - and sample tools - for manipulating Core files (in Haskell) are available in the - extcore package on Hackage. Note that the format of .hcr - files is different from the Core output format that GHC generates - for debugging purposes (), though the two formats appear somewhat similar. - - The Core format natively supports notes which you can add to - your source code using the CORE pragma (see ). - - - - - - - - - - Generate .hcr files. - - - - - -Currently (as of version 6.8.2), GHC does not have the ability to read in External Core files as source. If you would like GHC to have this ability, please make your wishes known to the GHC Team. - - - &debug; &flags; diff --git a/ghc.mk b/ghc.mk index 666d0a9a49..76eab17471 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1131,7 +1131,6 @@ sdist-ghc-prep : $(call sdist_ghc_file,compiler,stage2,cmm,,CmmParse,y) $(call sdist_ghc_file,compiler,stage2,parser,,Lexer,x) $(call sdist_ghc_file,compiler,stage2,parser,,Parser,y.pp) - $(call sdist_ghc_file,compiler,stage2,parser,,ParserCore,y) $(call sdist_ghc_file,utils/hpc,dist-install,,,HpcParser,y) $(call sdist_ghc_file,utils/genprimopcode,dist,,,Lexer,x) $(call sdist_ghc_file,utils/genprimopcode,dist,,,Parser,y) diff --git a/mk/config.mk.in b/mk/config.mk.in index 7cc7aecf2c..afe48ab5e1 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -790,25 +790,6 @@ else HSCOLOUR_SRCS = YES endif -################################################################################ -# -# 31-bit-Int Core files -# -################################################################################ - -# -# It is possible to configure the compiler and prelude to support 31-bit -# integers, suitable for a back-end and RTS using a tag bit on a 32-bit -# architecture. Currently the only useful output from this option is external Core -# files. The following additions to your build.mk will produce the -# 31-bit core output. Note that this is *not* just a library "way"; the -# compiler must be built a special way too. - -# GhcCppOpts +=-DWORD_SIZE_IN_BITS=31 -# GhcLibHcOpts +=-fext-core -fno-code -DWORD_SIZE_IN_BITS=31 -# GhcLibCppOpts += -DWORD_SIZE_IN_BITS=31 -# SplitObjs=NO - ################################################################################ # # Library configure arguments diff --git a/testsuite/config/ghc b/testsuite/config/ghc index 947f558c08..f763e72ed3 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -21,8 +21,7 @@ config.compile_ways = ['normal', 'hpc'] config.run_ways = ['normal', 'hpc'] # ways that are not enabled by default, but can always be invoked explicitly -config.other_ways = ['extcore','optextcore', - 'prof', +config.other_ways = ['prof', 'prof_hc_hb','prof_hb', 'prof_hd','prof_hy','prof_hr', 'threaded1_ls', 'threaded2_hT', @@ -93,8 +92,6 @@ config.way_flags = lambda name : { 'profasm' : ['-O', '-prof', '-static', '-auto-all'], 'profthreaded' : ['-O', '-prof', '-static', '-auto-all', '-threaded'], 'ghci' : ['--interactive', '-v0', '-ignore-dot-ghci', '+RTS', '-I0.1', '-RTS'], - 'extcore' : ['-fext-core'], - 'optextcore' : ['-O', '-fext-core'], 'threaded1' : ['-threaded', '-debug'], 'threaded1_ls' : ['-threaded', '-debug'], 'threaded2' : ['-O', '-threaded', '-eventlog'], @@ -127,8 +124,6 @@ config.way_rts_flags = { 'profasm' : ['-hc', '-p'], # test heap profiling too 'profthreaded' : ['-p'], 'ghci' : [], - 'extcore' : [], - 'optextcore' : [], 'threaded1' : [], 'threaded1_ls' : ['-ls'], 'threaded2' : ['-N2 -ls'], diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 0657db83d3..3479b6a5ba 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -996,8 +996,6 @@ def compile_and_run__( name, way, top_mod, extra_mods, extra_hc_opts ): if way == 'ghci': # interpreted... return interpreter_run( name, way, extra_hc_opts, 0, top_mod ) - elif way == 'extcore' or way == 'optextcore' : - return extcore_run( name, way, extra_hc_opts, 0, top_mod ) else: # compiled... force = 0 if extra_mods: @@ -1384,99 +1382,6 @@ def split_file(in_fn, delimiter, out1_fn, out2_fn): line = infile.readline() out2.close() -# ----------------------------------------------------------------------------- -# Generate External Core for the given program, then compile the resulting Core -# and compare its output to the expected output - -def extcore_run( name, way, extra_hc_opts, compile_only, top_mod ): - - depsfilename = qualify(name, 'deps') - errname = add_suffix(name, 'comp.stderr') - qerrname = qualify(errname,'') - - hcname = qualify(name, 'hc') - oname = qualify(name, 'o') - - rm_no_fail( qerrname ) - rm_no_fail( qualify(name, '') ) - - if (top_mod == ''): - srcname = add_hs_lhs_suffix(name) - else: - srcname = top_mod - - qcorefilename = qualify(name, 'hcr') - corefilename = add_suffix(name, 'hcr') - rm_no_fail(qcorefilename) - - # Generate External Core - - if (top_mod == ''): - to_do = ' ' + srcname + ' ' - else: - to_do = ' --make ' + top_mod + ' ' - - flags = copy.copy(getTestOpts().compiler_always_flags) - if getTestOpts().outputdir != None: - flags.extend(["-outputdir", getTestOpts().outputdir]) - cmd = 'cd ' + getTestOpts().testdir + " && '" \ - + config.compiler + "' " \ - + join(flags,' ') + ' ' \ - + join(config.way_flags(name)[way],' ') + ' ' \ - + extra_hc_opts + ' ' \ - + getTestOpts().extra_hc_opts \ - + to_do \ - + '>' + errname + ' 2>&1' - result = runCmdFor(name, cmd) - - exit_code = result >> 8 - - if exit_code != 0: - if_verbose(1,'Compiling to External Core failed (status ' + `result` + ') errors were:') - if_verbose_dump(1,qerrname) - return failBecause('ext core exit code non-0') - - # Compile the resulting files -- if there's more than one module, we need to read the output - # of the previous compilation in order to find the dependencies - if (top_mod == ''): - to_compile = corefilename - else: - result = runCmdFor(name, 'grep Compiling ' + qerrname + ' | awk \'{print $4}\' > ' + depsfilename) - deps = open(depsfilename).read() - deplist = string.replace(deps, '\n',' '); - deplist2 = string.replace(deplist,'.lhs,', '.hcr'); - to_compile = string.replace(deplist2,'.hs,', '.hcr'); - - flags = join(filter(lambda f: f != '-fext-core',config.way_flags(name)[way]),' ') - if getTestOpts().outputdir != None: - flags.extend(["-outputdir", getTestOpts().outputdir]) - - cmd = 'cd ' + getTestOpts().testdir + " && '" \ - + config.compiler + "' " \ - + join(getTestOpts().compiler_always_flags,' ') + ' ' \ - + to_compile + ' ' \ - + extra_hc_opts + ' ' \ - + getTestOpts().extra_hc_opts + ' ' \ - + flags \ - + ' -fglasgow-exts -o ' + name \ - + '>' + errname + ' 2>&1' - - result = runCmdFor(name, cmd) - exit_code = result >> 8 - - if exit_code != 0: - if_verbose(1,'Compiling External Core file(s) failed (status ' + `result` + ') errors were:') - if_verbose_dump(1,qerrname) - return failBecause('ext core exit code non-0') - - # Clean up - rm_no_fail ( oname ) - rm_no_fail ( hcname ) - rm_no_fail ( qcorefilename ) - rm_no_fail ( depsfilename ) - - return simple_run ( name, way, './'+name, getTestOpts().extra_run_opts ) - # ----------------------------------------------------------------------------- # Utils diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 9077af2e0c..1efe2a63b7 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -48,9 +48,7 @@ test('cgrun047', normal, compile_and_run, ['']) test('cgrun048', normal, compile_and_run, ['']) test('cgrun049', normal, compile_and_run, ['-funbox-strict-fields']) test('cgrun050', normal, compile_and_run, ['']) -# Doesn't work with External Core due to datatype declaration with no constructors -test('cgrun051', [expect_fail_for(['extcore','optextcore']), exit_code(1)], - compile_and_run, ['']) +test('cgrun051', normal, compile_and_run, ['']) test('cgrun052', only_ways(['optasm']), compile_and_run, ['-funbox-strict-fields']) test('cgrun053', normal, compile_and_run, ['']) test('cgrun054', normal, compile_and_run, ['']) diff --git a/testsuite/tests/ext-core/Makefile b/testsuite/tests/ext-core/Makefile deleted file mode 100644 index d52dd9c428..0000000000 --- a/testsuite/tests/ext-core/Makefile +++ /dev/null @@ -1,29 +0,0 @@ -TOP=../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk - -# T5881 needs a script because it goes wrong only when -# the modules are compiled separately, not with --make -T5881: - $(RM) -f T5881.hi T5881.o T5881a.hi T5881a.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T5881a.hs - '$(TEST_HC)' $(TEST_HC_OPTS) -c T5881.hs - -# T6025 is like T5881; needs separate compile -T6025: - $(RM) -f T6025.hi T6025.o T6025a.hi T6025a.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T6025a.hs - '$(TEST_HC)' $(TEST_HC_OPTS) -c T6025.hs - -# T6054 is like T5881; needs separate compile -# The second compile fails, and should do so, hence leading "-" -T6054: - $(RM) -f T6054.hi T6054.o T6054a.hi T6054a.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T6054a.hs - -'$(TEST_HC)' $(TEST_HC_OPTS) -c T6054.hs - -T7022: - $(RM) -f T7022.hi T7022.o T7022a.hi T7022a.o T7022b.hi T7022b.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T7022a.hs - '$(TEST_HC)' $(TEST_HC_OPTS) -c T7022b.hs -v0 - -'$(TEST_HC)' $(TEST_HC_OPTS) -c -v0 T7022.hs diff --git a/testsuite/tests/ext-core/T7239.hs b/testsuite/tests/ext-core/T7239.hs deleted file mode 100644 index 4331b9e493..0000000000 --- a/testsuite/tests/ext-core/T7239.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Main where - -data T a = T a - -type C = T Int -type CL = [C] - -main = print 1 diff --git a/testsuite/tests/ext-core/all.T b/testsuite/tests/ext-core/all.T deleted file mode 100644 index a1fbb8b7e7..0000000000 --- a/testsuite/tests/ext-core/all.T +++ /dev/null @@ -1,3 +0,0 @@ -setTestOpts(only_compiler_types(['ghc'])) - -test('T7239', normal, compile, ['-fext-core']) diff --git a/testsuite/tests/ffi/should_compile/all.T b/testsuite/tests/ffi/should_compile/all.T index a192a7b0cc..81f6a0d51b 100644 --- a/testsuite/tests/ffi/should_compile/all.T +++ b/testsuite/tests/ffi/should_compile/all.T @@ -9,30 +9,21 @@ test('cc001', normal, compile, ['']) # Non-static C call # cc004 test also uses stdcall, so it only works on i386. if config.platform.startswith('i386-'): - ways = expect_fail_for(['extcore','optextcore']) + ways = expect_fail else: - ways = expect_fail + ways = normal test('cc004', ways, compile, ['']) -# foreign label -test('cc005', expect_fail_for(['extcore','optextcore']), compile, ['']) - -# Missing: -# test('cc006', normal, compile, ['']) - +test('cc005', normal, compile, ['']) test('cc007', normal, compile, ['']) -# foreign label -test('cc008', expect_fail_for(['extcore','optextcore']), compile, ['']) -# foreign label -test('cc009', expect_fail_for(['extcore','optextcore']), compile, ['']) -# Non-static C call -test('cc010', expect_fail_for(['extcore','optextcore']), compile, ['']) +test('cc008', normal, compile, ['']) +test('cc009', normal, compile, ['']) +test('cc010', normal , compile, ['']) test('cc011', normal, compile, ['']) test('cc012', normal, compile, ['']) test('cc013', normal, compile, ['']) test('cc014', normal, compile, ['']) test('ffi-deriv1', normal, compile, ['']) - test('T1357', normal, compile, ['']) test('T3624', normal, compile, ['']) test('T3742', normal, compile, ['']) diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T index 567c3e67ce..7efc6eb3d8 100644 --- a/testsuite/tests/ffi/should_run/all.T +++ b/testsuite/tests/ffi/should_run/all.T @@ -4,10 +4,7 @@ # extra run flags # expected process return value, if not zero -# Doesn't work with External Core due to __labels -test('fed001', [only_compiler_types(['ghc']), - expect_fail_for(['extcore','optextcore'])], - compile_and_run, ['']) +test('fed001', normal, compile_and_run, ['']) # Omit GHCi for these two, as they use foreign export test('ffi001', omit_ways(['ghci']), compile_and_run, ['']) @@ -37,9 +34,7 @@ test('ffi005', [ omit_ways(prof_ways), exit_code(3) ], compile_and_run, ['']) -# ffi[006-009] don't work with External Core due to non-static-C foreign calls - -test('ffi006', expect_fail_for(['extcore','optextcore']), compile_and_run, ['']) +test('ffi006', normal, compile_and_run, ['']) # Skip ffi00{7,8} for GHCi. These tests both try to exit or raise an # error from a foreign export, which shuts down the runtime. When @@ -48,15 +43,8 @@ test('ffi006', expect_fail_for(['extcore','optextcore']), compile_and_run, ['']) # Sometimes we end up with the wrong exit code, or get an extra # 'interrupted' message from the GHCi thread shutting down. -test('ffi007', - [omit_ways(['ghci']), expect_fail_for(['extcore','optextcore'])], - compile_and_run, ['']) - -test('ffi008', - [expect_fail_for(['extcore','optextcore']), - exit_code(1), - omit_ways(['ghci'])], - compile_and_run, ['']) +test('ffi007', omit_ways(['ghci']), compile_and_run, ['']) +test('ffi008', [exit_code(1), omit_ways(['ghci'])], compile_and_run, ['']) # On i386, we need -msse2 to get reliable floating point results maybe_skip = normal @@ -68,13 +56,11 @@ if config.platform.startswith('i386-'): else: maybe_skip = only_ways(['ghci']) -test('ffi009', [when(fast(), skip), expect_fail_for(['extcore','optextcore']), +test('ffi009', [when(fast(), skip), reqlib('random'), maybe_skip] ,compile_and_run, [opts]) -# Doesn't work with External Core due to __labels -test('ffi010', expect_fail_for(['extcore','optextcore']), compile_and_run, ['']) - +test('ffi010', normal, compile_and_run, ['']) test('ffi011', normal, compile_and_run, ['']) # The stdcall calling convention works on Windows, and sometimes on @@ -88,9 +74,7 @@ else: skip_if_not_windows = skip test('ffi012', skip_if_not_windows, compile_and_run, ['']) - -# Doesn't work with External Core due to __labels -test('ffi013', expect_fail_for(['extcore','optextcore']), compile_and_run, ['']) +test('ffi013', normal, compile_and_run, ['']) # threaded2 sometimes gives ffi014: Main_dDu: interrupted test('ffi014', diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index 735fa54fd5..511fe29a9a 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -35,9 +35,7 @@ test('tcrun017', normal, compile_and_run, ['']) test('tcrun018', normal, compile_and_run, ['']) test('tcrun019', normal, compile_and_run, ['']) test('tcrun020', normal, compile_and_run, ['']) -# Doesn't work with External Core due to datatype with no constructors -test('tcrun021', expect_fail_for(['extcore','optextcore']), - compile_and_run, ['-package containers']) +test('tcrun021', normal, compile_and_run, ['-package containers']) test('tcrun022', [omit_ways(['ghci']),only_compiler_types(['ghc'])], compile_and_run, ['-O']) test('tcrun023', normal, compile_and_run, ['-O']) @@ -46,8 +44,7 @@ test('tcrun025', extra_clean(['TcRun025_B.hi', 'TcRun025_B.o']), multimod_compile_and_run, ['tcrun025','']) test('tcrun026', normal, compile_and_run, ['']) test('tcrun027', normal, compile_and_run, ['']) -# Doesn't work with External Core due to datatype with no constructors -test('tcrun028', expect_fail_for(['extcore','optextcore']), compile_and_run, ['']) +test('tcrun028', normal, compile_and_run, ['']) test('tcrun029', normal, compile_and_run, ['']) test('tcrun030', normal, compile_and_run, ['']) test('tcrun031', only_compiler_types(['ghc']), compile_and_run, ['']) diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index aa64094add..7fe375a7d2 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -118,7 +118,7 @@ main = getArgs >>= \args -> do s <- getContents case parse s of Left err -> error ("parse error at " ++ (show err)) - Right p_o_specs@(Info _ entries) + Right p_o_specs@(Info _ _) -> seq (sanityTop p_o_specs) ( case head args of @@ -187,9 +187,6 @@ main = getArgs >>= \args -> "--make-haskell-source" -> putStr (gen_hs_source p_o_specs) - "--make-ext-core-source" - -> putStr (gen_ext_core_source entries) - "--make-latex-doc" -> putStr (gen_latex_doc p_o_specs) @@ -215,7 +212,6 @@ known_args "--primop-vector-tycons", "--make-haskell-wrappers", "--make-haskell-source", - "--make-ext-core-source", "--make-latex-doc" ] -- cgit v1.2.1