X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fderive.c;h=fccff4f9a699c959ed66c67cd2cee12887569921;hb=778b2c6bdbabf2c9f394f0ca2b76b55a7123aa5f;hp=414c7fb69202e7240a12183dc7f7e24397ebac27;hpb=84ece4ab29a5e6fa9c3a3826dce1520785c4ceec;p=ghc-hetmet.git diff --git a/ghc/interpreter/derive.c b/ghc/interpreter/derive.c index 414c7fb..fccff4f 100644 --- a/ghc/interpreter/derive.c +++ b/ghc/interpreter/derive.c @@ -9,17 +9,17 @@ * included in the distribution. * * $RCSfile: derive.c,v $ - * $Revision: 1.10 $ - * $Date: 1999/12/01 10:22:53 $ + * $Revision: 1.15 $ + * $Date: 2000/04/27 16:35:29 $ * ------------------------------------------------------------------------*/ -#include "prelude.h" +#include "hugsbasictypes.h" #include "storage.h" -#include "backend.h" #include "connect.h" #include "errors.h" + +#include "Rts.h" /* to make StgPtr visible in Assembler.h */ #include "Assembler.h" -#include "link.h" List cfunSfuns; /* List of (Cfun,[SelectorVar]) */ @@ -27,25 +27,25 @@ List cfunSfuns; /* List of (Cfun,[SelectorVar]) */ * local function prototypes: * ------------------------------------------------------------------------*/ -static List local getDiVars Args((Int)); -static Cell local mkBind Args((String,List)); -static Cell local mkVarAlts Args((Int,Cell)); -static List local makeDPats2 Args((Cell,Int)); -static Bool local isEnumType Args((Tycon)); -static Pair local mkAltEq Args((Int,List)); -static Pair local mkAltOrd Args((Int,List)); -static Cell local prodRange Args((Int,List,Cell,Cell,Cell)); -static Cell local prodIndex Args((Int,List,Cell,Cell,Cell)); -static Cell local prodInRange Args((Int,List,Cell,Cell,Cell)); -static List local mkIxBinds Args((Int,Cell,Int)); -static Cell local mkAltShow Args((Int,Cell,Int)); -static Cell local showsPrecRhs Args((Cell,Cell,Int)); -static Cell local mkReadCon Args((Name,Cell,Cell)); -static Cell local mkReadPrefix Args((Cell)); -static Cell local mkReadInfix Args((Cell)); -static Cell local mkReadTuple Args((Cell)); -static Cell local mkReadRecord Args((Cell,List)); -static List local mkBndBinds Args((Int,Cell,Int)); +static List local getDiVars ( Int ); +static Cell local mkBind ( String,List ); +static Cell local mkVarAlts ( Int,Cell ); +static List local makeDPats2 ( Cell,Int ); +static Bool local isEnumType ( Tycon ); +static Pair local mkAltEq ( Int,List ); +static Pair local mkAltOrd ( Int,List ); +static Cell local prodRange ( Int,List,Cell,Cell,Cell ); +static Cell local prodIndex ( Int,List,Cell,Cell,Cell ); +static Cell local prodInRange ( Int,List,Cell,Cell,Cell ); +static List local mkIxBinds ( Int,Cell,Int ); +static Cell local mkAltShow ( Int,Cell,Int ); +static Cell local showsPrecRhs ( Cell,Cell,Int ); +static Cell local mkReadCon ( Name,Cell,Cell ); +static Cell local mkReadPrefix ( Cell ); +static Cell local mkReadInfix ( Cell ); +static Cell local mkReadTuple ( Cell ); +static Cell local mkReadRecord ( Cell,List ); +static List local mkBndBinds ( Int,Cell,Int ); /* -------------------------------------------------------------------------- @@ -130,7 +130,7 @@ Tycon t; { /* type (i.e. all constructors arity == 0) */ * constructors in the datatype definition. * ------------------------------------------------------------------------*/ -static Pair local mkAltEq Args((Int,List)); +static Pair local mkAltEq ( Int,List ); List deriveEq(t) /* generate binding for derived == */ Type t; { /* for some TUPLE or DATATYPE t */ @@ -170,7 +170,7 @@ List pats; { /* arguments */ } -static Pair local mkAltOrd Args((Int,List)); +static Pair local mkAltOrd ( Int,List ); List deriveOrd(t) /* make binding for derived compare*/ Type t; { /* for some TUPLE or DATATYPE t */ @@ -259,11 +259,11 @@ Tycon t; { } -static List local mkIxBindsEnum Args((Tycon)); -static List local mkIxBinds Args((Int,Cell,Int)); -static Cell local prodRange Args((Int,List,Cell,Cell,Cell)); -static Cell local prodIndex Args((Int,List,Cell,Cell,Cell)); -static Cell local prodInRange Args((Int,List,Cell,Cell,Cell)); +static List local mkIxBindsEnum ( Tycon ); +static List local mkIxBinds ( Int,Cell,Int ); +static Cell local prodRange ( Int,List,Cell,Cell,Cell ); +static Cell local prodIndex ( Int,List,Cell,Cell,Cell ); +static Cell local prodInRange ( Int,List,Cell,Cell,Cell ); List deriveIx(t) /* Construct definition of indexing */ Tycon t; { @@ -912,14 +912,13 @@ Tycon t; { alts = cons(mkStgCaseAlt(c,vs,tag),alts); } - name(nm).line = tycon(t).line; - name(nm).type = conToTagType(t); - name(nm).arity = 1; - name(nm).stgVar = mkStgVar(mkStgLambda(singleton(v),mkStgCase(v,alts)), - NIL); + name(nm).line = tycon(t).line; + name(nm).type = conToTagType(t); + name(nm).arity = 1; + name(nm).closure = mkStgVar(mkStgLambda(singleton(v),mkStgCase(v,alts)), + NIL); tycon(t).conToTag = nm; - /* hack to make it print out */ - stgGlobals = cons(pair(nm,name(nm).stgVar),stgGlobals); + addToCodeList ( currentModule, nm ); } } @@ -981,24 +980,23 @@ Tycon t; { alts = cons(mkStgPrimAlt(singleton(pat),c),alts); } - name(nm).line = tycon(t).line; - name(nm).type = tagToConType(t); - name(nm).arity = 1; - name(nm).stgVar = mkStgVar( - mkStgLambda( - singleton(v1), - mkStgCase( - v1, - singleton( - mkStgCaseAlt( - nameMkI, - singleton(v2), - mkStgPrimCase(v2,alts))))), - NIL - ); + name(nm).line = tycon(t).line; + name(nm).type = tagToConType(t); + name(nm).arity = 1; + name(nm).closure = mkStgVar( + mkStgLambda( + singleton(v1), + mkStgCase( + v1, + singleton( + mkStgCaseAlt( + nameMkI, + singleton(v2), + mkStgPrimCase(v2,alts))))), + NIL + ); tycon(t).tagToCon = nm; - /* hack to make it print out */ - stgGlobals = cons(pair(nm,name(nm).stgVar),stgGlobals); + addToCodeList ( currentModule, nm ); } } @@ -1010,8 +1008,7 @@ Tycon t; { Void deriveControl(what) Int what; { switch (what) { - case INSTALL : - /* deliberate fall through */ + case PREPREL : case RESET : diVars = NIL; diNum = 0; @@ -1022,6 +1019,8 @@ Int what; { mark(diVars); mark(cfunSfuns); break; + + case POSTPREL: break; } }