* included in the distribution.
*
* $RCSfile: link.c,v $
- * $Revision: 1.27 $
- * $Date: 2000/01/07 17:49:29 $
+ * $Revision: 1.37 $
+ * $Date: 2000/01/12 14:52:53 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
Name nameZero; /* for monads with a zero */
Name nameId;
-Name nameRunIO;
+Name nameShow;
+Name namePutStr;
+Name nameRunIO_toplevel;
Name namePrint;
Name nameOtherwise;
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;
}
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;
}
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;
}
classFloating = linkClass("Floating");
classNum = linkClass("Num");
classMonad = linkClass("Monad");
-
+assert(nonNull(typeDouble));
+assert(nonNull(typeInteger));
stdDefaults = NIL;
stdDefaults = cons(typeDouble,stdDefaults);
# if DEFAULT_BIGNUM
*/
name(namePrimTakeMVar).type = primType(MONAD_Id, "rbc", "d");
- 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);
+ 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);
+ }
}
}
}
nameInRange = linkName("inRange");
nameMinus = linkName("-");
/* These come before calls to implementPrim */
- for(i=0; i<NUM_TUPLES; ++i) {
- implementTuple(i);
+ if (!combined) {
+ for(i=0; i<NUM_TUPLES; ++i) {
+ if (i != 1) implementTuple(i);
+ }
}
}
}
setCurrModule(modulePrelude);
/* primops */
- nameMkIO = linkName("primMkIO");
- for (i=0; asmPrimOps[i].name; ++i) {
- Text t = findText(asmPrimOps[i].name);
- Name n = findName(t);
- if (isNull(n)) {
- n = newName(t,NIL);
- }
- name(n).line = 0;
- name(n).defn = NIL;
- name(n).type = primType(asmPrimOps[i].monad,
- asmPrimOps[i].args,
- asmPrimOps[i].results);
- name(n).arity = strlen(asmPrimOps[i].args);
- name(n).primop = &(asmPrimOps[i]);
- implementPrim(n);
+ nameMkIO = linkName("hugsprimMkIO");
+
+ if (!combined) {
+ for (i=0; asmPrimOps[i].name; ++i) {
+ Text t = findText(asmPrimOps[i].name);
+ Name n = findName(t);
+ if (isNull(n)) {
+ n = newName(t,NIL);
+ }
+ name(n).line = 0;
+ name(n).defn = NIL;
+ name(n).type = primType(asmPrimOps[i].monad,
+ asmPrimOps[i].args,
+ asmPrimOps[i].results);
+ name(n).arity = strlen(asmPrimOps[i].args);
+ name(n).primop = &(asmPrimOps[i]);
+ implementPrim(n);
+ }
}
-
/* static(tidyInfix) */
nameNegate = linkName("negate");
/* user interface */
- nameRunIO = linkName("primRunIO_hugs_toplevel");
+ nameRunIO_toplevel = linkName("hugsprimRunIO_toplevel");
+ nameShow = linkName("show");
+ namePutStr = linkName("putStr");
namePrint = linkName("print");
/* desugar */
nameOtherwise = linkName("otherwise");
nameUndefined = linkName("undefined");
/* pmc */
# if NPLUSK
- namePmSub = linkName("primPmSub");
+ namePmSub = linkName("hugsprimPmSub");
# endif
/* translator */
- nameEqChar = linkName("primEqChar");
- nameCreateAdjThunk = linkName("primCreateAdjThunk");
- namePmInt = linkName("primPmInt");
- namePmInteger = linkName("primPmInteger");
- namePmDouble = linkName("primPmDouble");
+ nameEqChar = linkName("hugsprimEqChar");
+ nameCreateAdjThunk = linkName("hugsprimCreateAdjThunk");
+ namePmInt = linkName("hugsprimPmInt");
+ namePmInteger = linkName("hugsprimPmInteger");
+ namePmDouble = linkName("hugsprimPmDouble");
- namePmFromInteger = linkName("primPmFromInteger");
- namePmSubtract = linkName("primPmSubtract");
- namePmLe = linkName("primPmLe");
+ namePmFromInteger = linkName("hugsprimPmFromInteger");
+ namePmSubtract = linkName("hugsprimPmSubtract");
+ namePmLe = linkName("hugsprimPmLe");
implementCfun ( nameCons, NIL );
implementCfun ( nameNil, NIL );
case MARK :
break;
- case POSTPREL:
+ case POSTPREL: {
+ Module modulePrelBase = findModule(findText("PrelBase"));
+ assert(nonNull(modulePrelBase));
+#if 1
+ fprintf(stderr, "linkControl(POSTPREL)\n");
#if 1
- fprintf(stderr, "linkControl(POSTPREL)\n");
+ setCurrModule(modulePrelude);
+ linkPreludeTC();
+ linkPreludeCM();
+ linkPreludeNames();
+ name(nameNil).stgVar
+ = mkCPtr(lookupOTabName(modulePrelBase, "PrelBase_ZMZN_static_closure"));
+ name(nameCons).stgVar
+ = mkCPtr(lookupOTabName(modulePrelBase, "PrelBase_ZC_closure"));
+ nameUnpackString = linkName("hugsprimUnpackString");
#endif
- break;
-
+#endif
+ break;
+ }
case PREPREL :
if (combined) {
module(modulePrelude).objectExtraNames
= singleton(findText("libHS_cbits"));
- nameMkC = addWiredInBoxingTycon("PrelBase","Char", "C#",1,0,CHAR_REP );
- nameMkI = addWiredInBoxingTycon("PrelBase","Int", "I#",1,0,INT_REP );
- nameMkW = addWiredInBoxingTycon("PrelAddr","Word", "W#",1,0,WORD_REP );
- nameMkA = addWiredInBoxingTycon("PrelAddr","Addr", "A#",1,0,ADDR_REP );
- nameMkF = addWiredInBoxingTycon("PrelFloat","Float", "F#",1,0,FLOAT_REP );
- nameMkD = addWiredInBoxingTycon("PrelFloat","Double","D#",1,0,DOUBLE_REP);
+ 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#",1,0,0);
+ = addWiredInBoxingTycon("PrelNum","Integer","Integer#",0 ,STAR );
nameMkPrimByteArray
- = addWiredInBoxingTycon("PrelGHC","ByteArray","PrimByteArray#",1,0,0);
+ = addWiredInBoxingTycon("PrelGHC","ByteArray","PrimByteArray#",0 ,STAR );
for (i=0; i<NUM_TUPLES; ++i) {
- addTupleTycon(i);
+ if (i != 1) addTupleTycon(i);
}
addWiredInEnumTycon("PrelBase","Bool",
doubleton(findText("False"),findText("True")));
typeArrow = addPrimTycon(findText("(->)"),
pair(STAR,pair(STAR,STAR)),
2,DATATYPE,NIL);
+
+ pFun(nameInd, "_indirect");
+ name(nameInd).number = DFUNNAME;
+
} else {
modulePrelude = newModule(textPrelude);
setCurrModule(modulePrelude);
for (i=0; i<NUM_TUPLES; ++i) {
- addTupleTycon(i);
+ if (i != 1) addTupleTycon(i);
}
setCurrModule(modulePrelude);
/* implementTagToCon */
pFun(namePMFail, "primPmFail");
pFun(nameError, "error");
- pFun(nameUnpackString, "primUnpackString");
+ pFun(nameUnpackString, "hugsprimUnpackString");
/* hooks for handwritten bytecode */
pFun(namePrimSeq, "primSeq");
projects / ghc-hetmet.git / blobdiff