summaryrefslogtreecommitdiff
path: root/compiler/GHC/Hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Hs')
-rw-r--r--compiler/GHC/Hs/Binds.hs10
-rw-r--r--compiler/GHC/Hs/Decls.hs10
-rw-r--r--compiler/GHC/Hs/Doc.hs10
-rw-r--r--compiler/GHC/Hs/Dump.hs8
-rw-r--r--compiler/GHC/Hs/Expr.hs8
-rw-r--r--compiler/GHC/Hs/Expr.hs-boot2
-rw-r--r--compiler/GHC/Hs/Extension.hs4
-rw-r--r--compiler/GHC/Hs/ImpExp.hs6
-rw-r--r--compiler/GHC/Hs/Instances.hs2
-rw-r--r--compiler/GHC/Hs/Lit.hs6
-rw-r--r--compiler/GHC/Hs/Pat.hs8
-rw-r--r--compiler/GHC/Hs/Pat.hs-boot2
-rw-r--r--compiler/GHC/Hs/Stats.hs187
-rw-r--r--compiler/GHC/Hs/Types.hs10
-rw-r--r--compiler/GHC/Hs/Utils.hs10
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