/* --------------------------------------------------------------------------
* This is the Hugs type checker
*
- * Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
- * Haskell Group 1994-99, and is distributed as Open Source software
- * under the Artistic License; see the file "Artistic" that is included
- * in the distribution for details.
+ * 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: type.c,v $
- * $Revision: 1.5 $
- * $Date: 1999/03/09 14:51:16 $
+ * $Revision: 1.34 $
+ * $Date: 2000/04/06 14:23:55 $
* ------------------------------------------------------------------------*/
-#include "prelude.h"
+#include "hugsbasictypes.h"
#include "storage.h"
-#include "backend.h"
#include "connect.h"
-#include "link.h"
#include "errors.h"
-#include "subst.h"
+
#include "Assembler.h" /* for AsmCTypes */
/*#define DEBUG_TYPES*/
/*#define DEBUG_SELS*/
/*#define DEBUG_DEPENDS*/
/*#define DEBUG_DERIVING*/
-/*#define DEBUG_CODE*/
-
-Bool catchAmbigs = FALSE; /* TRUE => functions with ambig. */
- /* types produce error */
-
/* --------------------------------------------------------------------------
* Local function prototypes:
* ------------------------------------------------------------------------*/
-static Void local emptyAssumption Args((Void));
-static Void local enterBindings Args((Void));
-static Void local leaveBindings Args((Void));
-static Int local defType Args((Cell));
-static Type local useType Args((Cell));
-static Void local markAssumList Args((List));
-static Cell local findAssum Args((Text));
-static Pair local findInAssumList Args((Text,List));
-static List local intsIntersect Args((List,List));
-static List local genvarAllAss Args((List));
-static List local genvarAnyAss Args((List));
-static Int local newVarsBind Args((Cell));
-static Void local newDefnBind Args((Cell,Type));
-
-static Void local enterPendingBtyvs Args((Void));
-static Void local leavePendingBtyvs Args((Void));
-static Cell local patBtyvs Args((Cell));
-static Void local doneBtyvs Args((Int));
-static Void local enterSkolVars Args((Void));
-static Void local leaveSkolVars Args((Int,Type,Int,Int));
-
-static Void local typeError Args((Int,Cell,Cell,String,Type,Int));
-static Void local reportTypeError Args((Int,Cell,Cell,String,Type,Type));
-static Void local cantEstablish Args((Int,String,Cell,Type,List));
-static Void local tooGeneral Args((Int,Cell,Type,Type));
-
-static Cell local typeExpr Args((Int,Cell));
-
-static Cell local typeAp Args((Int,Cell));
-static Type local typeExpected Args((Int,String,Cell,Type,Int,Int,Bool));
-static Void local typeAlt Args((String,Cell,Cell,Type,Int,Int));
-static Int local funcType Args((Int));
-static Void local typeCase Args((Int,Int,Cell));
-static Void local typeComp Args((Int,Type,Cell,List));
-static Cell local typeMonadComp Args((Int,Cell));
-static Void local typeDo Args((Int,Cell));
-static Void local typeConFlds Args((Int,Cell));
-static Void local typeUpdFlds Args((Int,Cell));
-static Cell local typeFreshPat Args((Int,Cell));
-
-static Void local typeBindings Args((List));
-static Void local removeTypeSigs Args((Cell));
-
-static Void local monorestrict Args((List));
-static Void local restrictedBindAss Args((Cell));
-static Void local restrictedAss Args((Int,Cell,Type));
-
-static Void local unrestricted Args((List));
-static List local itbscc Args((List));
-static Void local addEvidParams Args((List,Cell));
-
-static Void local typeClassDefn Args((Class));
-static Void local typeInstDefn Args((Inst));
-static Void local typeMember Args((String,Name,Cell,List,Cell,Int));
-
-static Void local typeBind Args((Cell));
-static Void local typeDefAlt Args((Int,Cell,Pair));
-static Cell local typeRhs Args((Cell));
-static Void local guardedType Args((Int,Cell));
-
-static Void local genBind Args((List,Cell));
-static Void local genAss Args((Int,List,Cell,Type));
-static Type local genTest Args((Int,Cell,List,Type,Type,Int));
-static Type local generalize Args((List,Type));
-static Bool local equalTypes Args((Type,Type));
-
-static Void local typeDefnGroup Args((List));
-static Pair local typeSel Args((Name));
+static Void local emptyAssumption ( Void );
+static Void local enterBindings ( Void );
+static Void local leaveBindings ( Void );
+static Int local defType ( Cell );
+static Type local useType ( Cell );
+static Void local markAssumList ( List );
+static Cell local findAssum ( Text );
+static Pair local findInAssumList ( Text,List );
+static List local intsIntersect ( List,List );
+static List local genvarAllAss ( List );
+static List local genvarAnyAss ( List );
+static Int local newVarsBind ( Cell );
+static Void local newDefnBind ( Cell,Type );
+
+static Void local enterPendingBtyvs ( Void );
+static Void local leavePendingBtyvs ( Void );
+static Cell local patBtyvs ( Cell );
+static Void local doneBtyvs ( Int );
+static Void local enterSkolVars ( Void );
+static Void local leaveSkolVars ( Int,Type,Int,Int );
+
+static Void local typeError ( Int,Cell,Cell,String,Type,Int );
+static Void local reportTypeError ( Int,Cell,Cell,String,Type,Type );
+static Void local cantEstablish ( Int,String,Cell,Type,List );
+static Void local tooGeneral ( Int,Cell,Type,Type );
+
+static Cell local typeExpr ( Int,Cell );
+
+static Cell local typeAp ( Int,Cell );
+static Type local typeExpected ( Int,String,Cell,Type,Int,Int,Bool );
+static Void local typeAlt ( String,Cell,Cell,Type,Int,Int );
+static Int local funcType ( Int );
+static Void local typeCase ( Int,Int,Cell );
+static Void local typeComp ( Int,Type,Cell,List );
+static Cell local typeMonadComp ( Int,Cell );
+static Void local typeDo ( Int,Cell );
+static Void local typeConFlds ( Int,Cell );
+static Void local typeUpdFlds ( Int,Cell );
+#if IPARAM
+static Cell local typeWith ( Int,Cell );
+#endif
+static Cell local typeFreshPat ( Int,Cell );
+
+static Void local typeBindings ( List );
+static Void local removeTypeSigs ( Cell );
+
+static Void local monorestrict ( List );
+static Void local restrictedBindAss ( Cell );
+static Void local restrictedAss ( Int,Cell,Type );
+
+static Void local unrestricted ( List );
+static List local itbscc ( List );
+static Void local addEvidParams ( List,Cell );
+
+static Void local typeClassDefn ( Class );
+static Void local typeInstDefn ( Inst );
+static Void local typeMember ( String,Name,Cell,List,Cell,Int );
+
+static Void local typeBind ( Cell );
+static Void local typeDefAlt ( Int,Cell,Pair );
+static Cell local typeRhs ( Cell );
+static Void local guardedType ( Int,Cell );
+
+static Void local genBind ( List,Cell );
+static Void local genAss ( Int,List,Cell,Type );
+static Type local genTest ( Int,Cell,List,Type,Type,Int );
+static Type local generalize ( List,Type );
+static Bool local equalTypes ( Type,Type );
+
+static Void local typeDefnGroup ( List );
+static Pair local typeSel ( Name );
static List savedPs; /*::[[(Pred,offset,ev)]] */
static Cell dummyVar; /* Used to put extra tvars into ass*/
+Bool catchAmbigs = FALSE; /* TRUE => functions with ambig. */
+ /* types produce error */
+
+
#define saveVarsAss() List saveAssump = hd(varsBounds)
#define restoreVarsAss() hd(varsBounds) = saveAssump
#define addVarAssump(v,t) hd(varsBounds) = cons(pair(v,t),hd(varsBounds))
tyvar(intOf(fst(hd(sks))))->offs = UNUSED_GENERIC;
sks = tl(sks);
} while (nonNull(sks));
+ normPreds(l);
sps = elimPredsUsing(hd(localEvs),sps);
preds = revOnto(preds,sps);
}
typeError(l,e,in,where,t,o);
#define check(l,e,in,where,t,o) e=typeExpr(l,e); shouldBe(l,e,in,where,t,o)
#define inferType(t,o) typeIs=t; typeOff=o
+#if IPARAM
+#define spTypeExpr(l,e) svPreds = preds; preds = NIL; e = typeExpr(l,e); preds = revOnto(preds,svPreds);
+#define spCheck(l,e,in,where,t,o) svPreds = preds; preds = NIL; check(l,e,in,where,t,o); preds = revOnto(preds,svPreds);
+#else
+#define spTypeExpr(l,e) e = typeExpr(l,e);
+#define spCheck(l,e,in,where,t,o) check(l,e,in,where,t,o);
+#endif
static Void local cantEstablish(line,wh,e,t,ps)
Int line; /* Complain when declared preds */
static int tcMode = EXPRESSION;
#ifdef DEBUG_TYPES
-static Cell local mytypeExpr Args((Int,Cell));
+static Cell local mytypeExpr ( Int,Cell));
static Cell local typeExpr(l,e)
Int l;
Cell e; {
static int number = 0;
Cell retv;
int mynumber = number++;
+ List ps;
+ STACK_CHECK
Printf("%d) to check: ",mynumber);
printExp(stdout,e);
Putchar('\n');
retv = mytypeExpr(l,e);
Printf("%d) result: ",mynumber);
printType(stdout,debugType(typeIs,typeOff));
+ Printf("\n%d) preds: ",mynumber);
+ printContext(stdout,debugContext(preds));
Putchar('\n');
return retv;
}
static String aspat = "as (@) pattern";
static String typeSig = "type annotation";
static String lambda = "lambda expression";
- //printf("\n\n+++++++++++++++++++++++++++++++\n");
- //print(e,1000);
- //printf("\n\n");
+#if IPARAM
+ List svPreds;
+#endif
+
switch (whatIs(e)) {
/* The following cases can occur in either pattern or expr. mode */
case AP :
case NAME :
case VAROPCELL :
- case VARIDCELL : return typeAp(l,e);
+ case VARIDCELL :
+#if IPARAM
+ case IPVAR :
+#endif
+ return typeAp(l,e);
case TUPLE : typeTuple(e);
break;
-#if BIGNUMS
- case POSNUM :
- case ZERONUM :
- case NEGNUM : { Int alpha = newTyvars(1);
- inferType(aVar,alpha);
+ case BIGCELL : { Int alpha = newTyvars(1);
+ inferType(aVar,alpha);
return ap(ap(nameFromInteger,
assumeEvid(predNum,alpha)),
e);
}
-#endif
+
case INTCELL : { Int alpha = newTyvars(1);
inferType(aVar,alpha);
return ap(ap(nameFromInt,
case UPDFLDS : typeUpdFlds(l,e);
break;
+#if IPARAM
+ case WITHEXP : return typeWith(l,e);
+#endif
+
case COND : { Int beta = newTyvars(1);
check(l,fst3(snd(e)),e,cond,typeBool,0);
- check(l,snd3(snd(e)),e,cond,aVar,beta);
- check(l,thd3(snd(e)),e,cond,aVar,beta);
+ spCheck(l,snd3(snd(e)),e,cond,aVar,beta);
+ spCheck(l,thd3(snd(e)),e,cond,aVar,beta);
tyvarType(beta);
}
break;
case LETREC : enterBindings();
enterSkolVars();
mapProc(typeBindings,fst(snd(e)));
- snd(snd(e)) = typeExpr(l,snd(snd(e)));
+ spTypeExpr(l,snd(snd(e)));
leaveBindings();
leaveSkolVars(l,typeIs,typeOff,0);
break;
case FINLIST : { Int beta = newTyvars(1);
List xs;
for (xs=snd(e); nonNull(xs); xs=tl(xs)) {
- check(l,hd(xs),e,list,aVar,beta);
+ spCheck(l,hd(xs),e,list,aVar,beta);
}
inferType(listof,beta);
}
case LAZYPAT : snd(e) = typeExpr(l,snd(e));
break;
-#if NPLUSK
case ADDPAT : { Int alpha = newTyvars(1);
inferType(typeVarToVar,alpha);
return ap(e,assumeEvid(predIntegral,alpha));
}
-#endif
default : internal("typeExpr");
}
Cell p = NIL;
Cell a = e;
Int i;
- //print(h,1000);
- //printf("\n");
+#if IPARAM
+ List svPreds;
+#endif
switch (whatIs(h)) {
case NAME : typeIs = name(h).type;
}
break;
+#if IPARAM
+ case IPVAR : { Text t = textOf(h);
+ Int alpha = newTyvars(1);
+ Cell ip = pair(ap(IPCELL,t),aVar);
+ Cell ev = assumeEvid(ip,alpha);
+ typeIs = mkInt(alpha);
+ h = ap(h,ev);
+ }
+ break;
+#endif
+
default : h = typeExpr(l,h);
break;
}
if (isNull(typeIs)) {
- //printf("\n NAME " );
- //print(h,1000);
- //printf(" TYPE " ); print(typeIs,1000);
internal("typeAp1");
}
for (; nonNull(predsAre); predsAre=tl(predsAre)) {
evs = cons(assumeEvid(hd(predsAre),typeOff),evs);
}
- if (!isName(h) || !isCfun(h)) {
+ /* we now _always_ do this: if (!isName(h) || !isCfun(h)) */ {
h = applyToArgs(h,rev(evs));
}
}
for (as=getArgs(as); nonNull(as); as=tl(as), body=arg(body)) {
Type expect = dropRank1(arg(fun(body)),alpha,m);
- if (isPolyType(expect)) {
+ if (isPolyOrQualType(expect)) {
if (tcMode==EXPRESSION) /* poly/qual type in expr */
hd(as) = typeExpected(l,app,hd(as),expect,alpha,m,TRUE);
else if (hd(as)!=WILDCARD) { /* Pattern binding/match */
}
}
else { /* Not a poly/qual type */
- check(l,hd(as),e,app,expect,alpha);
+ spCheck(l,hd(as),e,app,expect,alpha);
}
h = ap(h,hd(as)); /* Save checked argument */
}
Int beta = funcType(n); /* check h::t1->t2->...->tn->rn+1 */
shouldBe(l,h,e,app,aVar,beta);
for (i=n; i>0; --i) { /* check e_i::t_i for each i */
- check(l,arg(a),e,app,aVar,beta+2*i-1);
+ spCheck(l,arg(a),e,app,aVar,beta+2*i-1);
p = a;
a = fun(a);
}
preds = NIL;
check(l,e,NIL,wh,t,o);
+ improve(l,ps,preds);
clearMarks();
mapProc(markAssumList,defnBounds);
mapProc(markPred,savePreds);
markBtyvs();
- for (i=0; i<n; i++)
- markTyvar(alpha+i);
+ if (n > 0) { /* mark alpha thru alpha+n-1, plus any */
+ /* type vars that are functionally */
+ List us = NIL, vs = NIL; /* dependent on them */
+ List fds = calcFunDepsPreds(preds);
+ for (i=0; i<n; i++) {
+ Type t1 = zonkTyvar(alpha+i);
+ us = zonkTyvarsIn(t1,us);
+ }
+ vs = oclose(fds,us);
+ for (; nonNull(vs); vs=tl(vs))
+ markTyvar(intOf(hd(vs)));
+ }
+ normPreds(l);
savePreds = elimPredsUsing(ps,savePreds);
if (nonNull(preds) && resolveDefs(genvarType(t,o,NIL)))
savePreds = elimPredsUsing(ps,savePreds);
while (getHead(t)==typeArrow && argCount==2 && nonNull(ps)) {
Type ta = arg(fun(t));
- if (isPolyType(ta)) {
+ if (isPolyOrQualType(ta)) {
if (hd(ps)!=WILDCARD) {
if (!isVar(hd(ps))) {
ERRMSG(l) "Argument " ETHEN ERREXPR(hd(ps));
List qs; {
static String boolQual = "boolean qualifier";
static String genQual = "generator";
+#if IPARAM
+ List svPreds;
+#endif
- if (isNull(qs)) /* no qualifiers left */
- fst(e) = typeExpr(l,fst(e));
- else {
+ STACK_CHECK
+ if (isNull(qs)) { /* no qualifiers left */
+ spTypeExpr(l,fst(e));
+ } else {
Cell q = hd(qs);
List qs1 = tl(qs);
switch (whatIs(q)) {
- case BOOLQUAL : check(l,snd(q),NIL,boolQual,typeBool,0);
+ case BOOLQUAL : spCheck(l,snd(q),NIL,boolQual,typeBool,0);
typeComp(l,m,e,qs1);
break;
case FROMQUAL : { Int beta = newTyvars(1);
saveVarsAss();
- check(l,snd(snd(q)),NIL,genQual,m,beta);
+ spCheck(l,snd(snd(q)),NIL,genQual,m,beta);
enterSkolVars();
fst(snd(q))
= typeFreshPat(l,patBtyvs(fst(snd(q))));
}
break;
- case DOQUAL : check(l,snd(q),NIL,genQual,m,newTyvars(1));
+ case DOQUAL : spCheck(l,snd(q),NIL,genQual,m,newTyvars(1));
typeComp(l,m,e,qs1);
break;
}
tyvar(beta)->kind = starToStar;
#if !MONAD_COMPS
bindTv(beta,typeList,0);
+ m = nameListMonad;
#endif
typeComp(l,mon,snd(e),snd(snd(e)));
Int to;
Int tf;
Int i;
+#if IPARAM
+ List svPreds;
+#endif
instantiate(name(c).type);
for (; nonNull(predsAre); predsAre=tl(predsAre))
for (i=sfunPos(fst(hd(fs)),c); --i>0; t=arg(t))
;
t = dropRank1(arg(fun(t)),to,tf);
- if (isPolyType(t))
+ if (isPolyOrQualType(t))
snd(hd(fs)) = typeExpected(l,conExpr,snd(hd(fs)),t,to,tf,TRUE);
else {
- check(l,snd(hd(fs)),e,conExpr,t,to);
+ spCheck(l,snd(hd(fs)),e,conExpr,t,to);
}
}
for (i=name(c).arity; i>0; i--)
Int alpha = newTyvars(2+n);
Int i;
List fs1;
+#if IPARAM
+ List svPreds;
+#endif
/* Calculate type and translation for each expr in the field list */
for (fs1=fs, i=alpha+2; nonNull(fs1); fs1=tl(fs1), i++) {
- snd(hd(fs1)) = typeExpr(line,snd(hd(fs1)));
+ spTypeExpr(line,snd(hd(fs1)));
bindTv(i,typeIs,typeOff);
}
ts = rev(ts);
/* Type check expression to be updated */
- fst3(snd(e)) = typeExpr(line,fst3(snd(e)));
+ spTypeExpr(line,fst3(snd(e)));
bindTv(alpha,typeIs,typeOff);
for (; nonNull(cs); cs=tl(cs)) { /* Loop through constrs */
/* (typeIs,typeOff) still carry the result type when we exit the loop */
}
+#if IPARAM
+static Cell local typeWith(line,e) /* Type check a with */
+Int line;
+Cell e; {
+ List fs = snd(snd(e)); /* List of field specifications */
+ Int n = length(fs);
+ Int alpha = newTyvars(2+n);
+ Int i;
+ List fs1;
+ Cell tIs;
+ Cell tOff;
+ List dpreds = NIL, dp;
+ Cell bs = NIL;
+
+ /* Type check expression to be updated */
+ fst(snd(e)) = typeExpr(line,fst(snd(e)));
+ bindTv(alpha,typeIs,typeOff);
+ tIs = typeIs;
+ tOff = typeOff;
+ /* elim duplicate uses of imp params */
+ preds = scSimplify(preds);
+ /* extract preds that we're going to bind */
+ for (fs1=fs; nonNull(fs1); fs1=tl(fs1)) {
+ Text t = textOf(fst(hd(fs1)));
+ Cell p = findIPEvid(t);
+ dpreds = cons(p, dpreds);
+ if (nonNull(p)) {
+ removeIPEvid(t);
+ } else {
+ /* maybe give a warning message here... */
+ }
+ }
+ dpreds = rev(dpreds);
+
+ /* Calculate type and translation for each expr in the field list */
+ for (fs1=fs, dp=dpreds, i=alpha+2; nonNull(fs1); fs1=tl(fs1), dp=tl(dp), i++) {
+ static String with = "with";
+ Cell ev = hd(dp);
+ snd(hd(fs1)) = typeExpr(line,snd(hd(fs1)));
+ bindTv(i,typeIs,typeOff);
+ if (nonNull(ev)) {
+ shouldBe(line,fst(hd(fs1)),e,with,snd(fst3(ev)),intOf(snd3(ev)));
+ bs = cons(cons(pair(thd3(ev), cons(triple(NIL, mkInt(line), snd(hd(fs1))), NIL)), NIL), bs);
+ }
+ }
+ typeIs = tIs;
+ typeOff = tOff;
+ return (ap(LETREC,pair(bs,fst(snd(e)))));
+}
+#endif
+
static Cell local typeFreshPat(l,p) /* find type of pattern, assigning */
Int l; /* fresh type variables to each var */
Cell p; { /* bound in the pattern */
preds = NIL; /* Type check the bindings */
mapProc(restrictedBindAss,bs);
mapProc(typeBind,bs);
+ improve(line,NIL,preds);
normPreds(line);
elimTauts();
preds = revOnto(preds,savePreds);
preds = NIL;
mapProc(typeBind,hd(imps));
+ improve(line,NIL,preds);
clearMarks();
mapProc(markAssumList,tl(defnBounds));
enterPendingBtyvs();
for (; nonNull(alts); alts=tl(alts))
typeAlt(extbind,fst(b),hd(alts),t,o,m);
+ improve(line,ps,preds);
leavePendingBtyvs();
if (nonNull(ps)) /* Add dict params, if necessary */
mapProc(markPred,savePreds);
markBtyvs();
+ normPreds(line);
savePreds = elimPredsUsing(ps,savePreds);
if (nonNull(preds)) {
List vs = NIL;
Int i = 0;
for (; i<m; ++i)
vs = cons(mkInt(o+i),vs);
- if (resolveDefs(vs))
+ if (resolveDefs(vs)) {
savePreds = elimPredsUsing(ps,savePreds);
+ }
if (nonNull(preds)) {
clearMarks();
reducePreds();
* ------------------------------------------------------------------------*/
static Void local typeClassDefn(c) /* Type check implementations of */
-Class c; { /* defaults for class c */
+Class c; { /* defaults for class c */
/* ----------------------------------------------------------------------
- * Generate code for default dictionary builder function:
- *
- * class.C sc1 ... scn d = let v1 ... = ...
- * vm ... = ...
- * in Make.C sc1 ... scn v1 ... vm
- *
- * where sci are superclass dictionary parameters, vj are implementations
- * for member functions, either taken from defaults, or using "error" to
- * produce a suitable error message. (Additional line number values must
- * be added at appropriate places but, for clarity, these are not shown
- * above.)
+ * Generate code for default dictionary builder functions:
* --------------------------------------------------------------------*/
Int beta = newKindedVars(cclass(c).kinds);
- List params = makePredAss(cclass(c).supers,beta);
- Cell body = cclass(c).dcon;
- Cell pat = body;
+ Cell d = inventDictVar();
+ List dparam = singleton(triple(cclass(c).head,mkInt(beta),d));
List mems = cclass(c).members;
List defs = cclass(c).defaults;
List dsels = cclass(c).dsels;
- Cell d = inventDictVar();
- List args = NIL;
- List locs = NIL;
- Cell l = mkInt(cclass(c).line);
- List ps;
-//printf("\ntypeClassDefn %s\n", textToStr(cclass(c).text));
- for (ps=params; nonNull(ps); ps=tl(ps)) {
- Cell v = thd3(hd(ps));
- body = ap(body,v);
- pat = ap(pat,inventVar());
- args = cons(v,args);
+ Cell pat = cclass(c).dcon;
+ Int width = cclass(c).numSupers + cclass(c).numMembers;
+ char buf[FILENAME_MAX+1];
+ Int i = 0;
+ Int j = 0;
+
+ if (isNull(defs) && nonNull(mems)) {
+ defs = cclass(c).defaults = cons(NIL,NIL);
}
- args = revOnto(args,singleton(d));
- params = appendOnto(params,
- singleton(triple(cclass(c).head,mkInt(beta),d)));
for (; nonNull(mems); mems=tl(mems)) {
- Cell v = inventVar(); /* Pick a name for component */
- Cell imp = NIL;
-//printf(" defaulti %s\n", textToStr(name(hd(mems)).text));
- if (nonNull(defs)) { /* Look for default implementation */
- imp = hd(defs);
- defs = tl(defs);
- }
-
- if (isNull(imp)) { /* Generate undefined member msg */
- static String header = "Undefined member: ";
- String name = textToStr(name(hd(mems)).text);
- char msg[FILENAME_MAX+1];
- Int i;
- Int j;
-
- for (i=0; i<FILENAME_MAX && header[i]!='\0'; i++)
- msg[i] = header[i];
- for (j=0; (i+j)<FILENAME_MAX && name[j]!='\0'; j++)
- msg[i+j] = name[j];
- msg[i+j] = '\0';
-
- imp = pair(v,singleton(pair(NIL,ap(l,ap(nameError,
- mkStr(findText(msg)))))));
- }
- else { /* Use default implementation */
- fst(imp) = v;
- typeMember("default member binding",
- hd(mems),
- snd(imp),
- params,
- cclass(c).head,
- beta);
- }
-
- locs = cons(imp,locs);
- body = ap(body,v);
- pat = ap(pat,v);
+ /* static String deftext = "default_"; */
+ static String deftext = "$dm";
+ String s = textToStr(name(hd(mems)).text);
+ Name n;
+ i = j = 0;
+ for (; i<FILENAME_MAX && deftext[i]!='\0'; i++) {
+ buf[i] = deftext[i];
+ }
+ for(; (i+j)<FILENAME_MAX && s[j]!='\0'; j++) {
+ buf[i+j] = s[j];
+ }
+ buf[i+j] = '\0';
+ n = newName(findText(buf),c);
+
+ if (isNull(hd(defs))) { /* No default definition */
+ static String header = "Undefined member: ";
+ for (i=0; i<FILENAME_MAX && header[i]!='\0'; i++)
+ buf[i] = header[i];
+ for (j=0; (i+j)<FILENAME_MAX && s[j]!='\0'; j++)
+ buf[i+j] = s[j];
+ buf[i+j] = '\0';
+ name(n).line = cclass(c).line;
+ name(n).arity = 1;
+ name(n).defn = singleton(pair(singleton(d),
+ ap(mkInt(cclass(c).line),
+ ap(nameError,
+ mkStr(fixLitText(
+ findText(buf)))))));
+ } else { /* User supplied default defn */
+ List alts = snd(hd(defs));
+ Int line = rhsLine(snd(hd(alts)));
+
+ typeMember("default member binding",
+ hd(mems),
+ alts,
+ dparam,
+ cclass(c).head,
+ beta);
+
+ name(n).line = line;
+ name(n).arity = 1+length(fst(hd(alts)));
+ name(n).defn = alts;
+
+ for (; nonNull(alts); alts=tl(alts)) {
+ fst(hd(alts)) = cons(d,fst(hd(alts)));
+ }
+ }
+
+ hd(defs) = n;
+ genDefns = cons(n,genDefns);
+ if (isNull(tl(defs)) && nonNull(tl(mems))) {
+ tl(defs) = cons(NIL,NIL);
+ }
+ defs = tl(defs);
}
- body = ap(l,body);
- if (nonNull(locs))
- body = ap(LETREC,pair(singleton(locs),body));
- name(cclass(c).dbuild).defn
- = singleton(pair(args,body));
- genDefns = cons(cclass(c).dbuild,genDefns);
- cclass(c).defaults = NIL;
/* ----------------------------------------------------------------------
* Generate code for superclass and member function selectors:
* --------------------------------------------------------------------*/
- args = getArgs(pat);
- pat = singleton(pat);
- for (; nonNull(dsels); dsels=tl(dsels)) {
- name(hd(dsels)).defn = singleton(pair(pat,ap(l,hd(args))));
- args = tl(args);
- genDefns = cons(hd(dsels),genDefns);
+ for (i=0; i<width; i++) {
+ pat = ap(pat,inventVar());
+ }
+ pat = singleton(pat);
+ for (i=0; nonNull(dsels); dsels=tl(dsels)) {
+ name(hd(dsels)).defn = singleton(pair(pat,
+ ap(mkInt(cclass(c).line),
+ nthArg(i++,hd(pat)))));
+ genDefns = cons(hd(dsels),genDefns);
}
for (mems=cclass(c).members; nonNull(mems); mems=tl(mems)) {
- name(hd(mems)).defn = singleton(pair(pat,ap(mkInt(name(hd(mems)).line),
- hd(args))));
- args = tl(args);
- genDefns = cons(hd(mems),genDefns);
+ name(hd(mems)).defn = singleton(pair(pat,
+ ap(mkInt(name(hd(mems)).line),
+ nthArg(i++,hd(pat)))));
+ genDefns = cons(hd(mems),genDefns);
}
-//printf("done\n" );
}
static Void local typeInstDefn(in) /* Type check implementations of */
* .
* .
* scm = ...
- * d = f (class.C sc1 ... scm d)
- * omit if the / f (Make.C sc1' ... scm' v1' ... vk')
- * instance decl { = let vj ... = ...
- * has no imps \ in Make.C sc1' ... scm' ... vj ...
+ * vj ... = ...
+ * d = Make.C sc1 ... scm v1 ... vk
* in d
*
- * where sci are superclass dictionaries, d and f are new names, vj
+ * where sci are superclass dictionaries, d is a new name, vj
* is a newly generated name corresponding to the implementation of a
* member function. (Additional line number values must be added at
* appropriate places but, for clarity, these are not shown above.)
+ * If no implementation of a particular vj is available, then we use
+ * the default implementation, partially applied to d.
* --------------------------------------------------------------------*/
Int alpha = newKindedVars(cclass(inst(in).c).kinds);
Int beta = newKindedVars(inst(in).kinds);
List params = makePredAss(inst(in).specifics,beta);
Cell d = inventDictVar();
+ /*
List evids = cons(triple(inst(in).head,mkInt(beta),d),
appendOnto(dupList(params),supers));
+ */
+ List evids = dupList(params);
List imps = inst(in).implements;
Cell l = mkInt(inst(in).line);
- Cell dictDef = cclass(inst(in).c).dbuild;
+ Cell dictDef = cclass(inst(in).c).dcon;
+ List mems = cclass(inst(in).c).members;
+ List defs = cclass(inst(in).c).defaults;
List args = NIL;
List locs = NIL;
List ps;
for (ps=supers; nonNull(ps); ps=tl(ps)) { /* Superclass dictionaries */
Cell pi = hd(ps);
- Cell ev = scEntail(params,fst3(pi),intOf(snd3(pi)),0);
- if (isNull(ev))
+ Cell ev = NIL;
+#if EXPLAIN_INSTANCE_RESOLUTION
+ if (showInstRes) {
+ fputs("scEntail: ", stdout);
+ printContext(stdout,copyPreds(params));
+ fputs(" ||- ", stdout);
+ printPred(stdout, copyPred(fst3(pi),intOf(snd3(pi))));
+ fputc('\n', stdout);
+ }
+#endif
+ ev = scEntail(params,fst3(pi),intOf(snd3(pi)),0);
+ if (isNull(ev)) {
+#if EXPLAIN_INSTANCE_RESOLUTION
+ if (showInstRes) {
+ fputs("inEntail: ", stdout);
+ printContext(stdout,copyPreds(evids));
+ fputs(" ||- ", stdout);
+ printPred(stdout, copyPred(fst3(pi),intOf(snd3(pi))));
+ fputc('\n', stdout);
+ }
+#endif
ev = inEntail(evids,fst3(pi),intOf(snd3(pi)),0);
+ }
if (isNull(ev)) {
clearMarks();
ERRMSG(inst(in).line) "Cannot build superclass instance" ETHEN
locs = cons(pair(thd3(pi),singleton(pair(NIL,ap(l,ev)))),locs);
dictDef = ap(dictDef,thd3(pi));
}
- dictDef = ap(dictDef,d);
-
- if (isNull(imps)) /* No implementations */
- locs = cons(pair(d,singleton(pair(NIL,ap(l,dictDef)))),locs);
- else { /* Implementations supplied*/
- List mems = cclass(inst(in).c).members;
- Cell f = inventVar();
- Cell pat = cclass(inst(in).c).dcon;
- Cell res = pat;
- List locs1 = NIL;
- locs = cons(pair(d,singleton(pair(NIL,ap(l,ap(f,dictDef))))),
- locs);
-
- for (ps=supers; nonNull(ps); ps=tl(ps)){/* Add param for each sc */
- Cell v = inventVar();
- pat = ap(pat,v);
- res = ap(res,v);
- }
-
- for (; nonNull(mems); mems=tl(mems)) { /* For each member: */
- Cell v = inventVar();
- Cell imp = NIL;
-
- if (nonNull(imps)) { /* Look for implementation */
- imp = hd(imps);
- imps = tl(imps);
- }
+ for (; nonNull(defs); defs=tl(defs)) {
+ Cell imp = NIL;
+ if (nonNull(imps)) {
+ imp = hd(imps);
+ imps = tl(imps);
+ }
+ if (isNull(imp)) {
+ dictDef = ap(dictDef,ap(hd(defs),d));
+ } else {
+ Cell v = inventVar();
+ dictDef = ap(dictDef,v);
+ typeMember("instance member binding",
+ hd(mems),
+ snd(imp),
+ evids,
+ inst(in).head,
+ beta);
+ locs = cons(pair(v,snd(imp)),locs);
+ }
+ mems = tl(mems);
+ }
+ locs = cons(pair(d,singleton(pair(NIL,ap(l,dictDef)))),locs);
+
+ name(inst(in).builder).defn /* Register builder imp */
+ = singleton(pair(args,ap(LETREC,pair(singleton(locs),
+ ap(l,d)))));
+
+ /* Invent a GHC-compatible name for the instance decl */
+ {
+ char buf[FILENAME_MAX+1];
+ char buf2[10];
+ Int i, j;
+ String str;
+ Cell qq = inst(in).head;
+ Cell pp = NIL;
+ static String zdftext = "$f";
+
+ while (isAp(qq)) {
+ pp = cons(arg(qq),pp);
+ qq = fun(qq);
+ }
+ // pp is now the fwd list of args(?) to this pred
+
+ i = 0;
+ for (j = 0; i<FILENAME_MAX && zdftext[j]!='\0'; i++, j++) {
+ buf[i] = zdftext[j];
+ }
+ str = textToStr(cclass(inst(in).c).text);
+ for (j = 0; i<FILENAME_MAX && str[j]!='\0'; i++, j++) {
+ buf[i] = str[j];
+ }
+ if (nonNull(pp)) {
+ qq = hd(pp);
+ while (isAp(qq)) qq = fun(qq);
+ switch (whatIs(qq)) {
+ case TYCON: str = textToStr(tycon(qq).text); break;
+ case TUPLE: str = textToStr(ghcTupleText(qq)); break;
+ case OFFSET: sprintf(buf2,"%d",offsetOf(qq));
+ str = buf2;
+ break;
+ default: internal("typeInstDefn: making GHC name"); break;
+ }
+ for (j = 0; i<FILENAME_MAX && str[j]!='\0'; i++, j++) {
+ buf[i] = str[j];
+ }
+ }
- if (isNull(imp)) { /* If none, f will copy */
- pat = ap(pat,v); /* its argument unchanged */
- res = ap(res,v);
- }
- else { /* Otherwise, add the impl */
- pat = ap(pat,WILDCARD); /* to f as a local defn */
- res = ap(res,v);
- typeMember("instance member binding",
- hd(mems),
- snd(imp),
- evids,
- inst(in).head,
- beta);
- locs1 = cons(pair(v,snd(imp)),locs1);
- }
- }
- res = ap(l,res);
- if (nonNull(locs1)) /* Build the body of f */
- res = ap(LETREC,pair(singleton(locs1),res));
- pat = singleton(pat); /* And the arglist for f */
- locs = cons(pair(f,singleton(pair(pat,res))),locs);
+ buf[i++] = '\0';
+ name(inst(in).builder).text = findText(buf);
+ //fprintf ( stderr, "result = %s\n", buf );
}
- d = ap(l,d);
- name(inst(in).builder).defn /* Register builder imp */
- = singleton(pair(args,ap(LETREC,pair(singleton(locs),d))));
genDefns = cons(inst(in).builder,genDefns);
}
typeAlt(wh,mem,hd(alts),t,o,m);
qualify(tl(ps),hd(alts)); /* Add any extra dict params */
}
+ improve(line,evids,preds);
leavePendingBtyvs();
evids = appendOnto(dupList(tl(ps)), /* Build full complement of dicts */
evids);
clearMarks();
+ normPreds(line);
qs = elimPredsUsing(evids,NIL);
if (nonNull(preds) && resolveDefs(genvarType(t,o,NIL)))
qs = elimPredsUsing(evids,qs);
#endif
if (!sameSchemes(t,rt))
tooGeneral(line,mem,rt,t);
- if (nonNull(preds))
- cantEstablish(line,wh,mem,t,ps);
-//printf("done\n" );
+ if (nonNull(preds)) {
+ preds = scSimplify(preds);
+ cantEstablish(line,wh,mem,t,ps);
+ }
}
/* --------------------------------------------------------------------------
static String guarded = "guarded expression";
static String guard = "guard";
Int line = intOf(fst(gded));
+#if IPARAM
+ List svPreds;
+#endif
gded = snd(gded);
- check(line,fst(gded),NIL,guard,typeBool,0);
- check(line,snd(gded),NIL,guarded,aVar,beta);
+ spCheck(line,fst(gded),NIL,guard,typeBool,0);
+ spCheck(line,snd(gded),NIL,guarded,aVar,beta);
}
Cell rhsExpr(rhs) /* find first expression on a rhs */
Cell rhs; {
+ STACK_CHECK
switch (whatIs(rhs)) {
case GUARDED : return snd(snd(hd(snd(rhs))));
case LETREC : return rhsExpr(snd(snd(rhs)));
Int rhsLine(rhs) /* find line number associated with */
Cell rhs; { /* a right hand side */
+ STACK_CHECK
switch (whatIs(rhs)) {
case GUARDED : return intOf(fst(hd(snd(rhs))));
case LETREC : return rhsLine(snd(snd(rhs)));
static Bool local equalTypes(t1,t2) /* Compare simple types for equality*/
Type t1, t2; {
-
+ STACK_CHECK
et: if (whatIs(t1)!=whatIs(t2))
return FALSE;
type = typeIs;
beta = typeOff;
clearMarks();
+ improve(0,NIL,preds);
normPreds(0);
elimTauts();
preds = scSimplify(preds);
static Void local typeDefnGroup(bs) /* type check group of value defns */
List bs; { /* (one top level scc) */
List as;
- // printf("\n\n+++ DefnGroup ++++++++++++++++++++++++++++\n");
- //{ List qq; for (qq=bs;nonNull(qq);qq=tl(qq)){
- // print(hd(qq),4);
- // printf("\n");
- //}}
emptySubstitution();
hd(defnBounds) = NIL;
Type rng = NIL; /* Inferred range */
Cell nv = inventVar();
List alts = NIL;
- Int o;
- Int m;
+ Int o = 0; /* bogus init to keep gcc -O happy */
+ Int m = 0; /* bogus init to keep gcc -O happy */
#ifdef DEBUG_SELS
Printf("Selector %s, cns=",textToStr(name(s).text));
* Local function prototypes:
* ------------------------------------------------------------------------*/
-static Type local basicType Args((Char));
+static Type local basicType ( Char );
-static Type stateVar = BOGUS(600); //NIL;
-static Type alphaVar = BOGUS(601); //NIL;
-static Type betaVar = BOGUS(602); //NIL;
-static Type gammaVar = BOGUS(603); //NIL;
-static Int nextVar = BOGUS(604); //0;
+static Type stateVar = NIL;
+static Type alphaVar = NIL;
+static Type betaVar = NIL;
+static Type gammaVar = NIL;
+static Type deltaVar = NIL;
+static Int nextVar = 0;
static Void clearTyVars( void )
{
alphaVar = NIL;
betaVar = NIL;
gammaVar = NIL;
+ deltaVar = NIL;
nextVar = 0;
}
return gammaVar;
}
+static Type mkDeltaVar( void )
+{
+ if (isNull(deltaVar)) {
+ deltaVar = mkOffset(nextVar++);
+ }
+ return deltaVar;
+}
+
static Type local basicType(k)
Char k; {
switch (k) {
return typeChar;
case INT_REP:
return typeInt;
-#ifdef PROVIDE_INT64
- case INT64_REP:
- return typeInt64;
-#endif
-#ifdef PROVIDE_INTEGER
case INTEGER_REP:
return typeInteger;
-#endif
-#ifdef PROVIDE_ADDR
case ADDR_REP:
return typeAddr;
-#endif
-#ifdef PROVIDE_WORD
case WORD_REP:
return typeWord;
-#endif
case FLOAT_REP:
return typeFloat;
case DOUBLE_REP:
return typeDouble;
-#ifdef PROVIDE_ARRAY
- case ARR_REP: return ap(typePrimArray,mkAlphaVar());
- case BARR_REP: return typePrimByteArray;
- case REF_REP: return ap2(typeRef,mkStateVar(),mkAlphaVar());
- case MUTARR_REP: return ap2(typePrimMutableArray,mkStateVar(),mkAlphaVar());
- case MUTBARR_REP: return ap(typePrimMutableByteArray,mkStateVar());
-#endif
-#ifdef PROVIDE_STABLE
+ case ARR_REP:
+ return ap(typePrimArray,mkAlphaVar());
+ case BARR_REP:
+ return typePrimByteArray;
+ case REF_REP:
+ return ap2(typeRef,mkStateVar(),mkAlphaVar());
+ case MUTARR_REP:
+ return ap2(typePrimMutableArray,mkStateVar(),mkAlphaVar());
+ case MUTBARR_REP:
+ return ap(typePrimMutableByteArray,mkStateVar());
case STABLE_REP:
return ap(typeStable,mkAlphaVar());
-#endif
#ifdef PROVIDE_WEAK
case WEAK_REP:
return ap(typeWeak,mkAlphaVar());
case FOREIGN_REP:
return typeForeign;
#endif
-#ifdef PROVIDE_CONCURRENT
case THREADID_REP:
return typeThreadId;
case MVAR_REP:
return ap(typeMVar,mkAlphaVar());
-#endif
case BOOL_REP:
return typeBool;
case HANDLER_REP:
return mkBetaVar(); /* polymorphic */
case GAMMA_REP:
return mkGammaVar(); /* polymorphic */
+ case DELTA_REP:
+ return mkDeltaVar(); /* polymorphic */
default:
printf("Kind: '%c'\n",k);
internal("basicType");
assert(length(tvars) == nextVar);
r = mkPolyType(simpleKind(length(tvars)),r);
}
-#if DEBUG_CODE
- if (debugCode) {
- printType(stdout,r); printf("\n");
- }
-#endif
return r;
}
Int what; {
switch (what) {
case RESET : tcMode = EXPRESSION;
+ daSccs = NIL;
preds = NIL;
pendingBtyvs = NIL;
+ daSccs = NIL;
emptyAssumption();
break;
mark(localEvs);
mark(savedPs);
mark(dummyVar);
+ mark(daSccs);
mark(preds);
mark(stdDefaults);
mark(arrow);
mark(predIntegral);
mark(starToStar);
mark(predMonad);
-#if IO_MONAD
- mark(typeProgIO);
-#endif
+ mark(typeProgIO);
break;
- case INSTALL : typeChecker(RESET);
- dummyVar = inventVar();
-
-#if !IGNORE_MODULES
- setCurrModule(modulePrelude);
-#endif
-
- starToStar = simpleKind(1);
-
- typeUnit = addPrimTycon(findText("()"),
- STAR,0,DATATYPE,NIL);
- typeArrow = addPrimTycon(findText("(->)"),
- simpleKind(2),2,
- DATATYPE,NIL);
- typeList = addPrimTycon(findText("[]"),
- starToStar,1,
- DATATYPE,NIL);
-
- arrow = fn(aVar,bVar);
- listof = ap(typeList,aVar);
- boundPair = ap(ap(mkTuple(2),aVar),aVar);
-
- nameUnit = addPrimCfun(findText("()"),0,0,typeUnit);
- tycon(typeUnit).defn
- = singleton(nameUnit);
-
- nameNil = addPrimCfun(findText("[]"),0,1,
- mkPolyType(starToStar,
- listof));
- nameCons = addPrimCfun(findText(":"),2,2,
- mkPolyType(starToStar,
- fn(aVar,
- fn(listof,
- listof))));
- name(nameCons).syntax
- = mkSyntax(RIGHT_ASS,5);
-
- tycon(typeList).defn
- = cons(nameNil,cons(nameCons,NIL));
-
- typeVarToVar = fn(aVar,aVar);
+ case POSTPREL:
+
+ if (combined) {
+ setCurrModule(modulePrelude);
+ dummyVar = inventVar();
+ typeUnit = mkTuple(0);
+ arrow = fn(aVar,bVar);
+ listof = ap(typeList,aVar);
+ boundPair = ap(ap(mkTuple(2),aVar),aVar);
+ nameUnit = findQualNameWithoutConsultingExportList
+ (mkQVar(findText("PrelBase"),
+ findText("()")));
+ typeVarToVar = fn(aVar,aVar);
+ }
+ break;
+
+ case PREPREL :
+ typeChecker(RESET);
+
+ if (combined) {
+ Module m = findFakeModule(findText("PrelBase"));
+ setCurrModule(m);
+
+ starToStar = simpleKind(1);
+ typeList = addPrimTycon(findText("[]"),
+ starToStar,1,
+ DATATYPE,NIL);
+
+ listof = ap(typeList,aVar);
+ nameNil = addPrimCfun(findText("[]"),0,1,
+ mkPolyType(starToStar,
+ listof));
+ nameCons = addPrimCfun(findText(":"),2,2,
+ mkPolyType(starToStar,
+ fn(aVar,
+ fn(listof,
+ listof))));
+ name(nameNil).parent =
+ name(nameCons).parent = typeList;
+
+ name(nameCons).syntax
+ = mkSyntax(RIGHT_ASS,5);
+
+ tycon(typeList).defn
+ = cons(nameNil,cons(nameCons,NIL));
+
+ } else {
+ dummyVar = inventVar();
+
+ setCurrModule(modulePrelPrim);
+
+ starToStar = simpleKind(1);
+
+ typeUnit = findTycon(findText("()"));
+ assert(nonNull(typeUnit));
+
+ typeArrow = addPrimTycon(findText("(->)"),
+ simpleKind(2),2,
+ DATATYPE,NIL);
+ typeList = addPrimTycon(findText("[]"),
+ starToStar,1,
+ DATATYPE,NIL);
+
+ arrow = fn(aVar,bVar);
+ listof = ap(typeList,aVar);
+ boundPair = ap(ap(mkTuple(2),aVar),aVar);
+
+ nameUnit = addPrimCfun(findText("()"),0,0,typeUnit);
+ tycon(typeUnit).defn
+ = singleton(nameUnit);
+
+ nameNil = addPrimCfun(findText("[]"),0,1,
+ mkPolyType(starToStar,
+ listof));
+ nameCons = addPrimCfun(findText(":"),2,2,
+ mkPolyType(starToStar,
+ fn(aVar,
+ fn(listof,
+ listof))));
+ name(nameNil).parent =
+ name(nameCons).parent = typeList;
+
+ name(nameCons).syntax
+ = mkSyntax(RIGHT_ASS,5);
+
+ tycon(typeList).defn
+ = cons(nameNil,cons(nameCons,NIL));
+
+ typeVarToVar = fn(aVar,aVar);
#if TREX
- typeNoRow = addPrimTycon(findText("EmptyRow"),
- ROW,0,DATATYPE,NIL);
- typeRec = addPrimTycon(findText("Rec"),
- pair(ROW,STAR),1,
- DATATYPE,NIL);
- nameNoRec = addPrimCfun(findText("EmptyRec"),0,0,
- ap(typeRec,typeNoRow));
+ typeNoRow = addPrimTycon(findText("EmptyRow"),
+ ROW,0,DATATYPE,NIL);
+ typeRec = addPrimTycon(findText("Rec"),
+ pair(ROW,STAR),1,
+ DATATYPE,NIL);
+ nameNoRec = addPrimCfun(findText("EmptyRec"),0,0,
+ ap(typeRec,typeNoRow));
#else
- /* bogus definitions to avoid changing the prelude */
- addPrimCfun(findText("Rec"), 0,0,typeUnit);
- addPrimCfun(findText("EmptyRow"), 0,0,typeUnit);
- addPrimCfun(findText("EmptyRec"), 0,0,typeUnit);
-#endif
-#if IO_MONAD
- nameUserErr = addPrimCfun(inventText(),1,1,NIL);
- nameNameErr = addPrimCfun(inventText(),1,2,NIL);
- nameSearchErr= addPrimCfun(inventText(),1,3,NIL);
-#if IO_HANDLES
- nameIllegal = addPrimCfun(inventText(),0,4,NIL);
- nameWriteErr = addPrimCfun(inventText(),1,5,NIL);
- nameEOFErr = addPrimCfun(inventText(),1,6,NIL);
+ /* bogus definitions to avoid changing the prelude */
+ addPrimCfun(findText("Rec"), 0,0,typeUnit);
+ addPrimCfun(findText("EmptyRow"), 0,0,typeUnit);
+ addPrimCfun(findText("EmptyRec"), 0,0,typeUnit);
#endif
-#endif
- break;
+ }
+ break;
+
}
}
projects / ghc-hetmet.git / blobdiff