...
 
Commits (53)
This diff is collapsed.
This diff is collapsed.
#!/bin/bash
set -e
toolchain=`pwd`/toolchain
PATH="$toolchain/bin:$PATH"
if [ -d "`pwd`/cabal-cache" ]; then
cp -Rf cabal-cache $HOME/.cabal
fi
if [ ! -e $toolchain/bin/ghc ]; then
mkdir -p tmp
cd tmp
ghc_tarball="https://downloads.haskell.org/~ghc/$GHC_VERSION/ghc-$GHC_VERSION-x86_64-apple-darwin.tar.xz"
echo "Fetching GHC from $ghc_tarball"
curl $ghc_tarball | tar -xJ
cd ghc-$GHC_VERSION
./configure --prefix=$toolchain
make install
cd ../..
rm -Rf tmp
fi
if [ ! -e $toolchain/bin/cabal ]; then
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
fi
if [ ! -e $toolchain/bin/happy ]; then
cabal update
cabal new-install happy --symlink-bindir=$toolchain/bin
fi
if [ ! -e $toolchain/bin/alex ]; then
cabal update
cabal new-install alex --symlink-bindir=$toolchain/bin
fi
#!/usr/bin/env bash
# vim: sw=2 et
set -euo pipefail
fail() {
echo "ERROR: $*" >&2
exit 1
}
hackage_index_state="@1522046735"
if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi
if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi
if [[ -z ${INTEGER_LIBRARY:-} ]]; then INTEGER_LIBRARY=integer-gmp; fi
if [[ -z ${BUILD_FLAVOUR:-} ]]; then BUILD_FLAVOUR=perf; fi
if [[ -z ${XZ:-} ]]; then
if which pxz; then
XZ="pxz"
elif which xz; then
# Check whether --threads is supported
if echo "hello" | xz --threads=$CORES >/dev/null; then
XZ="xz --threads=$CORES"
else
XZ="xz"
fi
else
echo "error: neither pxz nor xz were found"
exit 1
fi
fi
echo "Using $XZ for compression..."
cat > mk/build.mk <<EOF
V=1
HADDOCK_DOCS=YES
LATEX_DOCS=YES
HSCOLOUR_SRCS=YES
BUILD_SPHINX_HTML=$BUILD_SPHINX_HTML
BUILD_SPHINX_PDF=$BUILD_SPHINX_PDF
BeConservative=YES
INTEGER_LIBRARY=$INTEGER_LIBRARY
XZ_CMD=$XZ
EOF
cat <<EOF >> mk/build.mk
BuildFlavour=$BUILD_FLAVOUR
ifneq "\$(BuildFlavour)" ""
include mk/flavours/\$(BuildFlavour).mk
endif
GhcLibHcOpts+=-haddock
EOF
case "$(uname)" in
Linux)
if [[ -n ${TARGET:-} ]]; then
if [[ $TARGET = FreeBSD ]]; then
# cross-compiling to FreeBSD
echo 'HADDOCK_DOCS = NO' >> mk/build.mk
echo 'WERROR=' >> mk/build.mk
# https://circleci.com/docs/2.0/env-vars/#interpolating-environment-variables-to-set-other-environment-variables
echo 'export PATH=/opt/ghc/bin:$PATH' >> $BASH_ENV
else
fail "TARGET=$target not supported"
fi
fi
;;
Darwin)
if [[ -n ${TARGET:-} ]]; then
fail "uname=$(uname) not supported for cross-compilation"
fi
# It looks like we already have python2 here and just installing python3
# does not work.
brew upgrade python
brew install ghc cabal-install ncurses gmp
pip3 install sphinx
# PDF documentation disabled as MacTeX apparently doesn't include xelatex.
#brew cask install mactex
cabal update
cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state
# put them on the $PATH, don't fail if already installed
ln -s $HOME/.cabal/bin/alex /usr/local/bin/alex || true
ln -s $HOME/.cabal/bin/happy /usr/local/bin/happy || true
ln -s $HOME/.cabal/bin/HsColour /usr/local/bin/HsColour || true
echo "libraries/integer-gmp_CONFIGURE_OPTS += --configure-option=--with-intree-gmp" >> mk/build.mk
;;
*)
fail "uname=$(uname) not supported"
esac
echo "================================================="
echo "Build.mk:"
echo ""
cat mk/build.mk
echo "================================================="
#!/bin/bash
set -e
toolchain=`pwd`/toolchain
PATH="$toolchain/bin:/mingw64/bin:$PATH"
if [ -d "`pwd`/cabal-cache" ]; then
cp -Rf cabal-cache $APPDATA/cabal
fi
if [ ! -e $toolchain/bin/ghc ]; then
case $MSYSTEM in
MINGW32)
triple="i386-unknown-mingw32"
;;
MINGW64)
triple="x86_64-unknown-mingw32"
;;
*)
echo "win32-init: Unknown MSYSTEM $MSYSTEM"
exit 1
;;
esac
curl https://downloads.haskell.org/~ghc/$GHC_VERSION/ghc-$GHC_VERSION-$triple.tar.xz | tar -xJ
mv ghc-$GHC_VERSION toolchain
fi
if [ ! -e $toolchain/bin/cabal ]; then
url="https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-unknown-mingw32.zip"
curl $url > /tmp/cabal.zip
unzip /tmp/cabal.zip
mv cabal.exe $toolchain/bin
fi
if [ ! -e $toolchain/bin/happy ]; then
cabal update
cabal install happy
cp $APPDATA/cabal/bin/happy $toolchain/bin
fi
if [ ! -e $toolchain/bin/alex ]; then
cabal update
cabal install alex
cp $APPDATA/cabal/bin/alex $toolchain/bin
fi
......@@ -4,8 +4,8 @@
-- (c) The University of Glasgow 2002-2006
--
-- | ByteCodeLink: Bytecode assembler and linker
module ByteCodeAsm (
-- | Bytecode assembler and linker
module GHC.ByteCode.Asm (
assembleBCOs, assembleOneBCO,
bcoFreeNames,
......@@ -17,11 +17,11 @@ module ByteCodeAsm (
import GhcPrelude
import ByteCodeInstr
import ByteCodeItbls
import ByteCodeTypes
import GHC.ByteCode.Instr
import GHC.ByteCode.InfoTable
import GHC.ByteCode.Types
import GHCi.RemoteTypes
import GHCi
import GHC.Runtime.Interpreter
import HscTypes
import Name
......@@ -30,7 +30,7 @@ import Literal
import TyCon
import FastString
import GHC.StgToCmm.Layout ( ArgRep(..) )
import GHC.Runtime.Layout
import GHC.Runtime.Heap.Layout
import DynFlags
import Outputable
import GHC.Platform
......@@ -460,8 +460,8 @@ assembleI dflags i = case i of
LitNumWord -> int (fromIntegral i)
LitNumInt64 -> int64 (fromIntegral i)
LitNumWord64 -> int64 (fromIntegral i)
LitNumInteger -> panic "ByteCodeAsm.literal: LitNumInteger"
LitNumNatural -> panic "ByteCodeAsm.literal: LitNumNatural"
LitNumInteger -> panic "GHC.ByteCode.Asm.literal: LitNumInteger"
LitNumNatural -> panic "GHC.ByteCode.Asm.literal: LitNumNatural"
-- We can lower 'LitRubbish' to an arbitrary constant, but @NULL@ is most
-- likely to elicit a crash (rather than corrupt memory) in case absence
-- analysis messed up.
......
......@@ -4,15 +4,15 @@
-- (c) The University of Glasgow 2002-2006
--
-- | ByteCodeItbls: Generate infotables for interpreter-made bytecodes
module ByteCodeItbls ( mkITbls ) where
-- | Generate infotables for interpreter-made bytecodes
module GHC.ByteCode.InfoTable ( mkITbls ) where
#include "HsVersions.h"
import GhcPrelude
import ByteCodeTypes
import GHCi
import GHC.ByteCode.Types
import GHC.Runtime.Interpreter
import DynFlags
import HscTypes
import Name ( Name, getName )
......
......@@ -4,8 +4,8 @@
-- (c) The University of Glasgow 2002-2006
--
-- | ByteCodeInstrs: Bytecode instruction definitions
module ByteCodeInstr (
-- | Bytecode instruction definitions
module GHC.ByteCode.Instr (
BCInstr(..), ProtoBCO(..), bciStackUse,
) where
......@@ -13,7 +13,7 @@ module ByteCodeInstr (
import GhcPrelude
import ByteCodeTypes
import GHC.ByteCode.Types
import GHCi.RemoteTypes
import GHCi.FFI (C_ffi_cif)
import GHC.StgToCmm.Layout ( ArgRep(..) )
......@@ -28,7 +28,7 @@ import Literal
import DataCon
import VarSet
import PrimOp
import GHC.Runtime.Layout
import GHC.Runtime.Heap.Layout
import Data.Word
import GHC.Stack.CCS (CostCentre)
......
......@@ -8,8 +8,8 @@
-- (c) The University of Glasgow 2002-2006
--
-- | ByteCodeLink: Bytecode assembler and linker
module ByteCodeLink (
-- | Bytecode assembler and linker
module GHC.ByteCode.Linker (
ClosureEnv, emptyClosureEnv, extendClosureEnv,
linkBCO, lookupStaticPtr,
lookupIE,
......@@ -25,8 +25,8 @@ import GHCi.ResolvedBCO
import GHCi.BreakArray
import SizedSeq
import GHCi
import ByteCodeTypes
import GHC.Runtime.Interpreter
import GHC.ByteCode.Types
import HscTypes
import Name
import NameEnv
......@@ -90,7 +90,7 @@ lookupStaticPtr hsc_env addr_of_label_string = do
m <- lookupSymbol hsc_env addr_of_label_string
case m of
Just ptr -> return ptr
Nothing -> linkFail "ByteCodeLink: can't find label"
Nothing -> linkFail "GHC.ByteCode.Linker: can't find label"
(unpackFS addr_of_label_string)
lookupIE :: HscEnv -> ItblEnv -> Name -> IO (Ptr ())
......@@ -108,7 +108,7 @@ lookupIE hsc_env ie con_nm =
n <- lookupSymbol hsc_env sym_to_find2
case n of
Just addr -> return addr
Nothing -> linkFail "ByteCodeLink.lookupIE"
Nothing -> linkFail "GHC.ByteCode.Linker.lookupIE"
(unpackFS sym_to_find1 ++ " or " ++
unpackFS sym_to_find2)
......@@ -118,7 +118,7 @@ lookupPrimOp hsc_env primop = do
m <- lookupSymbol hsc_env (mkFastString sym_to_find)
case m of
Just p -> return (toRemotePtr p)
Nothing -> linkFail "ByteCodeLink.lookupCE(primop)" sym_to_find
Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE(primop)" sym_to_find
resolvePtr
:: HscEnv -> ItblEnv -> ClosureEnv -> NameEnv Int -> RemoteRef BreakArray
......@@ -135,7 +135,7 @@ resolvePtr hsc_env _ie ce bco_ix _ (BCOPtrName nm)
m <- lookupSymbol hsc_env sym_to_find
case m of
Just p -> return (ResolvedBCOStaticPtr (toRemotePtr p))
Nothing -> linkFail "ByteCodeLink.lookupCE" (unpackFS sym_to_find)
Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE" (unpackFS sym_to_find)
resolvePtr hsc_env _ _ _ _ (BCOPtrPrimOp op) =
ResolvedBCOStaticPtr <$> lookupPrimOp hsc_env op
resolvePtr hsc_env ie ce bco_ix breakarray (BCOPtrBCO bco) =
......
......@@ -4,7 +4,7 @@
--
-- | Bytecode assembler types
module ByteCodeTypes
module GHC.ByteCode.Types
( CompiledByteCode(..), seqCompiledByteCode, FFIInfo(..)
, UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)
, ItblEnv, ItblPtr(..)
......@@ -114,7 +114,7 @@ data CgBreakInfo
{ cgb_vars :: [Maybe (Id,Word16)]
, cgb_resty :: Type
}
-- See Note [Syncing breakpoint info] in compiler/main/InteractiveEval.hs
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
-- Not a real NFData instance because we can't rnf Id or Type
seqCgBreakInfo :: CgBreakInfo -> ()
......
......@@ -31,7 +31,7 @@ import CostCentre
import GHC.Cmm.CLabel
import GHC.Cmm.BlockId
import GHC.Cmm.Node
import GHC.Runtime.Layout
import GHC.Runtime.Heap.Layout
import GHC.Cmm.Expr
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
......
......@@ -8,7 +8,7 @@ module GHC.Cmm.CallConv (
import GhcPrelude
import GHC.Cmm.Expr
import GHC.Runtime.Layout
import GHC.Runtime.Heap.Layout
import GHC.Cmm (Convention(..))
import GHC.Cmm.Ppr () -- For Outputable instances
......
......@@ -35,7 +35,7 @@ import DynFlags
import FastString
import ForeignCall
import OrdList
import GHC.Runtime.Layout (ByteOff)
import GHC.Runtime.Heap.Layout (ByteOff)
import UniqSupply
import Util
import Panic
......
......@@ -38,7 +38,7 @@ import GhcPrelude
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.CLabel
import GHC.Runtime.Layout
import GHC.Runtime.Heap.Layout
import GHC.Data.Bitmap
import Stream (Stream)
import qualified Stream
......
......@@ -27,11 +27,10 @@ import GHC.Cmm.Utils
import DynFlags
import Maybes
import Outputable
import GHC.Runtime.Layout
import GHC.Runtime.Heap.Layout
import UniqSupply
import CostCentre
import GHC.StgToCmm.Heap
import ErrUtils
import Control.Monad
import Data.Map.Strict (Map)
......@@ -802,9 +801,6 @@ doSRTs dflags moduleSRTInfo procs data_ = do
(srt_declss, pairs, funSRTs, has_caf_refs) = unzip4 result
srt_decls = concat srt_declss
unless (null srt_decls) $
dumpIfSet_dyn dflags Opt_D_dump_srts "SRTs" FormatCMM (ppr srt_decls)
-- Next, update the info tables with the SRTs
let
srtFieldMap = mapFromList (concat pairs)
......
......@@ -18,7 +18,7 @@ import GHC.Cmm.Graph
import ForeignCall
import GHC.Cmm.Liveness
import GHC.Cmm.ProcPoint
import GHC.Runtime.Layout
import GHC.Runtime.Heap.Layout
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow
......
......@@ -35,7 +35,7 @@ import DynFlags
import FastString
import ForeignCall
import Outputable
import GHC.Runtime.Layout
import GHC.Runtime.Heap.Layout
import CoreSyn (Tickish)
import qualified Unique as U
......
......@@ -231,7 +231,7 @@ import GHC.Cmm.BlockId
import GHC.Cmm.Lexer
import GHC.Cmm.CLabel
import GHC.Cmm.Monad
import GHC.Runtime.Layout
import GHC.Runtime.Heap.Layout
import Lexer
import CostCentre
......
......@@ -75,7 +75,7 @@ import GhcPrelude
import TyCon ( PrimRep(..), PrimElemRep(..) )
import GHC.Types.RepType ( UnaryType, SlotTy (..), typePrimRep1 )
import GHC.Runtime.Layout
import GHC.Runtime.Heap.Layout
import GHC.Cmm
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
......
......@@ -7,18 +7,18 @@
-- (c) The University of Glasgow 2002-2006
--
-- | ByteCodeGen: Generate bytecode from Core
module ByteCodeGen ( UnlinkedBCO, byteCodeGen, coreExprToBCOs ) where
-- | GHC.CoreToByteCode: Generate bytecode from Core
module GHC.CoreToByteCode ( UnlinkedBCO, byteCodeGen, coreExprToBCOs ) where
#include "HsVersions.h"
import GhcPrelude
import ByteCodeInstr
import ByteCodeAsm
import ByteCodeTypes
import GHC.ByteCode.Instr
import GHC.ByteCode.Asm
import GHC.ByteCode.Types
import GHCi
import GHC.Runtime.Interpreter
import GHCi.FFI
import GHCi.RemoteTypes
import BasicTypes
......@@ -51,7 +51,7 @@ import FastString
import Panic
import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, nonVoidIds )
import GHC.StgToCmm.Layout
import GHC.Runtime.Layout hiding (WordOff, ByteOff, wordsToBytes)
import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
import GHC.Data.Bitmap
import OrdList
import Maybes
......@@ -88,7 +88,7 @@ byteCodeGen :: HscEnv
-> IO CompiledByteCode
byteCodeGen hsc_env this_mod binds tycs mb_modBreaks
= withTiming dflags
(text "ByteCodeGen"<+>brackets (ppr this_mod))
(text "GHC.CoreToByteCode"<+>brackets (ppr this_mod))
(const ()) $ do
-- Split top-level binds into strings and others.
-- See Note [generating code for top-level string literal bindings].
......@@ -105,7 +105,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks
mapM schemeTopBind flatBinds
when (notNull ffis)
(panic "ByteCodeGen.byteCodeGen: missing final emitBc?")
(panic "GHC.CoreToByteCode.byteCodeGen: missing final emitBc?")
dumpIfSet_dyn dflags Opt_D_dump_BCOs
"Proto-BCOs" FormatByteCode
......@@ -161,7 +161,7 @@ coreExprToBCOs :: HscEnv
-> IO UnlinkedBCO
coreExprToBCOs hsc_env this_mod expr
= withTiming dflags
(text "ByteCodeGen"<+>brackets (ppr this_mod))
(text "GHC.CoreToByteCode"<+>brackets (ppr this_mod))
(const ()) $ do
-- create a totally bogus name for the top-level BCO; this
-- should be harmless, since it's never used for anything
......@@ -175,7 +175,7 @@ coreExprToBCOs hsc_env this_mod expr
schemeR [] (invented_name, simpleFreeVars expr)
when (notNull mallocd)
(panic "ByteCodeGen.coreExprToBCOs: missing final emitBc?")
(panic "GHC.CoreToByteCode.coreExprToBCOs: missing final emitBc?")
dumpIfSet_dyn dflags Opt_D_dump_BCOs "Proto-BCOs" FormatByteCode
(ppr proto_bco)
......@@ -212,7 +212,7 @@ bytesToWords dflags (ByteOff bytes) =
let (q, r) = bytes `quotRem` (wORD_SIZE dflags)
in if r == 0
then fromIntegral q
else panic $ "ByteCodeGen.bytesToWords: bytes=" ++ show bytes
else panic $ "GHC.CoreToByteCode.bytesToWords: bytes=" ++ show bytes
wordSize :: DynFlags -> ByteOff
wordSize dflags = ByteOff (wORD_SIZE dflags)
......@@ -674,7 +674,7 @@ schemeE d s p (AnnCase scrut bndr _ alts)
= doCase d s p scrut bndr alts Nothing{-not an unboxed tuple-}
schemeE _ _ _ expr
= pprPanic "ByteCodeGen.schemeE: unhandled case"
= pprPanic "GHC.CoreToByteCode.schemeE: unhandled case"
(pprCoreExpr (deAnnotate' expr))
-- Is this Id a not-necessarily-lifted join point?
......@@ -965,7 +965,7 @@ findPushSeq (D: rest)
findPushSeq (L: rest)
= (PUSH_APPLY_L, 1, rest)
findPushSeq _
= panic "ByteCodeGen.findPushSeq"
= panic "GHC.CoreToByteCode.findPushSeq"
-- -----------------------------------------------------------------------------
-- Case expressions
......@@ -1222,7 +1222,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
!d_after_args = d0 + wordsToBytes dflags a_reps_sizeW
a_reps_pushed_RAW
| null a_reps_pushed_r_to_l || not (isVoidRep (head a_reps_pushed_r_to_l))
= panic "ByteCodeGen.generateCCall: missing or invalid World token?"
= panic "GHC.CoreToByteCode.generateCCall: missing or invalid World token?"
| otherwise
= reverse (tail a_reps_pushed_r_to_l)
......@@ -1294,7 +1294,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
a_reps -- | trace (showSDoc (ppr a_reps_pushed_RAW)) False = error "???"
| is_static = a_reps_pushed_RAW
| otherwise = if null a_reps_pushed_RAW
then panic "ByteCodeGen.generateCCall: dyn with no args"
then panic "GHC.CoreToByteCode.generateCCall: dyn with no args"
else tail a_reps_pushed_RAW
-- push the Addr#
......@@ -1324,7 +1324,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
conv = case cconv of
CCallConv -> FFICCall
StdCallConv -> FFIStdCall
_ -> panic "ByteCodeGen: unexpected calling convention"
_ -> panic "GHC.CoreToByteCode: unexpected calling convention"
-- the only difference in libffi mode is that we prepare a cif
-- describing the call type by calling libffi, and we attach the
......@@ -1620,7 +1620,7 @@ pushAtom _ _ (AnnLit lit) = do
LitNumNatural -> panic "pushAtom: LitNatural"
pushAtom _ _ expr
= pprPanic "ByteCodeGen.pushAtom"
= pprPanic "GHC.CoreToByteCode.pushAtom"
(pprCoreExpr (deAnnotate' expr))
......@@ -2007,7 +2007,7 @@ getLabelsBc n
getCCArray :: BcM (Array BreakIndex (RemotePtr CostCentre))
getCCArray = BcM $ \st ->
let breaks = expectJust "ByteCodeGen.getCCArray" $ modBreaks st in
let breaks = expectJust "GHC.CoreToByteCode.getCCArray" $ modBreaks st in
return (st, modBreaks_ccs breaks)
......
......@@ -71,6 +71,7 @@ import VarSet
import TyCoRep
import TyCoTidy ( tidyCo )
import Demand ( isTopSig )
import Cpr ( topCprSig )
import Data.Maybe ( catMaybes )
......@@ -442,7 +443,7 @@ toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
toIfaceIdInfo :: IdInfo -> IfaceIdInfo
toIfaceIdInfo id_info
= case catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
= case catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo, cpr_hsinfo,
inline_hsinfo, unfold_hsinfo, levity_hsinfo] of
[] -> NoInfo
infos -> HasInfo infos
......@@ -466,6 +467,10 @@ toIfaceIdInfo id_info
strict_hsinfo | not (isTopSig sig_info) = Just (HsStrictness sig_info)
| otherwise = Nothing
------------ CPR --------------
cpr_info = cprInfo id_info
cpr_hsinfo | cpr_info /= topCprSig = Just (HsCpr cpr_info)
| otherwise = Nothing
------------ Unfolding --------------
unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
loop_breaker = isStrongLoopBreaker (occInfo id_info)
......
......@@ -946,7 +946,7 @@ pragma. It is levity-polymorphic.
-> (# State# RealWorld, o #)
It needs no special treatment in GHC except this special inlining here
in CorePrep (and in ByteCodeGen).
in CorePrep (and in GHC.CoreToByteCode).
-- ---------------------------------------------------------------------------
-- CpeArg: produces a result satisfying CpeArg
......
......@@ -17,7 +17,7 @@ module GHC.Data.Bitmap (
import GhcPrelude
import GHC.Runtime.Layout
import GHC.Runtime.Heap.Layout
import DynFlags
import Util
......
......@@ -574,7 +574,7 @@ let-binding. When abs_sig = True
and hence the abs_binds is non-recursive
(it binds the mono_id but refers to the poly_id
These properties are exploited in DsBinds.dsAbsBinds to
These properties are exploited in GHC.HsToCore.Binds.dsAbsBinds to
generate code without a let-binding.
Note [ABExport wrapper]
......
......@@ -210,10 +210,10 @@ information from an `HsGroup`.
One might wonder why we even bother separating top-level fixity signatures
into two places at all. That is, why not just take the fixity signatures
from `hs_tyclds` and put them into `hs_fixds` so that they are all in one
location? This ends up causing problems for `DsMeta.repTopDs`, which translates
each fixity signature in `hs_fixds` and `hs_tyclds` into a Template Haskell
`Dec`. If there are any duplicate signatures between the two fields, this will
result in an error (#17608).
location? This ends up causing problems for `GHC.HsToCore.Quote.repTopDs`,
which translates each fixity signature in `hs_fixds` and `hs_tyclds` into a
Template Haskell `Dec`. If there are any duplicate signatures between the two
fields, this will result in an error (#17608).
-}
-- | Haskell Group
......
......@@ -577,8 +577,8 @@ data RecordUpdTc = RecordUpdTc
-- | HsWrap appears only in typechecker output
-- Invariant: The contained Expr is *NOT* itself an HsWrap.
-- See Note [Detecting forced eta expansion] in DsExpr. This invariant
-- is maintained by GHC.Hs.Utils.mkHsWrap.
-- See Note [Detecting forced eta expansion] in GHC.HsToCore.Expr.
-- This invariant is maintained by GHC.Hs.Utils.mkHsWrap.
-- hs_syn is something like HsExpr or HsCmd
data HsWrap hs_syn = HsWrap HsWrapper -- the wrapper
(hs_syn GhcTc) -- the thing that is wrapped
......@@ -2693,7 +2693,7 @@ data HsMatchContext p
-- (Just b) | Just _ <- x = e
-- | otherwise = e'
| RecUpd -- ^Record update [used only in DsExpr to
| RecUpd -- ^Record update [used only in GHC.HsToCore.Expr to
-- tell matchWrapper what sort of
-- runtime error message to generate]
......
......@@ -199,7 +199,7 @@ found to have.
-}
-- Comparison operations are needed when grouping literals
-- for compiling pattern-matching (module MatchLit)
-- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)
instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where
(OverLit _ val1 _) == (OverLit _ val2 _) = val1 == val2
(XOverLit val1) == (XOverLit val2) = val1 == val2
......
......@@ -425,7 +425,7 @@ data HsRecField' id arg = HsRecField {
--
-- The renamer produces an Unambiguous result if it can, rather than
-- just doing the lookup in the typechecker, so that completely
-- unambiguous updates can be represented by 'DsMeta.repUpdFields'.
-- unambiguous updates can be represented by 'GHC.HsToCore.Quote.repUpdFields'.
--
-- For example, suppose we have:
--
......
......@@ -758,11 +758,12 @@ positions in the kind of the tycon.
mkLHsWrap :: HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
mkLHsWrap co_fn (L loc e) = L loc (mkHsWrap co_fn e)
-- | Avoid @'HsWrap' co1 ('HsWrap' co2 _)@.
-- See Note [Detecting forced eta expansion] in "DsExpr"
-- | Avoid @'HsWrap' co1 ('HsWrap' co2 _)@ and @'HsWrap' co1 ('HsPar' _ _)@
-- See Note [Detecting forced eta expansion] in "GHC.HsToCore.Expr"
mkHsWrap :: HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
mkHsWrap co_fn e | isIdHsWrapper co_fn = e
mkHsWrap co_fn (XExpr (HsWrap co_fn' e)) = mkHsWrap (co_fn <.> co_fn') e
mkHsWrap co_fn (HsPar x (L l e)) = HsPar x (L l (mkHsWrap co_fn e))
mkHsWrap co_fn e = XExpr (HsWrap co_fn e)
mkHsWrapCo :: TcCoercionN -- A Nominal coercion a ~N b
......@@ -934,7 +935,7 @@ BUT we have a special case when abs_sig is true;
-- | Should we treat this as an unlifted bind? This will be true for any
-- bind that binds an unlifted variable, but we must be careful around
-- AbsBinds. See Note [Unlifted id check in isUnliftedHsBind]. For usage
-- information, see Note [Strict binds check] is DsBinds.
-- information, see Note [Strict binds check] is GHC.HsToCore.Binds.
isUnliftedHsBind :: HsBind GhcTc -> Bool -- works only over typechecked binds
isUnliftedHsBind bind
| AbsBinds { abs_exports = exports, abs_sig = has_sig } <- bind
......@@ -1102,17 +1103,17 @@ collect_lpat p bndrs
go (XPat {}) = bndrs
{-
Note [Dictionary binders in ConPatOut] See also same Note in DsArrows
Note [Dictionary binders in ConPatOut] See also same Note in GHC.HsToCore.Arrows
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Do *not* gather (a) dictionary and (b) dictionary bindings as binders
of a ConPatOut pattern. For most calls it doesn't matter, because
it's pre-typechecker and there are no ConPatOuts. But it does matter
more in the desugarer; for example, DsUtils.mkSelectorBinds uses
more in the desugarer; for example, GHC.HsToCore.Utils.mkSelectorBinds uses
collectPatBinders. In a lazy pattern, for example f ~(C x y) = ...,
we want to generate bindings for x,y but not for dictionaries bound by
C. (The type checker ensures they would not be used.)
Desugaring of arrow case expressions needs these bindings (see DsArrows
Desugaring of arrow case expressions needs these bindings (see GHC.HsToCore.Arrows
and arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its
own pat-binder-collector:
......@@ -1126,7 +1127,7 @@ f ~(C (n+1) m) = (n,m)
Here, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),
and *also* uses that dictionary to match the (n+1) pattern. Yet, the
variables bound by the lazy pattern are n,m, *not* the dictionary d.
So in mkSelectorBinds in DsUtils, we want just m,n as the variables bound.
So in mkSelectorBinds in GHC.HsToCore.Utils, we want just m,n as the variables bound.
-}
hsGroupBinders :: HsGroup GhcRn -> [Name]
......
......@@ -10,7 +10,7 @@ The Desugarer: turning HsSyn into Core.
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Desugar (
module GHC.HsToCore (
-- * Desugaring operations
deSugar, deSugarExpr
) where
......@@ -19,7 +19,7 @@ module Desugar (
import GhcPrelude
import DsUsage
import GHC.HsToCore.Usage
import DynFlags
import HscTypes
import GHC.Hs
......@@ -34,10 +34,10 @@ import CoreSyn
import CoreFVs ( exprsSomeFreeVarsList )
import CoreOpt ( simpleOptPgm, simpleOptExpr )
import PprCore
import DsMonad
import DsExpr
import DsBinds
import DsForeign
import GHC.HsToCore.Monad
import GHC.HsToCore.Expr
import GHC.HsToCore.Binds
import GHC.HsToCore.Foreign.Decl
import PrelNames ( coercibleTyConKey )
import TysPrim ( eqReprPrimTyCon )
import Unique ( hasKey )
......@@ -57,11 +57,11 @@ import FastString
import ErrUtils
import Outputable
import SrcLoc
import Coverage
import GHC.HsToCore.Coverage
import Util
import MonadUtils
import OrdList
import ExtractDocs
import GHC.HsToCore.Docs
import Data.List
import Data.IORef
......@@ -485,7 +485,7 @@ For the LHS of a RULE we do *not* want to desugar
[x] to build (\cn. x `c` n)
We want to leave explicit lists simply as chains
of cons's. We can achieve that slightly indirectly by
switching off EnableRewriteRules. See DsExpr.dsExplicitList.
switching off EnableRewriteRules. See GHC.HsToCore.Expr.dsExplicitList.
That keeps the desugaring of list comprehensions simple too.
......
......@@ -12,15 +12,15 @@ Desugaring arrow commands
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module DsArrows ( dsProcExpr ) where
module GHC.HsToCore.Arrows ( dsProcExpr ) where
#include "HsVersions.h"
import GhcPrelude
import Match
import DsUtils
import DsMonad
import GHC.HsToCore.Match
import GHC.HsToCore.Utils
import GHC.HsToCore.Monad
import GHC.Hs hiding (collectPatBinders, collectPatsBinders,
collectLStmtsBinders, collectLStmtBinders,
......@@ -33,8 +33,8 @@ import qualified GHC.Hs.Utils as HsUtils
-- So WATCH OUT; check each use of split*Ty functions.
-- Sigh. This is a pain.
import {-# SOURCE #-} DsExpr ( dsExpr, dsLExpr, dsLExprNoLP, dsLocalBinds,
dsSyntaxExpr )
import {-# SOURCE #-} GHC.HsToCore.Expr ( dsExpr, dsLExpr, dsLExprNoLP, dsLocalBinds,
dsSyntaxExpr )
import TcType
import Type ( splitPiTy )
......@@ -43,7 +43,7 @@ import CoreSyn
import CoreFVs
import CoreUtils
import MkCore
import DsBinds (dsHsWrapper)
import GHC.HsToCore.Binds (dsHsWrapper)
import Id
import ConLike
......
......@@ -17,20 +17,22 @@ lower levels it is preserved with @let@/@letrec@s).
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec,
dsHsWrapper, dsTcEvBinds, dsTcEvBinds_s, dsEvBinds, dsMkUserRule
) where
module GHC.HsToCore.Binds
( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec
, dsHsWrapper, dsTcEvBinds, dsTcEvBinds_s, dsEvBinds, dsMkUserRule
)
where
#include "HsVersions.h"
import GhcPrelude
import {-# SOURCE #-} DsExpr( dsLExpr )
import {-# SOURCE #-} Match( matchWrapper )
import {-# SOURCE #-} GHC.HsToCore.Expr ( dsLExpr )
import {-# SOURCE #-} GHC.HsToCore.Match ( matchWrapper )
import DsMonad
import DsGRHSs
import DsUtils
import GHC.HsToCore.Monad
import GHC.HsToCore.GuardedRHSs
import GHC.HsToCore.Utils
import GHC.HsToCore.PmCheck ( needToRunPmCheck, addTyCsDs, checkGuardMatches )
import GHC.Hs -- lots of things
......@@ -565,7 +567,7 @@ if there is no variable in the pattern desugaring looks like
in x `seq` body
In order to force the Ids in the binding group they are passed around
in the dsHsBind family of functions, and later seq'ed in DsExpr.ds_val_bind.
in the dsHsBind family of functions, and later seq'ed in GHC.HsToCore.Expr.ds_val_bind.
Consider a recursive group like this
......@@ -632,11 +634,11 @@ The restrictions are:
2. Unlifted binds must also be banged. (There is no trouble to compile an unbanged
unlifted bind, but an unbanged bind looks lazy, and we don't want users to be
surprised by the strictness of an unlifted bind.) Checked in first clause
of DsExpr.ds_val_bind.
of GHC.HsToCore.Expr.ds_val_bind.
3. Unlifted binds may not have polymorphism (#6078). (That is, no quantified type
variables or constraints.) Checked in first clause
of DsExpr.ds_val_bind.
of GHC.HsToCore.Expr.ds_val_bind.
4. Unlifted binds may not be recursive. Checked in second clause of ds_val_bind.
......
module DsBinds where
import DsMonad ( DsM )
import CoreSyn ( CoreExpr )
module GHC.HsToCore.Binds where
import GHC.HsToCore.Monad ( DsM )
import CoreSyn ( CoreExpr )
import TcEvidence (HsWrapper)
dsHsWrapper :: HsWrapper -> DsM (CoreExpr -> CoreExpr)
......@@ -10,14 +10,14 @@
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module Coverage (addTicksToBinds, hpcInitCode) where
module GHC.HsToCore.Coverage (addTicksToBinds, hpcInitCode) where
import GhcPrelude as Prelude
import qualified GHCi
import qualified GHC.Runtime.Interpreter as GHCi
import GHCi.RemoteTypes
import Data.Array
import ByteCodeTypes
import GHC.ByteCode.Types
import GHC.Stack.CCS
import Type
import GHC.Hs
......
......@@ -6,7 +6,7 @@
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module ExtractDocs (extractDocs) where
module GHC.HsToCore.Docs (extractDocs) where
import GhcPrelude
import Bag
......
module DsExpr where
import GHC.Hs ( HsExpr, LHsExpr, LHsLocalBinds, LPat, SyntaxExpr )
import DsMonad ( DsM, MatchResult )
import CoreSyn ( CoreExpr )
import GHC.Hs.Extension ( GhcTc)
module GHC.HsToCore.Expr where
import GHC.Hs ( HsExpr, LHsExpr, LHsLocalBinds, LPat, SyntaxExpr )
import GHC.HsToCore.Monad ( DsM, MatchResult )
import CoreSyn ( CoreExpr )
import GHC.Hs.Extension ( GhcTc)
dsExpr :: HsExpr GhcTc -> DsM CoreExpr
dsLExpr, dsLExprNoLP :: LHsExpr GhcTc -> DsM CoreExpr
......
......@@ -9,13 +9,15 @@ Desugaring foreign calls
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module DsCCall
( dsCCall
, mkFCall
, unboxArg
, boxResult
, resultWrapper
) where
module GHC.HsToCore.Foreign.Call
( dsCCall
, mkFCall
, unboxArg
, boxResult
, resultWrapper
)
where
#include "HsVersions.h"
......@@ -24,13 +26,13 @@ import GhcPrelude
import CoreSyn
import DsMonad
import GHC.HsToCore.Monad
import CoreUtils
import MkCore
import MkId
import ForeignCall
import DataCon
import DsUtils
import GHC.HsToCore.Utils
import TcType
import Type
......
......@@ -3,7 +3,7 @@
(c) The AQUA Project, Glasgow University, 1998
Desugaring foreign declarations (see also DsCCall).
Desugaring foreign declarations (see also GHC.HsToCore.Foreign.Call).
-}
{-# LANGUAGE CPP #-}
......@@ -13,7 +13,7 @@ Desugaring foreign declarations (see also DsCCall).
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module DsForeign ( dsForeigns ) where
module GHC.HsToCore.Foreign.Decl ( dsForeigns ) where
#include "HsVersions.h"
import GhcPrelude
......@@ -22,8 +22,8 @@ import TcRnMonad -- temp
import CoreSyn
import DsCCall
import DsMonad
import GHC.HsToCore.Foreign.Call
import GHC.HsToCore.Monad
import GHC.Hs
import DataCon
......@@ -72,7 +72,7 @@ is the same as
f :: prim_args -> IO prim_res
f a1 ... an = _ccall_ nm cc a1 ... an
\end{verbatim}
so we reuse the desugaring code in @DsCCall@ to deal with these.