diff options
Diffstat (limited to 'compiler/GHC/Hs')
-rw-r--r-- | compiler/GHC/Hs/Binds.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/Hs/Decls.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/Hs/Doc.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/Hs/Dump.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Hs/Expr.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Hs/Expr.hs-boot | 2 | ||||
-rw-r--r-- | compiler/GHC/Hs/Extension.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Hs/ImpExp.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Hs/Instances.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Hs/Lit.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Hs/Pat.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Hs/Pat.hs-boot | 2 | ||||
-rw-r--r-- | compiler/GHC/Hs/Stats.hs | 187 | ||||
-rw-r--r-- | compiler/GHC/Hs/Types.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/Hs/Utils.hs | 10 |
15 files changed, 235 insertions, 48 deletions
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs index 5068f082ce..0252656203 100644 --- a/compiler/GHC/Hs/Binds.hs +++ b/compiler/GHC/Hs/Binds.hs @@ -23,7 +23,7 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@. module GHC.Hs.Binds where -import GhcPrelude +import GHC.Prelude import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, LHsExpr, MatchGroup, pprFunBind, @@ -37,12 +37,12 @@ import GHC.Tc.Types.Evidence import GHC.Core.Type import GHC.Types.Name.Set import GHC.Types.Basic -import Outputable +import GHC.Utils.Outputable import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Var -import Bag -import FastString -import BooleanFormula (LBooleanFormula) +import GHC.Data.Bag +import GHC.Data.FastString +import GHC.Data.BooleanFormula (LBooleanFormula) import Data.Data hiding ( Fixity ) import Data.List hiding ( foldr ) diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index 0be89127a5..f0ffd06307 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -94,7 +94,7 @@ module GHC.Hs.Decls ( ) where -- friends: -import GhcPrelude +import GHC.Prelude import {-# SOURCE #-} GHC.Hs.Expr( HsExpr, HsSplice, pprExpr, pprSpliceDecl ) @@ -112,13 +112,13 @@ import GHC.Types.Name.Set -- others: import GHC.Core.Class -import Outputable -import Util +import GHC.Utils.Outputable +import GHC.Utils.Misc import GHC.Types.SrcLoc import GHC.Core.Type -import Bag -import Maybes +import GHC.Data.Bag +import GHC.Data.Maybe import Data.Data hiding (TyCon,Fixity, Infix) {- diff --git a/compiler/GHC/Hs/Doc.hs b/compiler/GHC/Hs/Doc.hs index 7da56b1524..9a5035b46e 100644 --- a/compiler/GHC/Hs/Doc.hs +++ b/compiler/GHC/Hs/Doc.hs @@ -23,13 +23,13 @@ module GHC.Hs.Doc #include "HsVersions.h" -import GhcPrelude +import GHC.Prelude -import Binary -import Encoding -import FastFunctions +import GHC.Utils.Binary +import GHC.Utils.Encoding +import GHC.Utils.IO.Unsafe import GHC.Types.Name -import Outputable +import GHC.Utils.Outputable as Outputable import GHC.Types.SrcLoc import Data.ByteString (ByteString) diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs index 2fe8711570..ee9df10c5d 100644 --- a/compiler/GHC/Hs/Dump.hs +++ b/compiler/GHC/Hs/Dump.hs @@ -15,12 +15,12 @@ module GHC.Hs.Dump ( BlankSrcSpan(..), ) where -import GhcPrelude +import GHC.Prelude import Data.Data hiding (Fixity) -import Bag +import GHC.Data.Bag import GHC.Types.Basic -import FastString +import GHC.Data.FastString import GHC.Types.Name.Set import GHC.Types.Name import GHC.Core.DataCon @@ -28,7 +28,7 @@ import GHC.Types.SrcLoc import GHC.Hs import GHC.Types.Var import GHC.Types.Module -import Outputable +import GHC.Utils.Outputable import qualified Data.ByteString as B diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs index 290a9716e2..a03c0aa50d 100644 --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -26,7 +26,7 @@ module GHC.Hs.Expr where #include "HsVersions.h" -- friends: -import GhcPrelude +import GHC.Prelude import GHC.Hs.Decls import GHC.Hs.Pat @@ -43,9 +43,9 @@ import GHC.Types.Name.Set import GHC.Types.Basic import GHC.Core.ConLike import GHC.Types.SrcLoc -import Util -import Outputable -import FastString +import GHC.Utils.Misc +import GHC.Utils.Outputable +import GHC.Data.FastString import GHC.Core.Type import GHC.Builtin.Types (mkTupleStr) import GHC.Tc.Utils.TcType (TcType) diff --git a/compiler/GHC/Hs/Expr.hs-boot b/compiler/GHC/Hs/Expr.hs-boot index 87a4a2b38e..ccfe2cb65d 100644 --- a/compiler/GHC/Hs/Expr.hs-boot +++ b/compiler/GHC/Hs/Expr.hs-boot @@ -11,7 +11,7 @@ module GHC.Hs.Expr where import GHC.Types.SrcLoc ( Located ) -import Outputable ( SDoc, Outputable ) +import GHC.Utils.Outputable ( SDoc, Outputable ) import {-# SOURCE #-} GHC.Hs.Pat ( LPat ) import GHC.Types.Basic ( SpliceExplicitFlag(..)) import GHC.Hs.Extension ( OutputableBndrId, GhcPass ) diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs index b24bdf19b8..57cd67e65a 100644 --- a/compiler/GHC/Hs/Extension.hs +++ b/compiler/GHC/Hs/Extension.hs @@ -25,13 +25,13 @@ module GHC.Hs.Extension where -- This module captures the type families to precisely identify the extension -- points for GHC.Hs syntax -import GhcPrelude +import GHC.Prelude import Data.Data hiding ( Fixity ) import GHC.Types.Name import GHC.Types.Name.Reader import GHC.Types.Var -import Outputable +import GHC.Utils.Outputable import GHC.Types.SrcLoc (Located) import Data.Kind diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs index d4ed3e64a0..813d0ef9bf 100644 --- a/compiler/GHC/Hs/ImpExp.hs +++ b/compiler/GHC/Hs/ImpExp.hs @@ -16,7 +16,7 @@ GHC.Hs.ImpExp: Abstract syntax: imports, exports, interfaces module GHC.Hs.ImpExp where -import GhcPrelude +import GHC.Prelude import GHC.Types.Module ( ModuleName ) import GHC.Hs.Doc ( HsDocString ) @@ -24,8 +24,8 @@ import GHC.Types.Name.Occurrence ( HasOccName(..), isTcOcc, isSymOcc ) import GHC.Types.Basic ( SourceText(..), StringLiteral(..), pprWithSourceText ) import GHC.Types.FieldLabel ( FieldLbl(..) ) -import Outputable -import FastString +import GHC.Utils.Outputable +import GHC.Data.FastString import GHC.Types.SrcLoc import GHC.Hs.Extension diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs index db7a46805c..6eca193bb8 100644 --- a/compiler/GHC/Hs/Instances.hs +++ b/compiler/GHC/Hs/Instances.hs @@ -16,7 +16,7 @@ module GHC.Hs.Instances where import Data.Data hiding ( Fixity ) -import GhcPrelude +import GHC.Prelude import GHC.Hs.Extension import GHC.Hs.Binds import GHC.Hs.Decls diff --git a/compiler/GHC/Hs/Lit.hs b/compiler/GHC/Hs/Lit.hs index 964df0d356..75e5c1d315 100644 --- a/compiler/GHC/Hs/Lit.hs +++ b/compiler/GHC/Hs/Lit.hs @@ -19,7 +19,7 @@ module GHC.Hs.Lit where #include "HsVersions.h" -import GhcPrelude +import GHC.Prelude import {-# SOURCE #-} GHC.Hs.Expr( HsExpr, pprExpr ) import GHC.Types.Basic @@ -27,8 +27,8 @@ import GHC.Types.Basic , negateFractionalLit, SourceText(..), pprWithSourceText , PprPrec(..), topPrec ) import GHC.Core.Type -import Outputable -import FastString +import GHC.Utils.Outputable +import GHC.Data.FastString import GHC.Hs.Extension import Data.ByteString (ByteString) diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs index c92967db81..4f73aa3e98 100644 --- a/compiler/GHC/Hs/Pat.hs +++ b/compiler/GHC/Hs/Pat.hs @@ -50,7 +50,7 @@ module GHC.Hs.Pat ( pprParendLPat, pprConArgs ) where -import GhcPrelude +import GHC.Prelude import {-# SOURCE #-} GHC.Hs.Expr (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprSplice) @@ -69,11 +69,11 @@ import GHC.Types.Name.Reader ( RdrName ) import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.TyCon -import Outputable +import GHC.Utils.Outputable import GHC.Core.Type import GHC.Types.SrcLoc -import Bag -- collect ev vars from pats -import Maybes +import GHC.Data.Bag -- collect ev vars from pats +import GHC.Data.Maybe import GHC.Types.Name (Name) -- libraries: import Data.Data hiding (TyCon,Fixity) diff --git a/compiler/GHC/Hs/Pat.hs-boot b/compiler/GHC/Hs/Pat.hs-boot index c7ff0a892e..1a783e3c7e 100644 --- a/compiler/GHC/Hs/Pat.hs-boot +++ b/compiler/GHC/Hs/Pat.hs-boot @@ -9,7 +9,7 @@ module GHC.Hs.Pat where -import Outputable +import GHC.Utils.Outputable import GHC.Hs.Extension ( OutputableBndrId, GhcPass, XRec ) import Data.Kind diff --git a/compiler/GHC/Hs/Stats.hs b/compiler/GHC/Hs/Stats.hs new file mode 100644 index 0000000000..5b76372f37 --- /dev/null +++ b/compiler/GHC/Hs/Stats.hs @@ -0,0 +1,187 @@ +-- | +-- Statistics for per-module compilations +-- +-- (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 +-- + +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} + +module GHC.Hs.Stats ( ppSourceStats ) where + +import GHC.Prelude + +import GHC.Data.Bag +import GHC.Hs +import GHC.Utils.Outputable +import GHC.Types.SrcLoc +import GHC.Utils.Misc + +import Data.Char + +-- | Source Statistics +ppSourceStats :: Bool -> Located HsModule -> SDoc +ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _)) + = (if short then hcat else vcat) + (map pp_val + [("ExportAll ", export_all), -- 1 if no export list + ("ExportDecls ", export_ds), + ("ExportModules ", export_ms), + ("Imports ", imp_no), + (" ImpSafe ", imp_safe), + (" ImpQual ", imp_qual), + (" ImpAs ", imp_as), + (" ImpAll ", imp_all), + (" ImpPartial ", imp_partial), + (" ImpHiding ", imp_hiding), + ("FixityDecls ", fixity_sigs), + ("DefaultDecls ", default_ds), + ("TypeDecls ", type_ds), + ("DataDecls ", data_ds), + ("NewTypeDecls ", newt_ds), + ("TypeFamilyDecls ", type_fam_ds), + ("DataConstrs ", data_constrs), + ("DataDerivings ", data_derivs), + ("ClassDecls ", class_ds), + ("ClassMethods ", class_method_ds), + ("DefaultMethods ", default_method_ds), + ("InstDecls ", inst_ds), + ("InstMethods ", inst_method_ds), + ("InstType ", inst_type_ds), + ("InstData ", inst_data_ds), + ("TypeSigs ", bind_tys), + ("ClassOpSigs ", generic_sigs), + ("ValBinds ", val_bind_ds), + ("FunBinds ", fn_bind_ds), + ("PatSynBinds ", patsyn_ds), + ("InlineMeths ", method_inlines), + ("InlineBinds ", bind_inlines), + ("SpecialisedMeths ", method_specs), + ("SpecialisedBinds ", bind_specs) + ]) + where + decls = map unLoc ldecls + + pp_val (_, 0) = empty + pp_val (str, n) + | not short = hcat [text str, int n] + | otherwise = hcat [text (trim str), equals, int n, semi] + + trim ls = takeWhile (not.isSpace) (dropWhile isSpace ls) + + (fixity_sigs, bind_tys, bind_specs, bind_inlines, generic_sigs) + = count_sigs [d | SigD _ d <- decls] + -- NB: this omits fixity decls on local bindings and + -- in class decls. ToDo + + tycl_decls = [d | TyClD _ d <- decls] + (class_ds, type_ds, data_ds, newt_ds, type_fam_ds) = + countTyClDecls tycl_decls + + inst_decls = [d | InstD _ d <- decls] + inst_ds = length inst_decls + default_ds = count (\ x -> case x of { DefD{} -> True; _ -> False}) decls + val_decls = [d | ValD _ d <- decls] + + real_exports = case exports of { Nothing -> []; Just (L _ es) -> es } + n_exports = length real_exports + export_ms = count (\ e -> case unLoc e of { IEModuleContents{} -> True + ; _ -> False}) + real_exports + export_ds = n_exports - export_ms + export_all = case exports of { Nothing -> 1; _ -> 0 } + + (val_bind_ds, fn_bind_ds, patsyn_ds) + = sum3 (map count_bind val_decls) + + (imp_no, imp_safe, imp_qual, imp_as, imp_all, imp_partial, imp_hiding) + = sum7 (map import_info imports) + (data_constrs, data_derivs) + = sum2 (map data_info tycl_decls) + (class_method_ds, default_method_ds) + = sum2 (map class_info tycl_decls) + (inst_method_ds, method_specs, method_inlines, inst_type_ds, inst_data_ds) + = sum5 (map inst_info inst_decls) + + count_bind (PatBind { pat_lhs = L _ (VarPat{}) }) = (1,0,0) + count_bind (PatBind {}) = (0,1,0) + count_bind (FunBind {}) = (0,1,0) + count_bind (PatSynBind {}) = (0,0,1) + count_bind b = pprPanic "count_bind: Unhandled binder" (ppr b) + + count_sigs sigs = sum5 (map sig_info sigs) + + sig_info (FixSig {}) = (1,0,0,0,0) + sig_info (TypeSig {}) = (0,1,0,0,0) + sig_info (SpecSig {}) = (0,0,1,0,0) + sig_info (InlineSig {}) = (0,0,0,1,0) + sig_info (ClassOpSig {}) = (0,0,0,0,1) + sig_info _ = (0,0,0,0,0) + + import_info :: LImportDecl GhcPs -> (Int, Int, Int, Int, Int, Int, Int) + import_info (L _ (ImportDecl { ideclSafe = safe, ideclQualified = qual + , ideclAs = as, ideclHiding = spec })) + = add7 (1, safe_info safe, qual_info qual, as_info as, 0,0,0) (spec_info spec) + + safe_info False = 0 + safe_info True = 1 + qual_info NotQualified = 0 + qual_info _ = 1 + as_info Nothing = 0 + as_info (Just _) = 1 + spec_info Nothing = (0,0,0,0,1,0,0) + spec_info (Just (False, _)) = (0,0,0,0,0,1,0) + spec_info (Just (True, _)) = (0,0,0,0,0,0,1) + + data_info (DataDecl { tcdDataDefn = HsDataDefn + { dd_cons = cs + , dd_derivs = L _ derivs}}) + = ( length cs + , foldl' (\s dc -> length (deriv_clause_tys $ unLoc dc) + s) + 0 derivs ) + data_info _ = (0,0) + + class_info decl@(ClassDecl {}) + = (classops, addpr (sum3 (map count_bind methods))) + where + methods = map unLoc $ bagToList (tcdMeths decl) + (_, classops, _, _, _) = count_sigs (map unLoc (tcdSigs decl)) + class_info _ = (0,0) + + inst_info :: InstDecl GhcPs -> (Int, Int, Int, Int, Int) + inst_info (TyFamInstD {}) = (0,0,0,1,0) + inst_info (DataFamInstD {}) = (0,0,0,0,1) + inst_info (ClsInstD { cid_inst = ClsInstDecl {cid_binds = inst_meths + , cid_sigs = inst_sigs + , cid_tyfam_insts = ats + , cid_datafam_insts = adts } }) + = case count_sigs (map unLoc inst_sigs) of + (_,_,ss,is,_) -> + (addpr (sum3 (map count_bind methods)), + ss, is, length ats, length adts) + where + methods = map unLoc $ bagToList inst_meths + + -- TODO: use Sum monoid + addpr :: (Int,Int,Int) -> Int + sum2 :: [(Int, Int)] -> (Int, Int) + sum3 :: [(Int, Int, Int)] -> (Int, Int, Int) + sum5 :: [(Int, Int, Int, Int, Int)] -> (Int, Int, Int, Int, Int) + sum7 :: [(Int, Int, Int, Int, Int, Int, Int)] -> (Int, Int, Int, Int, Int, Int, Int) + add7 :: (Int, Int, Int, Int, Int, Int, Int) -> (Int, Int, Int, Int, Int, Int, Int) + -> (Int, Int, Int, Int, Int, Int, Int) + + addpr (x,y,z) = x+y+z + sum2 = foldr add2 (0,0) + where + add2 (x1,x2) (y1,y2) = (x1+y1,x2+y2) + sum3 = foldr add3 (0,0,0) + where + add3 (x1,x2,x3) (y1,y2,y3) = (x1+y1,x2+y2,x3+y3) + sum5 = foldr add5 (0,0,0,0,0) + where + add5 (x1,x2,x3,x4,x5) (y1,y2,y3,y4,y5) = (x1+y1,x2+y2,x3+y3,x4+y4,x5+y5) + sum7 = foldr add7 (0,0,0,0,0,0,0) + + add7 (x1,x2,x3,x4,x5,x6,x7) (y1,y2,y3,y4,y5,y6,y7) = (x1+y1,x2+y2,x3+y3,x4+y4,x5+y5,x6+y6,x7+y7) diff --git a/compiler/GHC/Hs/Types.hs b/compiler/GHC/Hs/Types.hs index 38a0300a8f..fd782c6348 100644 --- a/compiler/GHC/Hs/Types.hs +++ b/compiler/GHC/Hs/Types.hs @@ -72,7 +72,7 @@ module GHC.Hs.Types ( #include "HsVersions.h" -import GhcPrelude +import GHC.Prelude import {-# SOURCE #-} GHC.Hs.Expr ( HsSplice, pprSplice ) @@ -88,10 +88,10 @@ import GHC.Core.Type import GHC.Hs.Doc import GHC.Types.Basic import GHC.Types.SrcLoc -import Outputable -import FastString -import Maybes( isJust ) -import Util ( count ) +import GHC.Utils.Outputable +import GHC.Data.FastString +import GHC.Data.Maybe( isJust ) +import GHC.Utils.Misc ( count ) import Data.Data hiding ( Fixity, Prefix, Infix ) diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index 75ef5b06bf..6e89b6844a 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -104,7 +104,7 @@ module GHC.Hs.Utils( #include "HsVersions.h" -import GhcPrelude +import GHC.Prelude import GHC.Hs.Decls import GHC.Hs.Binds @@ -130,10 +130,10 @@ import GHC.Types.Name.Set hiding ( unitFV ) import GHC.Types.Name.Env import GHC.Types.Basic import GHC.Types.SrcLoc -import FastString -import Util -import Bag -import Outputable +import GHC.Data.FastString +import GHC.Utils.Misc +import GHC.Data.Bag +import GHC.Utils.Outputable import GHC.Settings.Constants import Data.Either |