Commit acc74b01 authored by sewardj's avatar sewardj
Browse files

[project @ 2000-01-07 16:56:47 by sewardj]

storage.c:   unZcode tuple types (eg Z4T) correctly (off by one)
interface.c(startGHCClass):
              remember to do dictapsToQualtype on class member types
           (processInterfaces): return a Bool if Prelude.hi was
              processed, so we can know when to do everybody(POSTPREL)
parent e541bb94
......@@ -8,8 +8,8 @@
* included in the distribution.
*
* $RCSfile: connect.h,v $
* $Revision: 1.22 $
* $Date: 1999/12/20 16:55:26 $
* $Revision: 1.23 $
* $Date: 2000/01/07 16:56:47 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -554,7 +554,7 @@ extern Void interface Args((Int));
extern Void getFileSize Args((String, Long *));
extern ZPair readInterface Args((String,Long));
extern Void processInterfaces Args((Void));
extern Bool processInterfaces Args((Void));
extern List /* of ZTriple(I_INTERFACE,
Text--name of obj file,
......
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: hugs.c,v $
* $Revision: 1.32 $
* $Date: 2000/01/05 19:10:21 $
* $Revision: 1.33 $
* $Date: 2000/01/07 16:56:47 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
......@@ -965,6 +965,7 @@ String s; { /* to be read in ... */
/* Return TRUE if no imports were needed; FALSE otherwise. */
static Bool local addScript(stacknum) /* read single file */
Int stacknum; {
Bool didPrelude;
static char name[FILENAME_MAX+1];
Int len = scriptInfo[stacknum].size;
......@@ -984,7 +985,13 @@ Int stacknum; {
scriptFile = name;
if (scriptInfo[stacknum].fromSource) {
if (lastWasObject) processInterfaces();
if (lastWasObject) {
didPrelude = processInterfaces();
if (didPrelude) {
preludeLoaded = TRUE;
everybody(POSTPREL);
}
}
lastWasObject = FALSE;
Printf("Reading script \"%s\":\n",name);
needsImports = FALSE;
......@@ -1025,10 +1032,6 @@ Int stacknum; {
scriptFile = 0;
if (strcmp(scriptInfo[stacknum].modName, "Prelude")==0) {
preludeLoaded = TRUE;
everybody(POSTPREL);
}
return TRUE;
}
......@@ -1149,6 +1152,7 @@ Int n; { /* loading everything after and */
Time timeStamp; /* including the first script which*/
Long fileSize; /* has been either changed or added*/
static char name[FILENAME_MAX+1];
Bool didPrelude;
lastWasObject = FALSE;
ppSmStack("readscripts-begin");
......@@ -1246,7 +1250,12 @@ Int n; { /* loading everything after and */
if (numScripts==namesUpto) ppSmStack( "readscripts-final") ;
}
processInterfaces();
didPrelude = processInterfaces();
if (didPrelude) {
preludeLoaded = TRUE;
everybody(POSTPREL);
}
{ Int m = namesUpto-1;
Text mtext = findText(scriptInfo[m].modName);
......
......@@ -7,8 +7,8 @@
* Hugs version 1.4, December 1997
*
* $RCSfile: interface.c,v $
* $Revision: 1.22 $
* $Date: 2000/01/07 15:31:12 $
* $Revision: 1.23 $
* $Date: 2000/01/07 16:56:47 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -537,8 +537,10 @@ Void ppModule ( Text modt )
/* ifaces_outstanding holds a list of parsed interfaces
for which we need to load objects and create symbol
table entries.
Return TRUE if Prelude `elem` ifaces_outstanding, else FALSE.
*/
Void processInterfaces ( void )
Bool processInterfaces ( void )
{
List tmp;
List xs;
......@@ -551,12 +553,13 @@ Void processInterfaces ( void )
Module mod;
List all_known_types;
Int num_known_types;
Bool didPrelude;
List ifaces = NIL; /* :: List I_INTERFACE */
List iface_sizes = NIL; /* :: List Int */
List iface_onames = NIL; /* :: List Text */
if (isNull(ifaces_outstanding)) return;
if (isNull(ifaces_outstanding)) return FALSE;
fprintf ( stderr,
"processInterfaces: %d interfaces to process\n",
......@@ -841,6 +844,7 @@ fprintf(stderr, "abstractify newtype %s\n", textToStr(textOf(getIEntityName(ent)
calling the finishGHC* functions. But don't process
the export lists; those must wait for later.
*/
didPrelude = FALSE;
for (xs = ifaces; nonNull(xs); xs = tl(xs)) {
iface = unap(I_INTERFACE,hd(xs));
mname = textOf(zfst(iface));
......@@ -849,6 +853,8 @@ fprintf(stderr, "abstractify newtype %s\n", textToStr(textOf(getIEntityName(ent)
setCurrModule(mod);
ppModule ( module(mod).text );
if (mname == textPrelude) didPrelude = TRUE;
for (decls = zsnd(iface); nonNull(decls); decls = tl(decls)) {
Cell decl = hd(decls);
switch(whatIs(decl)) {
......@@ -909,6 +915,8 @@ fprintf(stderr, "abstractify newtype %s\n", textToStr(textOf(getIEntityName(ent)
/* Finished! */
ifaces_outstanding = NIL;
return didPrelude;
}
......@@ -1733,6 +1741,7 @@ List mems0; { /* [((VarId, Type))] */
Name mn;
/* Stick the new context on the member type */
memT = dictapsToQualtype(memT);
if (whatIs(memT)==POLYTYPE) internal("startGHCClass");
if (whatIs(memT)==QUAL) {
memT = pair(QUAL,
......
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: storage.c,v $
* $Revision: 1.31 $
* $Date: 2000/01/06 16:33:10 $
* $Revision: 1.32 $
* $Date: 2000/01/07 16:56:47 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -312,7 +312,7 @@ Text unZcodeThenFindText ( String s )
if (*s != 'T') goto parse_error;
s++;
p[n++] = '(';
while (i >= 0) { p[n++] = ','; i--; };
while (i > 0) { p[n++] = ','; i--; };
p[n++] = ')';
break;
default:
......@@ -812,7 +812,7 @@ Tycon addTupleTycon ( Int n )
if (tycon(i).tuple == n) return i;
if (combined)
m = findFakeModule(findText(n<=1 ? "PrelBase" : "PrelTup")); else
m = findFakeModule(findText(n==0 ? "PrelBase" : "PrelTup")); else
m = findModule(findText("Prelude"));
setCurrModule(m);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment