...
 
Commits (113)
......@@ -31,6 +31,7 @@ Thumbs.db
*.dyn_o
*.dyn_hi
__pycache__
.mypy_cache
*.SYMDEF*
log
......@@ -50,6 +51,9 @@ stage0
stage1
stage2
_build
*/generated/
*/ghc-stage1
.shake.*
.hadrian_ghci
# -----------------------------------------------------------------------------
......@@ -220,5 +224,12 @@ GIT_COMMIT_ID
# ghc.nix
ghc.nix/
# gdb
.gdb_history
.gdbinit
# Tooling - direnv
.envrc
# Tooling - vscode
.vscode
......@@ -127,7 +127,7 @@ lint-submods-marge:
refs:
- merge_requests
variables:
- $CI_MERGE_REQUEST_LABELS =~ /.*wip/marge_bot_batch_merge_job.*/
- "$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/"
lint-submods-mr:
extends: .lint-submods
......@@ -139,7 +139,7 @@ lint-submods-mr:
- merge_requests
except:
variables:
- $CI_MERGE_REQUEST_LABELS =~ /.*wip/marge_bot_batch_merge_job.*/
- "$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/"
lint-submods-branch:
extends: .lint-submods
......@@ -300,7 +300,8 @@ validate-x86_64-darwin:
tags:
- x86_64-darwin
variables:
GHC_VERSION: 8.6.3
GHC_VERSION: 8.6.5
CABAL_INSTALL_VERSION: 2.4.1.0
BIN_DIST_PREP_TAR_COMP: "bindistprep/ghc-x86_64-apple-darwin.tar.xz"
MACOSX_DEPLOYMENT_TARGET: "10.7"
# Only Sierra and onwards supports clock_gettime. See #12858
......@@ -323,7 +324,7 @@ validate-x86_64-darwin:
when: always
expire_in: 2 week
cache:
key: darwin
key: "darwin-$GHC_VERSION"
paths:
- cabal-cache
- toolchain
......@@ -691,6 +692,7 @@ validate-x86_64-linux-fedora27:
variables:
FORCE_SYMLINKS: 1
LANG: "en_US.UTF-8"
SPHINXBUILD: "/mingw64/bin/sphinx-build.exe"
cache:
paths:
- cabal-cache
......@@ -779,6 +781,19 @@ validate-x86_64-windows:
cache:
key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION"
nightly-x86_64-windows:
extends: .build-windows-make
stage: full-build
variables:
BUILD_FLAVOUR: "validate"
MSYSTEM: MINGW64
CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32"
only:
variables:
- $NIGHTLY
cache:
key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION"
# Normal Windows validate builds are profiled; that won't do for releases.
release-x86_64-windows:
extends: validate-x86_64-windows
......
......@@ -23,7 +23,7 @@ if [ ! -e $toolchain/bin/ghc ]; then
fi
if [ ! -e $toolchain/bin/cabal ]; then
cabal_tarball="https://downloads.haskell.org/~cabal/cabal-install-latest/cabal-install-2.4.1.0-x86_64-apple-darwin-sierra.tar.xz"
cabal_tarball="https://downloads.haskell.org/~cabal/cabal-install-$CABAL_INSTALL_VERSION/cabal-install-$CABAL_INSTALL_VERSION-x86_64-apple-darwin-sierra.tar.xz"
echo "Fetching cabal-install from $cabal_tarball"
curl $cabal_tarball | tar -xz
mv cabal $toolchain/bin
......
{
"languageServerHaskell.enableHIE": true,
"languageServerHaskell.diagnosticsOnChange": false,
"languageServerHaskell.hieExecutablePath": "/home/david/Documents/code/haskell-ide-engine/dist-newstyle/build/x86_64-linux/ghc-8.6.1/haskell-ide-engine-1.0.0.0/x/hie/build/hie/hie"
}
\ No newline at end of file
NOTES
* all changes in branch GL-16885_failing, last 3 commits are questionable. Try to see if b23415f7e55c1f1e6e9f951b09b7af4b3641cb03 is valid.
* currently building. Next run tests?
Refactor:
Collect "is bootable" info at: ?? ModSummary construction ??
Use "is bootable" info at interface check: ?? where ??
!!! we have ModSummary in HscMain.finish !!! just extract bootable and pass to hscSimpleIface hscNormalIface.
* [ ] CURRENT TASK:
* [ ] Error on non-cycle breaking SOURCE import
* [ ] Add test cases
* summariseRequirement hsModuleToModSummary are set to error as a placeholder, but the tests still pass! make sure you cover this case.
* Check for recompiling with adding/removing boot files (changing bootableness of modules in the TCMD).
* [ ] non-cycle SOURCE import is an error.
* [ ] Test .hi is loaded when .hi and .hi-boot both are in the TCMD
* [ ] Test .hi is loaded when .hi but not .hi-boot is in the TCMD
* [ ] Test .hi-boot is loaded when .hi-boot but not .hi is in the TCMD
* [ ] Recompilation:
* [ ] adding/removing a .hs-boot causes recompilation of .hs
* [ ] Just do a test and grep print out the boot deps
* [ ] Go through TODOs and finish implementation (e.g. summariseRequirement hsModuleToModSummary)
* [ ] Remove all of the old TCMD record fields that should not be used any more.
* [ ] Fix all `TODO #16885`
* [ ] Update wiki page on recompilation checking to include check for mi_deps_boot
* [X] Test case bootdeps is failing: B.hi-boot is marked as not bootable!
* looking at colls to hscSimpleIface|hscNormalIface to see origin of bootable value.
* OK! It always is just copied from ModSuUmmary's ms_bootable
* Narrowed down to makeNewModSummary (I think)
* Bingo! removing `isBootableFromSrcPath` and replacing with checkIsBootable fixed the issue and means more code reuse!
* bootdeps is passing now :-)
* [X] Update ModIface Fingerprints to incorporate mi_bootable
* I think incorporating it into mi_iface_hash is enough
* set in MkIface.addFingerprints (see iface_hash)
* [X] pass it to computeFingerprint
* [X] Update recompilation checker to check for change in mi_bootable
* So I have a comment "TODO #16885 checkDependencies [read] this checks if...", that suggests removing the check for a change in mi_deps (TCMD). But this was under the assumption that we'd just store direct dependencies and not the boot_deps. So now, I think we need to replace the check for change in TCMD, to a check for change in boot_deps. If boot deps changes, then the interface will change, so we must recompile. But also BOOTABLE must be checked for change.
* [X] Better document function in MkIface.
* [X] we pass around a ModSummary. Is that the new or old ModSummary? answer: new!
* passed from `hscIncrementalCompile`
* we pass around a ModIface. that is the old iface loaded from a .hi file.
* [X] Add check for boot_deps change: this may be similar to the check for TCMD.
* Looking at `checkDependencies`, I'm trying to understand how the hell !931 fixed the issue. It seems very strange. `checkForNewHomeDependency` does not consider source imports from the ModSummary! I think we just need to keep this simple and calculate the boot_deps from ModSummary and compare it to the old iface's boot_deps
* We have to recalculate the boot_deps, but we do this already somewhere. Can we reuse code? We do it to assign dep_mods_boot taken from imp_dep_mods_boot:
* combined in `plusImportAvails`
* created in `RnName.calculateAvails`
* [X] Remove check for TCMD change: we don't store TCMD in the interface file any more.
* [X] Add check for bootable change: bootable is stored in the interface so any change means a change in the interface (requires recompilation).
* [X] 9 tests are failing
* base01:
* "[Module "GHC.Base" no longer has a boot file.]"
* but I think this is a new build (no existing iface), unless the test runner runs multiple times without cleaning up? But even if that's the case, there is no boot file nor source import any way!
* WRONG!!!!!! this must mean that the ModuleSummary some how (incorrectly) has bootable=True.
* Is this a default value or someting?
* The ModuleSummary is the NEW info, ModIface is the old info.
* old bootable = True
* new bootable = False
* Hence somehow we get bootable = True in the interface... I'll check this by printint the .hi contents:
* OK by pure luck I removed some duplicate code and moved it to MkIface.checkIsBootable, but one of the original versions was wrong (forgot to add a boot suffix to the file location). Now the tests Pass!
* [X] check usages of emptyModIface eventually lead to a valid `bootable` field
* [X] LoadIface: Fake iface to fill cache and avoid "looking again" Value should not be used
* [X] ghcPrimIface: wired in module is not bootable (default for emptyModIface).
* [X] makeNewModSummary: set ms_bootable correctly. Check usages:
* This seems to mostly be updating time stamps. This is probably an important part of recompilation checking called from:
* makeNewModSummary <- summariseModule <- downsweep <- ...
* Does downsweep get the ("old ModSummaries" according to makeNewModSummary) ModSummaries from interface files ondisk? Somehow else?
* Old summaries is actually a paramater to downsweep
* ... <- downsweep <- depanalPartial <- depanal
* gets the "old" modules at the start of depanal `hsc_env <- getSession; hsc_mod_graph hsc_env`. So I guess we can load multiple times in interactive mode. So actually this may also mean a module's boot file was deleted/created, so we must also update isBootable.
* I thout we already found "the one place" where we should check for the existance of the boot file, but now there are more. How is that possible?
* Is it a oneshot mode vs make mode thing? summarizeFile|Module are bothin GhcMake, and runPhase does say it is the "old style build" or something. Fine! lets go ahead and implement in multiple places.
* What's the difference between summarizeFile and summarizeModule?
* Depending on the targets to be built (see `HscEnv { hsc_targets}` and `data TargetId`), we may have a Module name or a file name. hence in `downsweep`, if a target is a file path, then summarizeFile is used (here and only here). summarizeModule is used in all other places.
* summariseFile:
* Tries to load old ModSummary based on file path.
* calls local `new_summary`
* gets the preprocessed imports from the file
* [X] summariseFile
* [X] summariseModule
* [X] Adding Dependencies{ dep_mods_boot }
* [X]Update all constructions of Dependencies
* [X] Adding ImportAvails{ imp_dep_mods_boot }
* [X]Update all constructions of ImportAvails
* [X] plusImportAvails
* [X] emptyImportAvails
* [X] calculateAvails
* [X] Add ModIface{mi_bootable}
* [X] Update all constructions of ModIface
* [1/5] search for "mi_deps .*="
* (2/5) add bootable argument to mkIface_
* [X] usages of "mkIface_" w c
* I think the right time to check if is bootable is close to where we currently search for the source file. We just go ahead and search for the boot file too.
* [ / ] add ModSummary{bootable} and populate
* [/ error TODO] summariseRequirement
* [/ error TODO] hsModuleToModSummary
* [X] runPhase
* [X] Use bootable from ModSummary in HscMain.finish
* Take bootable arg in:
* [X] hscSimpleIface
* [X] hscSimpleIface
?_hsc_src :: HscSource appears in:
* MakeNewModSummary
* ModSummary
* ModGuts
* TcGblEnv
ModSummary has `ms_hsc_src :: HscSource` and things like `ModLocation` and `ms_hs_date :: UTCTime` which is related to file system operations. This seems close to the source of where is_boot should go
ModLocation { .. ml_hs_file :: Maybe FilePath .. } is the file path to the source file (if a source file exists. Does that mean ?exactly? when the module is a home package module?)
Maybe I can add ModSummary{bootable} and then use that to get it into TcGblEnv and ModGuts
\ No newline at end of file
......@@ -315,11 +315,11 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
AC_LINK_IFELSE(
[AC_LANG_PROGRAM([], [__asm__ (".subsections_via_symbols");])],
[AC_MSG_RESULT(yes)
HaskellHaveSubsectionsViaSymbols=True
TargetHasSubsectionsViaSymbols=YES
AC_DEFINE([HAVE_SUBSECTIONS_VIA_SYMBOLS],[1],
[Define to 1 if Apple-style dead-stripping is supported.])
],
[HaskellHaveSubsectionsViaSymbols=False
[TargetHasSubsectionsViaSymbols=NO
AC_MSG_RESULT(no)])
dnl ** check for .ident assembler directive
......@@ -329,9 +329,9 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
AC_LINK_IFELSE(
[AC_LANG_PROGRAM([__asm__ (".ident \"GHC x.y.z\"");], [])],
[AC_MSG_RESULT(yes)
HaskellHaveIdentDirective=True],
TargetHasIdentDirective=YES],
[AC_MSG_RESULT(no)
HaskellHaveIdentDirective=False])
TargetHasIdentDirective=NO])
dnl *** check for GNU non-executable stack note support (ELF only)
dnl (.section .note.GNU-stack,"",@progbits)
......@@ -361,9 +361,9 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
__asm__ (".section .text");
], [0])],
[AC_MSG_RESULT(yes)
HaskellHaveGnuNonexecStack=True],
TargetHasGnuNonexecStack=YES],
[AC_MSG_RESULT(no)
HaskellHaveGnuNonexecStack=False])
TargetHasGnuNonexecStack=NO])
CFLAGS="$CFLAGS2"
checkArch "$BuildArch" "HaskellBuildArch"
......@@ -380,9 +380,9 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
AC_SUBST(HaskellTargetArch)
AC_SUBST(HaskellTargetOs)
AC_SUBST(HaskellHaveSubsectionsViaSymbols)
AC_SUBST(HaskellHaveIdentDirective)
AC_SUBST(HaskellHaveGnuNonexecStack)
AC_SUBST(TargetHasSubsectionsViaSymbols)
AC_SUBST(TargetHasIdentDirective)
AC_SUBST(TargetHasGnuNonexecStack)
])
......@@ -2112,7 +2112,8 @@ AC_DEFUN([XCODE_VERSION],[
# FIND_LLVM_PROG()
# --------------------------------
# Find where the llvm tools are. We have a special function to handle when they
# are installed with a version suffix (e.g., llc-3.1).
# are installed with a version suffix (e.g., llc-7, llc-7.0) and without (e.g.
# llc).
#
# $1 = the variable to set
# $2 = the command to look for
......@@ -2120,7 +2121,7 @@ AC_DEFUN([XCODE_VERSION],[
#
AC_DEFUN([FIND_LLVM_PROG],[
# Test for program with and without version name.
AC_CHECK_TOOLS([$1], [$2-$3 $2], [:])
AC_CHECK_TOOLS([$1], [$2-$3 $2-$3.0 $2], [:])
if test "$$1" != ":"; then
AC_MSG_CHECKING([$$1 is version $3])
if test `$$1 --version | grep -c "version $3"` -gt 0 ; then
......
#!/usr/bin/env nix-shell
#! nix-shell -i bash shell.nix
# This script sets up the build environment by invoking nix-shell shell.nix
# and then runs the hadrian executable.
function rl {
TARGET_FILE="$1"
cd "$(dirname "$TARGET_FILE")"
TARGET_FILE="$(basename "$TARGET_FILE")"
# Iterate down a (possible) chain of symlinks
while [ -L "$TARGET_FILE" ]
do
TARGET_FILE="$(readlink "$TARGET_FILE")"
cd "$(dirname "$TARGET_FILE")"
TARGET_FILE="$(basename "$TARGET_FILE")"
done
# Compute the canonicalized name by finding the physical path
# for the directory we're in and appending the target file.
PHYS_DIR="$(pwd -P)"
RESULT="$PHYS_DIR/$TARGET_FILE"
echo "$RESULT"
}
absoluteRoot="$(dirname "$(rl "$0")")"
echo $absoluteRoot
cd "$absoluteRoot"
hadrian \
--directory="$absoluteRoot/.." \
"$@"
......@@ -685,6 +685,7 @@ summariseRequirement pn mod_name = do
return ModSummary {
ms_mod = mod,
ms_bootable = False,
ms_hsc_src = HsigFile,
ms_location = location,
ms_hs_date = time,
......@@ -773,6 +774,7 @@ hsModuleToModSummary pn hsc_src modname
time <- liftIO $ getModificationUTCTime (bkp_filename env)
hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location)
hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location)
bootable <- checkIsBootable hsc_src location
-- Also copied from 'getImports'
let (src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps
......@@ -795,6 +797,7 @@ hsModuleToModSummary pn hsc_src modname
this_mod <- liftIO $ addHomeModuleToFinder hsc_env modname location
return ModSummary {
ms_mod = this_mod,
ms_bootable = bootable,
ms_hsc_src = hsc_src,
ms_location = location,
ms_hspp_file = (case hiDir dflags of
......
......@@ -110,7 +110,9 @@ data Literal
| LitNumber !LitNumType !Integer Type
-- ^ Any numeric literal that can be
-- internally represented with an Integer
-- internally represented with an Integer.
-- See Note [Types of LitNumbers] below for the
-- Type field.
| LitString ByteString -- ^ A string-literal: stored and emitted
-- UTF-8 encoded, we'll arrange to decode it
......@@ -251,6 +253,7 @@ instance Binary Literal where
6 -> do
nt <- get bh
i <- get bh
-- Note [Types of LitNumbers]
let t = case nt of
LitNumInt -> intPrimTy
LitNumInt64 -> int64PrimTy
......@@ -267,20 +270,15 @@ instance Binary Literal where
return (LitRubbish)
instance Outputable Literal where
ppr lit = pprLiteral (\d -> d) lit
ppr = pprLiteral id
instance Eq Literal where
a == b = case (a `compare` b) of { EQ -> True; _ -> False }
a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
a == b = compare a b == EQ
-- | Needed for the @Ord@ instance of 'AltCon', which in turn is needed in
-- 'TrieMap.CoreMap'.
instance Ord Literal where
a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
compare a b = cmpLit a b
compare = cmpLit
{-
Construction
......@@ -309,13 +307,11 @@ Int/Word range.
wrapLitNumber :: DynFlags -> Literal -> Literal
wrapLitNumber dflags v@(LitNumber nt i t) = case nt of
LitNumInt -> case platformWordSize (targetPlatform dflags) of
4 -> LitNumber nt (toInteger (fromIntegral i :: Int32)) t
8 -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t
w -> panic ("wrapLitNumber: Unknown platformWordSize: " ++ show w)
PW4 -> LitNumber nt (toInteger (fromIntegral i :: Int32)) t
PW8 -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t
LitNumWord -> case platformWordSize (targetPlatform dflags) of
4 -> LitNumber nt (toInteger (fromIntegral i :: Word32)) t
8 -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t
w -> panic ("wrapLitNumber: Unknown platformWordSize: " ++ show w)
PW4 -> LitNumber nt (toInteger (fromIntegral i :: Word32)) t
PW8 -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t
LitNumInt64 -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t
LitNumWord64 -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t
LitNumInteger -> v
......@@ -644,6 +640,26 @@ litIsLifted _ = False
{-
Types
~~~~~
Note [Types of LitNumbers]
~~~~~~~~~~~~~~~~~~~~~~~~~~
A LitNumber's type is always known from its LitNumType:
LitNumInteger -> Integer
LitNumNatural -> Natural
LitNumInt -> Int# (intPrimTy)
LitNumInt64 -> Int64# (int64PrimTy)
LitNumWord -> Word# (wordPrimTy)
LitNumWord64 -> Word64# (word64PrimTy)
The reason why we have a Type field is because Integer and Natural types live
outside of GHC (in the libraries), so we have to get the actual Type via
lookupTyCon, tcIfaceTyConByName etc. that's too inconvenient in the call sites
of literalType, so we do that when creating these literals, and literalType
simply reads the field.
(But see also Note [Integer literals] and Note [Natural literals])
-}
-- | Find the Haskell 'Type' the literal occupies
......@@ -654,7 +670,7 @@ literalType (LitString _) = addrPrimTy
literalType (LitFloat _) = floatPrimTy
literalType (LitDouble _) = doublePrimTy
literalType (LitLabel _ _ _) = addrPrimTy
literalType (LitNumber _ _ t) = t
literalType (LitNumber _ _ t) = t -- Note [Types of LitNumbers]
literalType (LitRubbish) = mkForAllTy a Inferred (mkTyVarTy a)
where
a = alphaTyVarUnliftedRep
......
......@@ -89,7 +89,8 @@ module Var (
import GhcPrelude
import {-# SOURCE #-} TyCoRep( Type, Kind, pprKind )
import {-# SOURCE #-} TyCoRep( Type, Kind )
import {-# SOURCE #-} TyCoPpr( pprKind )
import {-# SOURCE #-} TcType( TcTyVarDetails, pprTcTyVarDetails, vanillaSkolemTv )
import {-# SOURCE #-} IdInfo( IdDetails, IdInfo, coVarDetails, isCoVarDetails,
vanillaIdInfo, pprIdDetails )
......
......@@ -19,7 +19,6 @@ import Module
import GHC.Platform
import Digraph
import CLabel
import PprCmmDecl ()
import Cmm
import CmmUtils
import DynFlags
......@@ -30,7 +29,6 @@ import UniqSupply
import CostCentre
import StgCmmHeap
import PprCmm()
import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map
......@@ -729,7 +727,7 @@ oneSRT dflags staticFuns blockids lbls isCAF cafs = do
-- important that we don't do this for static functions or CAFs,
-- see Note [Invalid optimisation: shortcutting].
updateSRTMap srtEntry =
when (not isCAF && not isStaticFun) $ do
when (not isCAF && (not isStaticFun || isNothing srtEntry)) $ do
let newSRTMap = Map.fromList [(cafLbl, srtEntry) | cafLbl <- lbls]
put (Map.union newSRTMap srtMap)
......
......@@ -10,7 +10,7 @@ import GhcPrelude
import CmmExpr
import SMRep
import Cmm (Convention(..))
import PprCmm ()
import PprCmm () -- For Outputable instances
import DynFlags
import GHC.Platform
......
......@@ -13,7 +13,6 @@ import Cmm
import CmmUtils
import CmmSwitch (eqSwitchTargetWith)
import CmmContFlowOpt
-- import PprCmm ()
import Hoopl.Block
import Hoopl.Graph
......
......@@ -48,6 +48,7 @@ import Hoopl.Collections
import GHC.Platform
import Maybes
import DynFlags
import ErrUtils (withTiming)
import Panic
import UniqSupply
import MonadUtils
......@@ -66,17 +67,22 @@ mkEmptyContInfoTable info_lbl
, cit_srt = Nothing
, cit_clo = Nothing }
cmmToRawCmm :: DynFlags -> Stream IO CmmGroup ()
-> IO (Stream IO RawCmmGroup ())
cmmToRawCmm :: DynFlags -> Stream IO CmmGroup a
-> IO (Stream IO RawCmmGroup a)
cmmToRawCmm dflags cmms
= do { uniqs <- mkSplitUniqSupply 'i'
; let do_one uniqs cmm = do
case initUs uniqs $ concatMapM (mkInfoTable dflags) cmm of
(b,uniqs') -> return (uniqs',b)
-- NB. strictness fixes a space leak. DO NOT REMOVE.
; return (Stream.mapAccumL do_one uniqs cmms >> return ())
; let do_one :: UniqSupply -> [CmmDecl] -> IO (UniqSupply, [RawCmmDecl])
do_one uniqs cmm =
-- NB. strictness fixes a space leak. DO NOT REMOVE.
withTiming (return dflags) (text "Cmm -> Raw Cmm") forceRes $
case initUs uniqs $ concatMapM (mkInfoTable dflags) cmm of
(b,uniqs') -> return (uniqs',b)
; return (snd <$> Stream.mapAccumL_ do_one uniqs cmms)
}
where forceRes (uniqs, rawcmms) =
uniqs `seq` foldr (\decl r -> decl `seq` r) () rawcmms
-- Make a concrete info table, represented as a list of CmmStatic
-- (it can't be simply a list of Word, because the SRT field is
-- represented by a label+offset expression).
......@@ -572,7 +578,7 @@ stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE dflags
stdSrtBitmapOffset :: DynFlags -> ByteOff
-- Byte offset of the SRT bitmap half-word which is
-- in the *higher-addressed* part of the type_lit
stdSrtBitmapOffset dflags = stdInfoTableSizeB dflags - hALF_WORD_SIZE dflags
stdSrtBitmapOffset dflags = stdInfoTableSizeB dflags - halfWordSize dflags
stdClosureTypeOffset :: DynFlags -> ByteOff
-- Byte offset of the closure type half-word
......@@ -580,7 +586,7 @@ stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE dflags
stdPtrsOffset, stdNonPtrsOffset :: DynFlags -> ByteOff
stdPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags
stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags + hALF_WORD_SIZE dflags
stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags + halfWordSize dflags
conInfoTableSizeB :: DynFlags -> Int
conInfoTableSizeB dflags = stdInfoTableSizeB dflags + wORD_SIZE dflags
......@@ -21,7 +21,7 @@ import Cmm
import CmmUtils
import CmmLive
import CmmSwitch (switchTargetsToList)
import PprCmm ()
import PprCmm () -- For Outputable instances
import Outputable
import DynFlags
......
......@@ -17,7 +17,7 @@ import GhcPrelude
import DynFlags
import BlockId
import Cmm
import PprCmmExpr ()
import PprCmmExpr () -- For Outputable instances
import Hoopl.Block
import Hoopl.Collections
import Hoopl.Dataflow
......
......@@ -39,7 +39,7 @@ cmmPipeline
-> CmmGroup -- Input C-- with Procedures
-> IO (ModuleSRTInfo, CmmGroup) -- Output CPS transformed C--
cmmPipeline hsc_env srtInfo prog =
cmmPipeline hsc_env srtInfo prog = withTiming (return dflags) (text "Cmm pipeline") forceRes $
do let dflags = hsc_dflags hsc_env
tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog
......@@ -49,6 +49,10 @@ cmmPipeline hsc_env srtInfo prog =
return (srtInfo, cmms)
where forceRes (info, group) =
info `seq` foldr (\decl r -> decl `seq` r) () group
dflags = hsc_dflags hsc_env
cpsTop :: HscEnv -> CmmDecl -> IO (CAFEnv, [CmmDecl])
cpsTop _ p@(CmmData {}) = return (mapEmpty, [p])
......
......@@ -14,7 +14,7 @@ import DynFlags
import BlockId
import CLabel
import Cmm
import PprCmm ()
import PprCmm () -- For Outputable instances
import CmmUtils
import CmmInfo
import CmmLive
......
......@@ -19,7 +19,6 @@ import GHC.Platform (isARM, platformArch)
import DynFlags
import Unique
import UniqFM
import PprCmm ()
import qualified Data.IntSet as IntSet
import Data.List (partition)
......
......@@ -227,8 +227,8 @@ packHalfWordsCLit :: DynFlags -> StgHalfWord -> StgHalfWord -> CmmLit
-- but be careful: that's vulnerable when reversed
packHalfWordsCLit dflags lower_half_word upper_half_word
= if wORDS_BIGENDIAN dflags
then mkWordCLit dflags ((l `shiftL` hALF_WORD_SIZE_IN_BITS dflags) .|. u)
else mkWordCLit dflags (l .|. (u `shiftL` hALF_WORD_SIZE_IN_BITS dflags))
then mkWordCLit dflags ((l `shiftL` halfWordSizeInBits dflags) .|. u)
else mkWordCLit dflags (l .|. (u `shiftL` halfWordSizeInBits dflags))
where l = fromStgHalfWord lower_half_word
u = fromStgHalfWord upper_half_word
......
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
-----------------------------------------------------------------------------
--
......@@ -11,7 +12,7 @@
module Debug (
DebugBlock(..), dblIsEntry,
DebugBlock(..),
cmmDebugGen,
cmmDebugLabels,
cmmDebugLink,
......@@ -32,7 +33,6 @@ import CoreSyn
import FastString ( nilFS, mkFastString )
import Module
import Outputable
import PprCore ()
import PprCmmExpr ( pprExpr )
import SrcLoc
import Util ( seqList )
......@@ -59,8 +59,7 @@ data DebugBlock =
, dblParent :: !(Maybe DebugBlock)
-- ^ The parent of this proc. See Note [Splitting DebugBlocks]
, dblTicks :: ![CmmTickish] -- ^ Ticks defined in this block
, dblSourceTick
:: !(Maybe CmmTickish) -- ^ Best source tick covering block
, dblSourceTick :: !(Maybe CmmTickish) -- ^ Best source tick covering block
, dblPosition :: !(Maybe Int) -- ^ Output position relative to
-- other blocks. @Nothing@ means
-- the block was optimized out
......@@ -68,22 +67,19 @@ data DebugBlock =
, dblBlocks :: ![DebugBlock] -- ^ Nested blocks
}
-- | Is this the entry block?
dblIsEntry :: DebugBlock -> Bool
dblIsEntry blk = dblProcedure blk == dblLabel blk
instance Outputable DebugBlock where
ppr blk = (if dblProcedure blk == dblLabel blk
then text "proc "
else if dblHasInfoTbl blk
then text "pp-blk "
else text "blk ") <>
ppr blk = (if | dblProcedure blk == dblLabel blk
-> text "proc"
| dblHasInfoTbl blk
-> text "pp-blk"
| otherwise
-> text "blk") <+>
ppr (dblLabel blk) <+> parens (ppr (dblCLabel blk)) <+>
(maybe empty ppr (dblSourceTick blk)) <+>
(maybe (text "removed") ((text "pos " <>) . ppr)
(dblPosition blk)) <+>
(ppr (dblUnwind blk)) <+>
(if null (dblBlocks blk) then empty else ppr (dblBlocks blk))
(ppr (dblUnwind blk)) $+$
(if null (dblBlocks blk) then empty else nest 4 (ppr (dblBlocks blk)))
-- | Intermediate data structure holding debug-relevant context information
-- about a block.
......
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Hoopl.Block
( C
( Extensibility (..)
, O
, C
, MaybeO(..)
, IndexedCO
, Block(..)
......@@ -40,19 +43,21 @@ import GhcPrelude
-- -----------------------------------------------------------------------------
-- Shapes: Open and Closed
-- | Used at the type level to indicate an "open" structure with
-- a unique, unnamed control-flow edge flowing in or out.
-- "Fallthrough" and concatenation are permitted at an open point.
data O
-- | Used at the type level to indicate "open" vs "closed" structure.
data Extensibility
-- | An "open" structure with a unique, unnamed control-flow edge flowing in
-- or out. "Fallthrough" and concatenation are permitted at an open point.
= Open
-- | A "closed" structure which supports control transfer only through the use
-- of named labels---no "fallthrough" is permitted. The number of control-flow
-- edges is unconstrained.
| Closed
-- | Used at the type level to indicate a "closed" structure which
-- supports control transfer only through the use of named
-- labels---no "fallthrough" is permitted. The number of control-flow
-- edges is unconstrained.
data C
type O = 'Open
type C = 'Closed
-- | Either type indexed by closed/open using type families
type family IndexedCO ex a b :: *
type family IndexedCO (ex :: Extensibility) (a :: k) (b :: k) :: k
type instance IndexedCO C a _b = a
type instance IndexedCO O _a b = b
......
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fprof-auto-top #-}
--
......@@ -49,7 +51,7 @@ import Hoopl.Graph
import Hoopl.Collections
import Hoopl.Label
type family Fact x f :: *
type family Fact (x :: Extensibility) f :: *
type instance Fact C f = FactBase f
type instance Fact O f = f
......
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
......@@ -30,7 +31,7 @@ import Hoopl.Collections
type Body n = LabelMap (Block n C C)
-- | @Body@ abstracted over @block@
type Body' block (n :: * -> * -> *) = LabelMap (block n C C)
type Body' block (n :: Extensibility -> Extensibility -> *) = LabelMap (block n C C)
-------------------------------
-- | Gives access to the anchor points for
......@@ -75,7 +76,7 @@ type Graph = Graph' Block
-- | @Graph'@ is abstracted over the block type, so that we can build
-- graphs of annotated blocks for example (Compiler.Hoopl.Dataflow
-- needs this).
data Graph' block (n :: * -> * -> *) e x where
data Graph' block (n :: Extensibility -> Extensibility -> *) e x where
GNil :: Graph' block n O O
GUnit :: block n O O -> Graph' block n O O
GMany :: MaybeO e (block n O C)
......
......@@ -19,8 +19,7 @@
-----------------------------------------------------------------------------
module PprC (
writeCs,
pprStringInCStyle
writeC
) where
#include "HsVersions.h"
......@@ -32,7 +31,7 @@ import BlockId
import CLabel
import ForeignCall
import Cmm hiding (pprBBlock)
import PprCmm ()
import PprCmm () -- For Outputable instances
import Hoopl.Block
import Hoopl.Collections
import Hoopl.Graph
......@@ -68,13 +67,8 @@ import Data.Array.ST
-- --------------------------------------------------------------------------
-- Top level
pprCs :: [RawCmmGroup] -> SDoc
pprCs cmms
= pprCode CStyle (vcat $ map pprC cmms)
writeCs :: DynFlags -> Handle -> [RawCmmGroup] -> IO ()
writeCs dflags handle cmms
= printForC dflags handle (pprCs cmms)
writeC :: DynFlags -> Handle -> RawCmmGroup -> IO ()
writeC dflags handle cmm = printForC dflags handle (pprC cmm $$ blankLine)
-- --------------------------------------------------------------------------
-- Now do some real work
......
......@@ -41,7 +41,6 @@ where
import GhcPrelude hiding (succ)
import BlockId ()
import CLabel
import Cmm
import CmmUtils
......@@ -52,7 +51,6 @@ import Outputable
import PprCmmDecl
import PprCmmExpr
import Util
import PprCore ()
import BasicTypes
import Hoopl.Block
......
......@@ -13,7 +13,7 @@ module SMRep (
StgWord, fromStgWord, toStgWord,
StgHalfWord, fromStgHalfWord, toStgHalfWord,
hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
halfWordSize, halfWordSizeInBits,
-- * Closure repesentation
SMRep(..), -- CmmInfo sees the rep; no one else does
......@@ -107,9 +107,8 @@ toStgWord dflags i
= case platformWordSize (targetPlatform dflags) of
-- These conversions mean that things like toStgWord (-1)
-- do the right thing
4 -> StgWord (fromIntegral (fromInteger i :: Word32))
8 -> StgWord (fromInteger i :: Word64)
w -> panic ("toStgWord: Unknown platformWordSize: " ++ show w)
PW4 -> StgWord (fromIntegral (fromInteger i :: Word32))
PW8 -> StgWord (fromInteger i)
instance Outputable StgWord where
ppr (StgWord i) = integer (toInteger i)
......@@ -129,17 +128,18 @@ toStgHalfWord dflags i
= case platformWordSize (targetPlatform dflags) of
-- These conversions mean that things like toStgHalfWord (-1)
-- do the right thing
4 -> StgHalfWord (fromIntegral (fromInteger i :: Word16))
8 -> StgHalfWord (fromInteger i :: Word32)
w -> panic ("toStgHalfWord: Unknown platformWordSize: " ++ show w)
PW4 -> StgHalfWord (fromIntegral (fromInteger i :: Word16))
PW8 -> StgHalfWord (fromInteger i :: Word32)
instance Outputable StgHalfWord where
ppr (StgHalfWord w) = integer (toInteger w)
hALF_WORD_SIZE :: DynFlags -> ByteOff
hALF_WORD_SIZE dflags = platformWordSize (targetPlatform dflags) `shiftR` 1
hALF_WORD_SIZE_IN_BITS :: DynFlags -> Int
hALF_WORD_SIZE_IN_BITS dflags = platformWordSize (targetPlatform dflags) `shiftL` 2
-- | Half word size in bytes
halfWordSize :: DynFlags -> ByteOff
halfWordSize dflags = platformWordSizeInBytes (targetPlatform dflags) `div` 2
halfWordSizeInBits :: DynFlags -> Int
halfWordSizeInBits dflags = platformWordSizeInBits (targetPlatform dflags) `div` 2
{-
************************************************************************
......
......@@ -32,6 +32,7 @@ import CLabel
import StgSyn
import DynFlags
import ErrUtils
import HscTypes
import CostCentre
......@@ -70,7 +71,7 @@ codeGen dflags this_mod data_tycons
; cgref <- liftIO $ newIORef =<< initC
; let cg :: FCode () -> Stream IO CmmGroup ()
cg fcode = do
cmm <- liftIO $ do
cmm <- liftIO . withTiming (return dflags) (text "STG -> Cmm") (`seq` ()) $ do
st <- readIORef cgref
let (a,st') = runC dflags this_mod st (getCmm fcode)
......
......@@ -71,7 +71,7 @@ import GhcPrelude
import StgSyn
import SMRep
import Cmm
import PprCmmExpr()
import PprCmmExpr() -- For Outputable instances
import CostCentre
import BlockId
......@@ -166,19 +166,27 @@ assertNonVoidStgArgs args = ASSERT(not (any (isVoidTy . stgArgType) args))
-- Why are these here?
-- | Assumes that there is precisely one 'PrimRep' of the type. This assumption
-- holds after unarise.
-- See Note [Post-unarisation invariants]
idPrimRep :: Id -> PrimRep
idPrimRep id = typePrimRep1 (idType id)
-- NB: typePrimRep1 fails on unboxed tuples,
-- but by StgCmm no Ids have unboxed tuple type
-- See also Note [VoidRep] in RepType
-- | Assumes that Ids have one PrimRep, which holds after unarisation.
-- See Note [Post-unarisation invariants]
addIdReps :: [NonVoid Id] -> [NonVoid (PrimRep, Id)]
addIdReps = map (\id -> let id' = fromNonVoid id
in NonVoid (idPrimRep id', id'))
-- | Assumes that arguments have one PrimRep, which holds after unarisation.
-- See Note [Post-unarisation invariants]
addArgReps :: [NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)]
addArgReps = map (\arg -> let arg' = fromNonVoid arg
in NonVoid (argPrimRep arg', arg'))
-- | Assumes that the argument has one PrimRep, which holds after unarisation.
-- See Note [Post-unarisation invariants]
argPrimRep :: StgArg -> PrimRep
argPrimRep arg = typePrimRep1 (stgArgType arg)
......
......@@ -46,6 +46,7 @@ import SMRep
import FastString
import Outputable
import Util
import Data.Maybe
import Data.Bits ((.&.), bit)
import Control.Monad (liftM, when, unless)
......@@ -872,43 +873,65 @@ emitPrimOp dflags r@[res] op args
emit stmt
emitPrimOp dflags results op args
= case callishPrimOpSupported dflags op of
= case callishPrimOpSupported dflags op args of
Left op -> emit $ mkUnsafeCall (PrimTarget op) results args
Right gen -> gen results args
-- Note [QuotRem optimization]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- `quot` and `rem` with constant divisor can be implemented with fast bit-ops
-- (shift, .&.).
--
-- Currently we only support optimization (performed in CmmOpt) when the
-- constant is a power of 2. #9041 tracks the implementation of the general
-- optimization.
--
-- `quotRem` can be optimized in the same way. However as it returns two values,
-- it is implemented as a "callish" primop which is harder to match and
-- to transform later on. For simplicity, the current implementation detects cases
-- that can be optimized (see `quotRemCanBeOptimized`) and converts STG quotRem
-- primop into two CMM quot and rem primops.
type GenericOp = [CmmFormal] -> [CmmActual] -> FCode ()
callishPrimOpSupported :: DynFlags -> PrimOp -> Either CallishMachOp GenericOp
callishPrimOpSupported dflags op
callishPrimOpSupported :: DynFlags -> PrimOp -> [CmmExpr] -> Either CallishMachOp GenericOp
callishPrimOpSupported dflags op args
= case op of
IntQuotRemOp | ncg && (x86ish || ppc) ->
Left (MO_S_QuotRem (wordWidth dflags))
| otherwise ->
Right (genericIntQuotRemOp (wordWidth dflags))
IntQuotRemOp | ncg && (x86ish || ppc)
, not quotRemCanBeOptimized
-> Left (MO_S_QuotRem (wordWidth dflags))
| otherwise
-> Right (genericIntQuotRemOp (wordWidth dflags))
Int8QuotRemOp | ncg && (x86ish || ppc)
, not quotRemCanBeOptimized
-> Left (MO_S_QuotRem W8)
| otherwise -> Right (genericIntQuotRemOp W8)
Int16QuotRemOp | ncg && (x86ish || ppc)
, not quotRemCanBeOptimized
-> Left (MO_S_QuotRem W16)
| otherwise -> Right (genericIntQuotRemOp W16)
WordQuotRemOp | ncg && (x86ish || ppc) ->
Left (MO_U_QuotRem (wordWidth dflags))
| otherwise ->
Right (genericWordQuotRemOp (wordWidth dflags))
WordQuotRemOp | ncg && (x86ish || ppc)
, not quotRemCanBeOptimized
-> Left (MO_U_QuotRem (wordWidth dflags))
| otherwise
-> Right (genericWordQuotRemOp (wordWidth dflags))
WordQuotRem2Op | (ncg && (x86ish || ppc))
|| llvm -> Left (MO_U_QuotRem2 (wordWidth dflags))
| otherwise -> Right (genericWordQuotRem2Op dflags)
Word8QuotRemOp | ncg && (x86ish || ppc)
, not quotRemCanBeOptimized
-> Left (MO_U_QuotRem W8)
| otherwise -> Right (genericWordQuotRemOp W8)
Word16QuotRemOp| ncg && (x86ish || ppc)
, not quotRemCanBeOptimized
-> Left (MO_U_QuotRem W16)
| otherwise -> Right (genericWordQuotRemOp W16)
......@@ -944,6 +967,11 @@ callishPrimOpSupported dflags op
_ -> pprPanic "emitPrimOp: can't translate PrimOp " (ppr op)
where
-- See Note [QuotRem optimization]
quotRemCanBeOptimized = case args of
[_, CmmLit (CmmInt n _) ] -> isJust (exactLog2 n)
_ -> False
ncg = case hscTarget dflags of
HscAsm -> True
_ -> False
......
......@@ -1055,10 +1055,17 @@ mkEtaWW orig_n orig_expr in_scope orig_ty
where
empty_subst = mkEmptyTCvSubst in_scope
go :: Arity -- Number of value args to expand to
-> TCvSubst -> Type -- We are really looking at subst(ty)
-> [EtaInfo] -- Accumulating parameter
-> (InScopeSet, [EtaInfo])
go n subst ty eis -- See Note [exprArity invariant]
----------- Done! No more expansion needed
| n == 0
= (getTCvInScope subst, reverse eis)
----------- Forall types (forall a. ty)
| Just (tcv,ty') <- splitForAllTy_maybe ty
, let (subst', tcv') = Type.substVarBndr subst tcv
= let ((n_subst, n_tcv), n_n)
......@@ -1069,10 +1076,11 @@ mkEtaWW orig_n orig_expr in_scope orig_ty
-- lambda \co:ty. e co. In this case we generate a new variable
-- of the coercion type, update the scope, and reduce n by 1.
| isTyVar tcv = ((subst', tcv'), n)
| otherwise = (freshEtaId n subst' (varType tcv'), n-1)
| otherwise = (freshEtaId n subst' (varType tcv'), n-1)
-- Avoid free vars of the original expression
in go n_n n_subst ty' (EtaVar n_tcv : eis)
----------- Function types (t1 -> t2)
| Just (arg_ty, res_ty) <- splitFunTy_maybe ty
, not (isTypeLevPoly arg_ty)
-- See Note [Levity polymorphism invariants] in CoreSyn
......@@ -1082,14 +1090,19 @@ mkEtaWW orig_n orig_expr in_scope orig_ty
-- Avoid free vars of the original expression
= go (n-1) subst' res_ty (EtaVar eta_id' : eis)
----------- Newtypes
-- Given this:
-- newtype T = MkT ([T] -> Int)
-- Consider eta-expanding this
-- eta_expand 1 e T
-- We want to get
-- coerce T (\x::[T] -> (coerce ([T]->Int) e) x)
| Just (co, ty') <- topNormaliseNewType_maybe ty
= -- Given this:
-- newtype T = MkT ([T] -> Int)
-- Consider eta-expanding this
-- eta_expand 1 e T
-- We want to get
-- coerce T (\x::[T] -> (coerce ([T]->Int) e) x)
go n subst ty' (pushCoercion co eis)
, let co' = Coercion.substCo subst co
-- Remember to apply the substitution to co (#16979)
-- (or we could have applied to ty, but then
-- we'd have had to zap it for the recursive call)
= go n subst ty' (pushCoercion co' eis)
| otherwise -- We have an expression of arity > 0,
-- but its type isn't a function, or a binder
......
......@@ -72,6 +72,7 @@ import VarSet
import Var
import Type
import TyCoRep
import TyCoFVs
import TyCon
import CoAxiom
import FamInstEnv
......
......@@ -49,6 +49,8 @@ import Kind
import Type
import RepType
import TyCoRep -- checks validity of types/coercions
import TyCoSubst
import TyCoFVs
import TyCon
import CoAxiom
import BasicTypes
......@@ -1051,7 +1053,7 @@ lintTyApp fun_ty arg_ty
; in_scope <- getInScope
-- substTy needs the set of tyvars in scope to avoid generating
-- uniques that are already in scope.
-- See Note [The substitution invariant] in TyCoRep
-- See Note [The substitution invariant] in TyCoSubst
; return (substTyWithInScope in_scope [tv] [arg_ty] body_ty) }
| otherwise
......@@ -1495,7 +1497,7 @@ lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind
lint_app doc kfn kas
= do { in_scope <- getInScope
-- We need the in_scope set to satisfy the invariant in
-- Note [The substitution invariant] in TyCoRep
-- Note [The substitution invariant] in TyCoSubst
; foldlM (go_app in_scope) kfn kas }
where
fail_msg extra = vcat [ hang (text "Kind application error in") 2 doc
......@@ -1717,7 +1719,7 @@ lintCoercion (ForAllCo tv1 kind_co co)
-- scope. All the free vars of `t2` and `kind_co` should
-- already be in `in_scope`, because they've been
-- linted and `tv2` has the same unique as `tv1`.
-- See Note [The substitution invariant]
-- See Note [The substitution invariant] in TyCoSubst.
unitVarEnv tv1 (TyVarTy tv2 `mkCastTy` mkSymCo kind_co)
tyr = mkInvForAllTy tv2 $
substTy subst t2
......@@ -1748,7 +1750,7 @@ lintCoercion (ForAllCo cv1 kind_co co)
-- scope. All the free vars of `t2` and `kind_co` should
-- already be in `in_scope`, because they've been
-- linted and `cv2` has the same unique as `cv1`.
-- See Note [The substitution invariant]
-- See Note [The substitution invariant] in TyCoSubst.
unitVarEnv cv1 (eta1 `mkTransCo` (mkCoVarCo cv2)
`mkTransCo` (mkSymCo eta2))
tyr = mkTyCoInvForAllTy cv2 $
......
This diff is collapsed.