[project @ 1999-12-16 16:34:40 by sewardj]

[ghc-hetmet.git] / ghc / interpreter / derive.c

diff --git a/ghc/interpreter/derive.c b/ghc/interpreter/derive.c
index 26f26ec..5a4010a 100644 (file)
--- a/ghc/interpreter/derive.c
+++ b/ghc/interpreter/derive.c
@@ -2,13 +2,15 @@
 /* --------------------------------------------------------------------------
  * Deriving
  *
- * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
- * All rights reserved. See NOTICE for details and conditions of use etc...
- * Hugs version 1.4, December 1997
+ * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
+ * Yale Haskell Group, and the Oregon Graduate Institute of Science and
+ * Technology, 1994-1999, All rights reserved.  It is distributed as
+ * free software under the license in the file "License", which is
+ * included in the distribution.
  *
  * $RCSfile: derive.c,v $
- * $Revision: 1.6 $
- * $Date: 1999/04/27 10:06:50 $
+ * $Revision: 1.11 $
+ * $Date: 1999/12/10 15:59:43 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -253,17 +255,7 @@ Tycon t; {
     implementTagToCon(t);
     return cons(mkBind("toEnum",      mkVarAlts(l,tycon(t).tagToCon)),
            cons(mkBind("fromEnum",    mkVarAlts(l,tycon(t).conToTag)),
-           cons(mkBind("enumFrom",    singleton(pair(singleton(x),  
-                                        pair(mkInt(l),
-                                        ap2(nameFromTo,x,last))))),
-           /* default instance of enumFromTo is good */
-           cons(mkBind("enumFromThen",singleton(pair(doubleton(x,y),
-                                        pair(mkInt(l),
-                                        ap3(nameFromThenTo,x,y,
-                                        ap(COND,triple(ap2(nameLe,x,y),
-                                        last,first))))))),
-           /* default instance of enumFromThenTo is good */
-           NIL))));
+           NIL));
 }
 
 
@@ -338,19 +330,22 @@ Int  n; {
     Cell ls   = h;
     Cell us   = h;
     Cell is   = h;
+    Cell js   = h;
     Cell pr   = NIL;
     Cell pats = NIL;
+    
     Int  i;
 
     for (i=0; i<n; ++i, vs=tl(vs)) {    /* build three patterns for values */
         ls = ap(ls,hd(vs));             /* of the datatype concerned       */
         us = ap(us,hd(vs=tl(vs)));
         is = ap(is,hd(vs=tl(vs)));
+       js = ap(js,hd(vs));             /* ... and one expression          */
     }
     pr   = ap2(mkTuple(2),ls,us);       /* Build (ls,us)                   */
     pats = cons(pr,cons(is,NIL));       /* Build [(ls,us),is]              */
 
-    return cons(prodRange(line,singleton(pr),ls,us,is),
+    return cons(prodRange(line,singleton(pr),ls,us,js),
            cons(prodIndex(line,pats,ls,us,is),
            cons(prodInRange(line,pats,ls,us,is),
            NIL)));
@@ -542,10 +537,11 @@ Int  a; {
             if (defaultSyntax(name(h).text)==APPLIC) {
                 rhs = ap(showsBQ,
                          ap2(nameComp,
-                             ap(nameApp,mkStr(name(h).text)),
+                            ap(nameApp,mkStr(fixLitText(name(h).text))),
                              ap(showsBQ,rhs)));
             } else {
-                rhs = ap2(nameComp,ap(nameApp,mkStr(name(h).text)),rhs);
+               rhs = ap2(nameComp,
+                         ap(nameApp,mkStr(fixLitText(name(h).text))),rhs);
             }
 
             rhs = ap2(nameComp,
@@ -921,7 +917,6 @@ Tycon t; {
         name(nm).arity  = 1;
         name(nm).stgVar = mkStgVar(mkStgLambda(singleton(v),mkStgCase(v,alts)),
                                    NIL);
-        name(nm).stgSize = stgSize(stgVarBody(name(nm).stgVar));
         tycon(t).conToTag = nm;
         /* hack to make it print out */
         stgGlobals = cons(pair(nm,name(nm).stgVar),stgGlobals); 
@@ -1001,7 +996,6 @@ Tycon t; {
                                     mkStgPrimCase(v2,alts))))),
                             NIL
                           );
-        name(nm).stgSize = stgSize(stgVarBody(name(nm).stgVar));
         tycon(t).tagToCon = nm;
         /* hack to make it print out */
         stgGlobals = cons(pair(nm,name(nm).stgVar),stgGlobals); 
@@ -1016,8 +1010,7 @@ Tycon t; {
 Void deriveControl(what)
 Int what; {
     switch (what) {
-        case INSTALL :
-                /* deliberate fall through */
+        case PREPREL :
         case RESET   : 
                 diVars      = NIL;
                 diNum       = 0;
@@ -1028,6 +1021,8 @@ Int what; {
                 mark(diVars);
                 mark(cfunSfuns);
                 break;
+
+       case POSTPREL: break;
     }
 }