diff options
| -rw-r--r-- | ghc/interpreter/interface.c | 23 | ||||
| -rw-r--r-- | ghc/interpreter/link.c | 6 | ||||
| -rw-r--r-- | ghc/interpreter/storage.c | 28 |
3 files changed, 33 insertions, 24 deletions
diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c index 993e6405cb..cf4e399546 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.28 $ - * $Date: 2000/02/08 15:32:30 $ + * $Revision: 1.29 $ + * $Date: 2000/02/08 17:50:46 $ * ------------------------------------------------------------------------*/ #include "prelude.h" @@ -566,7 +566,6 @@ static void* ifFindItblFor ( Name n ) t = enZcodeThenFindText(buf); p = lookupOTabName ( name(n).mod, textToStr(t) ); -if (p) fprintf(stderr, "FOUND `%s'\n",textToStr(t)); if (p) return p; if (name(n).arity == 0) { @@ -575,7 +574,6 @@ if (p) fprintf(stderr, "FOUND `%s'\n",textToStr(t)); textToStr( name(n).text ) ); t = enZcodeThenFindText(buf); p = lookupOTabName ( name(n).mod, textToStr(t) ); -if (p) fprintf(stderr, "FOUND `%s'\n",textToStr(t)); if (p) return p; } @@ -587,11 +585,14 @@ if (p) fprintf(stderr, "FOUND `%s'\n",textToStr(t)); void ifLinkConstrItbl ( Name n ) { /* name(n) is either a constructor or a field name. - If the latter, ignore it. Otherwise, find its info table - in the object code. + If the latter, ignore it. If it is a non-nullary constructor, + find its info table in the object code. If it's nullary, + we can skip the info table, since all accesses will go via + the _closure label. */ - if (!islower(textToStr(name(n).text)[0])) - name(n).itbl = ifFindItblFor(n); + if (islower(textToStr(name(n).text)[0])) return; + if (name(n).arity == 0) return; + name(n).itbl = ifFindItblFor(n); } @@ -1971,7 +1972,7 @@ static Class finishGHCClass ( Tycon cls_tyc ) if (isNull(nw)) internal("finishGHCClass"); line = cclass(nw).line; - ctr = - length(cclass(nw).members); + ctr = -2; assert (currentModule == cclass(nw).mod); cclass(nw).level = 0; @@ -1986,10 +1987,9 @@ static Class finishGHCClass ( Tycon cls_tyc ) Name n = findName(txt); assert(nonNull(n)); name(n).text = txt; -fprintf(stderr, "TEXT IS `%s'\n", textToStr(name(n).text)); name(n).line = cclass(nw).line; name(n).type = ty; - name(n).number = ctr++; + name(n).number = ctr--; name(n).arity = arityInclDictParams(name(n).type); name(n).parent = nw; hd(mems) = n; @@ -2063,7 +2063,6 @@ VarId var; { /* VarId */ { Name b = newName( /*inventText()*/ textOf(var),NIL); -fprintf(stderr, "DICTIONARY NAME `%s'\n", textToStr(textOf(var)) ); name(b).line = line; name(b).arity = length(spec); /* unused? */ /* and surely wrong */ name(b).number = DFUNNAME; diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c index bb42e1c6c7..f107aa7f8a 100644 --- a/ghc/interpreter/link.c +++ b/ghc/interpreter/link.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: link.c,v $ - * $Revision: 1.40 $ - * $Date: 2000/02/08 15:32:30 $ + * $Revision: 1.41 $ + * $Date: 2000/02/08 17:50:46 $ * ------------------------------------------------------------------------*/ #include "prelude.h" @@ -530,7 +530,7 @@ assert(nonNull(namePMFail)); /* pmc */ - xyzzy(nameSel, "_SEL"); + pFun(nameSel, "_SEL"); /* strict constructors */ xyzzy(nameFlip, "flip" ); diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c index 193613ee5e..39558ff379 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.41 $ - * $Date: 2000/02/08 15:32:30 $ + * $Revision: 1.42 $ + * $Date: 2000/02/08 17:50:46 $ * ------------------------------------------------------------------------*/ #include "prelude.h" @@ -2942,6 +2942,11 @@ static String maybeTyconStr ( Tycon t ) if (isTycon(t)) return textToStr(tycon(t).text); else return "??"; } +static String maybeClassStr ( Class c ) +{ + if (isClass(c)) return textToStr(cclass(c).text); else return "??"; +} + static String maybeText ( Text t ) { if (isNull(t)) return "(nil)"; @@ -2963,8 +2968,7 @@ void dumpTycon ( Int t ) printf ( "{\n" ); printf ( " text: %s\n", textToStr(tycon(t).text) ); printf ( " line: %d\n", tycon(t).line ); - printf ( " mod: %d %s\n", tycon(t).mod, - maybeModuleStr(tycon(t).mod)); + printf ( " mod: %s\n", maybeModuleStr(tycon(t).mod)); printf ( " tuple: %d\n", tycon(t).tuple); printf ( " arity: %d\n", tycon(t).arity); printf ( " kind: "); print100(tycon(t).kind); @@ -2990,8 +2994,7 @@ void dumpName ( Int n ) printf ( "{\n" ); printf ( " text: %s\n", textToStr(name(n).text) ); printf ( " line: %d\n", name(n).line ); - printf ( " mod: %d %s\n", name(n).mod, - maybeModuleStr(name(n).mod)); + printf ( " mod: %s\n", maybeModuleStr(name(n).mod)); printf ( " syntax: %d\n", name(n).syntax ); printf ( " parent: %d\n", name(n).parent ); printf ( " arity: %d\n", name(n).arity ); @@ -3017,8 +3020,7 @@ void dumpClass ( Int c ) printf ( "{\n" ); printf ( " text: %s\n", textToStr(cclass(c).text) ); printf ( " line: %d\n", cclass(c).line ); - printf ( " mod: %d %s\n", cclass(c).mod, - maybeModuleStr(cclass(c).mod)); + printf ( " mod: %s\n", maybeModuleStr(cclass(c).mod)); printf ( " arity: %d\n", cclass(c).arity ); printf ( " level: %d\n", cclass(c).level ); printf ( " kinds: "); print100( cclass(c).kinds ); @@ -3045,7 +3047,15 @@ void dumpInst ( Int i ) return; } printf ( "{\n" ); -// printf ( " text: %s\n", textToStr(cclass(c)).text) ); + printf ( " class: %s\n", maybeClassStr(inst(i).c) ); + printf ( " line: %d\n", inst(i).line ); + printf ( " mod: %s\n", maybeModuleStr(inst(i).mod)); + printf ( " kinds: "); print100( inst(i).kinds ); + printf ( " head: "); print100( inst(i).head ); + printf ( " specs: "); print100( inst(i).specifics ); + printf ( " #specs: %d\n", inst(i).numSpecifics ); + printf ( " impls: "); print100( inst(i).implements ); + printf ( " builder: %s\n", maybeNameStr( inst(i).builder ) ); printf ( "}\n" ); } |