Commit 1dfaee31 authored by apt's avatar apt
Browse files

[project @ 2001-08-17 17:18:51 by apt]

How I spent my summer vacation.

Primops
-------

The format of the primops.txt.pp file has been enhanced to allow
(latex-style) primop descriptions to be included.  There is a new flag
to genprimopcode that generates documentation including these
descriptions. A first cut at descriptions of the more interesting
primops has been made, and the file has been reordered a bit.

31-bit words
------------

The front end now can cope with the possibility of 31-bit (or even 30-bit)
Int# and Word# types.  The only current use of this is to generate
external .core files that can be translated into OCAML source files
(OCAML uses a one-bit tag to distinguish integers from pointers).
The only way to get this right now is by hand-defining the preprocessor
symbol WORD_SIZE_IN_BITS, which is normally set automatically from
the familiar WORD_SIZE_IN_BYTES.

Just in case 31-bit words are used, we now have Int32# and Word32# primitive types
and an associated family of operators, paralleling the existing 64-bit
stuff.  Of course, none of the operators actually need to be implemented
in the absence of a 31-bit backend.
There has also been some minor re-jigging of the 32 vs. 64 bit stuff.
See the description at the top of primops.txt.pp file for more details.
Note that, for the first time, the *type* of a primop can now depend
on the target word size.

Also, the family of primops intToInt8#, intToInt16#, etc.
have been renamed narrow8Int#, narrow16Int#, etc., to emphasize
that they work on Int#'s and don't actually convert between types.

Addresses
---------

As another part of coping with the possibility of 31-bit ints,
the addr2Int# and int2Addr# primops are now thoroughly deprecated
(and not even defined in the 31-bit case) and all uses
of them have been removed except from the (deprecated) module
hslibs/lang/Addr

Addr# should now be treated as a proper abstract type, and has these suitable operators:

nullAddr# : Int# -> Addr# (ignores its argument; nullary primops cause problems at various places)
plusAddr# :  Addr# -> Int# -> Addr#
minusAddr : Addr# -> Addr# -> Int#
remAddr# : Addr# -> Int# -> Int#

Obviously, these don't allow completely arbitrary offsets if 31-bit ints are
in use, but they should do for all practical purposes.

It is also still possible to generate an address constant, and there is a built-in rule
that makes use of this to remove the nullAddr# calls.

Misc
----
There is a new compile flag -fno-code that causes GHC to quit after generating .hi files
and .core files (if requested) but before generating STG.

Z-encoded names for tuples have been rationalized; e.g.,
Z3H now means an unboxed 3-tuple, rather than an unboxed
tuple with 3 commas (i.e., a 4-tuple)!

Removed misc. litlits in hslibs/lang

Misc. small changes to external core format.  The external core description
has also been substantially updated, and incorporates the automatically-generated
primop documentation; its in the repository at /papers/ext-core/core.tex.

A little make-system addition to allow passing CPP options to compiler and
library builds.
parent d30f8fc1
# -----------------------------------------------------------------------------
# $Id: Makefile,v 1.189 2001/08/16 22:54:24 sof Exp $
# $Id: Makefile,v 1.190 2001/08/17 17:18:51 apt Exp $
TOP = ..
include $(TOP)/mk/boilerplate.mk
......@@ -324,7 +324,8 @@ PRIMOP_BITS=primop-data-decl.hs-incl \
primop-usage.hs-incl \
primop-primop-info.hs-incl
SRC_CPP_OPTS += -I$(GHC_INCLUDE_DIR)
SRC_CPP_OPTS += -I$(GHC_INCLUDE_DIR) -traditional
SRC_CPP_OPTS += ${GhcCppOpts}
ifneq "$(BootingFromHc)" "YES"
prelude/PrimOp.lhs prelude/PrimOp.o: $(PRIMOP_BITS)
......
......@@ -1305,6 +1305,8 @@ pprUnionTag CharRep = char 'c'
pprUnionTag Int8Rep = ptext SLIT("i8")
pprUnionTag IntRep = char 'i'
pprUnionTag WordRep = char 'w'
pprUnionTag Int32Rep = char 'i'
pprUnionTag Word32Rep = char 'w'
pprUnionTag AddrRep = char 'a'
pprUnionTag FloatRep = char 'f'
pprUnionTag DoubleRep = panic "pprUnionTag:Double?"
......
......@@ -15,11 +15,11 @@ module Literal
, inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
, word2IntLit, int2WordLit
, intToInt8Lit, intToInt16Lit, intToInt32Lit
, wordToWord8Lit, wordToWord16Lit, wordToWord32Lit
, narrow8IntLit, narrow16IntLit, narrow32IntLit
, narrow8WordLit, narrow16WordLit, narrow32WordLit
, char2IntLit, int2CharLit
, float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
, addr2IntLit, int2AddrLit, float2DoubleLit, double2FloatLit
, nullAddrLit, float2DoubleLit, double2FloatLit
) where
#include "HsVersions.h"
......@@ -100,9 +100,9 @@ data Literal
| MachAddr Integer -- Whatever this machine thinks is a "pointer"
| MachInt Integer -- Int# At least 32 bits
| MachInt Integer -- Int# At least WORD_SIZE_IN_BITS bits
| MachInt64 Integer -- Int64# At least 64 bits
| MachWord Integer -- Word# At least 32 bits
| MachWord Integer -- Word# At least WORD_SIZE_IN_BITS bits
| MachWord64 Integer -- Word64# At least 64 bits
| MachFloat Rational
......@@ -163,11 +163,11 @@ inCharRange c = c >= 0 && c <= tARGET_MAX_CHAR
~~~~~~~~~
\begin{code}
word2IntLit, int2WordLit,
intToInt8Lit, intToInt16Lit, intToInt32Lit,
wordToWord8Lit, wordToWord16Lit, wordToWord32Lit,
narrow8IntLit, narrow16IntLit, narrow32IntLit,
narrow8WordLit, narrow16WordLit, narrow32WordLit,
char2IntLit, int2CharLit,
float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
addr2IntLit, int2AddrLit, float2DoubleLit, double2FloatLit
float2DoubleLit, double2FloatLit
:: Literal -> Literal
word2IntLit (MachWord w)
......@@ -178,12 +178,12 @@ int2WordLit (MachInt i)
| i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD
| otherwise = MachWord i
intToInt8Lit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
intToInt16Lit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
intToInt32Lit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
wordToWord8Lit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
wordToWord16Lit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
wordToWord32Lit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
char2IntLit (MachChar c) = MachInt (toInteger c)
int2CharLit (MachInt i) = MachChar (fromInteger i)
......@@ -194,11 +194,11 @@ int2FloatLit (MachInt i) = MachFloat (fromInteger i)
double2IntLit (MachDouble f) = MachInt (truncate f)
int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
addr2IntLit (MachAddr a) = MachInt a
int2AddrLit (MachInt i) = MachAddr i
float2DoubleLit (MachFloat f) = MachDouble f
double2FloatLit (MachDouble d) = MachFloat d
nullAddrLit :: Literal
nullAddrLit = MachAddr 0
\end{code}
Predicates
......
......@@ -258,18 +258,19 @@ Here's our convention for splitting up the interface file name space:
$dm... default methods
$p... superclass selectors
$w... workers
$T... compiler-generated tycons for dictionaries
$D... ...ditto data cons
:T... compiler-generated tycons for dictionaries
:D... ...ditto data cons
$sf.. specialised version of f
in encoded form these appear as Zdfxxx etc
:... keywords (export:, letrec: etc.)
--- I THINK THIS IS WRONG!
This knowledge is encoded in the following functions.
@mk_deriv@ generates an @OccName@ from the one-char prefix and a string.
@mk_deriv@ generates an @OccName@ from the prefix and a string.
NB: The string must already be encoded!
\begin{code}
......@@ -426,13 +427,12 @@ The basic encoding scheme is this.
foo## foozhzh
foo##1 foozhzh1
fooZ fooZZ
:+ Zczp
() Z0T
(,,,,) Z4T 5-tuple
(#,,,,#) Z4H unboxed 5-tuple
(NB: the number is one different to the number of
elements. No real reason except that () is a zero-tuple,
while (,) is a 2-tuple.)
:+ ZCzp
() Z0T 0-tuple
(,,,,) Z5T 5-tuple
(# #) Z1H unboxed 1-tuple (note the space)
(#,,,,#) Z5H unboxed 5-tuple
(NB: There is no Z1T nor Z0H.)
\begin{code}
-- alreadyEncoded is used in ASSERTs to check for encoded
......@@ -459,11 +459,13 @@ encode cs = case maybe_tuple cs of
go [] = []
go (c:cs) = encode_ch c ++ go cs
maybe_tuple "(# #)" = Just("Z1H")
maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
(n, '#' : ')' : cs) -> Just ('Z' : shows n "H")
(n, '#' : ')' : cs) -> Just ('Z' : shows (n+1) "H")
other -> Nothing
maybe_tuple "()" = Just("Z0T")
maybe_tuple ('(' : cs) = case count_commas (0::Int) cs of
(n, ')' : cs) -> Just ('Z' : shows n "T")
(n, ')' : cs) -> Just ('Z' : shows (n+1) "T")
other -> Nothing
maybe_tuple other = Nothing
......@@ -565,8 +567,10 @@ decode_escape (c : rest)
| isDigit c = go (digitToInt c) rest
where
go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
go n ('T' : rest) = '(' : replicate n ',' ++ ')' : decode rest
go n ('H' : rest) = '(' : '#' : replicate n ',' ++ '#' : ')' : decode rest
go 0 ('T' : rest) = "()" ++ (decode rest)
go n ('T' : rest) = '(' : replicate (n-1) ',' ++ ')' : decode rest
go 1 ('H' : rest) = "(# #)" ++ (decode rest)
go n ('H' : rest) = '(' : '#' : replicate (n-1) ',' ++ '#' : ')' : decode rest
go n ('U' : rest) = chr n : decode rest
go n other = pprPanic "decode_escape" (ppr n <+> text (c:rest))
......@@ -576,7 +580,7 @@ decode_escape (c : rest) = pprTrace "decode_escape" (char c) (decode rest)
%************************************************************************
%* *
n\subsection{Lexical categories}
\subsection{Lexical categories}
%* *
%************************************************************************
......
%
% (c) The GRASP Project, Glasgow University, 1992-1998
%
% $Id: CgRetConv.lhs,v 1.29 2000/11/14 17:41:04 sewardj Exp $
% $Id: CgRetConv.lhs,v 1.30 2001/08/17 17:18:52 apt Exp $
%
\section[CgRetConv]{Return conventions for the code generator}
......@@ -77,6 +77,8 @@ dataReturnConvPrim :: PrimRep -> MagicId
dataReturnConvPrim IntRep = VanillaReg IntRep (_ILIT 1)
dataReturnConvPrim WordRep = VanillaReg WordRep (_ILIT 1)
dataReturnConvPrim Int32Rep = VanillaReg Int32Rep (_ILIT 1)
dataReturnConvPrim Word32Rep = VanillaReg Word32Rep (_ILIT 1)
dataReturnConvPrim Int64Rep = LongReg Int64Rep (_ILIT 1)
dataReturnConvPrim Word64Rep = LongReg Word64Rep (_ILIT 1)
dataReturnConvPrim AddrRep = VanillaReg AddrRep (_ILIT 1)
......
......@@ -34,7 +34,7 @@ data Exp
| Case Exp Vbind [Alt] {- non-empty list -}
| Coerce Ty Exp
| Note String Exp
| Ccall String Ty
| External String Ty
data Bind
= Vb Vbind
......
......@@ -128,8 +128,10 @@ make_exp :: CoreExpr -> C.Exp
make_exp (Var v) =
case globalIdDetails v of
DataConId _ -> C.Dcon (make_con_qid (Var.varName v))
FCallId (CCall (CCallSpec (StaticTarget nm) _ _)) -> C.Ccall (_UNPK_ nm) (make_ty (varType v))
FCallId (CCall (CCallSpec (StaticTarget nm) _ _)) -> C.External (_UNPK_ nm) (make_ty (varType v))
FCallId _ -> error "MkExternalCore died: can't handle non-static-C foreign call"
_ -> C.Var (make_var_qid (Var.varName v))
make_exp (Lit (l@(MachLabel s))) = C.External (_UNPK_ s) (make_ty (literalType l))
make_exp (Lit l) = C.Lit (make_lit l)
make_exp (App e (Type t)) = C.Appt (make_exp e) (make_ty t)
make_exp (App e1 e2) = C.App (make_exp e1) (make_exp e2)
......@@ -163,7 +165,6 @@ make_lit l =
MachWord64 i -> C.Lint i t
MachFloat r -> C.Lrational r t
MachDouble r -> C.Lrational r t
MachLabel s -> C.Lstring (_UNPK_ s) t
_ -> error "MkExternalCore died: make_lit"
where
t = make_ty (literalType l)
......@@ -188,18 +189,17 @@ make_kind _ = error "MkExternalCore died: make_kind"
{- Id generation. -}
{- Use encoded strings, except restore '#'s.
{- Use encoded strings.
Also, adjust casing to work around some badly-chosen internal names. -}
make_id :: Bool -> Name -> C.Id
make_id is_var nm =
case n of
c:cs -> if isUpper c && is_var then (toLower c):(decode cs)
else if isLower c && (not is_var) then (toUpper c):(decode cs)
else decode n
'Z':cs | is_var -> 'z':cs
'z':cs | not is_var -> 'Z':cs
c:cs | isUpper c && is_var -> 'z':'d':n
c:cs | isLower c && (not is_var) -> 'Z':'d':n
_ -> n
where n = (occNameString . nameOccName) nm
decode ('z':'h':cs) = '#':(decode cs)
decode (c:cs) = c:(decode cs)
decode [] = []
make_var_id :: Name -> C.Id
make_var_id = make_id True
......
......@@ -135,7 +135,7 @@ pexp (Case e vb alts) = sep [text "%case" <+> paexp e,
$$ (indent (braces (vcat (punctuate (char ';') (map palt alts)))))
pexp (Coerce t e) = (text "%coerce" <+> paty t) $$ pexp e
pexp (Note s e) = (text "%note" <+> pstring s) $$ pexp e
pexp (Ccall n t) = (text "%ccall" <+> pstring n) $$ paty t
pexp (External n t) = (text "%external" <+> pstring n) $$ paty t
pexp e = pfexp e
......
......@@ -331,6 +331,7 @@ data HscLang
| HscJava
| HscILX
| HscInterpreted
| HscNothing
deriving (Eq, Show)
defaultDynFlags = DynFlags {
......
{-# OPTIONS -#include "hschooks.h" #-}
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.65 2001/08/15 09:32:40 rrt Exp $
-- $Id: DriverFlags.hs,v 1.66 2001/08/17 17:18:52 apt Exp $
--
-- Driver flags
--
......@@ -387,6 +387,7 @@ dynamic_flags = [
, ( "fvia-c", NoArg (setLang HscC) )
, ( "fvia-C", NoArg (setLang HscC) )
, ( "filx", NoArg (setLang HscILX) )
, ( "fno-code", NoArg (setLang HscNothing) )
-- "active negatives"
, ( "fno-implicit-prelude", NoArg (setDynFlag Opt_NoImplicitPrelude) )
......
......@@ -177,6 +177,7 @@ genPipeline todo stop_flag persistent_output lang (filename,suffix)
HscILX | split -> not_valid
| otherwise -> [ Unlit, Cpp, Hsc, Ilx2Il, Ilasm ]
#endif
HscNothing -> [ Unlit, Cpp, Hsc ]
| cish = [ Cc, As ]
......@@ -535,13 +536,14 @@ run_phase Hsc basename suff input_fn output_fn
HscRecomp pcs details iface stub_h_exists stub_c_exists
_maybe_interpreted_code -> do
-- deal with stubs
maybe_stub_o <- compileStub dyn_flags' stub_c_exists
case maybe_stub_o of
Nothing -> return ()
Just stub_o -> add v_Ld_inputs stub_o
return (Just output_fn)
-- deal with stubs
maybe_stub_o <- compileStub dyn_flags' stub_c_exists
case maybe_stub_o of
Nothing -> return ()
Just stub_o -> add v_Ld_inputs stub_o
case hscLang dyn_flags of
HscNothing -> return Nothing
_ -> return (Just output_fn)
}
-----------------------------------------------------------------------------
......@@ -1034,6 +1036,7 @@ compile ghci_mode summary source_unchanged have_object
HscILX -> return (phaseInputExt Ilx2Il)
#endif
HscInterpreted -> return (error "no output file")
HscNothing -> return (error "no output file")
let dyn_flags' = dyn_flags { hscOutName = output_fn,
hscStubCOutName = basename ++ "_stub.c",
......
......@@ -202,6 +202,7 @@ hscRecomp ghci_mode dflags have_object
= do {
-- what target are we shooting for?
; let toInterp = dopt_HscLang dflags == HscInterpreted
; let toNothing = dopt_HscLang dflags == HscNothing
; when (verbosity dflags >= 1) $
hPutStrLn stderr ("Compiling " ++
......@@ -359,19 +360,23 @@ hscRecomp ghci_mode dflags have_object
mkFinalIface ghci_mode dflags location
maybe_checked_iface new_iface tidy_details
------------------ Code generation ------------------
abstractC <- _scc_ "CodeGen"
codeGen dflags this_mod imported_modules
cost_centre_info fe_binders
local_tycons stg_binds
------------------ Code output -----------------------
(stub_h_exists, stub_c_exists)
<- codeOutput dflags this_mod local_tycons
binds stg_binds
c_code h_code abstractC
return (stub_h_exists, stub_c_exists, Nothing, final_iface)
if toNothing
then do
return (False, False, Nothing, final_iface)
else do
------------------ Code generation ------------------
abstractC <- _scc_ "CodeGen"
codeGen dflags this_mod imported_modules
cost_centre_info fe_binders
local_tycons stg_binds
------------------ Code output -----------------------
(stub_h_exists, stub_c_exists)
<- codeOutput dflags this_mod local_tycons
binds stg_binds
c_code h_code abstractC
return (stub_h_exists, stub_c_exists, Nothing, final_iface)
; let final_details = tidy_details {md_binds = []}
......
......@@ -457,7 +457,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
AddrNeOp -> int_NE_code x y
AddrLtOp -> trivialCode (CMP ULT) x y
AddrLeOp -> trivialCode (CMP ULE) x y
FloatGtOp -> cmpF_code (FCMP TF LE) EQQ x y
FloatGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
FloatEqOp -> cmpF_code (FCMP TF EQQ) NE x y
......@@ -494,6 +494,10 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
DoubleMulOp -> trivialFCode DoubleRep (FMUL TF) x y
DoubleDivOp -> trivialFCode DoubleRep (FDIV TF) x y
AddrAddOp -> trivialCode (ADD Q False) x y
AddrSubOp -> trivialCode (SUB Q False) x y
AddrRemOp -> trivialCode (REM Q True) x y
AndOp -> trivialCode AND x y
OrOp -> trivialCode OR x y
XorOp -> trivialCode XOR x y
......@@ -765,6 +769,10 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
DoubleMulOp -> trivialFCode DoubleRep GMUL x y
DoubleDivOp -> trivialFCode DoubleRep GDIV x y
AddrAddOp -> add_code L x y
AddrSubOp -> sub_code L x y
AddrRemOp -> trivialCode (IREM L) Nothing x y
AndOp -> let op = AND L in trivialCode op (Just op) x y
OrOp -> let op = OR L in trivialCode op (Just op) x y
XorOp -> let op = XOR L in trivialCode op (Just op) x y
......@@ -1132,6 +1140,10 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
DoubleMulOp -> trivialFCode DoubleRep FMUL x y
DoubleDivOp -> trivialFCode DoubleRep FDIV x y
AddrAddOp -> trivialCode (ADD False False) x y
AddrSubOp -> trivialCode (SUB False False) x y
AddrRemOp -> imul_div SLIT(".rem") x y
AndOp -> trivialCode (AND False) x y
OrOp -> trivialCode (OR False) x y
XorOp -> trivialCode (XOR False) x y
......
......@@ -7,6 +7,7 @@ module StixPrim ( primCode, amodeToStix, amodeToStix', foreignCallCode )
where
#include "HsVersions.h"
#include "MachDeps.h"
import MachMisc
import Stix
......@@ -140,33 +141,41 @@ primCode [res] Integer2IntOp arg@[sa,da]
primCode [res] Integer2WordOp arg@[sa,da]
= gmpInteger2Word res (sa,da)
primCode [res] Int2AddrOp [arg]
= simpleCoercion AddrRep res arg
primCode [res] Addr2IntOp [arg]
= simpleCoercion IntRep res arg
primCode [res] Int2WordOp [arg]
= simpleCoercion IntRep{-WordRep?-} res arg
primCode [res] Word2IntOp [arg]
= simpleCoercion IntRep res arg
primCode [res] AddrNullOp [arg]
= let
assign = StAssign AddrRep (amodeToStix res) (StInt 0)
in
returnUs (\xs -> assign : xs)
primCode [res] AddrToHValueOp [arg]
= simpleCoercion PtrRep res arg
primCode [res] IntToInt8Op [arg]
#if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64)
primCode [res] Int2AddrOp [arg]
= simpleCoercion AddrRep res arg
primCode [res] Addr2IntOp [arg]
= simpleCoercion IntRep res arg
#endif
primCode [res] Narrow8IntOp [arg]
= narrowingCoercion IntRep Int8Rep res arg
primCode [res] IntToInt16Op [arg]
primCode [res] Narrow16IntOp [arg]
= narrowingCoercion IntRep Int16Rep res arg
primCode [res] IntToInt32Op [arg]
primCode [res] Narrow32IntOp [arg]
= narrowingCoercion IntRep Int32Rep res arg
primCode [res] WordToWord8Op [arg]
primCode [res] Narrow8WordOp [arg]
= narrowingCoercion WordRep Word8Rep res arg
primCode [res] WordToWord16Op [arg]
primCode [res] Narrow16WordOp [arg]
= narrowingCoercion WordRep Word16Rep res arg
primCode [res] WordToWord32Op [arg]
primCode [res] Narrow32WordOp [arg]
= narrowingCoercion WordRep Word32Rep res arg
\end{code}
......
......@@ -318,8 +318,10 @@ typeConName = kindQual SLIT("Type") typeConKey
funTyConName = tcQual pREL_GHC_Name SLIT("(->)") funTyConKey
charPrimTyConName = tcQual pREL_GHC_Name SLIT("Char#") charPrimTyConKey
intPrimTyConName = tcQual pREL_GHC_Name SLIT("Int#") intPrimTyConKey
int32PrimTyConName = tcQual pREL_GHC_Name SLIT("Int32#") int32PrimTyConKey
int64PrimTyConName = tcQual pREL_GHC_Name SLIT("Int64#") int64PrimTyConKey
wordPrimTyConName = tcQual pREL_GHC_Name SLIT("Word#") wordPrimTyConKey
word32PrimTyConName = tcQual pREL_GHC_Name SLIT("Word32#") word32PrimTyConKey
word64PrimTyConName = tcQual pREL_GHC_Name SLIT("Word64#") word64PrimTyConKey
addrPrimTyConName = tcQual pREL_GHC_Name SLIT("Addr#") addrPrimTyConKey
floatPrimTyConName = tcQual pREL_GHC_Name SLIT("Float#") floatPrimTyConKey
......@@ -696,58 +698,60 @@ intPrimTyConKey = mkPreludeTyConUnique 14
intTyConKey = mkPreludeTyConUnique 15
int8TyConKey = mkPreludeTyConUnique 16
int16TyConKey = mkPreludeTyConUnique 17
int32TyConKey = mkPreludeTyConUnique 18
int64PrimTyConKey = mkPreludeTyConUnique 19
int64TyConKey = mkPreludeTyConUnique 20
integerTyConKey = mkPreludeTyConUnique 21
listTyConKey = mkPreludeTyConUnique 22
foreignObjPrimTyConKey = mkPreludeTyConUnique 23
foreignObjTyConKey = mkPreludeTyConUnique 24
foreignPtrTyConKey = mkPreludeTyConUnique 25
weakPrimTyConKey = mkPreludeTyConUnique 26
mutableArrayPrimTyConKey = mkPreludeTyConUnique 27
mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 28
orderingTyConKey = mkPreludeTyConUnique 29
mVarPrimTyConKey = mkPreludeTyConUnique 30
ratioTyConKey = mkPreludeTyConUnique 31
rationalTyConKey = mkPreludeTyConUnique 32
realWorldTyConKey = mkPreludeTyConUnique 33
stablePtrPrimTyConKey = mkPreludeTyConUnique 34
stablePtrTyConKey = mkPreludeTyConUnique 35
statePrimTyConKey = mkPreludeTyConUnique 36
stableNamePrimTyConKey = mkPreludeTyConUnique 50
stableNameTyConKey = mkPreludeTyConUnique 51
mutableByteArrayTyConKey = mkPreludeTyConUnique 52
mutVarPrimTyConKey = mkPreludeTyConUnique 53
ioTyConKey = mkPreludeTyConUnique 55
byteArrayTyConKey = mkPreludeTyConUnique 56
wordPrimTyConKey = mkPreludeTyConUnique 57
wordTyConKey = mkPreludeTyConUnique 58
word8TyConKey = mkPreludeTyConUnique 59
word16TyConKey = mkPreludeTyConUnique 60
word32TyConKey = mkPreludeTyConUnique 61
word64PrimTyConKey = mkPreludeTyConUnique 62
word64TyConKey = mkPreludeTyConUnique 63
liftedConKey = mkPreludeTyConUnique 64
unliftedConKey = mkPreludeTyConUnique 65
anyBoxConKey = mkPreludeTyConUnique 66
kindConKey = mkPreludeTyConUnique 67
boxityConKey = mkPreludeTyConUnique 68
typeConKey = mkPreludeTyConUnique 69
threadIdPrimTyConKey = mkPreludeTyConUnique 70
bcoPrimTyConKey = mkPreludeTyConUnique 71
ptrTyConKey = mkPreludeTyConUnique 72
funPtrTyConKey = mkPreludeTyConUnique 73
int32PrimTyConKey = mkPreludeTyConUnique 18
int32TyConKey = mkPreludeTyConUnique 19
int64PrimTyConKey = mkPreludeTyConUnique 20
int64TyConKey = mkPreludeTyConUnique 21
integerTyConKey = mkPreludeTyConUnique 22
listTyConKey = mkPreludeTyConUnique 23
foreignObjPrimTyConKey = mkPreludeTyConUnique 24
foreignObjTyConKey = mkPreludeTyConUnique 25
foreignPtrTyConKey = mkPreludeTyConUnique 26
weakPrimTyConKey = mkPreludeTyConUnique 27
mutableArrayPrimTyConKey = mkPreludeTyConUnique 28
mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 29
orderingTyConKey = mkPreludeTyConUnique 30
mVarPrimTyConKey = mkPreludeTyConUnique 31
ratioTyConKey = mkPreludeTyConUnique 32
rationalTyConKey = mkPreludeTyConUnique 33
realWorldTyConKey = mkPreludeTyConUnique 34
stablePtrPrimTyConKey = mkPreludeTyConUnique 35
stablePtrTyConKey = mkPreludeTyConUnique 36
statePrimTyConKey = mkPreludeTyConUnique 50
stableNamePrimTyConKey = mkPreludeTyConUnique 51
stableNameTyConKey = mkPreludeTyConUnique 52
mutableByteArrayTyConKey = mkPreludeTyConUnique 53
mutVarPrimTyConKey = mkPreludeTyConUnique 55
ioTyConKey = mkPreludeTyConUnique 56
byteArrayTyConKey = mkPreludeTyConUnique 57
wordPrimTyConKey = mkPreludeTyConUnique 58
wordTyConKey = mkPreludeTyConUnique 59
word8TyConKey = mkPreludeTyConUnique 60
word16TyConKey = mkPreludeTyConUnique 61
word32PrimTyConKey = mkPreludeTyConUnique 62
word32TyConKey = mkPreludeTyConUnique 63
word64PrimTyConKey = mkPreludeTyConUnique 64
word64TyConKey = mkPreludeTyConUnique 65
liftedConKey = mkPreludeTyConUnique 66
unliftedConKey = mkPreludeTyConUnique 67
anyBoxConKey = mkPreludeTyConUnique 68
kindConKey = mkPreludeTyConUnique 69
boxityConKey = mkPreludeTyConUnique 70
typeConKey = mkPreludeTyConUnique 71
threadIdPrimTyConKey = mkPreludeTyConUnique 72
bcoPrimTyConKey = mkPreludeTyConUnique 73
ptrTyConKey = mkPreludeTyConUnique 74
funPtrTyConKey = mkPreludeTyConUnique 75
-- Usage type constructors
usageConKey = mkPreludeTyConUnique 74
usOnceTyConKey = mkPreludeTyConUnique 75
usManyTyConKey = mkPreludeTyConUnique 76
usageConKey = mkPreludeTyConUnique 76
usOnceTyConKey = mkPreludeTyConUnique 77
usManyTyConKey = mkPreludeTyConUnique 78
-- Generic Type Constructors
crossTyConKey = mkPreludeTyConUnique 77
plusTyConKey = mkPreludeTyConUnique 78
genUnitTyConKey = mkPreludeTyConUnique 79
crossTyConKey = mkPreludeTyConUnique 79
plusTyConKey = mkPreludeTyConUnique 80
genUnitTyConKey = mkPreludeTyConUnique 81
\end{code}
%************************************************************************
......
......@@ -24,11 +24,11 @@ import Id ( mkWildId )
import Literal ( Literal(..), isLitLitLit, mkMachInt, mkMachWord
, literalType
, word2IntLit, int2WordLit
, intToInt8Lit, intToInt16Lit, intToInt32Lit
, wordToWord8Lit, wordToWord16Lit, wordToWord32Lit
, narrow8IntLit, narrow16IntLit, narrow32IntLit
, narrow8WordLit, narrow16WordLit, narrow32WordLit
, char2IntLit, int2CharLit
, float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
, addr2IntLit, int2AddrLit, float2DoubleLit, double2FloatLit
, nullAddrLit, float2DoubleLit, double2FloatLit
)
import PrimOp ( PrimOp(..), primOpOcc )
import TysWiredIn ( trueDataConId, falseDataConId )
......@@ -60,6 +60,7 @@ primOpRule op = fmap BuiltinRule (primop_rule op)
-- ToDo: something for integer-shift ops?
-- NotOp
primop_rule AddrNullOp = Just nullAddrRule
primop_rule SeqOp = Just seqRule
primop_rule TagToEnumOp = Just tagToEnumRule
primop_rule DataToTagOp = Just dataToTagRule
......@@ -89,20 +90,18 @@ primOpRule op = fmap BuiltinRule (primop_rule op)
-- coercions
primop_rule Word2IntOp = Just (oneLit (litCoerce word2IntLit op_name))
primop_rule Int2WordOp = Just (oneLit (litCoerce int2WordLit op_name))
primop_rule IntToInt8Op = Just (oneLit (litCoerce intToInt8Lit op_name))
primop_rule IntToInt16Op = Just (oneLit (litCoerce intToInt16Lit op_name))
primop_rule IntToInt32Op = Just (oneLit (litCoerce intToInt32Lit op_name))
primop_rule WordToWord8Op = Just (oneLit (litCoerce wordToWord8Lit op_name))
primop_rule WordToWord16Op = Just (oneLit (litCoerce wordToWord16Lit op_name))