From acc74b0119bdf71eb0bf37616f4d400c5a3a6ab7 Mon Sep 17 00:00:00 2001 From: sewardj Date: Fri, 7 Jan 2000 16:56:47 +0000 Subject: [PATCH] [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) --- ghc/interpreter/connect.h | 6 +++--- ghc/interpreter/hugs.c | 25 +++++++++++++++++-------- ghc/interpreter/interface.c | 17 +++++++++++++---- ghc/interpreter/storage.c | 8 ++++---- 4 files changed, 37 insertions(+), 19 deletions(-) diff --git a/ghc/interpreter/connect.h b/ghc/interpreter/connect.h index ff99e1e..d634c9d 100644 --- a/ghc/interpreter/connect.h +++ b/ghc/interpreter/connect.h @@ -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, diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c index 9b69788..1d7b094 100644 --- a/ghc/interpreter/hugs.c +++ b/ghc/interpreter/hugs.c @@ -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 @@ -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); diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c index f3cb05c..26ba51d 100644 --- a/ghc/interpreter/interface.c +++ b/ghc/interpreter/interface.c @@ -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, diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c index b26e386..d18eabf 100644 --- a/ghc/interpreter/storage.c +++ b/ghc/interpreter/storage.c @@ -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); -- 1.7.10.4