Fixing exports of Prelude
Alastair David Reid
reid@cs.utah.edu
17 Aug 2001 01:30:04 -0600
I'm attaching some diffs to fix the problem that Hugs' Prelude exports
functions that should be exported by modules Char, Ratio, IO, IOExts,
etc. and makes sure that internal Hugs functions like the exception
handling extensions, the internal details of the IO monad, etc. are
not visible to normal Hugs users.
What the diffs do is allow Hugs to start by loading multiple modules
instead of just loading one module. With this change, you can split
the Hugs Prelude into two files like this:
Prelude.hs:
module Prelude( <insert export list found in Haskell report here> ) where
import PreludeBuiltin
PreludeBuiltin.hs:
module PreludeBuiltin(
<copy the rest of the current Hugs Prelude.hs into here>
As an added bonus, this change also makes it easier to safely define
your own Prelude because all the delicate magic is in PreludeBuiltin.
All that writing your own Prelude does is change the names
automatically imported into your modules. (But beware that derived
instances and other syntactic sugar will use PreludeBuiltin.<whatever>
so defining your own Eq or Num class will not cause the syntactic
sugar to mean anything new.)
I'm not sure about committing my changes though so I'm attaching the
diffs for readers of this list (in particular, those with commit
privileges) to contemplate.
If people seem to think it's cool, I'll go ahead and commit the
changes. Here's some reasons why you might _not_ want me to go ahead:
1) The first module loaded _has_ to be called PreludeBuiltin.
This pretty much forces you to adopt a structure like that shown
above. It'd be nicer if youhad the option of sticking with the
current organisation.
2) There's a bunch of code in Hugs that treats the Prelude differently
from other modules. For example, when printing error messages, we
print "Int" instead of "Prelude.Int". But now the definition of
Int is in PreludeBuiltin - have I caught all the special cases
and changed them appropriately?
3) Some parts of the code are probably _meant_ to print the module
name as a prefix. Now names like Prelude.Left will be rendered
as PreludeBuiltin.Left. When does this happen? Is this a serious
problem?
4) I haven't tested this code very thoroughly.
(I don't use Hugs much at work so I'm not likely to test it much
more any time soon.)
Apart from a few spot checks, the most thorough test I ran was to
make sure that Hugs could load StdLibs.hs and HugsLibs.hs which are
supposed to import all the standard and non-standard libraries included
in Hugs. I'm not sure if this tests obscure corners like Trex though.
So, before I go ahead and commit this, some people who use Hugs
heavily should use this version for all their development for
a while.
5) I haven't updated (or run!) the test suite.
(This is easy but tedious: changes in the module structure require
a change to the number in _every_ entry in hugs98/tests/testSuite.in.)
6) You'd want to take a bit more care over the changes to Prelude.hs
and the libraries. In particular, you'd want to make sure the
Prelude's export list does match the report.
7) The diffs are bigger and a bit uglier than I'd like.
A lower tech solution (like just calling things by names like
prelude_toUpper) would achieve a lot of the benefit at a fraction
of the cost.
[These diffs are based on a similar change in STG-Hugs - but are
more complex because STG-Hugs had simpler dependencies between the
compiler and the Prelude. Another source of complexity is that
it's 3 years since I last hacked on these parts of Hugs and, due to
limited hacking time, the changes were made kinda quickly.]
I've put a complete snapshot of my Hugs source tree in
http://www.cs.utah.edu/~reid/hugshacks/multi-module-prelude.tgz (about
875Kbytes) since that's easier to use if you want to run the code.
--
Alastair Reid reid@cs.utah.edu http://www.cs.utah.edu/~reid/
-- Here's the actual Prelude I ran with. The differences from the
-- sketch above are that I haven't carefully crosschecked it against
-- the report and I take care not to have internal Hugs functions in scope
-- when Hugs starts up. (One could take even more care to make sure that
-- toUpper and friends are also hidden.)
module Prelude (
-- module PreludeList,
map, (++), concat, filter,
head, last, tail, init, null, length, (!!),
foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,
iterate, repeat, replicate, cycle,
take, drop, splitAt, takeWhile, dropWhile, span, break,
lines, words, unlines, unwords, reverse, and, or,
any, all, elem, notElem, lookup,
sum, product, maximum, minimum, concatMap,
zip, zip3, zipWith, zipWith3, unzip, unzip3,
-- module PreludeText,
ReadS, ShowS,
Read(readsPrec, readList),
Show(show, showsPrec, showList),
reads, shows, read, lex,
showChar, showString, readParen, showParen,
-- module PreludeIO,
FilePath, IOError, ioError, userError, catch,
putChar, putStr, putStrLn, print,
getChar, getLine, getContents, interact,
readFile, writeFile, appendFile, readIO, readLn,
-- List type: []((:), [])
(:),
-- Tuple types: (,), (,,), etc.
-- Trivial type: ()
-- Functions: (->)
Eq((==), (/=)),
Ord(compare, (<), (<=), (>=), (>), max, min),
Enum(succ, pred, toEnum, fromEnum, enumFrom, enumFromThen,
enumFromTo, enumFromThenTo),
Bounded(minBound, maxBound),
-- Num((+), (-), (*), negate, abs, signum, fromInteger),
Num((+), (-), (*), negate, abs, signum, fromInteger, fromInt),
Real(toRational),
-- Integral(quot, rem, div, mod, quotRem, divMod, toInteger),
Integral(quot, rem, div, mod, quotRem, divMod, even, odd, toInteger, toInt),
-- Fractional((/), recip, fromRational),
Fractional((/), recip, fromRational, fromDouble),
Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,
asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),
RealFrac(properFraction, truncate, round, ceiling, floor),
RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,
encodeFloat, exponent, significand, scaleFloat, isNaN,
isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2),
Monad((>>=), (>>), return, fail),
Functor(fmap),
mapM, mapM_, sequence, sequence_, (=<<),
maybe, either,
(&&), (||), not, otherwise,
subtract, even, odd, gcd, lcm, (^), (^^),
fromIntegral, realToFrac,
fst, snd, curry, uncurry, id, const, (.), flip, ($), until,
asTypeOf, error, undefined,
seq, ($!),
Bool(False, True),
Maybe(Nothing, Just),
Either(Left, Right),
Ordering(LT, EQ, GT),
Char, String, Int, Integer, Rational, Float, Double, IO,
) where
-- We hide these symbols so that if all you do is start Hugs, you can't
-- see types like EmptyRec.
import PreludeBuiltin hiding (
IO(..), IOResult(..), primExitWith, Addr, Word, StablePtr, ForeignObj,
basicIORun, blockIO, IOFinished(..),
threadToIOResult,
HugsException, catchHugsException, primThrowException,
Rec, EmptyRec, EmptyRow,
)
import PreludeBuiltin(
IO()
)
-- Here's the changes to the libraries
Index: lib/Char.hs
===================================================================
RCS file: /home/cvs/root/hugs98/lib/Char.hs,v
retrieving revision 1.1.1.1
diff -C2 -r1.1.1.1 Char.hs
*** lib/Char.hs 1999/06/07 23:53:36 1.1.1.1
--- lib/Char.hs 2001/08/17 06:27:02
***************
*** 18,23 ****
-- This module is (almost) empty; Char operations are currently defined in
! -- the prelude, but should eventually be moved to this library file instead.
-- No Unicode support yet.
isLatin1 c = True
--- 18,32 ----
-- This module is (almost) empty; Char operations are currently defined in
! -- PreludeBuiltin, but should eventually be moved to this library file instead.
-- No Unicode support yet.
+
+ import PreludeBuiltin (
+ isAscii, isControl, isPrint, isSpace, isUpper, isLower,
+ isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
+ digitToInt, intToDigit,
+ toUpper, toLower,
+ ord, chr,
+ readLitChar, showLitChar, lexLitChar,
+ )
isLatin1 c = True
Index: lib/Ix.hs
===================================================================
RCS file: /home/cvs/root/hugs98/lib/Ix.hs,v
retrieving revision 1.1.1.1
diff -C2 -r1.1.1.1 Ix.hs
*** lib/Ix.hs 1999/06/07 23:53:36 1.1.1.1
--- lib/Ix.hs 2001/08/17 06:27:02
***************
*** 13,15 ****
--- 13,19 ----
-- eventually be moved to this library file instead.
+ import PreludeBuiltin(
+ Ix(range, index, inRange, rangeSize),
+ )
+
-----------------------------------------------------------------------------
Index: lib/Numeric.hs
===================================================================
RCS file: /home/cvs/root/hugs98/lib/Numeric.hs,v
retrieving revision 1.1.1.1
diff -C2 -r1.1.1.1 Numeric.hs
*** lib/Numeric.hs 1999/06/07 23:53:36 1.1.1.1
--- lib/Numeric.hs 2001/08/17 06:27:03
***************
*** 19,22 ****
--- 19,29 ----
import Char
import Array
+ import Ratio
+ import PreludeBuiltin(
+ showSigned, showInt,
+ readSigned, readInt,
+ readDec, readOct, readHex, readSigned,
+ readFloat, lexDigits,
+ )
-- This converts a rational to a floating. This should be used in the
Index: lib/Random.hs
===================================================================
RCS file: /home/cvs/root/hugs98/lib/Random.hs,v
retrieving revision 1.2
diff -C2 -r1.2 Random.hs
*** lib/Random.hs 1999/09/23 23:14:39 1.2
--- lib/Random.hs 2001/08/17 06:27:04
***************
*** 22,26 ****
import IOExts
!
-- The RandomGen class: ------------------------------------------------------
--- 22,27 ----
import IOExts
! import Numeric
! import Char
-- The RandomGen class: ------------------------------------------------------
Index: lib/Ratio.hs
===================================================================
RCS file: /home/cvs/root/hugs98/lib/Ratio.hs,v
retrieving revision 1.1.1.1
diff -C2 -r1.1.1.1 Ratio.hs
*** lib/Ratio.hs 1999/06/07 23:53:36 1.1.1.1
--- lib/Ratio.hs 2001/08/17 06:27:04
***************
*** 11,13 ****
--- 11,17 ----
-- but should eventually be moved to this library file instead.
+ import PreludeBuiltin(
+ Ratio, (%), numerator, denominator, approxRational,
+ )
+
-----------------------------------------------------------------------------
Index: lib/System.hs
===================================================================
RCS file: /home/cvs/root/hugs98/lib/System.hs,v
retrieving revision 1.1.1.1
diff -C2 -r1.1.1.1 System.hs
*** lib/System.hs 1999/06/07 23:53:36 1.1.1.1
--- lib/System.hs 2001/08/17 06:27:04
***************
*** 15,18 ****
--- 15,22 ----
) where
+ import PreludeBuiltin(
+ primExitWith,
+ )
+
data ExitCode = ExitSuccess | ExitFailure Int
deriving (Eq, Ord, Read, Show)
Index: lib/exts/IOExts.hs
===================================================================
RCS file: /home/cvs/root/hugs98/lib/exts/IOExts.hs,v
retrieving revision 1.5
diff -C2 -r1.5 IOExts.hs
*** lib/exts/IOExts.hs 2001/06/27 00:12:02 1.5
--- lib/exts/IOExts.hs 2001/08/17 06:27:05
***************
*** 35,38 ****
--- 35,44 ----
import Array
+ import PreludeBuiltin(
+ IO(..), IOResult(..), primExitWith, Addr, Word, StablePtr, ForeignObj,
+ basicIORun, blockIO, IOFinished(..),
+ threadToIOResult,
+ HugsException, catchHugsException, primThrowException,
+ )
-----------------------------------------------------------------------------
-- and here are the changes to the Hugs compiler
Index: src/array.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/array.c,v
retrieving revision 1.3
diff -C2 -r1.3 array.c
*** src/array.c 1999/09/13 11:00:59 1.3
--- src/array.c 2001/08/17 06:27:06
***************
*** 78,83 ****
switch (what) {
case INSTALL :
! setCurrModule(modulePrelude);
! #define pFun(n,s,t) addPrim(0,n=newName(findText(s),NIL),t,modulePrelude,NIL)
pFun(nameEltUndef, "_undefined_array_element",
"eltUndef");
--- 78,83 ----
switch (what) {
case INSTALL :
! setCurrModule(modulePreludeBuiltin);
! #define pFun(n,s,t) addPrim(0,n=newName(findText(s),NIL),t,modulePreludeBuiltin,NIL)
pFun(nameEltUndef, "_undefined_array_element",
"eltUndef");
Index: src/builtin.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/builtin.c,v
retrieving revision 1.18
diff -C2 -r1.18 builtin.c
*** src/builtin.c 2001/08/07 23:29:59 1.18
--- src/builtin.c 2001/08/17 06:27:11
***************
*** 2256,2261 ****
registerPrims(&stmonadPrims);
#endif
! setCurrModule(modulePrelude);
! #define pFun(n,s,t) addPrim(0,n=newName(findText(s),NIL),t,modulePrelude,NIL)
pFun(nameFatbar, "_FATBAR", "fatbar");
pFun(nameFail, "_FAIL", "fail");
--- 2256,2261 ----
registerPrims(&stmonadPrims);
#endif
! setCurrModule(modulePreludeBuiltin);
! #define pFun(n,s,t) addPrim(0,n=newName(findText(s),NIL),t,modulePreludeBuiltin,NIL)
pFun(nameFatbar, "_FATBAR", "fatbar");
pFun(nameFail, "_FAIL", "fail");
Index: src/connect.h
===================================================================
RCS file: /home/cvs/root/hugs98/src/connect.h,v
retrieving revision 1.21
diff -C2 -r1.21 connect.h
*** src/connect.h 2001/06/14 21:28:52 1.21
--- src/connect.h 2001/08/17 06:27:12
***************
*** 18,22 ****
extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/
! extern Module modulePrelude;
/* --------------------------------------------------------------------------
--- 18,22 ----
extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/
! extern Module modulePreludeBuiltin;
/* --------------------------------------------------------------------------
***************
*** 108,111 ****
--- 108,112 ----
extern Text textPrelude;
+ extern Text textPreludeBuiltin;
extern Text textNum; /* used to process default decls */
#if NPLUSK
Index: src/hugs.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/hugs.c,v
retrieving revision 1.44
diff -C2 -r1.44 hugs.c
*** src/hugs.c 2001/08/11 01:54:35 1.44
--- src/hugs.c 2001/08/17 06:27:17
***************
*** 147,150 ****
--- 147,151 ----
static Time lastChange[NUM_SCRIPTS]; /* Time of last change to script */
static Bool postponed[NUM_SCRIPTS]; /* Indicates postponed load */
+ static Int scriptBase; /* Number of scripts in Prelude */
static Int numScripts; /* Number of scripts loaded */
static Int namesUpto; /* Number of script names set */
***************
*** 372,375 ****
--- 373,377 ----
}
readScripts(0);
+ scriptBase = numScripts;
}
***************
*** 1065,1069 ****
projInput(currProject);
scriptFile = currProject;
! forgetScriptsFrom(1);
while ((s=readFilename())!=0)
addScriptName(s,TRUE);
--- 1067,1071 ----
projInput(currProject);
scriptFile = currProject;
! forgetScriptsFrom(scriptBase);
while ((s=readFilename())!=0)
addScriptName(s,TRUE);
***************
*** 1185,1189 ****
if (scriptName[i])
free(scriptName[i]);
! dropScriptsFrom(scno-1); /* don't count prelude as script */
namesUpto = scno;
if (numScripts>namesUpto)
--- 1187,1191 ----
if (scriptName[i])
free(scriptName[i]);
! dropScriptsFrom(scno);
namesUpto = scno;
if (numScripts>namesUpto)
***************
*** 1200,1204 ****
while ((s=readFilename())!=0)
addScriptName(s,TRUE);
! readScripts(1);
}
--- 1202,1206 ----
while ((s=readFilename())!=0)
addScriptName(s,TRUE);
! readScripts(scriptBase);
}
***************
*** 1221,1225 ****
}
loadProject(s);
! readScripts(1);
}
--- 1223,1227 ----
}
loadProject(s);
! readScripts(scriptBase);
}
***************
*** 1236,1240 ****
getFileInfo(scriptName[n], &timeStamp, &fileSize);
if (timeChanged(timeStamp,lastChange[n])) {
! dropScriptsFrom(n-1);
numScripts = n;
break;
--- 1238,1242 ----
getFileInfo(scriptName[n], &timeStamp, &fileSize);
if (timeChanged(timeStamp,lastChange[n])) {
! dropScriptsFrom(n);
numScripts = n;
break;
***************
*** 1247,1261 ****
getFileInfo(scriptName[numScripts], &timeStamp, &fileSize);
timeSet(lastChange[numScripts],timeStamp);
! if (numScripts>0) /* no new script for prelude */
! startNewScript(scriptName[numScripts]);
if (addScript(scriptName[numScripts],fileSize))
numScripts++;
else
! dropScriptsFrom(numScripts-1);
}
if (listScripts)
whatScripts();
! if (numScripts<=1)
setLastEdit((String)0, 0);
}
--- 1249,1262 ----
getFileInfo(scriptName[numScripts], &timeStamp, &fileSize);
timeSet(lastChange[numScripts],timeStamp);
! startNewScript(scriptName[numScripts]);
if (addScript(scriptName[numScripts],fileSize))
numScripts++;
else
! dropScriptsFrom(numScripts);
}
if (listScripts)
whatScripts();
! if (numScripts<=scriptBase)
setLastEdit((String)0, 0);
}
***************
*** 1310,1318 ****
if (nonNull(c=findTycon(t=findText(nm)))) {
if (startEdit(tycon(c).line,scriptName[scriptThisTycon(c)])) {
! readScripts(1);
}
} else if (nonNull(c=findName(t))) {
if (startEdit(name(c).line,scriptName[scriptThisName(c)])) {
! readScripts(1);
}
} else {
--- 1311,1319 ----
if (nonNull(c=findTycon(t=findText(nm)))) {
if (startEdit(tycon(c).line,scriptName[scriptThisTycon(c)])) {
! readScripts(scriptBase);
}
} else if (nonNull(c=findName(t))) {
if (startEdit(name(c).line,scriptName[scriptThisName(c)])) {
! readScripts(scriptBase);
}
} else {
***************
*** 1325,1329 ****
static Void local runEditor() { /* run editor on script lastEdit */
if (startEdit(lastLine,lastEdit)) /* at line lastLine */
! readScripts(1);
}
--- 1326,1330 ----
static Void local runEditor() { /* run editor on script lastEdit */
if (startEdit(lastLine,lastEdit)) /* at line lastLine */
! readScripts(scriptBase);
}
***************
*** 2037,2041 ****
InAutoReloadFiles = TRUE;
saveInputState();
! readScripts(1);
restoreInputState();
InAutoReloadFiles = FALSE;
--- 2038,2042 ----
InAutoReloadFiles = TRUE;
saveInputState();
! readScripts(scriptBase);
restoreInputState();
InAutoReloadFiles = FALSE;
***************
*** 2117,2122 ****
Command cmd;
everybody(RESET); /* reset to sensible initial state */
! dropScriptsFrom(numScripts-1); /* remove partially loaded scripts */
! /* not counting prelude as a script*/
#if IGNORE_MODULES
--- 2118,2122 ----
Command cmd;
everybody(RESET); /* reset to sensible initial state */
! dropScriptsFrom(numScripts); /* remove partially loaded scripts */
#if IGNORE_MODULES
***************
*** 2143,2147 ****
break;
case LOAD : clearProject();
! forgetScriptsFrom(1);
load();
break;
--- 2143,2147 ----
break;
case LOAD : clearProject();
! forgetScriptsFrom(scriptBase);
load();
break;
***************
*** 2150,2154 ****
load();
break;
! case RELOAD : readScripts(1);
break;
case PROJECT: project();
--- 2150,2154 ----
load();
break;
! case RELOAD : readScripts(scriptBase);
break;
case PROJECT: project();
Index: src/input.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/input.c,v
retrieving revision 1.26
diff -C2 -r1.26 input.c
*** src/input.c 2001/06/14 21:28:52 1.26
--- src/input.c 2001/08/17 06:27:22
***************
*** 141,144 ****
--- 141,145 ----
Text textNum; /* Num */
Text textPrelude; /* Prelude */
+ Text textPreludeBuiltin; /* PreludeBuiltin */
Text textPlus; /* (+) */
***************
*** 1815,1818 ****
--- 1816,1820 ----
textImplies = findText("=>");
textPrelude = findText("Prelude");
+ textPreludeBuiltin = findText("PreludeBuiltin");
textNum = findText("Num");
textModule = findText("module");
Index: src/interns.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/interns.c,v
retrieving revision 1.5
diff -C2 -r1.5 interns.c
*** src/interns.c 2001/04/02 04:05:13 1.5
--- src/interns.c 2001/08/17 06:27:22
***************
*** 32,36 ****
case INSTALL :
#define predef(nm,str) nm=newName(findText(str),NIL); name(nm).defn=PREDEFINED
! setCurrModule(modulePrelude);
predef(nameLeft, "Left");
predef(nameRight, "Right");
--- 32,36 ----
case INSTALL :
#define predef(nm,str) nm=newName(findText(str),NIL); name(nm).defn=PREDEFINED
! setCurrModule(modulePreludeBuiltin);
predef(nameLeft, "Left");
predef(nameRight, "Right");
Index: src/iomonad.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/iomonad.c,v
retrieving revision 1.15
diff -C2 -r1.15 iomonad.c
*** src/iomonad.c 2001/06/23 21:46:43 1.15
--- src/iomonad.c 2001/08/17 06:27:25
***************
*** 52,57 ****
switch (what) {
case INSTALL :
! setCurrModule(modulePrelude);
! #define pFun(n,s,t) addPrim(0,n=newName(findText(s),NIL),t,modulePrelude,NIL)
pFun(namePass, "_pass", "passIO");
#if IO_HANDLES
--- 52,57 ----
switch (what) {
case INSTALL :
! setCurrModule(modulePreludeBuiltin);
! #define pFun(n,s,t) addPrim(0,n=newName(findText(s),NIL),t,modulePreludeBuiltin,NIL)
pFun(namePass, "_pass", "passIO");
#if IO_HANDLES
Index: src/output.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/output.c,v
retrieving revision 1.23
diff -C2 -r1.23 output.c
*** src/output.c 2001/08/15 01:07:06 1.23
--- src/output.c 2001/08/17 06:27:28
***************
*** 1628,1632 ****
static Void local putModule(m) /* print module qualifier */
Module m; {
! if (useQualifiedNames && !isPrelude(m)) { /* leave out "Prelude." qualifiers, too noisy. */
putStr(textToStr(module(m).text));
putChr('.');
--- 1628,1632 ----
static Void local putModule(m) /* print module qualifier */
Module m; {
! if (useQualifiedNames && !isPreludeBuiltin(m)) { /* leave out "Prelude." qualifiers, too noisy. */
putStr(textToStr(module(m).text));
putChr('.');
Index: src/printer.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/printer.c,v
retrieving revision 1.6
diff -C2 -r1.6 printer.c
*** src/printer.c 2001/06/09 15:55:13 1.6
--- src/printer.c 2001/08/17 06:27:29
***************
*** 47,52 ****
break;
case INSTALL :
! setCurrModule(modulePrelude);
! #define pFun(n,s,t) addPrim(0,n=newName(findText(s),NIL),t,modulePrelude,NIL)
pFun(namePrint, "_print", "print");
pFun(nameNPrint, "_nprint", "nprint");
--- 47,52 ----
break;
case INSTALL :
! setCurrModule(modulePreludeBuiltin);
! #define pFun(n,s,t) addPrim(0,n=newName(findText(s),NIL),t,modulePreludeBuiltin,NIL)
pFun(namePrint, "_print", "print");
pFun(nameNPrint, "_nprint", "nprint");
Index: src/static.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/static.c,v
retrieving revision 1.39
diff -C2 -r1.39 static.c
*** src/static.c 2001/08/07 23:29:59 1.39
--- src/static.c 2001/08/17 06:27:44
***************
*** 344,349 ****
if (isNull(m = findModule(textOf(nm))))
m = newModule(textOf(nm));
! else if (!isPreludeScript()) {
! /* You're allowed to break the rules in the Prelude! */
#if HSCRIPT
reloadModule = textToStr(textOf(nm));
--- 344,349 ----
if (isNull(m = findModule(textOf(nm))))
m = newModule(textOf(nm));
! else if (!isBaseScript()) {
! /* You're allowed to break the rules in the base script! */
#if HSCRIPT
reloadModule = textToStr(textOf(nm));
***************
*** 7004,7007 ****
--- 7004,7008 ----
#if !IGNORE_MODULES
Module thisModule = lastModule();
+ Module modulePrelude = findModule(textPrelude);
#endif
staticAnalysis(RESET);
***************
*** 7013,7018 ****
mapProc(checkQualImport, module(thisModule).qualImports);
mapProc(checkUnqualImport,unqualImports);
! /* Add "import Prelude" if there`s no explicit import */
! if (thisModule!=modulePrelude
&& isNull(cellAssoc(modulePrelude,unqualImports))
&& isNull(cellRevAssoc(modulePrelude,module(thisModule).qualImports))) {
--- 7014,7020 ----
mapProc(checkQualImport, module(thisModule).qualImports);
mapProc(checkUnqualImport,unqualImports);
! /* Add "import Prelude" if there`s no explicit import. */
! if ( !isNull(modulePrelude)
! && thisModule!=modulePrelude
&& isNull(cellAssoc(modulePrelude,unqualImports))
&& isNull(cellRevAssoc(modulePrelude,module(thisModule).qualImports))) {
***************
*** 7020,7026 ****
} else {
/* Every module (including the Prelude) implicitly contains
! * "import qualified Prelude"
*/
! module(thisModule).qualImports=cons(pair(mkCon(textPrelude),modulePrelude),
module(thisModule).qualImports);
}
--- 7022,7031 ----
} else {
/* Every module (including the Prelude) implicitly contains
! * "import qualified Prelude"
! * or, if we haven't loaded the Prelude yet,
! * "import qualified PreludeBuiltin as Prelude"
*/
! Module m = isNull(modulePrelude)?modulePreludeBuiltin:modulePrelude;
! module(thisModule).qualImports=cons(pair(mkCon(textPrelude),m),
module(thisModule).qualImports);
}
Index: src/stmonad.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/stmonad.c,v
retrieving revision 1.3
diff -C2 -r1.3 stmonad.c
*** src/stmonad.c 1999/09/13 11:01:08 1.3
--- src/stmonad.c 2001/08/17 06:27:44
***************
*** 24,28 ****
Int what; {
switch (what) {
! case INSTALL : setCurrModule(modulePrelude);
break;
}
--- 24,28 ----
Int what; {
switch (what) {
! case INSTALL : setCurrModule(modulePreludeBuiltin);
break;
}
Index: src/storage.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/storage.c,v
retrieving revision 1.17
diff -C2 -r1.17 storage.c
*** src/storage.c 2001/08/07 23:29:59 1.17
--- src/storage.c 2001/08/17 06:27:51
***************
*** 663,667 ****
for(; 0 != info_def; info_def=info_def->nextPrimInfoDef) {
#if !IGNORE_MODULES
! if ( ( lookInPrelude && isPrelude(info_def->prim_module)) ||
mod == info_def->prim_module ) {
#else
--- 663,667 ----
for(; 0 != info_def; info_def=info_def->nextPrimInfoDef) {
#if !IGNORE_MODULES
! if ( ( lookInPrelude && isPreludeBuiltin(info_def->prim_module)) ||
mod == info_def->prim_module ) {
#else
***************
*** 1356,1361 ****
}
! Bool isPreludeScript() { /* Test whether this is the Prelude*/
! return (scriptHw==0);
}
--- 1356,1361 ----
}
! Bool isBaseScript() { /* Test whether this is the first script loaded */
! return (scriptHw==1);
}
***************
*** 1367,1371 ****
Module lastModule() { /* Return module in current script file */
! return (moduleHw>MODMIN ? moduleHw-1 : modulePrelude);
}
#endif /* !IGNORE_MODULES */
--- 1367,1371 ----
Module lastModule() { /* Return module in current script file */
! return (moduleHw-1);
}
#endif /* !IGNORE_MODULES */
***************
*** 1387,1391 ****
Module moduleOfScript(s)
Script s; {
! return (s==0) ? modulePrelude : scripts[s-1].moduleHw;
}
--- 1387,1391 ----
Module moduleOfScript(s)
Script s; {
! return scripts[s-1].moduleHw;
}
***************
*** 1394,1400 ****
Module m; {
Script s;
- if (m == modulePrelude) {
- return STD_PRELUDE;
- }
for(s=0; s<scriptHw; ++s) {
if (scripts[s].moduleHw == m) {
--- 1394,1397 ----
***************
*** 1413,1419 ****
return s+1;
}
- }
- if (f == findText(STD_PRELUDE)) {
- return 0;
}
return (-1);
--- 1410,1413 ----
Index: src/storage.h
===================================================================
RCS file: /home/cvs/root/hugs98/src/storage.h,v
retrieving revision 1.20
diff -C2 -r1.20 storage.h
*** src/storage.h 2001/06/14 21:28:52 1.20
--- src/storage.h 2001/08/17 06:27:54
***************
*** 570,574 ****
extern Void setCurrModule Args((Module));
! #define isPrelude(m) (m==modulePrelude)
#endif /* !IGNORE_MODULES */
--- 570,574 ----
extern Void setCurrModule Args((Module));
! #define isPreludeBuiltin(m) (m==modulePreludeBuiltin)
#endif /* !IGNORE_MODULES */
***************
*** 923,927 ****
extern Bool moduleThisScript Args((Module));
extern Module moduleOfScript Args((Script));
! extern Bool isPreludeScript Args((Void));
extern Module lastModule Args((Void));
extern Script scriptThisFile Args((Text));
--- 923,927 ----
extern Bool moduleThisScript Args((Module));
extern Module moduleOfScript Args((Script));
! extern Bool isBaseScript Args((Void));
extern Module lastModule Args((Void));
extern Script scriptThisFile Args((Text));
Index: src/type.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/type.c,v
retrieving revision 1.35
diff -C2 -r1.35 type.c
*** src/type.c 2001/08/07 23:29:59 1.35
--- src/type.c 2001/08/17 06:28:00
***************
*** 33,37 ****
Type typeUnit;
! Module modulePrelude;
Type typeInt;
--- 33,37 ----
Type typeUnit;
! Module modulePreludeBuiltin;
Type typeInt;
***************
*** 3038,3043 ****
#if !IGNORE_MODULES
! modulePrelude = newModule(textPrelude);
! setCurrModule(modulePrelude);
#endif
--- 3038,3043 ----
#if !IGNORE_MODULES
! modulePreludeBuiltin = newModule(textPreludeBuiltin);
! setCurrModule(modulePreludeBuiltin);
#endif