X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Flink.c;h=31ac68d1aa84d62665e7950416bea493a697a9de;hb=11239ef19f0253309d55477a8fbf0e476c4b10a3;hp=3fc88fe770dd76b6fa1ed8c1bf7ec4d17f890b7a;hpb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;p=ghc-hetmet.git diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c index 3fc88fe..31ac68d 100644 --- a/ghc/interpreter/link.c +++ b/ghc/interpreter/link.c @@ -1,67 +1,50 @@ -/* -*- mode: hugs-c; -*- */ + /* -------------------------------------------------------------------------- * Load symbols required from the Prelude * - * 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: link.c,v $ - * $Revision: 1.2 $ - * $Date: 1998/12/02 13:22:18 $ + * $Revision: 1.58 $ + * $Date: 2000/04/07 16:22:12 $ * ------------------------------------------------------------------------*/ -#include "prelude.h" +#include "hugsbasictypes.h" #include "storage.h" #include "connect.h" -#include "static.h" -#include "translate.h" -#include "type.h" #include "errors.h" -#include "Assembler.h" /* for asmPrimOps and AsmReps */ - -#include "link.h" +#include "Assembler.h" /* for asmPrimOps and AsmReps */ +#include "Rts.h" /* to make Prelude.h palatable */ +#include "Prelude.h" /* for fixupRTStoPreludeRefs */ -Module modulePreludeHugs; Type typeArrow; /* Function spaces */ Type typeChar; Type typeInt; -#ifdef PROVIDE_INT64 -Type typeInt64; -#endif -#ifdef PROVIDE_INTEGER Type typeInteger; -#endif -#ifdef PROVIDE_WORD Type typeWord; -#endif -#ifdef PROVIDE_ADDR Type typeAddr; -#endif -#ifdef PROVIDE_ARRAY Type typePrimArray; Type typePrimByteArray; Type typeRef; Type typePrimMutableArray; Type typePrimMutableByteArray; -#endif Type typeFloat; Type typeDouble; -#ifdef PROVIDE_STABLE Type typeStable; -#endif +Type typeThreadId; +Type typeMVar; #ifdef PROVIDE_WEAK Type typeWeak; #endif #ifdef PROVIDE_FOREIGN Type typeForeign; #endif -#ifdef PROVIDE_CONCURRENT -Type typeThreadId; -Type typeMVar; -#endif Type typeList; Type typeUnit; @@ -78,9 +61,6 @@ Class classRead; Class classIx; Class classEnum; Class classBounded; -#if EVAL_INSTANCES -Class classEval; -#endif Class classReal; /* `numeric' classes */ Class classIntegral; @@ -89,42 +69,35 @@ Class classRealFloat; Class classFractional; Class classFloating; Class classNum; - Class classMonad; /* Monads and monads with a zero */ -Class classMonad0; List stdDefaults; /* standard default values */ -Name nameTrue, nameFalse; /* primitive boolean constructors */ -Name nameNil, nameCons; /* primitive list constructors */ +Name nameTrue; +Name nameFalse; /* primitive boolean constructors */ +Name nameNil; +Name nameCons; /* primitive list constructors */ Name nameUnit; /* primitive Unit type constructor */ Name nameEq; -Name nameFromInt, nameFromDouble; /* coercion of numerics */ +Name nameFromInt; +Name nameFromDouble; /* coercion of numerics */ Name nameFromInteger; -Name nameReturn, nameBind; /* for translating monad comps */ +Name nameReturn; +Name nameBind; /* for translating monad comps */ Name nameZero; /* for monads with a zero */ -#if EVAL_INSTANCES -Name nameStrict; /* Members of class Eval */ -Name nameSeq; -#endif Name nameId; -Name nameRunIO; +Name nameShow; +Name namePutStr; +Name nameRunIO_toplevel; Name namePrint; Name nameOtherwise; Name nameUndefined; /* generic undefined value */ -#if NPLUSK Name namePmSub; -#endif Name namePMFail; Name nameEqChar; -Name nameEqInt; -#if !OVERLOADED_CONSTANTS -Name nameEqInteger; -#endif -Name nameEqDouble; Name namePmInt; Name namePmInteger; Name namePmDouble; @@ -135,64 +108,128 @@ Name nameMkIO; Name nameUnpackString; Name nameError; Name nameInd; - -Name nameForce; +Name nameCreateAdjThunk; + +Name nameAnd; +Name nameCompAux; +Name nameRangeSize; +Name nameComp; +Name nameShowField; +Name nameApp; +Name nameShowParen; +Name nameReadParen; +Name nameLex; +Name nameReadField; +Name nameFlip; + +Name namePrimSeq; +Name namePrimCatch; +Name namePrimRaise; +Name namePrimTakeMVar; + +Name nameFromTo; +Name nameFromThen; +Name nameFrom; +Name nameFromThenTo; +Name nameNegate; + +Name nameAssert; +Name nameAssertError; +Name nameTangleMessage; +Name nameIrrefutPatError; +Name nameNoMethodBindingError; +Name nameNonExhaustiveGuardsError; +Name namePatError; +Name nameRecSelError; +Name nameRecConError; +Name nameRecUpdError; /* these names are required before we've had a chance to do the right thing */ Name nameSel; +Name nameUnsafeUnpackCString; /* constructors used during translation and codegen */ Name nameMkC; /* Char# -> Char */ Name nameMkI; /* Int# -> Int */ -#ifdef PROVIDE_INT64 -Name nameMkInt64; /* Int64# -> Int64 */ -#endif -#ifdef PROVIDE_INTEGER Name nameMkInteger; /* Integer# -> Integer */ -#endif -#ifdef PROVIDE_WORD Name nameMkW; /* Word# -> Word */ -#endif -#ifdef PROVIDE_ADDR Name nameMkA; /* Addr# -> Addr */ -#endif Name nameMkF; /* Float# -> Float */ Name nameMkD; /* Double# -> Double */ -#ifdef PROVIDE_ARRAY Name nameMkPrimArray; Name nameMkPrimByteArray; Name nameMkRef; Name nameMkPrimMutableArray; Name nameMkPrimMutableByteArray; -#endif -#ifdef PROVIDE_STABLE Name nameMkStable; /* StablePtr# a -> StablePtr a */ -#endif +Name nameMkThreadId; /* ThreadId# -> ThreadId */ +Name nameMkPrimMVar; /* MVar# a -> MVar a */ #ifdef PROVIDE_WEAK Name nameMkWeak; /* Weak# a -> Weak a */ #endif #ifdef PROVIDE_FOREIGN Name nameMkForeign; /* ForeignObj# -> ForeignObj */ #endif -#ifdef PROVIDE_CONCURRENT -Name nameMkThreadId; /* ThreadId# -> ThreadId */ -Name nameMkMVar; /* MVar# -> MVar */ -#endif + + + +Name nameMinBnd; +Name nameMaxBnd; +Name nameCompare; +Name nameShowsPrec; +Name nameIndex; +Name nameReadsPrec; +Name nameRange; +Name nameEQ; +Name nameInRange; +Name nameGt; +Name nameLe; +Name namePlus; +Name nameMult; +Name nameMFail; +Type typeOrdering; +Module modulePrelPrim; +Module modulePrelude; +Name nameMap; +Name nameMinus; + +/* -------------------------------------------------------------------------- + * Frequently used type skeletons: + * ------------------------------------------------------------------------*/ + +Type arrow; /* mkOffset(0) -> mkOffset(1) */ +Type boundPair; /* (mkOffset(0),mkOffset(0)) */ +Type listof; /* [ mkOffset(0) ] */ +Type typeVarToVar; /* mkOffset(0) -> mkOffset(0) */ + +Cell predNum; /* Num (mkOffset(0)) */ +Cell predFractional; /* Fractional (mkOffset(0)) */ +Cell predIntegral; /* Integral (mkOffset(0)) */ +Kind starToStar; /* Type -> Type */ +Cell predMonad; /* Monad (mkOffset(0)) */ +Type typeProgIO; /* IO a */ + /* -------------------------------------------------------------------------- * * ------------------------------------------------------------------------*/ -static Tycon linkTycon( String s ); -static Tycon linkClass( String s ); -static Name linkName ( String s ); +static Tycon linkTycon ( String s ); +static Tycon linkClass ( String s ); +static Name linkName ( String s ); +static Name predefinePrim ( String s ); + static Tycon linkTycon( String s ) { Tycon tc = findTycon(findText(s)); - if (nonNull(tc)) { - return tc; + if (nonNull(tc)) return tc; + if (combined) { + tc = findTyconInAnyModule(findText(s)); + if (nonNull(tc)) return tc; } +FPrintf(stderr, "frambozenvla! unknown tycon %s\n", s ); +return NIL; ERRMSG(0) "Prelude does not define standard type \"%s\"", s EEND; } @@ -200,9 +237,13 @@ static Tycon linkTycon( String s ) static Class linkClass( String s ) { Class cc = findClass(findText(s)); - if (nonNull(cc)) { - return cc; - } + if (nonNull(cc)) return cc; + if (combined) { + cc = findClassInAnyModule(findText(s)); + if (nonNull(cc)) return cc; + } +FPrintf(stderr, "frambozenvla! unknown class %s\n", s ); +return NIL; ERRMSG(0) "Prelude does not define standard class \"%s\"", s EEND; } @@ -210,293 +251,574 @@ static Class linkClass( String s ) static Name linkName( String s ) { Name n = findName(findText(s)); - if (nonNull(n)) { - return n; - } + if (nonNull(n)) return n; + if (combined) { + n = findNameInAnyModule(findText(s)); + if (nonNull(n)) return n; + } +FPrintf(stderr, "frambozenvla! unknown name %s\n", s ); +return NIL; ERRMSG(0) "Prelude does not define standard name \"%s\"", s EEND; } -/* ToDo: kill this! */ -static Name predefinePrim ( String s ); -static Name predefinePrim ( String s ) +static Name predefinePrim ( String s ) { - Name nm = newName(findText(s)); - name(nm).defn=PREDEFINED; + Name nm; + Text t = findText(s); + nm = findName(t); + if (nonNull(nm)) { + //fprintf(stderr, "predefinePrim: %s already exists\n", s ); + } else { + nm = newName(t,NIL); + name(nm).defn=PREDEFINED; + } return nm; } -Void linkPreludeTC() { /* Hook to tycons and classes in */ + +/* -------------------------------------------------------------------------- + * + * ------------------------------------------------------------------------*/ + +/* In standalone mode, linkPreludeTC, linkPreludeCM and linkPrimNames + are called, in that order, during static analysis of Prelude.hs. + In combined mode such an analysis does not happen. Instead these + calls will be made as a result of a call link(POSTPREL). + + linkPreludeTC, linkPreludeCM and linkPreludeNames are needed in both + standalone and combined modes. +*/ + + +Void linkPreludeTC(void) { /* Hook to tycons and classes in */ static Bool initialised = FALSE; /* prelude when first loaded */ if (!initialised) { Int i; initialised = TRUE; - setCurrModule(modulePreludeHugs); - - typeChar = linkTycon("Char"); - typeInt = linkTycon("Int"); -#ifdef PROVIDE_INT64 - typeInt64 = linkTycon("Int64"); -#endif -#ifdef PROVIDE_INTEGER - typeInteger = linkTycon("Integer"); -#endif -#ifdef PROVIDE_WORD - typeWord = linkTycon("Word"); -#endif -#ifdef PROVIDE_ADDR - typeAddr = linkTycon("Addr"); -#endif -#ifdef PROVIDE_ARRAY + if (combined) { + setCurrModule(modulePrelude); + } else { + setCurrModule(modulePrelPrim); + } + + typeChar = linkTycon("Char"); + typeInt = linkTycon("Int"); + typeInteger = linkTycon("Integer"); + typeWord = linkTycon("Word"); + typeAddr = linkTycon("Addr"); typePrimArray = linkTycon("PrimArray"); typePrimByteArray = linkTycon("PrimByteArray"); - typeRef = linkTycon("Ref"); + typeRef = linkTycon("STRef"); typePrimMutableArray = linkTycon("PrimMutableArray"); typePrimMutableByteArray = linkTycon("PrimMutableByteArray"); -#endif - typeFloat = linkTycon("Float"); - typeDouble = linkTycon("Double"); -#ifdef PROVIDE_STABLE - typeStable = linkTycon("StablePtr"); -#endif -#ifdef PROVIDE_WEAK - typeWeak = linkTycon("Weak"); -#endif -#ifdef PROVIDE_FOREIGN - typeForeign = linkTycon("ForeignObj"); -#endif -#ifdef PROVIDE_CONCURRENT - typeThreadId = linkTycon("ThreadId"); - typeMVar = linkTycon("MVar"); -#endif - - typeBool = linkTycon("Bool"); - typeST = linkTycon("ST"); - typeIO = linkTycon("IO"); - typeException = linkTycon("Exception"); - typeList = linkTycon("[]"); - typeUnit = linkTycon("()"); - typeString = linkTycon("String"); - - classEq = linkClass("Eq"); - classOrd = linkClass("Ord"); - classIx = linkClass("Ix"); - classEnum = linkClass("Enum"); - classShow = linkClass("Show"); - classRead = linkClass("Read"); - classBounded = linkClass("Bounded"); -#if EVAL_INSTANCES - classEval = linkClass("Eval"); -#endif - classReal = linkClass("Real"); - classIntegral = linkClass("Integral"); - classRealFrac = linkClass("RealFrac"); - classRealFloat = linkClass("RealFloat"); - classFractional = linkClass("Fractional"); - classFloating = linkClass("Floating"); - classNum = linkClass("Num"); - classMonad = linkClass("Monad"); - classMonad0 = linkClass("MonadZero"); - - stdDefaults = NIL; - stdDefaults = cons(typeDouble,stdDefaults); -#if DEFAULT_BIGNUM - stdDefaults = cons(typeBignum,stdDefaults); -#else - stdDefaults = cons(typeInt,stdDefaults); -#endif - mkTypes(); - - nameMkC = addPrimCfun(findText("C#"),1,0,CHAR_REP); - nameMkI = addPrimCfun(findText("I#"),1,0,INT_REP); -#ifdef PROVIDE_INT64 - nameMkInt64 = addPrimCfun(findText("Int64#"),1,0,INT64_REP); -#endif -#ifdef PROVIDE_WORD - nameMkW = addPrimCfun(findText("W#"),1,0,WORD_REP); -#endif -#ifdef PROVIDE_ADDR - nameMkA = addPrimCfun(findText("A#"),1,0,ADDR_REP); -#endif - nameMkF = addPrimCfun(findText("F#"),1,0,FLOAT_REP); - nameMkD = addPrimCfun(findText("D#"),1,0,DOUBLE_REP); -#ifdef PROVIDE_STABLE - nameMkStable = addPrimCfun(findText("Stable#"),1,0,STABLE_REP); -#endif - -#ifdef PROVIDE_INTEGER - nameMkInteger = addPrimCfun(findText("Integer#"),1,0,0); -#endif -#ifdef PROVIDE_FOREIGN - nameMkForeign = addPrimCfun(findText("Foreign#"),1,0,0); -#endif -#ifdef PROVIDE_WEAK - nameMkWeak = addPrimCfun(findText("Weak#"),1,0,0); -#endif -#ifdef PROVIDE_ARRAY - nameMkPrimArray = addPrimCfun(findText("PrimArray#"),1,0,0); - nameMkPrimByteArray = addPrimCfun(findText("PrimByteArray#"),1,0,0); - nameMkRef = addPrimCfun(findText("Ref#"),1,0,0); - nameMkPrimMutableArray = addPrimCfun(findText("PrimMutableArray#"),1,0,0); - nameMkPrimMutableByteArray = addPrimCfun(findText("PrimMutableByteArray#"),1,0,0); -#endif -#ifdef PROVIDE_CONCURRENT - nameMkThreadId = addPrimCfun(findText("ThreadId#"),1,0,0); - nameMkMVar = addPrimCfun(findText("MVar#"),1,0,0); -#endif - -#if EVAL_INSTANCES - addEvalInst(0,typeArrow,2,NIL); /* Add Eval instances for (->) */ -#endif + typeFloat = linkTycon("Float"); + typeDouble = linkTycon("Double"); + typeStable = linkTycon("StablePtr"); +# ifdef PROVIDE_WEAK + typeWeak = linkTycon("Weak"); +# endif +# ifdef PROVIDE_FOREIGN + typeForeign = linkTycon("ForeignObj"); +# endif + typeThreadId = linkTycon("ThreadId"); + typeMVar = linkTycon("MVar"); + typeBool = linkTycon("Bool"); + typeST = linkTycon("ST"); + typeIO = linkTycon("IO"); + typeException = linkTycon("Exception"); + typeString = linkTycon("String"); + typeOrdering = linkTycon("Ordering"); + + classEq = linkClass("Eq"); + classOrd = linkClass("Ord"); + classIx = linkClass("Ix"); + classEnum = linkClass("Enum"); + classShow = linkClass("Show"); + classRead = linkClass("Read"); + classBounded = linkClass("Bounded"); + classReal = linkClass("Real"); + classIntegral = linkClass("Integral"); + classRealFrac = linkClass("RealFrac"); + classRealFloat = linkClass("RealFloat"); + classFractional = linkClass("Fractional"); + classFloating = linkClass("Floating"); + classNum = linkClass("Num"); + classMonad = linkClass("Monad"); + + stdDefaults = NIL; + stdDefaults = cons(typeDouble,stdDefaults); + stdDefaults = cons(typeInteger,stdDefaults); + + predNum = ap(classNum,aVar); + predFractional = ap(classFractional,aVar); + predIntegral = ap(classIntegral,aVar); + predMonad = ap(classMonad,aVar); + typeProgIO = ap(typeIO,aVar); + + nameMkC = addPrimCfunREP(findText("C#"),1,0,CHAR_REP); + nameMkI = addPrimCfunREP(findText("I#"),1,0,INT_REP); + nameMkW = addPrimCfunREP(findText("W#"),1,0,WORD_REP); + nameMkA = addPrimCfunREP(findText("A#"),1,0,ADDR_REP); + nameMkF = addPrimCfunREP(findText("F#"),1,0,FLOAT_REP); + nameMkD = addPrimCfunREP(findText("D#"),1,0,DOUBLE_REP); + nameMkStable = addPrimCfunREP(findText("Stable#"),1,0,STABLE_REP); + nameMkThreadId = addPrimCfunREP(findText("ThreadId#"),1,0,THREADID_REP); + +# ifdef PROVIDE_FOREIGN + nameMkForeign = addPrimCfunREP(findText("Foreign#"),1,0,0); +# endif +# ifdef PROVIDE_WEAK + nameMkWeak = addPrimCfunREP(findText("Weak#"),1,0,0); +# endif + nameMkPrimArray = addPrimCfunREP(findText("PrimArray#"),1,0,0); + nameMkPrimByteArray = addPrimCfunREP(findText("PrimByteArray#"),1,0,0); + nameMkRef = addPrimCfunREP(findText("STRef#"),1,0,0); + nameMkPrimMutableArray = addPrimCfunREP(findText("PrimMutableArray#"),1,0,0); + nameMkPrimMutableByteArray = addPrimCfunREP(findText("PrimMutableByteArray#"),1,0,0); + nameMkPrimMVar = addPrimCfunREP(findText("MVar#"),1,0,0); + nameMkInteger = addPrimCfunREP(findText("Integer#"),1,0,0); + + if (!combined) { + name(namePrimSeq).type = primType(MONAD_Id, "ab", "b"); + name(namePrimCatch).type = primType(MONAD_Id, "aH", "a"); + name(namePrimRaise).type = primType(MONAD_Id, "E", "a"); + + /* This is a lie. For a more accurate type of primTakeMVar + see ghc/interpreter/lib/Prelude.hs. + */ + name(namePrimTakeMVar).type = primType(MONAD_Id, "rbc", "d"); + } - for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */ -#if EVAL_INSTANCES - addEvalInst(0,mkTuple(i),i,NIL); -#endif -#if DERIVE_EQ - addTupInst(classEq,i); -#endif -#if DERIVE_ORD - addTupInst(classOrd,i); -#endif -#if DERIVE_IX - addTupInst(classIx,i); -#endif -#if DERIVE_SHOW - addTupInst(classShow,i); -#endif -#if DERIVE_READ - addTupInst(classRead,i); -#endif -#if DERIVE_BOUNDED - addTupInst(classBounded,i); -#endif + if (!combined) { + for (i=2; i<=NUM_DTUPLES; i++) {/* Add derived instances of tuples */ + addTupInst(classEq,i); + addTupInst(classOrd,i); + addTupInst(classIx,i); + addTupInst(classShow,i); + addTupInst(classRead,i); + addTupInst(classBounded,i); + } } } } -Void linkPreludeCM() { /* Hook to cfuns and mfuns in */ +Void linkPreludeCM(void) { /* Hook to cfuns and mfuns in */ static Bool initialised = FALSE; /* prelude when first loaded */ if (!initialised) { Int i; initialised = TRUE; - setCurrModule(modulePreludeHugs); + + if (combined) { + setCurrModule(modulePrelude); + } else { + setCurrModule(modulePrelPrim); + } + /* constructors */ - nameFalse = linkName("False"); - nameTrue = linkName("True"); - nameNil = linkName("[]"); - nameCons = linkName(":"); - nameUnit = linkName("()"); - /* members */ - nameEq = linkName("=="); - nameFromInt = linkName("fromInt"); - nameFromInteger = linkName("fromInteger"); - nameFromDouble = linkName("fromDouble"); -#if EVAL_INSTANCES - nameStrict = linkName("strict"); - nameSeq = linkName("seq"); -#endif - nameReturn = linkName("return"); - nameBind = linkName(">>="); - nameZero = linkName("zero"); + nameFalse = linkName("False"); + nameTrue = linkName("True"); + /* members */ + nameEq = linkName("=="); + nameFromInt = linkName("fromInt"); + nameFromInteger = linkName("fromInteger"); + nameReturn = linkName("return"); + nameBind = linkName(">>="); + nameMFail = linkName("fail"); + nameLe = linkName("<="); + nameGt = linkName(">"); + nameShowsPrec = linkName("showsPrec"); + nameReadsPrec = linkName("readsPrec"); + nameEQ = linkName("EQ"); + nameCompare = linkName("compare"); + nameMinBnd = linkName("minBound"); + nameMaxBnd = linkName("maxBound"); + nameRange = linkName("range"); + nameIndex = linkName("index"); + namePlus = linkName("+"); + nameMult = linkName("*"); + nameRangeSize = linkName("rangeSize"); + nameInRange = linkName("inRange"); + nameMinus = linkName("-"); /* These come before calls to implementPrim */ - for(i=0; i)"), - pair(STAR,pair(STAR,STAR)), - 2,DATATYPE,NIL); - - /* ToDo: fix pFun (or eliminate its use) */ -#define pFun(n,s,t) n = predefinePrim(s) - /* newtype and USE_NEWTYPE_FOR_DICTS */ - pFun(nameId, "id", "id"); - /* desugaring */ - pFun(nameInd, "_indirect","error"); - name(nameInd).number = DFUNNAME; - /* pmc */ - pFun(nameSel, "_SEL", "sel"); - /* strict constructors */ - pFun(nameForce, "primForce","id"); - /* implementTagToCon */ - pFun(namePMFail, "primPmFail","primPmFail"); -#undef pFun - - break; + case POSTPREL: { + Name nm; + Module modulePrelBase = findModule(findText("PrelBase")); + assert(nonNull(modulePrelBase)); + /* fprintf(stderr, "linkControl(POSTPREL)\n"); */ + setCurrModule(modulePrelude); + linkPreludeTC(); + linkPreludeCM(); + linkPrimNames(); + fixupRTStoPreludeRefs ( lookupObjName ); + + nameUnpackString = linkName("hugsprimUnpackString"); + namePMFail = linkName("hugsprimPmFail"); +assert(nonNull(namePMFail)); +#define xyzzy(aaa,bbb) aaa = linkName(bbb) + + + /* pmc */ + pFun(nameSel, "_SEL"); + + /* strict constructors */ + xyzzy(nameFlip, "flip" ); + + /* parser */ + xyzzy(nameFromTo, "enumFromTo"); + xyzzy(nameFromThenTo, "enumFromThenTo"); + xyzzy(nameFrom, "enumFrom"); + xyzzy(nameFromThen, "enumFromThen"); + + /* deriving */ + xyzzy(nameApp, "++"); + xyzzy(nameReadField, "hugsprimReadField"); + xyzzy(nameReadParen, "readParen"); + xyzzy(nameShowField, "hugsprimShowField"); + xyzzy(nameShowParen, "showParen"); + xyzzy(nameLex, "lex"); + xyzzy(nameComp, "."); + xyzzy(nameAnd, "&&"); + xyzzy(nameCompAux, "hugsprimCompAux"); + xyzzy(nameMap, "map"); + + /* implementTagToCon */ + xyzzy(nameError, "hugsprimError"); + + + typeStable = linkTycon("Stable"); + typeRef = linkTycon("IORef"); + // {Prim,PrimByte,PrimMutable,PrimMutableByte}Array ? + + ifLinkConstrItbl ( nameFalse ); + ifLinkConstrItbl ( nameTrue ); + ifLinkConstrItbl ( nameNil ); + ifLinkConstrItbl ( nameCons ); + + /* PrelErr.hi doesn't give a type for error, alas. + So error never appears in any symbol table. + So we fake it by copying the table entry for + hugsprimError -- which is just a call to error. + Although we put it on the Prelude export list, we + have to claim internally that it lives in PrelErr, + so that the correct symbol (PrelErr_error_closure) + is referred to. + Big Big Sigh. + */ + nm = newName ( findText("error"), NIL ); + name(nm) = name(nameError); + name(nm).mod = findModule(findText("PrelErr")); + name(nm).text = findText("error"); + setCurrModule(modulePrelude); + module(modulePrelude).exports + = cons ( nm, module(modulePrelude).exports ); + + /* The GHC prelude doesn't seem to export Addr. Add it to the + export list for the sake of compatibility with standalone mode. + */ + module(modulePrelude).exports + = cons ( pair(typeAddr,DOTDOT), + module(modulePrelude).exports ); + addTycon(typeAddr); + + /* Make nameListMonad be the builder fn for instance Monad []. + Standalone hugs does this with a disgusting hack in + checkInstDefn() in static.c. We have a slightly different + disgusting hack for the combined case. + */ + { + Class cm; /* :: Class */ + List is; /* :: [Inst] */ + cm = findClassInAnyModule(findText("Monad")); + assert(nonNull(cm)); + is = cclass(cm).instances; + assert(nonNull(is)); + while (nonNull(is) && snd(inst(hd(is)).head) != typeList) + is = tl(is); + assert(nonNull(is)); + nameListMonad = inst(hd(is)).builder; + assert(nonNull(nameListMonad)); + } + + break; + } + case PREPREL : + + if (combined) { + Module modulePrelBase; + + modulePrelude = findFakeModule(textPrelude); + + nameMkC = addWiredInBoxingTycon("PrelBase", "Char", "C#", + CHAR_REP, STAR ); + nameMkI = addWiredInBoxingTycon("PrelBase", "Int", "I#", + INT_REP, STAR ); + nameMkW = addWiredInBoxingTycon("PrelAddr", "Word", "W#", + WORD_REP, STAR ); + nameMkA = addWiredInBoxingTycon("PrelAddr", "Addr", "A#", + ADDR_REP, STAR ); + nameMkF = addWiredInBoxingTycon("PrelFloat","Float", "F#", + FLOAT_REP, STAR ); + nameMkD = addWiredInBoxingTycon("PrelFloat","Double","D#", + DOUBLE_REP, STAR ); + nameMkInteger + = addWiredInBoxingTycon("PrelNum","Integer","Integer#", + 0 ,STAR ); + nameMkPrimByteArray + = addWiredInBoxingTycon("PrelGHC","ByteArray", + "PrimByteArray#",0 ,STAR ); + + for (i=0; i)"), + pair(STAR,pair(STAR,STAR)), + 2,DATATYPE,NIL); + + /* desugaring */ + pFun(nameInd, "_indirect"); + name(nameInd).number = DFUNNAME; + + /* newtype and USE_NEWTYPE_FOR_DICTS */ + /* make a name entry for PrelBase.id _before_ loading Prelude + since ifSetClassDefaultsAndDCon() may need to refer to + nameId. + */ + modulePrelBase = findModule(findText("PrelBase")); + module(modulePrelBase).objectExtraNames + = singleton(findText("libHS_cbits")); + + setCurrModule(modulePrelBase); + pFun(nameId, "id"); + setCurrModule(modulePrelude); + + } else { + fixupRTStoPreludeRefs(NULL); + + modulePrelPrim = findFakeModule(textPrelPrim); + modulePrelude = findFakeModule(textPrelude); + setCurrModule(modulePrelPrim); + + for (i=0; i)"), + pair(STAR,pair(STAR,STAR)), + 2,DATATYPE,NIL); + + /* newtype and USE_NEWTYPE_FOR_DICTS */ + pFun(nameId, "id"); + + /* desugaring */ + pFun(nameInd, "_indirect"); + name(nameInd).number = DFUNNAME; + + /* pmc */ + pFun(nameSel, "_SEL"); + + /* strict constructors */ + pFun(nameFlip, "flip" ); + + /* parser */ + pFun(nameFromTo, "enumFromTo"); + pFun(nameFromThenTo, "enumFromThenTo"); + pFun(nameFrom, "enumFrom"); + pFun(nameFromThen, "enumFromThen"); + + /* deriving */ + pFun(nameApp, "++"); + pFun(nameReadField, "hugsprimReadField"); + pFun(nameReadParen, "readParen"); + pFun(nameShowField, "hugsprimShowField"); + pFun(nameShowParen, "showParen"); + pFun(nameLex, "lex"); + pFun(nameComp, "."); + pFun(nameAnd, "&&"); + pFun(nameCompAux, "hugsprimCompAux"); + pFun(nameMap, "map"); + + /* implementTagToCon */ + pFun(namePMFail, "hugsprimPmFail"); + pFun(nameError, "error"); + pFun(nameUnpackString, "hugsprimUnpackString"); + + /* assertion and exception issues */ + pFun(nameAssert, "assert"); + pFun(nameAssertError, "assertError"); + pFun(nameTangleMessage, "tangleMessager"); + pFun(nameIrrefutPatError, + "irrefutPatError"); + pFun(nameNoMethodBindingError, + "noMethodBindingError"); + pFun(nameNonExhaustiveGuardsError, + "nonExhaustiveGuardsError"); + pFun(namePatError, "patError"); + pFun(nameRecSelError, "recSelError"); + pFun(nameRecConError, "recConError"); + pFun(nameRecUpdError, "recUpdError"); + + /* hooks for handwritten bytecode */ + pFun(namePrimSeq, "primSeq"); + pFun(namePrimCatch, "primCatch"); + pFun(namePrimRaise, "primRaise"); + pFun(namePrimTakeMVar, "primTakeMVar"); + { + StgVar vv = mkStgVar(NIL,NIL); + Name n = namePrimSeq; + name(n).line = 0; + name(n).arity = 1; + name(n).type = NIL; + vv = mkStgVar(NIL,NIL); + stgVarInfo(vv) = mkPtr ( asm_BCO_seq() ); + name(n).stgVar = vv; + stgGlobals=cons(pair(n,vv),stgGlobals); + namePrimSeq = n; + } + { + StgVar vv = mkStgVar(NIL,NIL); + Name n = namePrimCatch; + name(n).line = 0; + name(n).arity = 2; + name(n).type = NIL; + stgVarInfo(vv) = mkPtr ( asm_BCO_catch() ); + name(n).stgVar = vv; + stgGlobals=cons(pair(n,vv),stgGlobals); + } + { + StgVar vv = mkStgVar(NIL,NIL); + Name n = namePrimRaise; + name(n).line = 0; + name(n).arity = 1; + name(n).type = NIL; + stgVarInfo(vv) = mkPtr ( asm_BCO_raise() ); + name(n).stgVar = vv; + stgGlobals=cons(pair(n,vv),stgGlobals); + } + { + StgVar vv = mkStgVar(NIL,NIL); + Name n = namePrimTakeMVar; + name(n).line = 0; + name(n).arity = 2; + name(n).type = NIL; + stgVarInfo(vv) = mkPtr ( asm_BCO_takeMVar() ); + name(n).stgVar = vv; + stgGlobals=cons(pair(n,vv),stgGlobals); + } + } + break; } } +#undef pFun +//#include "fooble.c" /*-------------------------------------------------------------------------*/