Skip to content

GitLab

Commit 82f81d12 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files
Options

Merge branch 'master' of http://darcs.haskell.org/ghc

parents deec5b74 12f3a53e
Hide whitespace changes
Inline Side-by-side
Showing with 361 additions and 190 deletions
compiler/main/DriverPhases.hs
View file @ 82f81d12
......@@ -35,6 +35,7 @@ module DriverPhases (
#include "HsVersions.h"
import {-# SOURCE #-} DynFlags
import Outputable
import Platform
import System.FilePath
......@@ -131,33 +132,39 @@ eqPhase _ _ = False
-- Partial ordering on phases: we want to know which phases will occur before
-- which others. This is used for sanity checking, to ensure that the
-- pipeline will stop at some point (see DriverPipeline.runPipeline).
happensBefore :: Phase -> Phase -> Bool
StopLn `happensBefore` _ = False
x `happensBefore` y = after_x `eqPhase` y || after_x `happensBefore` y
where
after_x = nextPhase x
happensBefore :: DynFlags -> Phase -> Phase -> Bool
happensBefore dflags p1 p2 = p1 `happensBefore'` p2
where StopLn `happensBefore'` _ = False
x `happensBefore'` y = after_x `eqPhase` y
|| after_x `happensBefore'` y
where after_x = nextPhase dflags x
nextPhase :: Phase -> Phase
-- A conservative approximation to the next phase, used in happensBefore
nextPhase (Unlit sf) = Cpp sf
nextPhase (Cpp sf) = HsPp sf
nextPhase (HsPp sf) = Hsc sf
nextPhase (Hsc _) = HCc
nextPhase Splitter = SplitAs
nextPhase LlvmOpt = LlvmLlc
nextPhase LlvmLlc = LlvmMangle
nextPhase LlvmMangle = As
nextPhase SplitAs = MergeStub
nextPhase As = MergeStub
nextPhase Ccpp = As
nextPhase Cc = As
nextPhase Cobjc = As
nextPhase Cobjcpp = As
nextPhase CmmCpp = Cmm
nextPhase Cmm = HCc
nextPhase HCc = As
nextPhase MergeStub = StopLn
nextPhase StopLn = panic "nextPhase: nothing after StopLn"
nextPhase :: DynFlags -> Phase -> Phase
nextPhase dflags p
-- A conservative approximation to the next phase, used in happensBefore
= case p of
Unlit sf -> Cpp sf
Cpp sf -> HsPp sf
HsPp sf -> Hsc sf
Hsc _ -> maybeHCc
Splitter -> SplitAs
LlvmOpt -> LlvmLlc
LlvmLlc -> LlvmMangle
LlvmMangle -> As
SplitAs -> MergeStub
As -> MergeStub
Ccpp -> As
Cc -> As
Cobjc -> As
Cobjcpp -> As
CmmCpp -> Cmm
Cmm -> maybeHCc
HCc -> As
MergeStub -> StopLn
StopLn -> panic "nextPhase: nothing after StopLn"
where maybeHCc = if platformUnregisterised (targetPlatform dflags)
then HCc
else As
-- the first compilation phase for a given file is determined
-- by its suffix.
......
compiler/main/DriverPipeline.hs
View file @ 82f81d12
......@@ -503,70 +503,96 @@ runPipeline
-> IO (DynFlags, FilePath) -- ^ (final flags, output filename)
runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
mb_basename output maybe_loc maybe_stub_o
= do r <- runPipeline' stop_phase hsc_env0 (input_fn, mb_phase)
mb_basename output maybe_loc maybe_stub_o
let dflags = extractDynFlags hsc_env0
whenCannotGenerateDynamicToo dflags $ do
= do let
dflags0 = hsc_dflags hsc_env0
-- Decide where dump files should go based on the pipeline output
dflags = dflags0 { dumpPrefix = Just (basename ++ ".") }
hsc_env = hsc_env0 {hsc_dflags = dflags}
(input_basename, suffix) = splitExtension input_fn
suffix' = drop 1 suffix -- strip off the .
basename | Just b <- mb_basename = b
| otherwise = input_basename
-- If we were given a -x flag, then use that phase to start from
start_phase = fromMaybe (startPhase suffix') mb_phase
isHaskell (Unlit _) = True
isHaskell (Cpp _) = True
isHaskell (HsPp _) = True
isHaskell (Hsc _) = True
isHaskell _ = False
isHaskellishFile = isHaskell start_phase
env = PipeEnv{ pe_isHaskellishFile = isHaskellishFile,
stop_phase,
src_basename = basename,
src_suffix = suffix',
output_spec = output }
-- We want to catch cases of "you can't get there from here" before
-- we start the pipeline, because otherwise it will just run off the
-- end.
--
-- There is a partial ordering on phases, where A < B iff A occurs
-- before B in a normal compilation pipeline.
let happensBefore' = happensBefore dflags
when (not (start_phase `happensBefore'` stop_phase)) $
throwGhcException (UsageError
("cannot compile this file to desired target: "
++ input_fn))
debugTraceMsg dflags 4 (text "Running the pipeline")
r <- runPipeline' start_phase stop_phase hsc_env env input_fn
output maybe_loc maybe_stub_o
-- If we are compiling a Haskell module, and doing
-- -dynamic-too, but couldn't do the -dynamic-too fast
-- path, then rerun the pipeline for the dyn way
let dflags = extractDynFlags hsc_env
when isHaskellishFile $ whenCannotGenerateDynamicToo dflags $ do
debugTraceMsg dflags 4
(text "Running the pipeline again for -dynamic-too")
let dflags' = doDynamicToo dflags
hsc_env1 <- newHscEnv dflags'
_ <- runPipeline' stop_phase hsc_env1 (input_fn, mb_phase)
mb_basename output maybe_loc maybe_stub_o
-- TODO: This should use -dyno
output' = case output of
SpecificFile fn -> SpecificFile (replaceExtension fn (objectSuf dflags'))
Persistent -> Persistent
Temporary -> Temporary
hsc_env' <- newHscEnv dflags'
_ <- runPipeline' start_phase stop_phase hsc_env' env input_fn
output' maybe_loc maybe_stub_o
return ()
return r
runPipeline'
:: Phase -- ^ When to stop
:: Phase -- ^ When to start
-> Phase -- ^ When to stop
-> HscEnv -- ^ Compilation environment
-> (FilePath,Maybe Phase) -- ^ Input filename (and maybe -x suffix)
-> Maybe FilePath -- ^ original basename (if different from ^^^)
-> PipeEnv
-> FilePath -- ^ Input filename
-> PipelineOutput -- ^ Output filename
-> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module
-> Maybe FilePath -- ^ stub object, if we have one
-> IO (DynFlags, FilePath) -- ^ (final flags, output filename)
runPipeline' stop_phase hsc_env0 (input_fn, mb_phase)
mb_basename output maybe_loc maybe_stub_o
-> IO (DynFlags, FilePath) -- ^ (final flags, output filename)
runPipeline' start_phase stop_phase hsc_env env input_fn
output maybe_loc maybe_stub_o
= do
let dflags0 = hsc_dflags hsc_env0
(input_basename, suffix) = splitExtension input_fn
suffix' = drop 1 suffix -- strip off the .
basename | Just b <- mb_basename = b
| otherwise = input_basename
-- Decide where dump files should go based on the pipeline output
dflags = dflags0 { dumpPrefix = Just (basename ++ ".") }
hsc_env = hsc_env0 {hsc_dflags = dflags}
-- If we were given a -x flag, then use that phase to start from
start_phase = fromMaybe (startPhase suffix') mb_phase
-- We want to catch cases of "you can't get there from here" before
-- we start the pipeline, because otherwise it will just run off the
-- end.
--
-- There is a partial ordering on phases, where A < B iff A occurs
-- before B in a normal compilation pipeline.
when (not (start_phase `happensBefore` stop_phase)) $
throwGhcException (UsageError
("cannot compile this file to desired target: "
++ input_fn))
-- this is a function which will be used to calculate output file names
-- as we go along (we partially apply it to some of its inputs here)
let get_output_fn = getOutputFilename stop_phase output basename
let get_output_fn = getOutputFilename stop_phase output (src_basename env)
-- Execute the pipeline...
let env = PipeEnv{ stop_phase,
src_basename = basename,
src_suffix = suffix',
output_spec = output }
state = PipeState{ hsc_env, maybe_loc, maybe_stub_o = maybe_stub_o }
let state = PipeState{ hsc_env, maybe_loc, maybe_stub_o = maybe_stub_o }
(state', output_fn) <- unP (pipeLoop start_phase input_fn) env state
let PipeState{ hsc_env=hsc_env', maybe_loc } = state'
dflags' = hsc_dflags hsc_env'
dflags = hsc_dflags hsc_env'
-- Sometimes, a compilation phase doesn't actually generate any output
-- (eg. the CPP phase when -fcpp is not turned on). If we end on this
......@@ -575,20 +601,21 @@ runPipeline' stop_phase hsc_env0 (input_fn, mb_phase)
-- further compilation stages can tell what the original filename was.
case output of
Temporary ->
return (dflags', output_fn)
_other ->
do final_fn <- get_output_fn dflags' stop_phase maybe_loc
return (dflags, output_fn)
_ ->
do final_fn <- get_output_fn dflags stop_phase maybe_loc
when (final_fn /= output_fn) $ do
let msg = ("Copying `" ++ output_fn ++"' to `" ++ final_fn ++ "'")
line_prag = Just ("{-# LINE 1 \"" ++ input_fn ++ "\" #-}\n")
copyWithHeader dflags msg line_prag output_fn final_fn
return (dflags', final_fn)
return (dflags, final_fn)
-- -----------------------------------------------------------------------------
-- The pipeline uses a monad to carry around various bits of information
-- PipeEnv: invariant information passed down
data PipeEnv = PipeEnv {
pe_isHaskellishFile :: Bool,
stop_phase :: Phase, -- ^ Stop just before this phase
src_basename :: String, -- ^ basename of original input source
src_suffix :: String, -- ^ its extension
......@@ -656,12 +683,13 @@ phaseOutputFilename next_phase = do
pipeLoop :: Phase -> FilePath -> CompPipeline FilePath
pipeLoop phase input_fn = do
PipeEnv{stop_phase} <- getPipeEnv
PipeState{hsc_env} <- getPipeState
dflags <- getDynFlags
let happensBefore' = happensBefore dflags
case () of
_ | phase `eqPhase` stop_phase -- All done
-> return input_fn
| not (phase `happensBefore` stop_phase)
| not (phase `happensBefore'` stop_phase)
-- Something has gone wrong. We'll try to cover all the cases when
-- this could happen, so if we reach here it is a panic.
-- eg. it might happen if the -C flag is used on a source file that
......@@ -670,9 +698,8 @@ pipeLoop phase input_fn = do
" but I wanted to stop at phase " ++ show stop_phase)
| otherwise
-> do liftIO $ debugTraceMsg (hsc_dflags hsc_env) 4
-> do liftIO $ debugTraceMsg dflags 4
(ptext (sLit "Running phase") <+> ppr phase)
dflags <- getDynFlags
(next_phase, output_fn) <- runPhase phase input_fn dflags
pipeLoop next_phase output_fn
......@@ -1457,6 +1484,12 @@ runPhase MergeStub input_fn dflags
panic "runPhase(MergeStub): no stub"
Just stub_o -> do
liftIO $ joinObjectFiles dflags [input_fn, stub_o] output_fn
whenGeneratingDynamicToo dflags $ do
liftIO $ debugTraceMsg dflags 4
(text "Merging stub again for -dynamic-too")
let dyn_input_fn = replaceExtension input_fn (dynObjectSuf dflags)
dyn_output_fn = replaceExtension output_fn (dynObjectSuf dflags)
liftIO $ joinObjectFiles dflags [dyn_input_fn, stub_o] dyn_output_fn
return (StopLn, output_fn)
-- warning suppression
......@@ -1956,12 +1989,20 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do
-- remember, in code we *compile*, the HOST is the same our TARGET,
-- and BUILD is the same as our HOST.
let sse2 = isSse2Enabled dflags
sse4_2 = isSse4_2Enabled dflags
sse_defs =
[ "-D__SSE__=1" | sse2 || sse4_2 ] ++
[ "-D__SSE2__=1" | sse2 || sse4_2 ] ++
[ "-D__SSE4_2__=1" | sse4_2 ]
cpp_prog ( map SysTools.Option verbFlags
++ map SysTools.Option include_paths
++ map SysTools.Option hsSourceCppOpts
++ map SysTools.Option target_defs
++ map SysTools.Option hscpp_opts
++ map SysTools.Option cc_opts
++ map SysTools.Option sse_defs
++ [ SysTools.Option "-x"
, SysTools.Option "c"
, SysTools.Option input_fn
......
compiler/main/DynFlags.hs
View file @ 82f81d12
......@@ -118,6 +118,10 @@ module DynFlags (
tAG_MASK,
mAX_PTR_TAG,
tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD,
-- * SSE
isSse2Enabled,
isSse4_2Enabled,
) where
#include "HsVersions.h"
......@@ -590,6 +594,7 @@ data DynFlags = DynFlags {
dynHiSuf :: String,
outputFile :: Maybe String,
dynOutputFile :: Maybe String,
outputHi :: Maybe String,
dynLibLoader :: DynLibLoader,
......@@ -1144,6 +1149,7 @@ doDynamicToo :: DynFlags -> DynFlags
doDynamicToo dflags0 = let dflags1 = unSetGeneralFlag' Opt_Static dflags0
dflags2 = addWay' WayDyn dflags1
dflags3 = dflags2 {
outputFile = dynOutputFile dflags2,
hiSuf = dynHiSuf dflags2,
objectSuf = dynObjectSuf dflags2
}
......@@ -1222,6 +1228,7 @@ defaultDynFlags mySettings =
pluginModNameOpts = [],
outputFile = Nothing,
dynOutputFile = Nothing,
outputHi = Nothing,
dynLibLoader = SystemDependent,
dumpPrefix = Nothing,
......@@ -1594,7 +1601,7 @@ setObjectDir, setHiDir, setStubDir, setDumpDir, setOutputDir,
addCmdlineFramework, addHaddockOpts, addGhciScript,
setInteractivePrint
:: String -> DynFlags -> DynFlags
setOutputFile, setOutputHi, setDumpPrefixForce
setOutputFile, setDynOutputFile, setOutputHi, setDumpPrefixForce
:: Maybe String -> DynFlags -> DynFlags
setObjectDir f d = d{ objectDir = Just f}
......@@ -1614,6 +1621,7 @@ setDynHiSuf f d = d{ dynHiSuf = f}
setHcSuf f d = d{ hcSuf = f}
setOutputFile f d = d{ outputFile = f}
setDynOutputFile f d = d{ dynOutputFile = f}
setOutputHi f d = d{ outputHi = f}
addPluginModuleName :: String -> DynFlags -> DynFlags
......@@ -1796,11 +1804,31 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
throwGhcException (CmdLineError ("combination not supported: " ++
intercalate "/" (map wayDesc theWays)))
let (dflags4, consistency_warnings) = makeDynFlagsConsistent dflags3
-- TODO: This is an ugly hack. Do something better.
-- -fPIC affects the CMM code we generate, so if
-- we are in -dynamic-too mode we need -fPIC to be on during the
-- shared part of the compilation.
let doingDynamicToo = gopt Opt_BuildDynamicToo dflags3
platform = targetPlatform dflags3
dflags4 = if doingDynamicToo
then foldr setGeneralFlag' dflags3
(wayGeneralFlags platform WayDyn)
else dflags3
{-
TODO: This test doesn't quite work: We don't want to give an error
when e.g. compiling a C file, only when compiling Haskell files.
when doingDynamicToo $
unless (isJust (outputFile dflags4) == isJust (dynOutputFile dflags4)) $
throwGhcException $ CmdLineError
"With -dynamic-too, must give -dyno iff giving -o"
-}
let (dflags5, consistency_warnings) = makeDynFlagsConsistent dflags4
liftIO $ setUnsafeGlobalDynFlags dflags4
liftIO $ setUnsafeGlobalDynFlags dflags5
return (dflags4, leftover, consistency_warnings ++ sh_warns ++ warns)
return (dflags5, leftover, consistency_warnings ++ sh_warns ++ warns)
updateWays :: DynFlags -> DynFlags
updateWays dflags
......@@ -1992,6 +2020,7 @@ dynamic_flags = [
------- Output Redirection ------------------------------------------
, Flag "odir" (hasArg setObjectDir)
, Flag "o" (sepArg (setOutputFile . Just))
, Flag "dyno" (sepArg (setDynOutputFile . Just))
, Flag "ohi" (hasArg (setOutputHi . Just ))
, Flag "osuf" (hasArg setObjectSuf)
, Flag "dynosuf" (hasArg setDynObjectSuf)
......@@ -2153,6 +2182,11 @@ dynamic_flags = [
, Flag "monly-4-regs" (NoArg (addWarn "The -monly-4-regs flag does nothing; it will be removed in a future GHC release"))
, Flag "msse2" (NoArg (setGeneralFlag Opt_SSE2))
, Flag "msse4.2" (NoArg (setGeneralFlag Opt_SSE4_2))
-- at some point we should probably have a single SSE flag that
-- contains the SSE version, instead of having a different flag
-- per version. That would make it easier to e.g. check if SSE2 is
-- enabled as you wouldn't have to check if either Opt_SSE2 or
-- Opt_SSE4_2 is set (as the latter implies the former).
------ Warning opts -------------------------------------------------
, Flag "W" (NoArg (mapM_ setWarningFlag minusWOpts))
......@@ -3371,3 +3405,21 @@ makeDynFlagsConsistent dflags
arch = platformArch platform
os = platformOS platform
-- -----------------------------------------------------------------------------
-- SSE
isSse2Enabled :: DynFlags -> Bool
isSse2Enabled dflags = isSse4_2Enabled dflags || isSse2Enabled'
where
isSse2Enabled' = case platformArch (targetPlatform dflags) of
ArchX86_64 -> -- SSE2 is fixed on for x86_64. It would be
-- possible to make it optional, but we'd need to
-- fix at least the foreign call code where the
-- calling convention specifies the use of xmm regs,
-- and possibly other places.
True
ArchX86 -> gopt Opt_SSE2 dflags
_ -> False
isSse4_2Enabled :: DynFlags -> Bool
isSse4_2Enabled dflags = gopt Opt_SSE4_2 dflags
compiler/main/GhcMake.hs
View file @ 82f81d12
......@@ -709,9 +709,9 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
prevailing_target = hscTarget (hsc_dflags hsc_env)
local_target = hscTarget dflags
-- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
-- If OPTIONS_GHC contains -fasm or -fllvm, be careful that
-- we don't do anything dodgy: these should only work to change
-- from -fvia-C to -fasm and vice-versa, otherwise we could
-- from -fllvm to -fasm and vice-versa, otherwise we could
-- end up trying to link object code to byte code.
target = if prevailing_target /= local_target
&& (not (isObjectTarget prevailing_target)
......
compiler/main/HscMain.hs
View file @ 82f81d12
......@@ -1250,8 +1250,9 @@ hscWriteIface iface no_change mod_summary = do
-- TODO: We should do a no_change check for the dynamic
-- interface file too
let dynIfaceFile = replaceExtension ifaceFile (dynHiSuf dflags)
dynIfaceFile' = addBootSuffix_maybe (mi_boot iface) dynIfaceFile
dynDflags = doDynamicToo dflags
writeIfaceFile dynDflags dynIfaceFile iface
writeIfaceFile dynDflags dynIfaceFile' iface
-- | Compile to hard-code.
hscGenHardCode :: CgGuts -> ModSummary
......
compiler/nativeGen/SPARC/Base.hs
View file @ 82f81d12
-- | Bits and pieces on the bottom of the module dependency tree.
-- Also import the required constants, so we know what we're using.
--
-- In the interests of cross-compilation, we want to free ourselves
-- from the autoconf generated modules like main/Constants
-- Also import the required constants, so we know what we're using.
--
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
-- In the interests of cross-compilation, we want to free ourselves
-- from the autoconf generated modules like main/Constants
module SPARC.Base (
wordLength,
wordLengthInBits,
spillAreaLength,
spillSlotSize,
extraStackArgsHere,
fits13Bits,
is32BitInteger,
largeOffsetError
wordLength,
wordLengthInBits,
spillAreaLength,
spillSlotSize,
extraStackArgsHere,
fits13Bits,
is32BitInteger,
largeOffsetError
)
where
......@@ -36,13 +29,13 @@ wordLength :: Int
wordLength = 4
wordLengthInBits :: Int
wordLengthInBits
= wordLength * 8
wordLengthInBits
= wordLength * 8
-- Size of the available spill area
spillAreaLength :: DynFlags -> Int
spillAreaLength
= rESERVED_C_STACK_BYTES
= rESERVED_C_STACK_BYTES
-- | We need 8 bytes because our largest registers are 64 bit.
spillSlotSize :: Int
......@@ -50,7 +43,7 @@ spillSlotSize = 8
-- | We (allegedly) put the first six C-call arguments in registers;
-- where do we start putting the rest of them?
-- where do we start putting the rest of them?
extraStackArgsHere :: Int
extraStackArgsHere = 23
......@@ -61,22 +54,22 @@ fits13Bits :: Integral a => a -> Bool
fits13Bits x = x >= -4096 && x < 4096
-- | Check whether an integer will fit in 32 bits.
-- A CmmInt is intended to be truncated to the appropriate
-- number of bits, so here we truncate it to Int64. This is
-- important because e.g. -1 as a CmmInt might be either
-- -1 or 18446744073709551615.
-- A CmmInt is intended to be truncated to the appropriate
-- number of bits, so here we truncate it to Int64. This is
-- important because e.g. -1 as a CmmInt might be either
-- -1 or 18446744073709551615.
--
is32BitInteger :: Integer -> Bool
is32BitInteger i
= i64 <= 0x7fffffff && i64 >= -0x80000000
where i64 = fromIntegral i :: Int64
is32BitInteger i
= i64 <= 0x7fffffff && i64 >= -0x80000000
where i64 = fromIntegral i :: Int64
-- | Sadness.
largeOffsetError :: (Integral a, Show a) => a -> b
largeOffsetError i
= panic ("ERROR: SPARC native-code generator cannot handle large offset ("
++ show i ++ ");\nprobably because of large constant data structures;" ++
"\nworkaround: use -fvia-C on this module.\n")
++ show i ++ ");\nprobably because of large constant data structures;" ++
"\nworkaround: use -fllvm on this module.\n")
compiler/nativeGen/X86/CodeGen.hs
View file @ 82f81d12
......@@ -71,20 +71,12 @@ is32BitPlatform = do
sse2Enabled :: NatM Bool
sse2Enabled = do
dflags <- getDynFlags
case platformArch (targetPlatform dflags) of
ArchX86_64 -> -- SSE2 is fixed on for x86_64. It would be
-- possible to make it optional, but we'd need to
-- fix at least the foreign call code where the
-- calling convention specifies the use of xmm regs,
-- and possibly other places.
return True
ArchX86 -> return (gopt Opt_SSE2 dflags || gopt Opt_SSE4_2 dflags)
_ -> panic "sse2Enabled: Not an X86* arch"
return (isSse2Enabled dflags)
sse4_2Enabled :: NatM Bool
sse4_2Enabled = do
dflags <- getDynFlags
return (gopt Opt_SSE4_2 dflags)
return (isSse4_2Enabled dflags)
if_sse2 :: NatM a -> NatM a -> NatM a
if_sse2 sse2 x87 = do
......
compiler/prelude/PrelRules.lhs
View file @ 82f81d12
......@@ -142,28 +142,28 @@ primOpRules nm Int2WordOp = mkPrimOpRule nm 1 [ liftLitDynFlags int2WordLit
, inversePrimOp Word2IntOp ]
primOpRules nm Narrow8IntOp = mkPrimOpRule nm 1 [ liftLit narrow8IntLit
, subsumedByPrimOp Narrow8IntOp
, subsumedByPrimOp Narrow16IntOp
, subsumedByPrimOp Narrow32IntOp ]
, Narrow8IntOp `subsumesPrimOp` Narrow16IntOp
, Narrow8IntOp `subsumesPrimOp` Narrow32IntOp ]
primOpRules nm Narrow16IntOp = mkPrimOpRule nm 1 [ liftLit narrow16IntLit
, Narrow16IntOp `subsumesPrimOp` Narrow8IntOp
, subsumedByPrimOp Narrow8IntOp
, subsumedByPrimOp Narrow16IntOp
, subsumedByPrimOp Narrow32IntOp ]
, Narrow16IntOp `subsumesPrimOp` Narrow32IntOp ]
primOpRules nm Narrow32IntOp = mkPrimOpRule nm 1 [ liftLit narrow32IntLit
, Narrow32IntOp `subsumesPrimOp` Narrow8IntOp
, Narrow32IntOp `subsumesPrimOp` Narrow16IntOp
, subsumedByPrimOp Narrow8IntOp
, subsumedByPrimOp Narrow16IntOp
, subsumedByPrimOp Narrow32IntOp
, removeOp32 ]
primOpRules nm Narrow8WordOp = mkPrimOpRule nm 1 [ liftLit narrow8WordLit
, subsumedByPrimOp Narrow8WordOp
, subsumedByPrimOp Narrow16WordOp
, subsumedByPrimOp Narrow32WordOp ]
, Narrow8WordOp `subsumesPrimOp` Narrow16WordOp
, Narrow8WordOp `subsumesPrimOp` Narrow32WordOp ]
primOpRules nm Narrow16WordOp = mkPrimOpRule nm 1 [ liftLit narrow16WordLit
, Narrow16WordOp `subsumesPrimOp` Narrow8WordOp
, subsumedByPrimOp Narrow8WordOp
, subsumedByPrimOp Narrow16WordOp
, subsumedByPrimOp Narrow32WordOp ]
, Narrow16WordOp `subsumesPrimOp` Narrow32WordOp ]
primOpRules nm Narrow32WordOp = mkPrimOpRule nm 1 [ liftLit narrow32WordLit
, Narrow32WordOp `subsumesPrimOp` Narrow8WordOp
, Narrow32WordOp `subsumesPrimOp` Narrow16WordOp
, subsumedByPrimOp Narrow8WordOp