diff options
| author | Austin Seipp <austin@well-typed.com> | 2014-04-27 21:11:23 -0500 |
|---|---|---|
| committer | Austin Seipp <austin@well-typed.com> | 2014-05-03 11:18:04 -0500 |
| commit | 5bf22f06ef71f61094de7564dee770f136d5481a (patch) | |
| tree | 7121e4705dea853871b6d43dc587f78b68aeb99c | |
| parent | a05f8dd15b51db7e71ab783182548f1af6dd2ceb (diff) | |
| download | haskell-5bf22f06ef71f61094de7564dee770f136d5481a.tar.gz | |
Remove external core
Signed-off-by: Austin Seipp <austin@well-typed.com>
36 files changed, 51 insertions, 3733 deletions
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 @@ -1519,14 +1494,6 @@ bindIfaceBndrs (b:bs) thing_inside 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 = do { name <- newIfaceName (mkTyVarOccFS occ) 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(..) ) @@ -306,107 +302,6 @@ tcRnImports hsc_env import_decls %************************************************************************ %* * - 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 @@ -<?xml version="1.0" encoding="utf-8"?> - -<!-- -This document is a semi-automatic conversion of docs/ext-core/core.tex to DocBook using - -1. `htlatex` to convert LaTeX to HTML -2. `pandoc` to convert HTML to DocBook -3. extensive manual work by James H. Fisher (jameshfisher@gmail.com) ---> - -<!-- -TODO: - -* Replace "java" programlisting with "ghccore" -("ghccore" is not recognized by highlighters, -causing some generators to fail). - -* Complete bibliography entries with journal titles; -I am unsure of the proper DocBook elements. - -* Integrate this file with the rest of the Users' Guide. ---> - - -<chapter id="an-external-representation-for-the-ghc-core-language-for-ghc-6.10"> - <title>An External Representation for the GHC Core Language (For GHC 6.10)</title> - - <para>Andrew Tolmach, Tim Chevalier ({apt,tjc}@cs.pdx.edu) and The GHC Team</para> - - <para>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.<footnote> - <para>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.</para> - - <para>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 <code>-fext-core</code>. We expect that GHC 6.10 will be - consistent with this definition.</para> - </footnote> - 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.</para> - - <section id="introduction"> - <title>Introduction</title> - - <para>The Glasgow Haskell Compiler (GHC) uses an intermediate language, - called <quote>Core,</quote> 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<subscript>ω</subscript>).</para> - - <para>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 <quote>Core Lint</quote> 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 <citation>stg-machine</citation> and then into C - or native code.</para> - - <para>Two existing papers discuss the original rationale for the design - and use of Core <citation>ghc-inliner,comp-by-trans-scp</citation>, 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) - <citation>gadts</citation> Core was extended beyond its previous - F<subscript>ω</subscript>-style incarnation to support type - equality constraints and safe coercions, and is now based on a - system known as F<subscript>C</subscript> <citation>system-fc</citation>.</para> - - <para>Researchers interested in writing just <emphasis>part</emphasis> 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 <citation>ghc-api</citation> to do the same task more cleanly. Both ways require new - code to be written in Haskell.</para> - - <para>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.</para> - - <para>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: - - <orderedlist> - <listitem> - precisely specifying the external format of Core; - </listitem> - <listitem> - modifying GHC to generate external Core files - (post-simplification; as always, users can control the exact - transformations GHC does with command-line flags); - </listitem> - <listitem> - 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). - </listitem> - </orderedlist> - </para> - - <para>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.</para> - - <para>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.</para> - - <para>This document addresses the first requirement, a formal Core - definition, by proposing a formal grammar for an - <link linkend="external-grammar-of-core">external representation of Core</link>, - and an <link linkend="informal-semantics">informal semantics</link>.</para> - - <para>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.</para> - - <para>Formal static and dynamic semantics in the form of an executable - typechecker and interpreter are available separately in the GHC - source tree - <footnote><ulink url="http://git.haskell.org/ghc.git/tree">http://git.haskell.org/ghc.git</ulink></footnote> - under <code>utils/ext-core</code>.</para> - - </section> - <section id="external-grammar-of-core"> - <title>External Grammar of Core</title> - - <para>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:</para> - - <itemizedlist> - <listitem>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.</listitem> - - <listitem>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.</listitem> - - <listitem>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.<footnote> - 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. - </footnote></listitem> - - <listitem>The syntax of identifiers is heavily restricted (to just - alphanumerics and underscores); this again makes Core easier - to parse but harder to read.</listitem> - </itemizedlist> - - <para>We use the following notational conventions for syntax: - - <informaltable frame="none"> - <tgroup cols='2' align='left' colsep="0" rowsep="0"> - <tbody> - <row> - <entry>[ pat ]</entry> - <entry>optional</entry> - </row> - - <row> - <entry>{ pat }</entry> - <entry>zero or more repetitions</entry> - </row> - - <row> - <entry> - { pat }<superscript>+</superscript> - </entry> - <entry>one or more repetitions</entry> - </row> - - <row> - <entry> - pat<subscript>1</subscript> ∣ pat<subscript>2</subscript> - </entry> - <entry>choice</entry> - </row> - - <row> - <entry> - <code>fibonacci</code> - </entry> - <entry>terminal syntax in typewriter font</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </para> - - <informaltable frame="none" colsep="0" rowsep="0"> - <tgroup cols='5'> - <colspec colname="cat" align="left" colwidth="3*" /> - <colspec colname="lhs" align="right" colwidth="2*" /> - <colspec align="center" colwidth="*" /> - <colspec colname="rhs" align="left" colwidth="10*" /> - <colspec colname="name" align="right" colwidth="6*" /> - <tbody> - <row rowsep="1"> - <entry>Module</entry> - <entry>module</entry> - <entry>→</entry> - <entry> - <code>%module</code> mident { tdef ; }{ vdefg ; } - </entry> - <entry></entry> - </row> - - <row> - <entry morerows="1" valign="top">Type defn.</entry> - <entry morerows="1" valign="top">tdef</entry> - <entry>→</entry> - <entry> - <code>%data</code> qtycon { tbind } <code>= {</code> [ cdef {<code>;</code> cdef } ] <code>}</code> - </entry> - <entry>algebraic type</entry> - </row> - <row rowsep="1"> - <entry>∣</entry> - <entry> - <code>%newtype</code> qtycon qtycon { tbind } <code>=</code> ty - </entry> - <entry>newtype</entry> - </row> - - <row rowsep="1"> - <entry>Constr. defn.</entry> - <entry>cdef</entry> - <entry>→</entry> - <entry> - qdcon { <code>@</code> tbind }{ aty }<superscript>+</superscript> - </entry> - </row> - - <row> - <entry morerows="2" valign="top">Value defn.</entry> - <entry morerows="1" valign="top">vdefg</entry> - <entry>→</entry> - <entry><code>%rec {</code> vdef { <code>;</code> vdef } <code>}</code></entry> - <entry>recursive</entry> - </row> - - <row> - <entry>∣</entry> - <entry>vdef</entry> - <entry>non-recursive</entry> - </row> - - <row rowsep="1"> - <entry>vdef</entry> - <entry>→</entry> - <entry>qvar <code>::</code> ty <code>=</code> exp</entry> - <entry></entry> - </row> - - <row> - <entry morerows="3" valign="top">Atomic expr.</entry> - <entry morerows="3" valign="top">aexp</entry> - <entry>→</entry> - <entry>qvar</entry> - <entry>variable</entry> - </row> - - <row> - <entry>∣</entry> - <entry>qdcon</entry> - <entry>data constructor</entry> - </row> - - <row> - <entry>∣</entry> - <entry>lit</entry> - <entry>literal</entry> - </row> - - <row rowsep="1"> - <entry>∣</entry> - <entry><code>(</code> exp <code>)</code></entry> - <entry>nested expr.</entry> - </row> - - <row> - <entry morerows="9" valign="top">Expression</entry> - <entry morerows="9" valign="top">exp</entry> - <entry>→</entry> - <entry>aexp</entry> - <entry>atomic expresion</entry> - </row> - - <row> - <entry>∣</entry> - <entry>aexp { arg }<superscript>+</superscript></entry> - <entry>application</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>\</code> { binder }<superscript>+</superscript> &arw; exp</entry> - <entry>abstraction</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>%let</code> vdefg <code>%in</code> exp</entry> - <entry>local definition</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>%case (</code> aty <code>)</code> exp <code>%of</code> vbind <code>{</code> alt { <code>;</code> alt } <code>}</code></entry> - <entry>case expression</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>%cast</code> exp aty</entry> - <entry>type coercion</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>%note</code> " { char } " exp</entry> - <entry>expression note</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>%external ccall "</code> { char } <code>"</code> aty</entry> - <entry>external reference</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>%dynexternal ccall</code> aty</entry> - <entry>external reference (dynamic)</entry> - </row> - - <row rowsep="1"> - <entry>∣</entry> - <entry><code>%label "</code> { char } <code>"</code></entry> - <entry>external label</entry> - </row> - - <row> - <entry morerows="1" valign="top">Argument</entry> - <entry morerows="1" valign="top">arg</entry> - <entry>→</entry> - <entry><code>@</code> aty</entry> - <entry>type argument</entry> - </row> - - <row rowsep="1"> - <entry>∣</entry> - <entry>aexp</entry> - <entry>value argument</entry> - </row> - - <row> - <entry morerows="2" valign="top">Case alt.</entry> - <entry morerows="2" valign="top">alt</entry> - <entry>→</entry> - <entry>qdcon { <code>@</code> tbind }{ vbind } <code>&arw;</code> exp</entry> - <entry>constructor alternative</entry> - </row> - - <row> - <entry>∣</entry> - <entry>lit <code>&arw;</code> exp</entry> - <entry>literal alternative</entry> - </row> - - <row rowsep="1"> - <entry>∣</entry> - <entry><code>%_ &arw;</code> exp</entry> - <entry>default alternative</entry> - </row> - - <row> - <entry morerows="1" valign="top">Binder</entry> - <entry morerows="1" valign="top">binder</entry> - <entry>→</entry> - <entry><code>@</code> tbind</entry> - <entry>type binder</entry> - </row> - - <row rowsep="1"> - <entry>∣</entry> - <entry>vbind</entry> - <entry>value binder</entry> - </row> - - <row> - <entry morerows="1" valign="top">Type binder</entry> - <entry morerows="1" valign="top">tbind</entry> - <entry>→</entry> - <entry>tyvar</entry> - <entry>implicitly of kind *</entry> - </row> - - <row rowsep="1"> - <entry>∣</entry> - <entry><code>(</code> tyvar <code>::</code> kind <code>)</code></entry> - <entry>explicitly kinded</entry> - </row> - - <row rowsep="1"> - <entry>Value binder</entry> - <entry>vbind</entry> - <entry>→</entry> - <entry><code>(</code> var <code>::</code> ty <code>)</code></entry> - <entry></entry> - </row> - - <row> - <entry morerows="3" valign="top">Literal</entry> - <entry morerows="3" valign="top">lit</entry> - <entry>→</entry> - <entry><code>(</code> [<code>-</code>] { digit }<superscript>+</superscript> <code>::</code> ty <code>)</code></entry> - <entry>integer</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>(</code> [<code>-</code>] { digit }<superscript>+</superscript> <code>%</code> { digit }<superscript>+</superscript> <code>::</code> ty <code>)</code></entry> - <entry>rational</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>( '</code> char <code>' ::</code> ty <code>)</code></entry> - <entry>character</entry> - </row> - - <row rowsep="1"> - <entry>∣</entry> - <entry><code>( "</code> { char } <code>" ::</code> ty <code>)</code></entry> - <entry>string</entry> - </row> - - <row> - <entry morerows="2" valign="top">Character</entry> - <entry morerows="1" valign="top">char</entry> - <entry>→</entry> - <entry namest="rhs" nameend="name"><emphasis>any ASCII character in range 0x20-0x7E except 0x22,0x27,0x5c</emphasis></entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>\x</code> hex hex</entry> - <entry>ASCII code escape sequence</entry> - </row> - - <row rowsep="1"> - <entry>hex</entry> - <entry>→</entry> - <entry>0∣…∣9 ∣a ∣…∣f</entry> - <entry></entry> - </row> - - <row> - <entry morerows="2" valign="top">Atomic type</entry> - <entry morerows="2" valign="top">aty</entry> - <entry>→</entry> - <entry>tyvar</entry> - <entry>type variable</entry> - </row> - - <row> - <entry>∣</entry> - <entry>qtycon</entry> - <entry>type constructor</entry> - </row> - - <row rowsep="1"> - <entry>∣</entry> - <entry><code>(</code> ty <code>)</code></entry> - <entry>nested type</entry> - </row> - - <row> - <entry morerows="7" valign="top">Basic type</entry> - <entry morerows="7" valign="top">bty</entry> - <entry>→</entry> - <entry>aty</entry> - <entry>atomic type</entry> - </row> - - <row> - <entry>∣</entry> - <entry>bty aty</entry> - <entry>type application</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>%trans</code> aty aty</entry> - <entry>transitive coercion</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>%sym</code> aty</entry> - <entry>symmetric coercion</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>%unsafe</code> aty aty</entry> - <entry>unsafe coercion</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>%left</code> aty</entry> - <entry>left coercion</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>%right</code> aty</entry> - <entry>right coercion</entry> - </row> - - <row rowsep="1"> - <entry>∣</entry> - <entry><code>%inst</code> aty aty</entry> - <entry>instantiation coercion</entry> - </row> - - <row> - <entry morerows="2" valign="top">Type</entry> - <entry morerows="2" valign="top">ty</entry> - <entry>→</entry> - <entry>bty</entry> - <entry>basic type</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>%forall</code> { tbind }<superscript>+</superscript> <code>.</code> ty</entry> - <entry>type abstraction</entry> - </row> - - <row rowsep="1"> - <entry>∣</entry> - <entry>bty <code>&arw;</code> ty</entry> - <entry>arrow type construction</entry> - </row> - - <row> - <entry morerows="4" valign="top">Atomic kind</entry> - <entry morerows="4" valign="top">akind</entry> - <entry>→</entry> - <entry><code>*</code></entry> - <entry>lifted kind</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>#</code></entry> - <entry>unlifted kind</entry> - </row> - - <row> - <entry>∣</entry> - <entry><code>?</code></entry> - <entry>open kind</entry> - </row> - - <row> - <entry>∣</entry> - <entry>bty <code>:=:</code> bty</entry> - <entry>equality kind</entry> - </row> - - <row rowsep="1"> - <entry>∣</entry> - <entry><code>(</code> kind <code>)</code></entry> - <entry>nested kind</entry> - </row> - - <row> - <entry morerows="1" valign="top">Kind</entry> - <entry morerows="1" valign="top">kind</entry> - <entry>→</entry> - <entry>akind</entry> - <entry>atomic kind</entry> - </row> - - <row rowsep="1"> - <entry>∣</entry> - <entry>akind <code>&arw;</code> kind</entry> - <entry>arrow kind</entry> - </row> - - <row> - <entry morerows="7" valign="top">Identifier</entry> - <entry>mident</entry> - <entry>→</entry> - <entry>pname <code>:</code> uname</entry> - <entry>module</entry> - </row> - - <row> - <entry>tycon</entry> - <entry>→</entry> - <entry>uname</entry> - <entry>type constr.</entry> - </row> - - <row> - <entry>qtycon</entry> - <entry>→</entry> - <entry>mident <code>.</code> tycon</entry> - <entry>qualified type constr.</entry> - </row> - - <row> - <entry>tyvar</entry> - <entry>→</entry> - <entry>lname</entry> - <entry>type variable</entry> - </row> - - <row> - <entry>dcon</entry> - <entry>→</entry> - <entry>uname</entry> - <entry>data constr.</entry> - </row> - - <row> - <entry>qdcon</entry> - <entry>→</entry> - <entry>mident <code>.</code> dcon</entry> - <entry>qualified data constr.</entry> - </row> - - <row> - <entry>var</entry> - <entry>→</entry> - <entry>lname</entry> - <entry>variable</entry> - </row> - - <row rowsep="1"> - <entry>qvar</entry> - <entry>→</entry> - <entry>[ mident <code>.</code> ] var</entry> - <entry>optionally qualified variable</entry> - </row> - - <row> - <entry morerows="6" valign="top">Name</entry> - <entry>lname</entry> - <entry>→</entry> - <entry>lower { namechar }</entry> - <entry></entry> - </row> - - <row> - <entry>uname</entry> - <entry>→</entry> - <entry>upper { namechar }</entry> - <entry></entry> - </row> - - <row> - <entry>pname</entry> - <entry>→</entry> - <entry>{ namechar }<superscript>+</superscript></entry> - <entry></entry> - </row> - - <row> - <entry>namechar</entry> - <entry>→</entry> - <entry>lower ∣ upper ∣ digit</entry> - <entry></entry> - </row> - - <row> - <entry>lower</entry> - <entry>→</entry> - <entry><code>a</code> ∣ <code>b</code> ∣ … ∣ <code>z</code> ∣ <code>_</code></entry> - <entry></entry> - </row> - - <row> - <entry>upper</entry> - <entry>→</entry> - <entry><code>A</code> ∣ <code>B</code> ∣ … ∣ <code>Z</code></entry> - <entry></entry> - </row> - - <row> - <entry>digit</entry> - <entry>→</entry> - <entry><code>0</code> ∣ <code>1</code> ∣ … ∣ <code>9</code></entry> - <entry></entry> - </row> - </tbody> - </tgroup> - </informaltable> - </section> - - <section id="informal-semantics"> - <title>Informal Semantics</title> - - <para>At the term level, Core resembles a explicitly-typed polymorphic - lambda calculus (F<subscript>ω</subscript>), with the addition of - local <code>let</code> bindings, algebraic type definitions, constructors, and - <code>case</code> 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.<citation>system-fc</citation></para> - - <para>In this section we concentrate on the less obvious points about - Core.</para> - - <section id="program-organization-and-modules"> - <title>Program Organization and Modules</title> - - <para>Core programs are organized into <emphasis>modules</emphasis>, corresponding directly - to source-level Haskell modules. Each module has a identifying - name <emphasis>mident</emphasis>. A module identifier consists of a <emphasis>package name</emphasis> - followed by a module name, which may be hierarchical: for - example, <code>base:GHC.Base</code> is the module identifier for GHC’s Base - module. Its name is <code>Base</code>, and it lives in the GHC hierarchy - within the <code>base</code> package. Section 5.8 of the GHC users’ guide - explains package names <citation>ghc-user-guide</citation>. 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.<footnote> - 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. - </footnote></para> - - <para>Each module may contain the following kinds of top-level - declarations: - - <itemizedlist> - <listitem> - Algebraic data type declarations, each defining a type - constructor and one or more data constructors; - </listitem> - <listitem> - Newtype declarations, corresponding to Haskell <code>newtype</code> - declarations, each defining a type constructor and a - coercion name; and - </listitem> - <listitem> - Value declarations, defining the types and values of - top-level variables. - </listitem> - </itemizedlist> - </para> - - <para>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.</para> - - <para>Identifiers defined in top-level declarations may be <emphasis>external</emphasis> or - <emphasis>internal</emphasis>. External identifiers can be referenced from any other - module in the program, using conventional dot notation (e.g., - <code>base:GHC.Base.Bool</code>, <code>base:GHC.Base.True</code>). 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).</para> - - <para>A top-level value is external if it is defined and referenced - using a fully qualified name with a dot (e.g., <code>main:MyModule.foo = ...</code>); - otherwise, it is internal (e.g., <code>bar = ...</code>). Note that - Core’s notion of an external identifier does not necessarily - coincide with that of <quote>exported</quote> 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.<footnote> - Two examples of such identifiers are: data - constructors, and values that potentially appear in an unfolding. For an - example of the latter, consider <code>Main.foo = ... Main.bar ...</code>, where - <code>Main.foo</code> is inlineable. Since <code>bar</code> appears in <code>foo</code>’s unfolding, it is - defined and referenced with an external name, even if <code>bar</code> was not - exported by the original source module. - </footnote> - However, if an identifier was exported by the Haskell source - module, it will appear as an external name in Core.</para> - - <para>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.</para> - - <para>There is also an implicitly-defined module <code>ghc-prim:GHC.Prim</code>, - which exports the <quote>built-in</quote> types and values that must be - provided by any implementation of Core (including GHC). Details - of this module are in the <link linkend="primitive-module">Primitive Module section</link>.</para> - - <para>A Core <emphasis>program</emphasis> is a collection of distinctly-named modules that - includes a module called main:Main having an exported value - called <code>main:ZCMain.main</code> of type <code>base:GHC.IOBase.IO a</code> (for some - type <code>a</code>). (Note that the strangely named wrapper for <code>main</code> is the - one exception to the rule that qualified names defined within a - module <code>m</code> must have module name <code>m</code>.)</para> - - <para>Many Core programs will contain library modules, such as - <code>base:GHC.Base</code>, 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 <code>main:Main.main</code> implies that every program will - contain a large subset of the standard library modules.</para> - - </section> - <section id="namespaces"> - <title>Namespaces</title> - - <para>There are five distinct namespaces: - <orderedlist> - <listitem>module identifiers (<code>mident</code>),</listitem> - <listitem>type constructors (<code>tycon</code>),</listitem> - <listitem>type variables (<code>tyvar</code>),</listitem> - <listitem>data constructors (<code>dcon</code>),</listitem> - <listitem>term variables (<code>var</code>).</listitem> - </orderedlist> - </para> - - <para>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.</para> - - <para>Primitive types and operators are not syntactically - distinguished.</para> - - <para>Primitive <emphasis>coercion</emphasis> operators, of which there are six, <emphasis>are</emphasis> - 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.</para> - - <para>A given variable (type or term) may have multiple definitions - within a module. However, definitions of term variables never - <quote>shadow</quote> 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 <code>%external</code> expressions may - contain <code>tyvar</code> bindings that shadow outer bindings.</para> - - <para>Core generated by GHC makes heavy use of encoded names, in which - the characters <code>Z</code> and <code>z</code> are used to introduce escape sequences - for non-alphabetic characters such as dollar sign <code>$</code> (<code>zd</code>), hash <code>#</code> - (<code>zh</code>), plus <code>+</code> (<code>zp</code>), etc. This is the same encoding used in <code>.hi</code> - files and in the back-end of GHC itself, except that we - sometimes change an initial <code>z</code> to <code>Z</code>, or vice-versa, in order to - maintain case distinctions.</para> - - <para>Finally, note that hierarchical module names are z-encoded in - Core: for example, <code>base:GHC.Base.foo</code> is rendered as - <code>base:GHCziBase.foo</code>. A parser may reconstruct the module - hierarchy, or regard <code>GHCziBase</code> as a flat name.</para> - - </section> - <section id="types-and-kinds"> - <title>Types and Kinds</title> - - <para>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.</para> - - <section id="types"> - <title>Types</title> - - <para>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 (<code>&arw;</code>). (The prefix identifier for - this constructor is <code>ghc-prim:GHC.Prim.ZLzmzgZR</code>; this should - only appear in unapplied or partially applied form.)</para> - - <para>There are also a number of other primitive type constructors - (e.g., <code>Intzh</code>) that are predefined in the <code>GHC.Prim</code> module, but - have no special syntax. <code>%data</code> and <code>%newtype</code> declarations - introduce additional type constructors, as described below. - Type constructors are distinguished solely by name.</para> - - </section> - <section id="coercions"> - <title>Coercions</title> - - <para>A type may also be built using one of the primitive coercion - operators, as described in <link linkend="namespaces">the Namespaces section</link>. For details on the - meanings of these operators, see the System FC paper <citation>system-fc</citation>. Also - see <link linkend="newtypes">the Newtypes section</link> for - examples of how GHC uses coercions in Core code.</para> - - </section> - <section id="kinds"> - <title>Kinds</title> - <para>As described in the Haskell definition, it is necessary to - distinguish well-formed type-expressions by classifying them - into different <emphasis>kinds</emphasis> <citation>haskell98, p. 41</citation><!-- TODO -->. In particular, Core - explicitly records the kind of every bound type variable.</para> - - <para>In addition, Core’s kind system includes equality kinds, as in - System FC <citation>system-fc</citation>. An application of a built-in coercion, or of a - user-defined coercion as introduced by a <code>newtype</code> declaration, - has an equality kind.</para> - - </section> - <section id="lifted-and-unlifted-types"> - <title>Lifted and Unlifted Types</title> - - <para>Semantically, a type is <emphasis>lifted</emphasis> 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.</para> - - <para>Currently, all the primitive types are unlifted (including a - few boxed primitive types such as <code>ByteArrayzh</code>). Peyton-Jones - and Launchbury <citation>pj:unboxed</citation> described the ideas behind unboxed and - unlifted types.</para> - - </section> - <section id="type-constructors-base-kinds-and-higher-kinds"> - <title>Type Constructors; Base Kinds and Higher Kinds</title> - - <para>Every type constructor has a kind, depending on its arity and - whether it or its arguments are lifted.</para> - - <para>Term variables can only be assigned types that have base - kinds: the base kinds are <code>*</code>, <code>#</code>, and <code>?</code>. The three base kinds - distinguish the liftedness of the types they classify: <code>*</code> - represents lifted types; <code>#</code> represents unlifted types; and <code>?</code> is - the <quote>open</quote> kind, representing a type that may be either lifted - or unlifted. Of these, only <code>*</code> 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).</para> - - <para>In particular, no top-level identifier (except in - <code>ghc-prim:GHC.Prim</code>) has a type of kind <code>#</code> or <code>?</code>.</para> - - <para>Nullary type constructors have base kinds: for example, the - type <code>Int</code> has kind <code>*</code>, and <code>Int#</code> has kind <code>#</code>.</para> - - <para>Non-nullary type constructors have higher kinds: kinds that - have the form - k<subscript>1</subscript><code>&arw;</code>k<subscript>2</subscript>, where - k<subscript>1</subscript> and k<subscript>2</subscript> are - kinds. For example, the function type constructor <code>&arw;</code> has - kind <code>* &arw; (* &arw; *)</code>. Since Haskell allows abstracting - over type constructors, type variables may have higher kinds; - however, much more commonly they have kind <code>*</code>, so that is the - default if a type binder omits a kind.</para> - - </section> - - <section id="type-synonyms-and-type-equivalence"> - <title>Type Synonyms and Type Equivalence</title> - - <para>There is no mechanism for defining type synonyms - (corresponding to Haskell <code>type</code> declarations).</para> - - <para>Type equivalence is just syntactic equivalence on type - expressions (of base kinds) modulo:</para> - - <itemizedlist> - <listitem>alpha-renaming of variables bound in <code>%forall</code> types;</listitem> - <listitem>the identity a <code>&arw;</code> b ≡ <code>ghc-prim:GHC.Prim.ZLzmzgZR</code> a b</listitem> - </itemizedlist> - - </section> - </section> - <section id="algebraic-data-types"> - <title>Algebraic data types</title> - - <para>Each data declaration introduces a new type constructor and a - set of one or more data constructors, normally corresponding - directly to a source Haskell <code>data</code> declaration. For example, the - source declaration - - <programlisting language="haskell"> -data Bintree a = - Fork (Bintree a) (Bintree a) - | Leaf a - </programlisting> - - might induce the following Core declaration - - <programlisting language="java"> -%data Bintree a = { - Fork (Bintree a) (Bintree a); - Leaf a)} - </programlisting> - - which introduces the unary type constructor Bintree of kind - <code>*&arw;*</code> and two data constructors with types - - <programlisting language="java"> -Fork :: %forall a . Bintree a &arw; Bintree a &arw; Bintree a -Leaf :: %forall a . a &arw; Bintree a - </programlisting> - - We define the <emphasis>arity</emphasis> of each data constructor to be the number of - value arguments it takes; e.g. <code>Fork</code> has arity 2 and <code>Leaf</code> has - arity 1.</para> - - <para>For a less conventional example illustrating the possibility of - higher-order kinds, the Haskell source declaration - - <programlisting language="haskell"> -data A f a = MkA (f a) - </programlisting> - - might induce the Core declaration - - <programlisting language="java"> -%data A (f::*&arw;*) a = { MkA (f a) } - </programlisting> - - which introduces the constructor - - <programlisting language="java"> -MkA :: %forall (f::*&arw;*) a . (f a) &arw; (A f) a - </programlisting></para> - - <para>GHC (like some other Haskell implementations) supports an - extension to Haskell98 for existential types such as - - <programlisting language="haskell"> -data T = forall a . MkT a (a &arw; Bool) - </programlisting> - - This is represented by the Core declaration - - <programlisting language="java"> -%data T = {MkT @a a (a &arw; Bool)} - </programlisting> - - which introduces the nullary type constructor T and the data - constructor - - <programlisting language="java"> -MkT :: %forall a . a &arw; (a &arw; Bool) &arw; T - </programlisting> - - 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 <code>T</code> is - shown in <link linkend="expression-forms">the Expression Forms section</link>.</para> - - </section> - <section id="newtypes"> - <title>Newtypes</title> - - <para>Each Core <code>%newtype</code> declaration introduces a new type constructor - and an associated representation type, corresponding to a source - Haskell <code>newtype</code> declaration. However, unlike in source Haskell, - a <code>%newtype</code> declaration does not introduce any data constructors.</para> - - <para>Each <code>%newtype</code> 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 <code>%newtype</code>, to the representation type.</para> - - <para>For example, the Haskell fragment - - <programlisting language="haskell"> -newtype U = MkU Bool -u = MkU True -v = case u of - MkU b &arw; not b - </programlisting> - - might induce the Core fragment - - <programlisting language="java"> -%newtype U ZCCoU = Bool; -u :: U = %cast (True) - ((%sym ZCCoU)); -v :: Bool = not (%cast (u) ZCCoU); - </programlisting></para> - - <para>The <code>newtype</code> declaration implies that the types <code>U</code> and <code>Bool</code> have - equivalent representations, and the coercion axiom <code>ZCCoU</code> - provides evidence that <code>U</code> is equivalent to <code>Bool</code>. Notice that in - the body of <code>u</code>, the boolean value <code>True</code> is cast to type <code>U</code> using - the primitive symmetry rule applied to <code>ZCCoU</code>: that is, using a - coercion of kind <code>Bool :=: U</code>. And in the body of <code>v</code>, <code>u</code> is cast - back to type <code>Bool</code> using the axiom <code>ZCCoU</code>.</para> - - <para>Notice that the <code>case</code> in the Haskell source code above translates - to a <code>cast</code> in the corresponding Core code. That is because - operationally, a <code>case</code> on a value whose type is declared by a - <code>newtype</code> declaration is a no-op. Unlike a <code>case</code> on any other - value, such a <code>case</code> does no evaluation: its only function is to - coerce its scrutinee’s type.</para> - - <para>Also notice that unlike in a previous draft version of External - Core, there is no need to handle recursive newtypes specially.</para> - - </section> - - <section id="expression-forms"> - <title>Expression Forms</title> - - <para>Variables and data constructors are straightforward.</para> - - <para>Literal (<emphasis role="variable">lit</emphasis>) 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 <link linkend="primitive-module">the Primitive Module section</link>. - The character and string formats can describe only 8-bit ASCII characters.</para> - - <para>Moreover, because the operational semantics for Core interprets - strings as C-style null-terminated strings, strings should not - contain embedded nulls.</para> - - <para>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 <code>@ symbol</code>. (In - abstractions, the <code>@</code> plays essentially the same role as the more - usual Λ symbol.) For example, the Haskell source declaration - - <programlisting language="haskell"> -f x = Leaf (Leaf x) - </programlisting> - - might induce the Core declaration - - <programlisting language="java"> -f :: %forall a . a &arw; BinTree (BinTree a) = - \ @a (x::a) &arw; Leaf @(Bintree a) (Leaf @a x) - </programlisting></para> - - <para>Value applications may be of user-defined functions, data - constructors, or primitives. None of these sorts of applications - are necessarily saturated.</para> - - <para>Note that the arguments of type applications are not always of - kind <code>*</code>. For example, given our previous definition of type <code>A</code>: - - <programlisting language="haskell"> -data A f a = MkA (f a) - </programlisting> - - the source code - - <programlisting language="haskell"> -MkA (Leaf True) - </programlisting> - - becomes - - <programlisting language="java"> -(MkA @Bintree @Bool) (Leaf @Bool True) - </programlisting></para> - - <para>Local bindings, of a single variable or of a set of mutually - recursive variables, are represented by <code>%let</code> expressions in the - usual way.</para> - - <para>By far the most complicated expression form is <code>%case</code>. <code>%case</code> - expressions are permitted over values of any type, although they - will normally be algebraic or primitive types (with literal - values). Evaluating a <code>%case</code> forces the evaluation of the - expression being tested (the <quote>scrutinee</quote>). The value of the - scrutinee is bound to the variable following the <code>%of</code> 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 <code>%case</code> - expression: that is, the result type that all of the <code>%case</code> - alternatives have (this is intended to make type reconstruction - easier in the presence of type equality coercions).</para> - - <para>In an algebraic <code>%case</code>, 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.</para> - - <para>For example, the following Haskell source expression - - <programlisting language="haskell"> -case g x of - Fork l r &arw; Fork r l - t@(Leaf v) &arw; Fork t t - </programlisting> - - might induce the Core expression - - <programlisting language="java"> -%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 - </programlisting></para> - - <para>When performing a <code>%case</code> 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 - - <programlisting language="haskell"> -data T = forall a . MkT a (a &arw; Bool) - </programlisting> - - the source - - <programlisting language="haskell"> -case x of - MkT w g &arw; g w - </programlisting> - - becomes - - <programlisting language="java"> -%case x %of (x’::T) - MkT @b (w::b) (g::b&arw;Bool) &arw; g w - </programlisting></para> - - <para>In a <code>%case</code> over literal alternatives, all the case alternatives - must be distinct literals of the same primitive type.</para> - - <para>The list of alternatives may begin with a default alternative - labeled with an underscore (<code>%_</code>), 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.</para> - - <para><code>%cast</code> is used to manipulate newtypes, as described in - <link linkend="newtypes">the Newtype section</link>. The <code>%cast</code> expression - takes an expression and a coercion: syntactically, the coercion - is an arbitrary type, but it must have an equality kind. In an - expression <code>(cast e co)</code>, if <code>e :: T</code> and <code>co</code> has kind <code>T :=: U</code>, then - the overall expression has type <code>U</code> <citation>ghc-fc-commentary</citation>. Here, <code>co</code> must be a - coercion whose left-hand side is <code>T</code>.</para> - - <para>Note that unlike the <code>%coerce</code> expression that existed in previous - versions of Core, this means that <code>%cast</code> is (almost) type-safe: - the coercion argument provides evidence that can be verified by - a typechecker. There are still unsafe <code>%cast</code>s, corresponding to - the unsafe <code>%coerce</code> 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: - - <programlisting language="haskell"> -case (error "") of - True &arw; 1 - False &arw; 2 - </programlisting> - - becomes: - - <programlisting language="java"> -%cast (error @ Bool (ZMZN @ Char)) -(%unsafe Bool Integer); - </programlisting> - - <code>%cast</code> has no operational meaning and is only used in - typechecking.</para> - - <para>A <code>%note</code> 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 (<code>InlineMe</code>) and cost-center labels for profiling.</para> - - <para>A <code>%external</code> 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: <code>%external</code> and <code>%dynexternal</code>. Only the former is supported - by the current set of stand-alone Core tools. In addition, there - is a <code>%label</code> construct which GHC may generate but which the Core - tools do not support.</para> - - <para>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.</para> - - </section> - - <section id="expression-evaluation"> - <title>Expression Evaluation</title> - <para>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-<emphasis>need</emphasis> 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 <citation>launchbury93natural</citation>.</para> - - <para>This section describes the model informally; a more formal - semantics is separately available as an executable interpreter.</para> - - <para>To simplify the semantics, we consider only <quote>well-behaved</quote> Core - programs in which constructor and primitive applications are - fully saturated, and in which non-trivial expresssions of - unlifted kind (<code>#</code>) appear only as scrutinees in <code>%case</code> - expressions. Any program can easily be put into this form; a - separately available preprocessor illustrates how. In the - remainder of this section, we use <quote>Core</quote> to mean <quote>well-behaved</quote> - Core.</para> - - <para>Evaluating a Core expression means reducing it to <emphasis>weak-head normal form (WHNF)</emphasis>, - i.e., a primitive value, lambda abstraction, - or fully-applied data constructor. Evaluating a program means - evaluating the expression <code>main:ZCMain.main</code>.</para> - - <para>To make sure that expression evaluation is shared, we make use - of a <emphasis>heap</emphasis>, which contains <emphasis>heap entries</emphasis>. A heap entry can be: - - <itemizedlist> - <listitem> - A <emphasis>thunk</emphasis>, representing an unevaluated expression, also known - as a suspension. - </listitem> - <listitem> - A <emphasis>WHNF</emphasis>, 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. - </listitem> - </itemizedlist></para> - - <para><emphasis>Heap pointers</emphasis> 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.</para> - - <para>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: - - <itemizedlist> - <listitem> - 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 <code>let</code>-bound (local)). - </listitem> - <listitem> - 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. - </listitem> - <listitem> - 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. - </listitem> - </itemizedlist></para> - - <para>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 - <emphasis>forced</emphasis>: 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 - - <itemizedlist> - <listitem>evaluating the operator expression of an application;</listitem> - <listitem>evaluating the scrutinee of a <code>case</code> expression; or</listitem> - <listitem>evaluating an argument to a primitive or external function application</listitem> - </itemizedlist> - </para> - - <para>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.</para> - - <para>With the exception of functions, arrays, and mutable variables, - we intend that values of all primitive types should be held - <emphasis>unboxed</emphasis>: they should not be heap-allocated. This does not - violate call-by-need semantics: all primitive types are - <emphasis>unlifted</emphasis>, which means that values of those types must be - evaluated strictly. Unboxed tuple types are not heap-allocated - either.</para> - - <para>Certain primitives and <code>%external</code> 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.</para> - - <para>An implementation must specially support the <code>raisezh</code> and - <code>handlezh</code> primitives: for example, by using a handler stack. - Again, real-world threading guarantees that they will execute in - the correct order.</para> - - </section> - </section> - <section id="primitive-module"> - <title>Primitive Module</title> - - <para>The semantics of External Core rely on the contents and informal - semantics of the primitive module <code>ghc-prim:GHC.Prim</code>. 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 - <link linkend="non-concurrent-back-end">the Non-concurrent Back End section</link>).</para> - - <para>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.</para> - - <para>For a full listing of the names and types of the primitive - operators, see the GHC library documentation <citation>ghcprim</citation>.</para> - - <section id="non-concurrent-back-end"> - <title>Non-concurrent Back End</title> - - <para>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:</para> - - <itemizedlist> - <listitem> - <code>ThreadIdzh</code> can be represented by a singleton type, whose - (unique) value is returned by <code>myThreadIdzh</code>. - </listitem> - <listitem> - <code>forkzh</code> can just die with an <quote>unimplemented</quote> message. - </listitem> - <listitem> - <code>killThreadzh</code> and <code>yieldzh</code> can also just die <quote>unimplemented</quote> - since in a one-thread world, the only thread a thread can - kill is itself, and if a thread yields the program hangs. - </listitem> - <listitem> - <code>MVarzh a</code> can be represented by <code>MutVarzh (Maybe a)</code>; where a - concurrent implementation would block, the sequential - implementation can just die with a suitable message (since - no other thread exists to unblock it). - </listitem> - <listitem> - <code>waitReadzh</code> and <code>waitWritezh</code> can be implemented using a <code>select</code> - with no timeout. - </listitem> - </itemizedlist> - </section> - - <section id="literals"> - <title>Literals</title> - - <para>Only the following combination of literal forms and types are - permitted:</para> - - <informaltable frame="none" colsep="0" rowsep="0"> - <tgroup cols='3'> - <colspec colname="literal" align="left" colwidth="*" /> - <colspec colname="type" align="left" colwidth="*" /> - <colspec colname="description" align="left" colwidth="4*" /> - <thead> - <row> - <entry>Literal form</entry> - <entry>Type</entry> - <entry>Description</entry> - </row> - </thead> - <tbody> - <row> - <entry morerows="3" valign="top">integer</entry> - <entry><code>Intzh</code></entry> - <entry>Int</entry> - </row> - <row> - <entry><code>Wordzh</code></entry> - <entry>Word</entry> - </row> - <row> - <entry><code>Addrzh</code></entry> - <entry>Address</entry> - </row> - <row> - <entry><code>Charzh</code></entry> - <entry>Unicode character code</entry> - </row> - - <row> - <entry morerows="1" valign="top">rational</entry> - <entry><code>Floatzh</code></entry> - <entry>Float</entry> - </row> - <row> - <entry><code>Doublezh</code></entry> - <entry>Double</entry> - </row> - - <row> - <entry>character</entry> - <entry><code>Charzh</code></entry> - <entry>Unicode character specified by ASCII character</entry> - </row> - - <row> - <entry>string</entry> - <entry><code>Addrzh</code></entry> - <entry>Address of specified C-format string</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </section> - </section> - - - <bibliolist> - <!-- This bibliography was semi-automatically converted by JabRef from core.bib. --> - - <title>References</title> - - <biblioentry> - <abbrev>ghc-user-guide</abbrev> - <authorgroup> - <author><surname>The GHC Team</surname></author> - </authorgroup> - <citetitle pubwork="article">The Glorious Glasgow Haskell Compilation System User's Guide, Version 6.8.2</citetitle> - <pubdate>2008</pubdate> - <bibliomisc><ulink url="http://www.haskell.org/ghc/docs/latest/html/users_guide/index.html">http://www.haskell.org/ghc/docs/latest/html/users_guide/index.html</ulink></bibliomisc> - </biblioentry> - - <biblioentry> - <abbrev>ghc-fc-commentary</abbrev> - <authorgroup> - <author><surname>GHC Wiki</surname></author> - </authorgroup> - <citetitle pubwork="article">System FC: equality constraints and coercions</citetitle> - <pubdate>2006</pubdate> - <bibliomisc><ulink url="http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/FC">http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/FC</ulink></bibliomisc> - </biblioentry> - - <biblioentry> - <abbrev>ghc-api</abbrev> - <authorgroup> - <author><surname>Haskell Wiki</surname></author> - </authorgroup> - <citetitle pubwork="article">Using GHC as a library</citetitle> - <pubdate>2007</pubdate> - <bibliomisc><ulink url="http://haskell.org/haskellwiki/GHC/As_a_library">http://haskell.org/haskellwiki/GHC/As_a_library</ulink></bibliomisc> - </biblioentry> - - <biblioentry> - <abbrev>haskell98</abbrev> - <authorgroup> - <editor><firstname>Simon</firstname><surname>Peyton-Jones</surname></editor> - </authorgroup> - <citetitle pubwork="article">Haskell 98 Language and Libraries: The Revised Report</citetitle> - <publisher> - <publishername>Cambridge University Press</publishername> - <address> - <city>Cambridge></city> - <state>UK</state> - </address> - </publisher> - <pubdate>2003</pubdate> - </biblioentry> - - <biblioentry> - <abbrev>system-fc</abbrev> - <authorgroup> - <author><firstname>Martin</firstname><surname>Sulzmann</surname></author> - <author><firstname>Manuel M.T.</firstname><surname>Chakravarty</surname></author> - <author><firstname>Simon</firstname><surname>Peyton-Jones</surname></author> - <author><firstname>Kevin</firstname><surname>Donnelly</surname></author> - </authorgroup> - <citetitle pubwork="article">System F with type equality coercions</citetitle> - <publisher> - <publishername>ACM</publishername> - <address> - <city>New York</city> - <state>NY</state> - <country>USA</country> - </address> - </publisher> - <artpagenums>53-66</artpagenums> - <pubdate>2007</pubdate> - <bibliomisc><ulink url="http://portal.acm.org/citation.cfm?id=1190324">http://portal.acm.org/citation.cfm?id=1190324</ulink></bibliomisc> - <!-- booktitle = {{TLDI '07: Proceedings of the 2007 ACM SIGPLAN International Workshop on Types in Language Design and Implementation}}, --> - </biblioentry> - - <biblioentry> - <abbrev>gadts</abbrev> - <authorgroup> - <author><firstname>Simon</firstname><surname>Peyton-Jones</surname></author> - <author><firstname>Dimitrios</firstname><surname>Vytiniotis</surname></author> - <author><firstname>Stephanie</firstname><surname>Weirich</surname></author> - <author><firstname>Geoffrey</firstname><surname>Washburn</surname></author> - </authorgroup> - <citetitle pubwork="article">Simple unification-based type inference for GADTs</citetitle> - <publisher> - <publishername>ACM</publishername> - <address> - <city>New York</city> - <state>NY</state> - <country>USA</country> - </address> - </publisher> - <artpagenums>50-61</artpagenums> - <pubdate>2006</pubdate> - <bibliomisc><ulink url="http://research.microsoft.com/Users/simonpj/papers/gadt/index.htm">http://research.microsoft.com/Users/simonpj/papers/gadt/index.htm</ulink></bibliomisc> - </biblioentry> - - <biblioentry> - <abbrev>Launchbury94</abbrev> - <authorgroup> - <author><firstname>John</firstname><surname>Launchbury</surname></author> - <author><firstname>Simon L.</firstname><surname>Peyton-Jones</surname></author> - </authorgroup> - <citetitle pubwork="article">Lazy Functional State Threads</citetitle> - <artpagenums>24-35</artpagenums> - <pubdate>1994</pubdate> - <bibliomisc><ulink url="http://citeseer.ist.psu.edu/article/launchbury93lazy.html">http://citeseer.ist.psu.edu/article/launchbury93lazy.html</ulink></bibliomisc> - <!-- booktitle = "{SIGPLAN} {Conference} on {Programming Language Design and Implementation}", --> - </biblioentry> - - <biblioentry> - <abbrev>pj:unboxed</abbrev> - <authorgroup> - <author><firstname>Simon L.</firstname><surname>Peyton-Jones</surname></author> - <author><firstname>John</firstname><surname>Launchbury</surname></author> - <editor><firstname>J.</firstname><surname>Hughes</surname></editor> - </authorgroup> - <citetitle pubwork="article">Unboxed Values as First Class Citizens in a Non-strict Functional Language</citetitle> - <publisher> - <publishername>Springer-Verlag LNCS523</publishername> - <address> - <city>Cambridge</city> - <state>Massachussetts</state> - <country>USA</country> - </address> - </publisher> - <artpagenums>636-666</artpagenums> - <pubdate>1991, August 26-28</pubdate> - <bibliomisc><ulink url="http://citeseer.ist.psu.edu/jones91unboxed.html">http://citeseer.ist.psu.edu/jones91unboxed.html</ulink></bibliomisc> - <!-- booktitle = "Proceedings of the Conference on Functional Programming and Computer Architecture", --> - </biblioentry> - - <biblioentry> - <abbrev>ghc-inliner</abbrev> - <authorgroup> - <author><firstname>Simon</firstname><surname>Peyton-Jones</surname></author> - <author><firstname>Simon</firstname><surname>Marlow</surname></author> - </authorgroup> - <citetitle pubwork="article">Secrets of the Glasgow Haskell Compiler inliner</citetitle> - <pubdate>1999</pubdate> - <address> - <city>Paris</city> - <country>France</country> - </address> - <bibliomisc><ulink url="http://research.microsoft.com/Users/simonpj/Papers/inlining/inline.pdf">http://research.microsoft.com/Users/simonpj/Papers/inlining/inline.pdf</ulink></bibliomisc> - <!-- booktitle = "Workshop on Implementing Declarative Languages", --> - </biblioentry> - - <biblioentry> - <abbrev>comp-by-trans-scp</abbrev> - <authorgroup> - <author><firstname>Simon L.</firstname><surname>Peyton-Jones</surname></author> - <author><firstname>A. L. M.</firstname><surname>Santos</surname></author> - </authorgroup> - <citetitle pubwork="article">A transformation-based optimiser for Haskell</citetitle> - <citetitle pubwork="journal">Science of Computer Programming</citetitle> - <volumenum>32</volumenum> - <issuenum>1-3</issuenum> - <artpagenums>3-47</artpagenums> - <pubdate>1998</pubdate> - <bibliomisc><ulink url="http://citeseer.ist.psu.edu/peytonjones98transformationbased.html">http://citeseer.ist.psu.edu/peytonjones98transformationbased.html</ulink></bibliomisc> - </biblioentry> - - <biblioentry> - <abbrev>stg-machine</abbrev> - <authorgroup> - <author><firstname>Simon L.</firstname><surname>Peyton-Jones</surname></author> - </authorgroup> - <citetitle pubwork="article">Implementing Lazy Functional Languages on Stock Hardware: The Spineless Tagless G-Machine</citetitle> - <citetitle pubwork="journal">Journal of Functional Programming</citetitle> - <volumenum>2</volumenum> - <issuenum>2</issuenum> - <artpagenums>127-202</artpagenums> - <pubdate>1992</pubdate> - <bibliomisc><ulink url="http://citeseer.ist.psu.edu/peytonjones92implementing.html">http://citeseer.ist.psu.edu/peytonjones92implementing.html</ulink></bibliomisc> - </biblioentry> - - <biblioentry> - <abbrev>launchbury93natural</abbrev> - <authorgroup> - <author><firstname>John</firstname><surname>Launchbury</surname></author> - </authorgroup> - <citetitle pubwork="article">A Natural Semantics for Lazy Evaluation</citetitle> - <artpagenums>144-154</artpagenums> - <address> - <city>Charleston</city> - <state>South Carolina</state> - </address> - <pubdate>1993</pubdate> - <bibliomisc><ulink url="http://citeseer.ist.psu.edu/launchbury93natural.html">http://citeseer.ist.psu.edu/launchbury93natural.html</ulink></bibliomisc> - <!-- booktitle = "Conference Record of the Twentieth Annual {ACM} {SIGPLAN}-{SIGACT} Symposium on Principles of Programming Languages", --> - </biblioentry> - - <biblioentry> - <abbrev>ghcprim</abbrev> - <authorgroup> - <author><surname>The GHC Team</surname></author> - </authorgroup> - <citetitle pubwork="article">Library documentation: GHC.Prim</citetitle> - <pubdate>2008</pubdate> - <bibliomisc><ulink url="http://www.haskell.org/ghc/docs/latest/html/libraries/base/GHC-Prim.html">http://www.haskell.org/ghc/docs/latest/html/libraries/base/GHC-Prim.html</ulink></bibliomisc> - </biblioentry> - </bibliolist> - -</chapter> 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 @@ <tbody> <row> <entry><option>-fext-core</option></entry> - <entry>Generate <filename>.hcr</filename> external Core files</entry> + <entry><emphasis>(deprecated)</emphasis> Generate <filename>.hcr</filename> external Core files</entry> <entry>dynamic</entry> <entry>-</entry> </row> 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 <filename>GHC/List.lhs</fi </sect2> -<sect2 id="core-pragma"> - <title>CORE pragma</title> - - <indexterm><primary>CORE pragma</primary></indexterm> - <indexterm><primary>pragma, CORE</primary></indexterm> - <indexterm><primary>core, annotation</primary></indexterm> - -<para> - The external core format supports <quote>Note</quote> annotations; - the <literal>CORE</literal> 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: - -<programlisting> -f x = ({-# CORE "foo" #-} show) ({-# CORE "bar" #-} x) -</programlisting> - - Semantically, this is equivalent to: - -<programlisting> -g x = show x -</programlisting> -</para> - -<para> - However, when external core is generated (via - <option>-fext-core</option>), there will be Notes attached to the - expressions <function>show</function> and <varname>x</varname>. - The core function declaration for <function>f</function> is: -</para> - -<programlisting> - 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); -</programlisting> - -<para> - Here, we can see that the function <function>show</function> (which - has been expanded out to a case expression over the Show dictionary) - has a <literal>%note</literal> attached to it, as does the - expression <varname>eta</varname> (which used to be called - <varname>x</varname>). -</para> - -</sect2> - </sect1> <sect1 id="special-ids"> 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 e95d590ca3..6753ff7e5b 100644 --- a/docs/users_guide/ug-ent.xml.in +++ b/docs/users_guide/ug-ent.xml.in @@ -12,7 +12,6 @@ <!ENTITY sooner SYSTEM "sooner.xml" > <!ENTITY lang-features SYSTEM "lang.xml" > <!ENTITY glasgowexts SYSTEM "glasgow_exts.xml" > -<!ENTITY external-core SYSTEM "external_core.xml" > <!ENTITY packages SYSTEM "packages.xml" > <!ENTITY parallel SYSTEM "parallel.xml" > <!ENTITY safehaskell SYSTEM "safe_haskell.xml" > diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index 9d145f6369..d762ff6a3c 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -2984,44 +2984,6 @@ data D = D !C </sect1> &runtime; - -<sect1 id="ext-core"> - <title>Generating and compiling External Core Files</title> - - <indexterm><primary>intermediate code generation</primary></indexterm> - - <para>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 - <filename>.hcr</filename>. The Core format is described in <ulink url="../../core.pdf"> - <citetitle>An External Representation for the GHC Core Language</citetitle></ulink>, - and sample tools - for manipulating Core files (in Haskell) are available in the - <ulink url="http://hackage.haskell.org/package/extcore">extcore package on Hackage</ulink>. Note that the format of <literal>.hcr</literal> - files is <emphasis>different</emphasis> from the Core output format that GHC generates - for debugging purposes (<xref linkend="options-debugging"/>), though the two formats appear somewhat similar.</para> - - <para>The Core format natively supports notes which you can add to - your source code using the <literal>CORE</literal> pragma (see <xref - linkend="pragmas"/>).</para> - - <variablelist> - - <varlistentry> - <term> - <option>-fext-core</option> - <indexterm><primary><option>-fext-core</option></primary></indexterm> - </term> - <listitem> - <para>Generate <literal>.hcr</literal> files.</para> - </listitem> - </varlistentry> - - </variablelist> - -<para>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 <ulink url="http://ghc.haskell.org/trac/ghc/wiki/MailingListsAndIRC">make your wishes known to the GHC Team</ulink>.</para> - -</sect1> - &debug; &flags; @@ -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 @@ -792,25 +792,6 @@ 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: @@ -1385,99 +1383,6 @@ def split_file(in_fn, delimiter, out1_fn, out2_fn): 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 def check_stdout_ok( name ): 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 099f814a1f..de37d13713 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" ] |