From: sewardj Date: Fri, 3 Dec 1999 17:01:26 +0000 (+0000) Subject: [project @ 1999-12-03 17:01:20 by sewardj] X-Git-Tag: Approximately_9120_patches~5434 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=68b0b216fd91c61f0397d3f5a5ae7bd2f53065ae;p=ghc-hetmet.git [project @ 1999-12-03 17:01:20 by sewardj] More mods to interface file parsing: * Strictness annotations in data decls * Allow qualified names in a couple more places --- diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c index 76e5549..8aad0eb 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.27 $ - * $Date: 1999/12/03 14:38:39 $ + * $Revision: 1.28 $ + * $Date: 1999/12/03 17:01:20 $ * ------------------------------------------------------------------------*/ #include @@ -97,7 +97,7 @@ static Void local browse Args((Void)); * Machine dependent code for Hugs interpreter: * ------------------------------------------------------------------------*/ - Bool combined = FALSE; + Bool combined = TRUE; #include "machdep.c" #ifdef WANT_TIMER diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c index 6eed036..28562d9 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.8 $ - * $Date: 1999/12/03 12:39:40 $ + * $Revision: 1.9 $ + * $Date: 1999/12/03 17:01:21 $ * ------------------------------------------------------------------------*/ /* ToDo: @@ -431,8 +431,8 @@ List syms; { /* [ConId | VarId] -- the names to import */ printf("\naddGHCImport %s\n", textToStr(mn) ); # endif - // Hack to avoid chasing Prel* junk right now - if (strncmp(textToStr(mn), "Prel",4)==0) return; + /* Don't chase PrelGHC -- it doesn't exist */ + if (strncmp(textToStr(mn), "PrelGHC",7)==0) return; found = FALSE; for (t=ifImports; nonNull(t); t=tl(t)) { @@ -552,9 +552,10 @@ Int line; List ctx0; /* [(QConId,VarId)] */ Cell tycon; /* ConId */ List ktyvars; /* [(VarId,Kind)] */ -List constrs0; /* [(ConId,[(Type,Text)],NIL)] +List constrs0; /* [(ConId,[(Type,Text,Int)],NIL)] The NIL will become the constr's type - The Text is an optional field name */ + The Text is an optional field name + The Int indicates strictness */ /* ToDo: worry about being given a decl for (->) ? * and worry about qualidents for () */ @@ -566,6 +567,7 @@ List constrs0; /* [(ConId,[(Type,Text)],NIL)] Cell conid; Pair conArg, ctxElem; Text conArgNm; + Int conArgStrictness; Text t = textOf(tycon); # ifdef DEBUG_IFACE @@ -607,11 +609,13 @@ List constrs0; /* [(ConId,[(Type,Text)],NIL)] tyvarsMentioned = NIL; /* [VarId] */ conArgs = reverse(fields); for (; nonNull(conArgs); conArgs=tl(conArgs)) { - conArg = hd(conArgs); /* (Type,Text) */ - conArgTy = fst(conArg); - conArgNm = snd(conArg); + conArg = hd(conArgs); /* (Type,Text) */ + conArgTy = fst3(conArg); + conArgNm = snd3(conArg); + conArgStrictness = intOf(thd3(conArg)); tyvarsMentioned = dupListOnto(ifTyvarsIn(conArgTy), tyvarsMentioned); + if (conArgStrictness > 0) conArgTy = bang(conArgTy); ty = fn(conArgTy,ty); if (nonNull(conArgNm)) { /* a field name is mentioned too */ @@ -663,7 +667,7 @@ List constrs0; /* [(ConId,[(Type,Text)],NIL)] static List local addGHCConstrs(line,cons,sels) Int line; -List cons; /* [(ConId,[(Type,Text)],Type)] */ +List cons; /* [(ConId,[(Type,Text,Int)],Type)] */ List sels; { /* [(VarId,Type)] */ List cs, ss; Int conNo = 0; /* or maybe 1? */ @@ -707,7 +711,7 @@ Pair sel; /* (VarId,Type) */ static Name local addGHCConstr(line,conNo,constr) Int line; Int conNo; -Triple constr; { /* (ConId,[(Type,Text)],Type) */ +Triple constr; { /* (ConId,[(Type,Text,Int)],Type) */ /* ToDo: add rank2 annotation and existential annotation * these affect how constr can be used. */ @@ -1052,6 +1056,8 @@ List ktyvars; { /* [(VarId|Text,Kind)] */ return ap(DICTAP, tvsToOffsets(line,snd(type),ktyvars)); case UNBOXEDTUP: /* bogus?? */ return ap(UNBOXEDTUP, tvsToOffsets(line,snd(type),ktyvars)); + case BANG: /* bogus?? */ + return ap(BANG, tvsToOffsets(line,snd(type),ktyvars)); case VARIDCELL: /* Ha! some real work to do! */ { Int i = 0; Text tv = textOf(type); diff --git a/ghc/interpreter/parser.y b/ghc/interpreter/parser.y index 8073580..300028d 100644 --- a/ghc/interpreter/parser.y +++ b/ghc/interpreter/parser.y @@ -12,8 +12,8 @@ * included in the distribution. * * $RCSfile: parser.y,v $ - * $Revision: 1.16 $ - * $Date: 1999/12/03 12:39:42 $ + * $Revision: 1.17 $ + * $Date: 1999/12/03 17:01:22 $ * ------------------------------------------------------------------------*/ %{ @@ -25,7 +25,6 @@ #define fixdecl(l,ops,a,p) ap(FIXDECL,\ triple(l,ops,mkInt(mkSyntax(a,intOf(p))))) #define grded(gs) ap(GUARDED,gs) -#define bang(t) ap(BANG,t) #define only(t) ap(ONLY,t) #define letrec(bs,e) (nonNull(bs) ? ap(LETREC,pair(bs,e)) : e) #define qualify(ps,t) (nonNull(ps) ? ap(QUAL,pair(ps,t)) : t) @@ -121,8 +120,8 @@ start : EXPR exp wherePart {inputExpr = letrec($3,$2); sp-=2;} */ /*- Top-level interface files -----------------------------*/ -iface : INTERFACE ifName NUMLIT checkVersion WHERE ifDecls - {$$ = gc6(NIL); } +iface : INTERFACE ifName NUMLIT orphans checkVersion WHERE ifDecls + {$$ = gc7(NIL); } | INTERFACE error {syntaxError("interface file");} ; ifDecls: {$$=gc0(NIL);} @@ -132,12 +131,6 @@ varid_or_conid : VARID { $$=gc1($1); } | CONID { $$=gc1($1); } ; -opt_bang : '!' {$$=gc1(NIL);} - | {$$=gc0(NIL);} - ; -opt_COCO : COCO {$$=gc1(NIL);} - | {$$=gc0(NIL);} - ; ifName : CONID {openGHCIface(textOf($1)); $$ = gc1(NIL);} @@ -145,7 +138,7 @@ checkVersion : NUMLIT {$$ = gc1(NIL); } ; ifDecl - : IMPORT CONID NUMLIT opt_bang opt_COCO version_list_junk + : IMPORT CONID NUMLIT orphans opt_COCO version_list_junk { addGHCImports(intOf($3),textOf($2), $6); $$ = gc6(NIL); @@ -194,6 +187,16 @@ ifDecl ; +/*- Top-level misc interface stuff ------------------------*/ +orphans : '!' {$$=gc1(NIL);} + | {$$=gc0(NIL);} + ; +opt_COCO : COCO {$$=gc1(NIL);} + | {$$=gc0(NIL);} + ; + + + /*- Interface variable and constructor ids ----------------*/ ifTyvar : VARID {$$ = $1;} ; @@ -228,7 +231,7 @@ ifCtxInst /* __forall [a b] {M.C1 a, M.C2 b} => */ | {$$=gc0(NIL);} ; ifInstHd /* { Class aType } :: (ConId, Type) */ - : '{' ifCon ifAType '}' {$$=gc4(ap(DICTAP,pair($2,singleton($3))));} + : '{' ifQCon ifAType '}' {$$=gc4(ap(DICTAP,pair($2,singleton($3))));} ; ifInstHdL /* { C a1 } -> { C2 a2 } -> ... -> { Cn an } :: [(ConId, Type)] */ @@ -257,35 +260,45 @@ ifCtxDeclLE /* M.C1 a :: (QConId,VarId) */ /*- Interface data declarations - constructor lists -------*/ -ifConstrs /* = Con1 | ... | ConN :: [(ConId,[(Type,Text)],NIL)] */ +/* The (Type,Text,Int) are (field type, name (or NIL), strictness). + Strictness is a number: mkInt(0) indicates lazy, mkInt(1) + indicates a strict field (!type) as in standard H98, and + mkInt(2) indicates unpacked -- a GHC extension. +*/ + +ifConstrs /* = Con1 | ... | ConN :: [(ConId,[(Type,Text,Int)],NIL)] */ : {$$ = gc0(NIL);} | '=' ifConstrL {$$ = gc2($2);} ; -ifConstrL /* [(ConId,[(Type,Text)],NIL)] */ +ifConstrL /* [(ConId,[(Type,Text,Int)],NIL)] */ : ifConstr {$$ = gc1(singleton($1));} | ifConstr '|' ifConstrL {$$ = gc3(cons($1,$3));} ; -ifConstr /* (ConId,[(Type,Text)],NIL) */ +ifConstr /* (ConId,[(Type,Text,Int)],NIL) */ : ifConData ifDataAnonFieldL {$$ = gc2(triple($1,$2,NIL));} | ifConData '{' ifDataNamedFieldL '}' {$$ = gc4(triple($1,$3,NIL));} ; -ifDataAnonFieldL /* [(Type,Text)] */ +ifDataAnonFieldL /* [(Type,Text,Int)] */ : {$$=gc0(NIL);} | ifDataAnonField ifDataAnonFieldL {$$=gc2(cons($1,$2));} ; -ifDataNamedFieldL /* [(Type,Text)] */ +ifDataNamedFieldL /* [(Type,Text,Int)] */ : {$$=gc0(NIL);} | ifDataNamedField {$$=gc1(cons($1,NIL));} | ifDataNamedField ',' ifDataNamedFieldL {$$=gc3(cons($1,$3));} ; -ifDataAnonField /* (Type,Text) */ - : ifAType {$$=gc1(pair($1,NIL));} +ifDataAnonField /* (Type,Text,Int) */ + : ifAType {$$=gc1(triple($1,NIL,mkInt(0)));} + | '!' ifAType {$$=gc2(triple($2,NIL,mkInt(1)));} + | '!' '!' ifAType {$$=gc3(triple($3,NIL,mkInt(2)));} ; -ifDataNamedField /* (Type,Text) */ - : VARID COCO ifAType {$$=gc3(pair($3,$1));} +ifDataNamedField /* (Type,Text,Int) */ + : VARID COCO ifAType {$$=gc3(triple($3,$1,mkInt(0)));} + | VARID COCO '!' ifAType {$$=gc4(triple($4,$1,mkInt(1)));} + | VARID COCO '!' '!' ifAType {$$=gc5(triple($5,$1,mkInt(2)));} ; diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c index c705286..a050959 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.20 $ - * $Date: 1999/12/03 12:39:46 $ + * $Revision: 1.21 $ + * $Date: 1999/12/03 17:01:23 $ * ------------------------------------------------------------------------*/ #include "prelude.h" @@ -2048,6 +2048,11 @@ Int depth; { print(snd(c),depth-1); Putchar(')'); break; + case BANG: + Printf("(BANG,"); + print(snd(c),depth-1); + Putchar(')'); + break; default: if (isBoxTag(tag)) { Printf("Tag(%d)=%d", c, tag); diff --git a/ghc/interpreter/storage.h b/ghc/interpreter/storage.h index 9d127b4..36bb320 100644 --- a/ghc/interpreter/storage.h +++ b/ghc/interpreter/storage.h @@ -10,8 +10,8 @@ * included in the distribution. * * $RCSfile: storage.h,v $ - * $Revision: 1.15 $ - * $Date: 1999/12/03 12:39:48 $ + * $Revision: 1.16 $ + * $Date: 1999/12/03 17:01:25 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- @@ -516,6 +516,8 @@ extern Tycon addPrimTycon Args((Text,Kind,Int,Cell,Cell)); #define polySigOf(t) fst(snd(t)) #define monotypeOf(t) snd(snd(t)) +#define bang(t) ap(BANG,t) + /* -------------------------------------------------------------------------- * Globally defined name values: * ------------------------------------------------------------------------*/ diff --git a/ghc/interpreter/translate.c b/ghc/interpreter/translate.c index f85275e..0fb0439 100644 --- a/ghc/interpreter/translate.c +++ b/ghc/interpreter/translate.c @@ -10,8 +10,8 @@ * included in the distribution. * * $RCSfile: translate.c,v $ - * $Revision: 1.20 $ - * $Date: 1999/11/29 18:53:15 $ + * $Revision: 1.21 $ + * $Date: 1999/12/03 17:01:26 $ * ------------------------------------------------------------------------*/ #include "prelude.h" @@ -469,7 +469,7 @@ Void stgDefn( Name n, Int arity, Cell e ) Void implementCfun(c,scs) /* Build implementation for constr */ Name c; /* fun c. scs lists integers (1..)*/ -List scs; { /* in incr order of strict comps. */ +List scs; { /* in incr order of strict fields. */ Int a = name(c).arity; if (a > 0) {