From fad75acc98ef8aec20e387614b3cdbc6821273c9 Mon Sep 17 00:00:00 2001 From: sewardj Date: Thu, 3 Feb 2000 13:55:22 +0000 Subject: [PATCH] [project @ 2000-02-03 13:55:21 by sewardj] -- Make default defaults work in combined mode -- rename some fns in lib/Prelude.hs to match names in HugsPrel.lhs --- ghc/interpreter/free.c | 9 +++---- ghc/interpreter/hugs.c | 6 ++--- ghc/interpreter/lib/Prelude.hs | 4 ++-- ghc/interpreter/link.c | 51 +++++++++++++++++++++++++++++++++------- ghc/interpreter/type.c | 5 ++-- ghc/lib/hugs/Prelude.hs | 4 ++-- 6 files changed, 58 insertions(+), 21 deletions(-) diff --git a/ghc/interpreter/free.c b/ghc/interpreter/free.c index ffa2de1..f9750e0 100644 --- a/ghc/interpreter/free.c +++ b/ghc/interpreter/free.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: free.c,v $ - * $Revision: 1.7 $ - * $Date: 1999/11/01 11:07:07 $ + * $Revision: 1.8 $ + * $Date: 2000/02/03 13:55:21 $ * ------------------------------------------------------------------------*/ #include "prelude.h" @@ -92,6 +92,9 @@ static List freeVarsPrimAlt( List acc, StgPrimAlt alt ) static List freeVarsExpr( List acc, StgExpr e ) { +#if 0 + printf( "freeVarsExpr: " );ppStgExpr(e);printf("\n"); +#endif switch (whatIs(e)) { case LETREC: mapAccum(freeVarsBind,acc,stgLetBinds(e)); @@ -118,11 +121,9 @@ static List freeVarsExpr( List acc, StgExpr e ) case NAME: return acc; /* Names are never free vars */ default: - /* printf("\n"); ppStgExpr(e); printf("\n"); - */ internal("freeVarsExpr"); } } diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c index 57a8fd4..f15a624 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.36 $ - * $Date: 2000/01/12 14:47:27 $ + * $Revision: 1.37 $ + * $Date: 2000/02/03 13:55:21 $ * ------------------------------------------------------------------------*/ #include @@ -1389,7 +1389,7 @@ static Void local evaluator() { /* evaluate expr and print value */ /* allocated during evaluation */ parseExp(); checkExp(); - defaultDefns = evalDefaults; + defaultDefns = combined ? stdDefaults : evalDefaults; type = typeCheckExp(TRUE); if (isPolyType(type)) { diff --git a/ghc/interpreter/lib/Prelude.hs b/ghc/interpreter/lib/Prelude.hs index 30bbcd7..a048123 100644 --- a/ghc/interpreter/lib/Prelude.hs +++ b/ghc/interpreter/lib/Prelude.hs @@ -1561,8 +1561,8 @@ hugsprimPmDouble :: Fractional a => Double -> a -> Bool hugsprimPmDouble n x = fromDouble n == x -- ToDo: make the message more informative. -primPmFail :: a -primPmFail = error "Pattern Match Failure" +hugsprimPmFail :: a +hugsprimPmFail = error "Pattern Match Failure" -- used in desugaring Foreign functions hugsprimMkIO :: (RealWorld -> (a,RealWorld)) -> IO a diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c index 652c46e..b1a3274 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.38 $ - * $Date: 2000/01/12 16:29:47 $ + * $Revision: 1.39 $ + * $Date: 2000/02/03 13:55:21 $ * ------------------------------------------------------------------------*/ #include "prelude.h" @@ -509,6 +509,7 @@ Void linkControl(what) Int what; { Int i; switch (what) { + //case EXIT : fooble();break; case RESET : case MARK : break; @@ -516,9 +517,7 @@ Int what; { case POSTPREL: { Module modulePrelBase = findModule(findText("PrelBase")); assert(nonNull(modulePrelBase)); -#if 1 fprintf(stderr, "linkControl(POSTPREL)\n"); -#if 1 setCurrModule(modulePrelude); linkPreludeTC(); linkPreludeCM(); @@ -526,8 +525,43 @@ Int what; { nameUnpackString = linkName("hugsprimUnpackString"); namePMFail = linkName("hugsprimPmFail"); -#endif -#endif + +#define xyzzy(aaa,bbb) aaa = linkName(bbb) + + + /* pmc */ + xyzzy(nameSel, "_SEL"); + + /* newtype and USE_NEWTYPE_FOR_DICTS */ + xyzzy(nameId, "id"); + + /* strict constructors */ + xyzzy(nameFlip, "flip" ); + + /* parser */ + xyzzy(nameFromTo, "enumFromTo"); + xyzzy(nameFromThenTo, "enumFromThenTo"); + xyzzy(nameFrom, "enumFrom"); + xyzzy(nameFromThen, "enumFromThen"); + + /* deriving */ + xyzzy(nameApp, "++"); + xyzzy(nameReadField, "readField"); + xyzzy(nameReadParen, "readParen"); + xyzzy(nameShowField, "showField"); + xyzzy(nameShowParen, "showParen"); + xyzzy(nameLex, "lex"); + xyzzy(nameComp, "."); + xyzzy(nameAnd, "&&"); + xyzzy(nameCompAux, "primCompAux"); + xyzzy(nameMap, "map"); + + /* implementTagToCon */ + xyzzy(nameError, "error"); + + typeStable = linkTycon("Stable"); + typeRef = linkTycon("IORef"); + // {Prim,PrimByte,PrimMutable,PrimMutableByte}Array ? break; } case PREPREL : @@ -565,7 +599,8 @@ Int what; { pair(STAR,pair(STAR,STAR)), 2,DATATYPE,NIL); - pFun(nameInd, "_indirect"); + /* desugaring */ + pFun(nameInd, "_indirect"); name(nameInd).number = DFUNNAME; } else { @@ -671,5 +706,5 @@ Int what; { } #undef pFun - +#include "fooble.c" /*-------------------------------------------------------------------------*/ diff --git a/ghc/interpreter/type.c b/ghc/interpreter/type.c index 2446ce0..c46657b 100644 --- a/ghc/interpreter/type.c +++ b/ghc/interpreter/type.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: type.c,v $ - * $Revision: 1.22 $ - * $Date: 2000/01/12 14:52:54 $ + * $Revision: 1.23 $ + * $Date: 2000/02/03 13:55:22 $ * ------------------------------------------------------------------------*/ #include "prelude.h" @@ -2807,6 +2807,7 @@ Int what; { nameUnit = findQualNameWithoutConsultingExportList (mkQVar(findText("PrelBase"), findText("()"))); + typeVarToVar = fn(aVar,aVar); } break; diff --git a/ghc/lib/hugs/Prelude.hs b/ghc/lib/hugs/Prelude.hs index 30bbcd7..a048123 100644 --- a/ghc/lib/hugs/Prelude.hs +++ b/ghc/lib/hugs/Prelude.hs @@ -1561,8 +1561,8 @@ hugsprimPmDouble :: Fractional a => Double -> a -> Bool hugsprimPmDouble n x = fromDouble n == x -- ToDo: make the message more informative. -primPmFail :: a -primPmFail = error "Pattern Match Failure" +hugsprimPmFail :: a +hugsprimPmFail = error "Pattern Match Failure" -- used in desugaring Foreign functions hugsprimMkIO :: (RealWorld -> (a,RealWorld)) -> IO a -- 1.7.10.4