Commit 5eb1c77c authored by partain's avatar partain

[project @ 1996-07-25 20:43:49 by partain]

Bulk of final changes for 2.01
parent f7ecf723
This diff is collapsed.
This is the root directory for functional-programming tools
distributed by the Computing Science Department at Glasgow University.
Simon Peyton Jones <simonpj@dcs.glasgow.ac.uk> is the ringleader
of this effort. The tools are:
Simon Peyton Jones <simonpj@dcs.gla.ac.uk> is the ringleader of this
effort. The tools are:
ghc the Glasgow Haskell compilation system
hslibs collection of Haskell libraries
haggis the Haggis GUI toolkit
happy the Happy Haskell parser generator
nofib the NoFib Haskell benchmarking suite
......
......@@ -51,15 +51,13 @@ trap 'rm -f dummy.c dummy.o dummy; exit 1' 1 2 15
# Note: order is significant - the case branches are not exclusive.
case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
alpha:OSF1:[VX]*:*)
# After 1.2, OSF1 uses "V1.3" for uname -r.
# After 4.x, OSF1 uses "X4.x" for uname -r.
echo alpha-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VX]//'`
exit 0 ;;
alpha:OSF1:*:*)
# A Vn.n version is a released version.
# A Tn.n version is a released field test version.
# A Xn.n version is an unreleased experimental baselevel.
# 1.2 uses "1.2" for uname -r.
echo alpha-dec-osf${UNAME_RELEASE}
exit 0 ;;
echo alpha-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//'`
exit 0 ;;
21064:Windows_NT:50:3)
echo alpha-dec-winnt3.5
exit 0 ;;
......@@ -118,11 +116,27 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
VAX*:ULTRIX*:*:*)
echo vax-dec-ultrix${UNAME_RELEASE}
exit 0 ;;
mips:*:4*:UMIPS)
echo mips-mips-riscos4sysv
exit 0 ;;
mips:*:5*:RISCos)
echo mips-mips-riscos${UNAME_RELEASE}
mips:*:*:UMIPS | mips:*:*:RISCos)
sed 's/^ //' << EOF >dummy.c
int main (argc, argv) int argc; char **argv; {
#if defined (host_mips) && defined (MIPSEB)
#if defined (SYSTYPE_SYSV)
printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
#endif
#if defined (SYSTYPE_SVR4)
printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
#endif
#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
#endif
#endif
exit (-1);
}
EOF
${CC-cc} dummy.c -o dummy && ./dummy "${UNAME_RELEASE}" \
&& rm dummy.c dummy && exit 0
rm -f dummy.c dummy
echo mips-mips-riscos{UNAME_RELEASE}
exit 0 ;;
Night_Hawk:Power_UNIX:*:*)
echo powerpc-harris-powerunix
......@@ -138,8 +152,8 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
exit 0 ;;
AViiON:dgux:*:*)
# DG/UX returns AViiON for all architectures
UNAME_PROCESSOR=`uname -p`
if [ $UNAME_PROCESSOR = mc88100 -o $UNAME_PROCESSOR = mc88100 ] ; then
UNAME_PROCESSOR=`/usr/bin/uname -p`
if [ $UNAME_PROCESSOR = mc88100 -o $UNAME_PROCESSOR = mc88110 ] ; then
if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx \
-o ${TARGET_BINARY_INTERFACE}x = x ] ; then
echo m88k-dg-dgux${UNAME_RELEASE}
......@@ -213,7 +227,7 @@ EOF
echo romp-ibm-bsd4.4
exit 0 ;;
ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC NetBSD and
echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to
echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to
exit 0 ;; # report: romp-ibm BSD 4.3
*:BOSX:*:*)
echo rs6000-bull-bosx
......@@ -330,6 +344,9 @@ EOF
p*:CYGWIN*:*)
echo powerpcle-unknown-cygwin32
exit 0 ;;
prep*:SunOS:5.*:*)
echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
exit 0 ;;
*:GNU:*:*)
echo `echo ${UNAME_MACHINE}|sed -e 's,/.*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
exit 0 ;;
......@@ -347,8 +364,12 @@ EOF
echo "${UNAME_MACHINE}-unknown-linux" ; exit 0
elif echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations: m68klinux"; then
echo "${UNAME_MACHINE}-unknown-linuxaout" ; exit 0
elif echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations: elf32ppc"; then
echo "powerpc-unknown-linux" ; exit 0
elif test "${UNAME_MACHINE}" = "alpha" ; then
echo alpha-unknown-linux ; exit 0
elif test "${UNAME_MACHINE}" = "sparc" ; then
echo sparc-unknown-linux ; exit 0
else
# Either a pre-BFD a.out linker (linuxoldld) or one that does not give us
# useful --help. Gcc wants to distinguish between linuxoldld and linuxaout.
......@@ -416,9 +437,15 @@ EOF
exit 0 ;;
M680[234]0:*:R3V[567]*:*)
test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;;
3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0)
3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 4850:*:4.0:3.0)
UNAME_REL=4.3
if test -f /etc/.relid; then
UNAME_REL=4.3.`awk '{ print $3 }' /etc/.relid`
fi
uname -p 2>/dev/null | grep 86 >/dev/null \
&& echo i486-ncr-sysv4.3 && exit 0 ;;
&& echo i486-ncr-sysv$UNAME_REL && exit 0
uname -p 2>/dev/null | /bin/grep entium >/dev/null \
&& echo i586-ncr-sysv$UNAME_REL && exit 0 ;;
3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
uname -p 2>/dev/null | grep 86 >/dev/null \
&& echo i486-ncr-sysv4 && exit 0 ;;
......
......@@ -815,7 +815,7 @@ case $os in
# Each alternative MUST END IN A *, to match a version number.
# -sysv* is not here because it comes later, after sysvr4.
-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
| -vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[3456]* \
| -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[3456]* \
| -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \
| -amigados* | -msdos* | -moss* | -newsos* | -unicos* | -aos* | -aof* \
| -nindy* | -mon960* | -vxworks* | -ebmon* | -hms* | -mvs* | -clix* \
......@@ -830,7 +830,7 @@ case $os in
# CYGNUS LOCAL
-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
| -windows* | -osx | -abug | -netware* | -proelf | -os9* \
| -macos* | -mpw* | -magic*)
| -macos* | -mpw* | -magic* | -rtems*)
;;
-mac*)
os=`echo $os | sed -e 's|mac|macos|'`
......
......@@ -648,7 +648,7 @@ AC_ARG_WITH(hc,
c | C) WithHc='C'
;;
in-place )
WithHc='IN-PLACE'
WithHc='IN-PLACE'
;;
*) echo "I don't understand this option: --with-hc=$withval"
exit 1
......@@ -686,6 +686,7 @@ case $WithHc in
c | C) WithHcType='HC_USE_HC_FILES'
;;
IN-PLACE) WithHcType='HC_GLASGOW_GHC'
WithHc='$(TOP_PWD)/ghc/driver/ghc'
;;
esac
AC_SUBST(WithHc)
......@@ -699,16 +700,15 @@ AC_ARG_WITH(gcc,
[HaveGcc=YES; WhatGccIsCalled="$withval"])
AC_SUBST(WhatGccIsCalled)
dnl ** Choose which make to use (default 'make -r')
MakeCmd='make -r'
dnl ** Choose which make to use (default 'make')
MakeCmd='make'
AC_ARG_WITH(make,
[
--with-make=<make command>
Use an alternate command instead of 'make'. This is useful
when GNU make is required (for instance when the default make
supplied by the system won't work, as is the case on FreeBSD
and NetBSD). You probably want to include the '-r' flag with
make, to exclude implicit suffix rules.],
and NetBSD).],
[MakeCmd="$withval"])
AC_SUBST(MakeCmd)
......@@ -741,16 +741,19 @@ AC_SUBST(HcMaxHeapWasSet)
AC_SUBST(HcMaxHeap)
dnl ** figure out about mkdependHS
MkDependHSCmd=':'
MkDependHSCmd='mkdependHS'
if test -f ./ghc/utils/mkdependHS/mkdependHS \
-o -f ./ghc/utils/mkdependHS/mkdependHS.prl ; then
MkDependHSCmd='TopDirPwd/ghc/utils/mkdependHS/mkdependHS'
else
AC_CHECK_PROG(have_mkdependHS,mkdependHS,YES,NO)
if test $have_mkdependHS = 'YES' ; then
MkDependHSCmd='mkdependHS'
fi
fi
AC_ARG_WITH(mkdependHS,
[--with-mkdependHS=<mkdependHS command>
Use a different command instead of 'mkdependHS'.],
[MkDependHSCmd="$withval"])
dnl AC_CHECK_PROG(have_mkdependHS,$MkDependHSCmd,YES,NO)
dnl if test $have_mkdependHS = 'NO' ; then
dnl MkDependHSCmd=':'
dnl fi
AC_SUBST(MkDependHSCmd)
# -------------------------------------------------------------------------
......@@ -764,7 +767,7 @@ if echo $CPP | egrep gcc >/dev/null 2>&1; then
echo '/(\S+\/cpp)/ && print "$1";' > conftest.pl
# GNUCPP: used in jmake.c (GnuCppCmd) and in mkdependC
# (where we could do with the usual pre-#defines)
GNUCPP="gcc -E"
GNUCPP="`eval $PerlCmd -n conftest.pl conftest.out`"
test -n "$verbose" && echo " setting GNUCPP to $GNUCPP"
# RAWCPP: we do not want *any* pre-#defines...
# (e.g., hscpp, mkdependHS)
......@@ -1558,7 +1561,7 @@ option, if used, overrides --with-hc=<...>:
WithHsLibsHc=$withval
;;
in-place )
WithHsLibsHc='IN-PLACE'
WithHsLibsHc='IN-PLACE'
;;
*) echo "I don't understand this option: --with-hc-for-hslibs=$withval"
exit 1
......@@ -1582,6 +1585,7 @@ case $WithHsLibsHc in
fi
;;
IN-PLACE) WithHsLibsHcType='HC_GLASGOW_GHC'
WithHsLibsHc='$(TOP_PWD)/ghc/driver/ghc'
;;
esac
AC_SUBST(WithHsLibsHc)
......@@ -1640,7 +1644,7 @@ The Haskell compiler to compile Happy; this option, if used, overrides
nhc* ) WithHappyHc=$withval
;;
in-place )
WithHappyHc='IN-PLACE'
WithHappyHc='IN-PLACE'
;;
*) echo "I don't understand this option: --with-hc-for-happy=$withval"
exit 1
......@@ -1680,6 +1684,7 @@ case $WithHappyHc in
fi
;;
IN-PLACE) WithHappyHcType='HC_GLASGOW_GHC'
WithHappyHc='$(TOP_PWD)/ghc/driver/ghc'
;;
esac
AC_SUBST(WithHappyHc)
......@@ -1715,7 +1720,7 @@ used, overrides --with-hc=<...>:
WithHaggisHc=$withval
;;
in-place )
WithHaggisHc='IN-PLACE'
WithHaggicHs='IN-PLACE'
;;
*) echo "I don't understand this option: --with-hc-for-haggis=$withval"
exit 1
......@@ -1739,6 +1744,7 @@ case $WithHaggisHc in
fi
;;
IN-PLACE) WithHaggisHcType='HC_GLASGOW_GHC'
WithHaggisHc='$(TOP_PWD)/ghc/driver/ghc'
;;
esac
AC_SUBST(WithHaggisHc)
......@@ -1753,29 +1759,11 @@ fi
dnl
dnl * `Literate' CONFIGURATION STUFF
if test "xxx$DoingLiterate" = 'xxxliterate' ; then
# a very big "if"!
BuildInfoUtils='NO'
AC_ARG_ENABLE(info-utils,
[
*******************************************************************
** Literate programming system OPTIONS:
--enable-info-utils build GNU info/makeinfo utilities],
[case "$enableval" in
yes) BuildInfoUtils='YES'
;;
no) BuildInfoUtils='NO'
;;
*) echo "I don't understand this option: --enable-info-utils=$enableval"
exit 1
;;
esac])
AC_SUBST(BuildInfoUtils)
# here ends a very big if DoingLiterate = 'literate' ...
fi
dnl if test "xxx$DoingLiterate" = 'xxxliterate' ; then
dnl # a very big "if"!
dnl
dnl # here ends a very big if DoingLiterate = 'literate' ...
dnl fi
#
# -------------------------------------------------------------------------
dnl
......@@ -1812,7 +1800,7 @@ used, overrides --with-hc=<...>:
nhc* ) WithNoFibHc=$withval
;;
in-place )
WithNoFibHc='IN-PLACE'
WithNoFibHc='IN-PLACE'
;;
*) echo "I don't understand this option: --with-hc-for-nofib=$withval"
exit 1
......@@ -1852,6 +1840,7 @@ case $WithNoFibHc in
fi
;;
IN-PLACE) WithNoFibHcType='HC_GLASGOW_GHC'
WithNoFibHc='$(TOP_PWD)/ghc/driver/ghc'
;;
esac
AC_SUBST(WithNoFibHc)
......@@ -2034,15 +2023,9 @@ for xx in Real Spectral Imaginary GHC_ONLY Specialise PRIVATE Parallel ; do
echo "#endif" >> nofib/mkworld/buildinfo.jm
done
# Here, by HACK means, we dump all the Build_ info
# Here, by HACK means, we add all the Build_ info
# into a file. See comment above.
rm -f nofib/mkworld/buildinfo.jm
echo creating nofib/mkworld/buildinfo.jm
cat > nofib/mkworld/buildinfo.jm <<EOF
XCOMM ** DO NOT EDIT! **
XCOMM This file is obliterated every time 'configure' is run!
EOF
for xx in normal p t u mc mr mt mp mg 2s 1s du a b c d e f g h i j k l m n o A B ; do
eval "yy=\$Build_$xx"
echo "#ifndef Build_$xx" >> nofib/mkworld/buildinfo.jm
......
......@@ -5,10 +5,12 @@ fptags Denis Howe <dbh@doc.ic.ac.uk>
Bourne-shell script.
Create an emacs tags file for one or more functional programs.
haskell.el A Haskell mode from Simon Marlow <simonm@dcs.glasgow.ac.uk>.
haskell-modes/ A collection of all known "Haskell modes" for GNU Emacs.
haskel.gif Provided by Lennart Augustsson <augustss@cs.chalmers.se>
haskell_poem Speaks for itself.
mira2hs Denis Howe <dbh@doc.ic.ac.uk>
Bourne-shell script.
Convert Miranda code to Haskell, more-or-less.
......
......@@ -7,7 +7,7 @@ include advertising or testimonials from happy users if they send them
along...
Will Partain
partain@dcs.glasgow.ac.uk
partain@dcs.gla.ac.uk
95/12/05
=======================================================================
......@@ -20,7 +20,7 @@ partain@dcs.glasgow.ac.uk
chalmers/thiemann -- Peter Thiemann added "indentation stuff"
and fontification -- version 0.2.
chalmers/sof -- Sigbjorn Finne's <sof@dcs.glasgow.ac.uk> hacked
chalmers/sof -- Sigbjorn Finne's <sof@dcs.gla.ac.uk> hacked
version of Thiemann's.
.......................................................................
......@@ -52,4 +52,4 @@ partain@dcs.glasgow.ac.uk
yale/chak : "extended by Manuel M.T. Chakravarty with rudimentary
editing features (including better syntax table) and support
for the font-lock-mode." Via Hans Wolfgang Loidl
<hwloidl@dcs.glasgow.ac.uk>
<hwloidl@dcs.gla.ac.uk>
This is version 2.01 of the Glorious Glasgow Haskell compilation
system (GHC). This is a major public release. The top-level file
"ANNOUNCE-0.28" says more.
system (GHC). GHC 2.01 is a compiler for Haskell 1.3.
Haskell is "the" standard lazy functional programming language [see
SIGPLAN Notices, May 1992]. Some general merits of GHC are given at
the end of this file.
2.01 is a full GHC release; however, as the first release of the 1.3
compiler, it is "test" quality; it very well may have serious bugs.
The top-level file "ANNOUNCE-2.01" says more.
Documentation of interest:
Haskell is "the" standard lazy functional programming language.
Haskell 1.3 is the current version of the language, released in
May. 1996. The language definition is on the Web at
http://haskell.cs.yale.edu/haskell-report/haskell-report.html
GHC documentation of interest:
* docs/install_guide/installing.{dvi,info,html}: How to configure,
build, and install the system.
......@@ -29,50 +33,54 @@ do not suffer or grumble in silence. The "bug reports" section of the
User's Guide (docs/users_guide/user.{dvi,info,html}) says what we
would like to know when you report a problem.
Current AQUA team (all @dcs.glasgow.ac.uk):
Current AQUA team (all @dcs.gla.ac.uk):
Sigbjorn Finne (sof) [PhD student]
Andy Gill (andy) [PhD student]
Kevin Hammond (kh) [GRASP; now a research fellow]
Hans Wolfgang Loidl (hwloidl) [PhD student]
Simon Marlow (simonm) [PhD student]
Darren Moffat (moffatd) [slave, summer '95]
Will Partain (partain) [hired hand, GRASP/AQUA]
Simon Peyton Jones (simonpj) [our Fearless Leader]
Patrick Sansom (sansom) [hired hand, "Bidirectional Analyses"]
Andr\'e Santos (andre) [PhD student]
Patrick Sansom (sansom) [hired hand, Bidirectional Analyses]
Phil Trinder (trinder) [hired hand, Parade]
David N Turner (dnt) [hired hand, Linear Types]
Past contributors and/or continuing advisors:
Cordy Hall (cvh) [GRASP; now at Open University]
John Launchbury (jl) [AQUA; now at OGI]
Jim Mattson (mattson) [hired hand, AQUA; just moved to HP]
Andy Gill (andy) [PhD student; at HP]
Cordy Hall (cvh) [GRASP]
Kevin Hammond (kh) [GRASP; at St. Andrews]
John Launchbury (jl) [AQUA; at OGI]
Jim Mattson (mattson) [hired hand, AQUA; HP]
Darren Moffat (moffatd) [slave, summer '95; at MoD]
Bryan O'Sullivan (bos) [visiting slave, summer '94; at Sun]
Alastair Reid (areid) [GHCI god, now working at Yale]
Phil Wadler (wadler) [GRASP]
Alastair Reid (areid) [GHCI god, at Yale]
Andr\'e Santos (andre) [PhD student; back in Brazil]
Phil Wadler (wadler) [GRASP; at Lucent soon]
Cool people who've let us use their machines:
hppa1.1-hp-hpux Sam Nelson, Stirling University
mips-sgi-irix5 Tim Niblett, Turing Institute, Glasgow
sparc-sun-solaris2 Durham University
powerpc-ibm-aix Walter Robinson, Mechanical Eng'g, Glasgow U.
Simon's projects' acronyms:
GRIP ('87-'90): Graph reduction in parallel
GRASP ('90-'92): Graph reduction applications support project
AQUA ('93- ): Declarative systems architecture: a quantitative approach
Dated: 95/07/24
Dated: 96/07
GHC WWW page: http://www.dcs.glasgow.ac.uk/fp/software/ghc.html
GHC WWW page: http://www.dcs.gla.ac.uk/fp/software/ghc.html
E-mail contacts:
glasgow-haskell-request@dcs.glasgow.ac.uk (general queries)
glasgow-haskell-request@dcs.gla.ac.uk (admin & general queries)
glasgow-haskell-bugs@dcs.glasgow.ac.uk (bug reports mailing list)
glasgow-haskell-users@dcs.glasgow.ac.uk (users' mailing list)
glasgow-haskell-bugs@dcs.gla.ac.uk (bug reports mailing list)
glasgow-haskell-users@dcs.gla.ac.uk (users' mailing list)
glasgow-haskell-bugs-request@... to join, send mail *here*
glasgow-haskell-users-request@... to join, send mail *here*
glasgow-haskell-bugs-request@... to join, send mail *here*
glasgow-haskell-users-request@... to join, send mail *here*
Anonymous FTP site: ftp.dcs.glasgow.ac.uk:pub/haskell/glasgow. Mostly
mirrored by ftp.cs.chalmers.se and nebula.cs.yale.edu (same
Anonymous FTP site: ftp.dcs.gla.ac.uk:pub/haskell/glasgow. Mostly
mirrored by ftp.cs.chalmers.se and haskell.cs.yale.edu (same
directory). Also: src.doc.ic.ac.uk, in
computing/programming/languages/haskell/glasgow/.
......@@ -819,8 +819,8 @@ NormalLibraryTarget(hsp,$(HSP_OBJS_O))
/* BuildPgmFromCFiles(hsp,parser/printtree.o parser/main.o,,libhsp.a) */
#if DoInstallGHCSystem == YES
MakeDirectories(install, $(INSTLIBDIR_GHC))
InstallBinaryTarget(hsp,$(INSTLIBDIR_GHC))
/* MakeDirectories(install, $(INSTLIBDIR_GHC)) */
/* InstallBinaryTarget(hsp,$(INSTLIBDIR_GHC)) */
#endif /* DoInstall... */
YaccRunWithExpectMsg(parser/hsparser,12,0)
......
......@@ -368,6 +368,7 @@ stmtMacroCosts macro modes =
GRAN_RESCHEDULE -> nullCosts {- GrAnSim bookkeeping -}
GRAN_FETCH_AND_RESCHEDULE -> nullCosts {- GrAnSim bookkeeping -}
THREAD_CONTEXT_SWITCH -> nullCosts {- GrAnSim bookkeeping -}
_ -> trace "Costs.stmtMacroCosts" nullCosts
-- ---------------------------------------------------------------------------
......
......@@ -40,6 +40,7 @@ module Id (
idType,
idUnique,
dataConRepType,
dataConArgTys,
dataConArity,
dataConNumFields,
......@@ -107,6 +108,7 @@ module Id (
getIdUpdateInfo,
getPragmaInfo,
replaceIdInfo,
addInlinePragma,
-- IdEnvs AND IdSets
SYN_IE(IdEnv), SYN_IE(GenIdSet), SYN_IE(IdSet),
......@@ -169,7 +171,7 @@ import MatchEnv ( MatchEnv )
import SrcLoc ( mkBuiltinSrcLoc )
import TyCon ( TyCon, mkTupleTyCon, tyConDataCons )
import Type ( mkSigmaTy, mkTyVarTys, mkFunTys, mkDictTy,
applyTyCon, instantiateTy,
applyTyCon, instantiateTy, mkForAllTys,
tyVarsOfType, applyTypeEnvToTy, typePrimRep,
GenType, SYN_IE(ThetaType), SYN_IE(TauType), SYN_IE(Type)
)
......@@ -816,6 +818,10 @@ idWantsToBeINLINEd :: Id -> Bool
idWantsToBeINLINEd (Id _ _ _ _ IWantToBeINLINEd _) = True
idWantsToBeINLINEd _ = False
addInlinePragma :: Id -> Id
addInlinePragma (Id u sn ty details _ info)
= Id u sn ty details IWantToBeINLINEd info
\end{code}
For @unlocaliseId@: See the brief commentary in
......@@ -1392,6 +1398,25 @@ dataConSig (Id _ _ _ (TupleConId arity) _ _)
tyvars = take arity alphaTyVars
tyvar_tys = mkTyVarTys tyvars
-- dataConRepType returns the type of the representation of a contructor
-- This may differ from the type of the contructor Id itself for two reasons:
-- a) the constructor Id may be overloaded, but the dictionary isn't stored
-- b) the constructor may store an unboxed version of a strict field.
-- Here's an example illustrating both:
-- data Ord a => T a = MkT Int! a
-- Here
-- T :: Ord a => Int -> a -> T a
-- but the rep type is
-- Trep :: Int# -> a -> T a
-- Actually, the unboxed part isn't implemented yet!
dataConRepType :: GenId (GenType tv u) -> GenType tv u
dataConRepType con
= mkForAllTys tyvars tau
where
(tyvars, theta, tau) = splitSigmaTy (idType con)
dataConFieldLabels :: DataCon -> [FieldLabel]
dataConFieldLabels (Id _ _ _ (DataConId _ _ fields _ _ _ _) _ _) = fields
dataConFieldLabels (Id _ _ _ (TupleConId _) _ _) = []
......
......@@ -103,7 +103,8 @@ mkSplitUniqSupply (C# c#)
returnPrimIO (I# (w2i (mask# `or#` u#)))
in
#if __GLASGOW_HASKELL__ >= 200
primIOToIO mk_supply#
primIOToIO mk_supply# >>= \ s ->
return s
#else
mk_supply# `thenPrimIO` \ s ->
return s
......
......@@ -18,7 +18,7 @@ import CoreSyn
import Bag
import Kind ( hasMoreBoxityInfo, Kind{-instance-} )
import Literal ( literalType, Literal{-instance-} )
import Id ( idType, isBottomingId,
import Id ( idType, isBottomingId, dataConRepType,
dataConArgTys, GenId{-instances-},
emptyIdSet, mkIdSet, intersectIdSets,
unionIdSets, elementOfIdSet, SYN_IE(IdSet)
......@@ -198,14 +198,8 @@ lintCoreExpr (Let binds body)
(addInScopeVars binders (lintCoreExpr body))
lintCoreExpr e@(Con con args)
= lintCoreArgs {-False-} e unoverloaded_ty args
= lintCoreArgs {-False-} e (dataConRepType con) args
-- Note: we don't check for primitive types in these arguments
where
-- Constructors are special in that they aren't passed their
-- dictionary arguments, so we swizzle them out of the
-- constructor type before handing over to lintCorArgs
unoverloaded_ty = mkForAllTys tyvars tau
(tyvars, theta, tau) = splitSigmaTy (idType con)
lintCoreExpr e@(Prim op args)
= lintCoreArgs {-True-} e (primOpType op) args
......
......@@ -48,7 +48,7 @@ import IdInfo ( arityMaybe, bottomIsGuaranteed )
import Literal ( isNoRepLit, isLitLitLit )
import Pretty
import TyCon ( tyConFamilySize )
import Type ( getAppDataTyConExpandingDicts )
import Type ( maybeAppDataTyConExpandingDicts )
import UniqSet ( emptyUniqSet, unitUniqSet, mkUniqSet,
addOneToUniqSet, unionUniqSets
)
......@@ -229,10 +229,16 @@ calcUnfoldingGuidance scc_s_OK bOMB_OUT_SIZE expr
(length val_binders)
(map discount_for val_binders)
size
discount_for b | b `is_elem` cased_args = tyConFamilySize tycon
| otherwise = 0
where
(tycon, _, _) = getAppDataTyConExpandingDicts (idType b)
discount_for b
| is_data && b `is_elem` cased_args = tyConFamilySize tycon
| otherwise = 0
where
(is_data, tycon)
= --trace "CoreUnfold.getAppDataTyConExpandingDicts:1" $
case (maybeAppDataTyConExpandingDicts (idType b)) of
Nothing -> (False, panic "discount")
Just (tc,_,_) -> (True, tc)
in
-- pprTrace "calcUnfold:" (ppAbove (ppr PprDebug uf) (ppr PprDebug expr))
uf
......@@ -307,7 +313,7 @@ sizeExpr scc_s_OK bOMB_OUT_SIZE args expr
------------
size_up_alts scrut_ty (AlgAlts alts deflt)
= foldr (addSize . size_alg_alt) (size_up_deflt deflt) alts
`addSizeN` (tyConFamilySize tycon)
`addSizeN` (if is_data then tyConFamilySize tycon else 1{-??-})
-- NB: we charge N for an alg. "case", where N is
-- the number of constructors in the thing being eval'd.
-- (You'll eventually get a "discount" of N if you
......@@ -316,8 +322,11 @@ sizeExpr scc_s_OK bOMB_OUT_SIZE args expr
size_alg_alt (con,args,rhs) = size_up rhs
-- Don't charge for args, so that wrappers look cheap
(tycon, _, _) = --trace "CoreUnfold.getAppDataTyConExpandingDicts" $
getAppDataTyConExpandingDicts scrut_ty
(is_data,tycon)
= --trace "CoreUnfold.getAppDataTyConExpandingDicts:2" $
case (maybeAppDataTyConExpandingDicts scrut_ty) of
Nothing -> (False, panic "size_up_alts")
Just (tc,_,_) -> (True, tc)
size_up_alts _ (PrimAlts alts deflt)
= foldr (addSize . size_prim_alt) (size_up_deflt deflt) alts
......@@ -345,7 +354,6 @@ sizeExpr scc_s_OK bOMB_OUT_SIZE args expr
sizeZero = Just (0, [])
sizeOne = Just (1, [])
sizeN n = Just (n, [])
sizeVar v = Just (0, [v])
addSizeN Nothing _ = Nothing
addSizeN (Just (n, xs)) m
......
......@@ -32,6 +32,7 @@ import CoreSyn
import CostCentre ( isDictCC, CostCentre, noCostCentre )
import Id ( idType, mkSysLocal, getIdArity, isBottomingId,