home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / hugs101.zip / hugs101sc.zip / hugsdist / src / subst.c < prev    next >
C/C++ Source or Header  |  1995-03-02  |  18KB  |  650 lines
  1. /* --------------------------------------------------------------------------
  2.  * subst.c:     Copyright (c) Mark P Jones 1991-1994.   All rights reserved.
  3.  *              See NOTICE for details and conditions of use etc...
  4.  *              Hugs Version 1.0 August 1994, derived from Gofer 2.30a
  5.  *
  6.  * Part of type checker dealing with operations on current substitution.
  7.  * ------------------------------------------------------------------------*/
  8.  
  9. static Void local emptySubstitution() {    /* clear current substitution       */
  10.     numTyvars   = 0;
  11. #if !FIXED_SUBST
  12.     if (maxTyvars!=NUM_TYVARS) {
  13.     maxTyvars = 0;
  14.     if (tyvars) {
  15.         free(tyvars);
  16.         tyvars = 0;
  17.     }
  18.     }
  19. #endif
  20.     nextGeneric = 0;
  21.     genericVars = NIL;
  22.     typeIs      = NIL;
  23.     predsAre    = NIL;
  24. }
  25.  
  26. static Void local expandSubst(n)    /* add further n type variables to */
  27. Int n; {                /* current substituion           */
  28. #if FIXED_SUBST
  29.     if (numTyvars+n>NUM_TYVARS) {
  30.     ERROR(0) "Too many type variables in type checker"
  31.     EEND;
  32.     }
  33. #else
  34.     if (numTyvars+n>maxTyvars) {    /* need to expand substitution       */
  35.         Int   newMax = maxTyvars+NUM_TYVARS;
  36.     Tyvar *newTvs;
  37.     Int   i;
  38.  
  39.     if (numTyvars+n>newMax) {    /* safety precaution           */
  40.         ERROR(0) "Substitution expanding too quickly"
  41.         EEND;
  42.     }
  43.  
  44.     /* It would be better to realloc() here, but that isn't portable
  45.      * enough for calloc()ed arrays.  The following code could cause
  46.      * a space leak if an interrupt occurs while we're copying the
  47.      * array ... we won't worry about this for the time being because
  48.      * we don't expect to have to go through this process much (if at
  49.      * all) in normal use of the type checker.
  50.      */
  51.  
  52.     newTvs = (Tyvar *)calloc(newMax,sizeof(Tyvar));
  53.     if (!newTvs) {
  54.         ERROR(0) "Too many variables (%d) in type checker", newMax
  55.         EEND;
  56.     }
  57.     for (i=0; i<numTyvars;++i) {        /* copy substitution       */
  58.         newTvs[i].offs  = tyvars[i].offs;
  59.         newTvs[i].bound = tyvars[i].bound;
  60.         newTvs[i].kind  = tyvars[i].kind;
  61.     }
  62.     maxTyvars = 0;                /* protection from SIGINT? */
  63.     if (tyvars) free(tyvars);
  64.     tyvars    = newTvs;
  65.     maxTyvars = newMax;
  66.     }
  67. #endif
  68. }
  69.  
  70. static Int local newTyvars(n)            /* allocate new type variables       */
  71. Int n; {                /* all of kind STAR           */
  72.     Int beta = numTyvars;
  73.  
  74.     expandSubst(n);
  75.     for (numTyvars+=n; n>0; n--) {
  76.     tyvars[numTyvars-n].offs  = UNUSED_GENERIC;
  77.     tyvars[numTyvars-n].bound = NIL;
  78.     tyvars[numTyvars-n].kind  = STAR;
  79. #ifdef DEBUG_TYPES
  80.     printf("new type variable: _%d ::: ",numTyvars-n);
  81.     printKind(stdout,tyvars[numTyvars-n].kind);
  82.     putchar('\n');
  83. #endif
  84.     }
  85.     return beta;
  86. }
  87.  
  88. static Int local newKindedVars(k)    /* allocate new variables with       */
  89. Kind k; {                /* specified kinds           */
  90.     Int beta = numTyvars;        /* if k = k0 -> k1 -> ... -> kn       */
  91.     for (; isAp(k); k=snd(k)) {        /* then allocate n vars with kinds */
  92.     expandSubst(1);            /* k0, k1, ..., k(n-1)           */
  93.     tyvars[numTyvars].offs  = UNUSED_GENERIC;
  94.     tyvars[numTyvars].bound = NIL;
  95.     tyvars[numTyvars].kind  = fst(k);
  96. #ifdef DEBUG_TYPES
  97.     printf("new type variable: _%d ::: ",numTyvars);
  98.     printKind(stdout,tyvars[numTyvars].kind);
  99.     putchar('\n');
  100. #endif
  101.     numTyvars++;
  102.     }
  103.     return beta;
  104. }
  105.  
  106. #define freeTypeVars(beta) numTyvars=beta
  107.  
  108. #define deRef(tyv,t,o)  while ((tyv=getTypeVar(t,o)) && tyv->bound) { \
  109.                             t = tyv->bound;                           \
  110.                             o = tyv->offs;                            \
  111.                         }
  112.  
  113. static Tyvar *local getTypeVar(t,o)    /* get number of type variable       */
  114. Type t;                 /* represented by (t,o) [if any].  */
  115. Int  o; {
  116.     switch (whatIs(t)) {
  117.     case INTCELL : return tyvar(intOf(t));
  118.     case OFFSET  : return tyvar(o+offsetOf(t));
  119.     }
  120.     return ((Tyvar *)0);
  121. }
  122.  
  123. static Void local tyvarType(vn)           /* load type held in type variable */
  124. Int vn; {                       /* vn into (typeIs,typeOff)       */
  125.     Tyvar *tyv;
  126.  
  127.     while ((tyv=tyvar(vn))->bound)
  128.     switch(whatIs(tyv->bound)) {
  129.         case INTCELL : vn = intOf(tyv->bound);
  130.                break;
  131.  
  132.         case OFFSET  : vn = offsetOf(tyv->bound)+(tyv->offs);
  133.                break;
  134.  
  135.         default     : typeIs  = tyv->bound;
  136.                typeOff = tyv->offs;
  137.                return;
  138.     }
  139.     typeIs  = var;
  140.     typeOff = vn;
  141. }
  142.  
  143. static Void local bindTv(vn,t,o)           /* set type variable vn to (t,o)   */
  144. Int  vn;
  145. Type t;
  146. Int  o; {
  147.     Tyvar *tyv = tyvar(vn);
  148.     tyv->bound = t;
  149.     tyv->offs  = o;
  150. #ifdef DEBUG_TYPES
  151.     printf("binding type variable: _%d to ",vn);
  152.     printType(stdout,debugType(t,o));
  153.     putchar('\n');
  154. #endif
  155. }
  156.  
  157. static Void local expandSyn(h,ar,at,ao)    /* Expand type synonym with:       */
  158. Tycon h;                /* head h               */
  159. Int   ar;                /* ar args (NB. ar>=tycon(h).arity)*/
  160. Type  *at;                /* original expression (*at,*ao)   */
  161. Int   *ao; {                /* expansion returned in (*at,*ao) */
  162.     ar -= tycon(h).arity;        /* calculate surplus arguments       */
  163.     if (ar==0)
  164.     expandSyn1(h,at,ao);
  165.     else {                /* if there are more args than the */
  166.     Type t    = *at;        /* arity, we have to do a little   */
  167.     Int  o    = *ao;        /* bit of work to isolate args that*/
  168.     Type args = NIL;        /* will not be changed by expansion*/
  169.     Int  i    = tycon(h).arity;
  170.     Kind k    = tycon(h).kind;
  171.     while (i-- > 0)            /* find kind of expanded part       */
  172.         k = snd(k);
  173.     while (ar-- > 0) {        /* find part to expand, and the       */
  174.         Tyvar *tyv;            /* unused arguments           */
  175.         args = cons(arg(t),args);
  176.         t    = fun(t);
  177.         deRef(tyv,t,o);
  178.     }
  179.     expandSyn1(h,&t,&o);        /* do the expansion           */
  180.     bindTv((i=newTyvars(1)),t,o);    /* and embed the results back in   */
  181.     tyvar(i)->kind = getKind(t,o);    /* (*at, *ao) as required       */
  182.     *at = applyToArgs(mkInt(i),args);
  183.     }
  184. }
  185.  
  186. static Void local expandSyn1(h,at,ao)    /* Expand type synonym with:       */
  187. Tycon h;                /* head h, tycon(h).arity args,       */
  188. Type  *at;                /* original expression (*at,*ao)   */
  189. Int   *ao; {                /* expansion returned in (*at,*ao) */
  190.     Int   n = tycon(h).arity;
  191.     Type  t = *at;
  192.     Int   o = *ao;
  193.     Tyvar *tyv;
  194.  
  195.     *at = tycon(h).defn;
  196.     *ao = newKindedVars(tycon(h).kind);
  197.     for (; 0<n--; t=fun(t)) {
  198.     deRef(tyv,t,o);
  199.     if (tyv || !isAp(t))
  200.         internal("expandSyn1");
  201.     bindTv(*ao+n,arg(t),o);
  202.     }
  203. }
  204.  
  205. static Cell local getDerefHead(t,o)    /* get value at head of type exp.  */
  206. Type t;
  207. Int  o; {
  208.     Tyvar *tyv;
  209.     argCount = 0;
  210.     for (;;) {
  211.     while (isAp(t)) {
  212.         argCount++;
  213.         t = fun(t);
  214.     }
  215.     tyv = getTypeVar(t,o);
  216.     if (tyv && tyv->bound) {
  217.         t = tyv->bound;
  218.         o = tyv->offs;
  219.     }
  220.     else
  221.         break;
  222.     }
  223.     return t;
  224. }
  225.  
  226. /* --------------------------------------------------------------------------
  227.  * Mark type expression, so that all variables are marked as unused generics
  228.  * ------------------------------------------------------------------------*/
  229.  
  230. static Void local clearMarks() {           /* set all unbound type vars to       */
  231.     Int i;                       /* unused generic variables       */
  232.     for (i=0; i<numTyvars; ++i)
  233.     if (isNull(tyvars[i].bound))
  234.         tyvars[i].offs = UNUSED_GENERIC;
  235.     nextGeneric = 0;
  236.     genericVars = NIL;
  237. }
  238.  
  239. static Void local resetGenericsFrom(n)    /* reset all generic vars to unused*/
  240. Int n; {                /* for generics >= n           */
  241.     Int i;
  242.  
  243.     if (n==0)                /* reset generic variables list       */
  244.     genericVars = NIL;        /* most common case: reset to zero */
  245.     else
  246.     for (i=length(genericVars); i>n; i--)
  247.         genericVars = tl(genericVars);
  248.  
  249.     for (i=0; i<numTyvars; ++i)
  250.     if (isNull(tyvars[i].bound) && tyvars[i].offs>=GENERIC+n)
  251.         tyvars[i].offs = UNUSED_GENERIC;
  252.     nextGeneric = n;
  253. }
  254.  
  255. static Void local markTyvar(vn)            /* mark fixed vars in type bound to*/
  256. Int vn; {                       /* given type variable           */
  257.     Tyvar *tyv = tyvar(vn);
  258.  
  259.     if (tyv->bound)
  260.     markType(tyv->bound, tyv->offs);
  261.     else
  262.     (tyv->offs) = FIXED_TYVAR;
  263. }
  264.  
  265. static Void local markType(t,o)            /* mark fixed vars in type (t,o)   */
  266. Type t;
  267. Int  o; {
  268.     switch (whatIs(t)) {
  269.     case TYCON   :
  270.     case TUPLE   :
  271.     case UNIT    :
  272.     case ARROW   :
  273.     case LIST    : return;
  274.  
  275.     case AP      : markType(fst(t),o);
  276.                markType(snd(t),o);
  277.                return;
  278.  
  279.     case OFFSET  : markTyvar(o+offsetOf(t));
  280.                return;
  281.  
  282.     case INTCELL : markTyvar(intOf(t));
  283.                return;
  284.  
  285.     default      : internal("markType");
  286.     }
  287. }
  288.  
  289. /* --------------------------------------------------------------------------
  290.  * Copy type expression from substitution to make a single type expression:
  291.  * ------------------------------------------------------------------------*/
  292.  
  293. static Type local copyTyvar(vn)            /* calculate most general form of  */
  294. Int vn; {                       /* type bound to given type var       */
  295.     Tyvar *tyv = tyvar(vn);
  296.  
  297.     if (tyv->bound)
  298.     return copyType(tyv->bound,tyv->offs);
  299.  
  300.     switch (tyv->offs) {
  301.     case FIXED_TYVAR    : return mkInt(vn);
  302.  
  303.     case UNUSED_GENERIC : (tyv->offs) = GENERIC + nextGeneric++;
  304.                   if (nextGeneric>=NUM_OFFSETS) {
  305.                   ERROR(0)
  306.                       "Too many polymorphic type variables"
  307.                   EEND;
  308.                   }
  309.                   genericVars = cons(mkInt(vn),genericVars);
  310.  
  311.     default         : return mkOffset(tyv->offs - GENERIC);
  312.     }
  313. }
  314.  
  315. static Type local copyType(t,o)            /* calculate most general form of  */
  316. Type t;                        /* type expression (t,o)        */
  317. Int  o; {
  318.     switch (whatIs(t)) {
  319.     case AP      : {   Type l = copyType(fst(t),o);  /* ensure correct */
  320.                Type r = copyType(snd(t),o);  /* eval. order    */
  321.                return ap(l,r);
  322.                }
  323.     case OFFSET  : return copyTyvar(o+offsetOf(t));
  324.     case INTCELL : return copyTyvar(intOf(t));
  325.     }
  326.  
  327.     return t;
  328. }
  329.  
  330. static Type local genvarTyvar(vn,vs)    /* calculate list of generic vars  */
  331. Int  vn;                /* thru variable vn, prepended to  */
  332. List vs; {                /* list vs               */
  333.     Tyvar *tyv = tyvar(vn);
  334.  
  335.     if (tyv->bound)
  336.     return genvarType(tyv->bound,tyv->offs,vs);
  337.     else if (tyv->offs == UNUSED_GENERIC) {
  338.     tyv->offs += GENERIC + nextGeneric++;
  339.         return cons(mkInt(vn),vs);
  340.     }
  341.     else
  342.     return vs;
  343. }
  344.  
  345. static List local genvarType(t,o,vs)    /* calculate list of generic vars  */
  346. Type t;                        /* in type expression (t,o)        */
  347. Int  o;                    /* results are prepended to vs       */
  348. List vs; {
  349.     switch (whatIs(t)) {
  350.     case AP      : return genvarType(snd(t),o,genvarType(fst(t),o,vs));
  351.     case OFFSET  : return genvarTyvar(o+offsetOf(t),vs);
  352.     case INTCELL : return genvarTyvar(intOf(t),vs);
  353.     }
  354.     return vs;
  355. }
  356.  
  357. #ifdef DEBUG_TYPES
  358. static Type local debugTyvar(vn)    /* expand type structure in full   */
  359. Int vn; {                /* detail               */
  360.     Tyvar *tyv = tyvar(vn);
  361.  
  362.     if (tyv->bound)
  363.     return debugType(tyv->bound,tyv->offs);
  364.     return mkInt(vn);
  365. }
  366.  
  367. static Type local debugType(t,o)
  368. Type t;
  369. Int  o; {
  370.     switch (whatIs(t)) {
  371.     case AP      : {   Type l = debugType(fst(t),o);
  372.                Type r = debugType(snd(t),o);
  373.                return ap(l,r);
  374.                }
  375.     case OFFSET  : return debugTyvar(o+offsetOf(t));
  376.     case INTCELL : return debugTyvar(intOf(t));
  377.     }
  378.  
  379.     return t;
  380. }
  381. #endif /*DEBUG_TYPES*/
  382.  
  383. /* --------------------------------------------------------------------------
  384.  * Occurs check:
  385.  * ------------------------------------------------------------------------*/
  386.  
  387. static Tyvar *lookingFor;               /* var to look for in occurs check */
  388.  
  389. static Bool local doesntOccurIn(t,o)       /* Return TRUE if var lookingFor   */
  390. Type t;                        /* isn't referenced in (t,o)       */
  391. Int o; {
  392.     Tyvar *tyv;
  393.  
  394.     for (;;) {
  395.     deRef(tyv,t,o);
  396.     if (tyv)            /* type variable           */
  397.         return tyv!=lookingFor;
  398.         else if (isAp(t)) {        /* application               */
  399.         if (doesntOccurIn(snd(t),o))
  400.         t = fst(t);
  401.         else
  402.         return FALSE;
  403.     }
  404.     else                            /* no variable found           */
  405.         break;
  406.     }
  407.     return TRUE;
  408. }
  409.  
  410. /* --------------------------------------------------------------------------
  411.  * Unification algorithm:
  412.  * ------------------------------------------------------------------------*/
  413.  
  414. static char *unifyFails = 0;        /* unification error message       */
  415. static Bool matchMode    = FALSE;    /* set to TRUE to prevent binding  */
  416.                            /* during matching process       */
  417.  
  418. static Bool local varToVarBind(tyv1,tyv2)/* Make binding tyv1 := tyv2       */
  419. Tyvar *tyv1, *tyv2; {
  420.     if (tyv1!=tyv2)
  421.     if (matchMode)
  422.         return FALSE;
  423.     else {
  424.         if (!eqKind(tyv1->kind,tyv2->kind)) {
  425.         unifyFails = "constructor variable kinds do not match";
  426.         return FALSE;
  427.         }
  428.         tyv1->bound = var;
  429.         tyv1->offs    = tyvNum(tyv2);
  430. #ifdef DEBUG_TYPES
  431.         printf("vv binding tyvar: _%d to _%d\n",tyvNum(tyv1),tyvNum(tyv2));
  432. #endif
  433.     }
  434.     return TRUE;
  435. }
  436.  
  437. static Bool local varToTypeBind(tyv,t,o)/* Make binding tyv := (t,o)       */
  438. Tyvar *tyv;
  439. Type  t;                /* guaranteed not to be a v'ble or */
  440. Int   o; {                /* have synonym as outermost constr*/
  441.     if (!matchMode) {
  442.     lookingFor = tyv;
  443.     if (doesntOccurIn(t,o)) {
  444.         if (!eqKind(tyv->kind,getKind(t,o))) {
  445.         unifyFails = "constructor variable kinds do not match";
  446.         return FALSE;
  447.         }
  448.         tyv->bound = t;
  449.         tyv->offs  = o;
  450. #ifdef DEBUG_TYPES
  451.         printf("vt binding type variable: _%d to ",tyvNum(tyv));
  452.         printType(stdout,debugType(t,o));
  453.         putchar('\n');
  454. #endif
  455.         return TRUE;
  456.     }
  457.     }
  458.     unifyFails = "unification would give infinite type";
  459.     return FALSE;    /* INFINITE TYPE (or failed match in matchMode)    */
  460. }
  461.  
  462. static Bool local kvarToVarBind(tyv1,tyv2)/* Make binding tyv1 := tyv2       */
  463. Tyvar *tyv1, *tyv2; {              /* for kind variable bindings       */
  464.     if (tyv1!=tyv2) {
  465.     tyv1->bound = var;
  466.     tyv1->offs  = tyvNum(tyv2);
  467.     }
  468.     return TRUE;
  469. }
  470.  
  471. static Bool local kvarToTypeBind(tyv,t,o)/* Make binding tyv := (t,o)       */
  472. Tyvar *tyv;                /* for kind variable bindings       */
  473. Type  t;                /* guaranteed not to be a v'ble or */
  474. Int   o; {                /* have synonym as outermost constr*/
  475.     lookingFor = tyv;
  476.     if (doesntOccurIn(t,o)) {
  477.     tyv->bound = t;
  478.     tyv->offs  = o;
  479.     return TRUE;
  480.     }
  481.     unifyFails = "unification would give infinite kind";
  482.     return FALSE;
  483. }
  484.  
  485. static Bool local unify(t1,o1,t2,o2)    /* Main unification routine       */
  486. Type t1,t2;                /* unify (t1,o1) with (t2,o2)       */
  487. Int  o1,o2; {
  488.     Tyvar *tyv1, *tyv2;
  489.  
  490.     deRef(tyv1,t1,o1);
  491.     deRef(tyv2,t2,o2);
  492.  
  493. un: if (tyv1)
  494.         if (tyv2)
  495.         return varToVarBind(tyv1,tyv2);        /* t1, t2 variables    */
  496.         else {
  497.         Cell h2 = getDerefHead(t2,o2);        /* t1 variable, t2 not */
  498.         if (isSynonym(h2) && argCount>=tycon(h2).arity) {
  499.         expandSyn(h2,argCount,&t2,&o2);
  500.         deRef(tyv2,t2,o2);
  501.         goto un;
  502.         }
  503.         return varToTypeBind(tyv1,t2,o2);
  504.         }
  505.     else
  506.         if (tyv2) {
  507.         Cell h1 = getDerefHead(t1,o1);        /* t2 variable, t1 not */
  508.         if (isSynonym(h1) && argCount>=tycon(h1).arity) {
  509.         expandSyn(h1,argCount,&t1,&o1);
  510.         deRef(tyv1,t1,o1);
  511.         goto un;
  512.         }
  513.         return varToTypeBind(tyv2,t1,o1);
  514.         }
  515.     else {                        /* t1, t2 not vars       */
  516.         Type h1 = getDerefHead(t1,o1);
  517.         Int  a1 = argCount;
  518.         Type h2 = getDerefHead(t2,o2);
  519.         Int  a2 = argCount;
  520.  
  521. #ifdef DEBUG_TYPES
  522.         printf("tt unifying types: ");
  523.         printType(stdout,debugType(t1,o1));
  524.         printf(" with ");
  525.         printType(stdout,debugType(t2,o2));
  526.         putchar('\n');
  527. #endif
  528.  
  529.         if (isOffset(h1) || isInt(h1)) h1=NIL;  /* represent var by NIL*/
  530.         if (isOffset(h2) || isInt(h2)) h2=NIL;
  531.  
  532.         if (nonNull(h1) && h1==h2) {/* Assuming well-formed types, both*/
  533.         if (a1!=a2) {        /* t1, t2 must have same no of args*/
  534.             unifyFails = "incompatible constructors";
  535.             return FALSE;
  536.         }
  537.         while (isAp(t1)) {
  538.             if (!unify(arg(t1),o1,arg(t2),o2))
  539.             return FALSE;
  540.             t1 = fun(t1);
  541.             deRef(tyv1,t1,o1);
  542.             t2 = fun(t2);
  543.             deRef(tyv2,t2,o2);
  544.         }
  545.         unifyFails = 0;
  546.         return TRUE;
  547.         }
  548.  
  549.         /* Types do not match -- look for type synonyms to expand */
  550.  
  551.         if (isSynonym(h1) && a1>=tycon(h1).arity) {
  552.         expandSyn(h1,a1,&t1,&o1);
  553.         deRef(tyv1,t1,o1);
  554.         goto un;
  555.         }
  556.         if (isSynonym(h2) && a2>=tycon(h2).arity) {
  557.         expandSyn(h2,a2,&t2,&o2);
  558.                 deRef(tyv2,t2,o2);
  559.         goto un;
  560.         }
  561.  
  562.         if ((isNull(h1) && a1<=a2) ||       /* last attempt -- maybe   */
  563.         (isNull(h2) && a2<=a1))    {    /* one head is a variable? */
  564.         for (;;) {
  565.             deRef(tyv1,t1,o1);
  566.             deRef(tyv2,t2,o2);
  567.  
  568.             if (tyv1)                /* unify heads!       */
  569.             if (tyv2)
  570.                 return varToVarBind(tyv1,tyv2);
  571.             else
  572.                 return varToTypeBind(tyv1,t2,o2);
  573.             else if (tyv2)
  574.             return varToTypeBind(tyv2,t1,o1);
  575.  
  576.             /* at this point, neither t1 nor t2 is a variable. In  */
  577.             /* addition, they must both be APs unless one of the   */
  578.             /* head variables has been bound during unification of */
  579.             /* the arguments.                       */
  580.  
  581.             if (!isAp(t1) || !isAp(t2)) {    /* might not be APs*/
  582.             unifyFails = 0;
  583.             return t1==t2;
  584.             }
  585.             if (!unify(arg(t1),o1,arg(t2),o2))    /* o/w must be APs */
  586.             return FALSE;
  587.             t1 = fun(t1);
  588.             t2 = fun(t2);
  589.         }
  590.         }
  591.     }
  592.     unifyFails = 0;
  593.     return FALSE;
  594. }
  595.  
  596. static Bool local sameType(t1,o1,t2,o2)/* Compare types without binding    */
  597. Type t1,t2;
  598. Int  o1,o2; {
  599.     Bool result;
  600.     matchMode = TRUE;
  601.     result    = unify(t1,o1,t2,o2);
  602.     matchMode = FALSE;
  603.     return result;
  604. }
  605.  
  606. Bool typeMatches(type,mt)        /* test if type matches monotype mt*/
  607. Type type, mt; {
  608.     Bool result;
  609.     if (isPolyType(type) || whatIs(type)==QUAL)
  610.     return FALSE;
  611.     typeChecker(RESET);
  612.     matchMode = TRUE;
  613.     result    = unify(mt,0,type,0);
  614.     matchMode = FALSE;
  615.     typeChecker(RESET);
  616.     return result;
  617. }
  618.  
  619. /* --------------------------------------------------------------------------
  620.  * Unify kind expressions:
  621.  * ------------------------------------------------------------------------*/
  622.  
  623. static Bool local kunify(k1,o1,k2,o2)    /* Unify kind expr (k1,o1) with       */
  624. Kind k1,k2;                /* (k2,o2)               */
  625. Int  o1,o2; {
  626.     Tyvar *kyv1, *kyv2;
  627.  
  628.     deRef(kyv1,k1,o1);
  629.     deRef(kyv2,k2,o2);
  630.  
  631.     if (kyv1)
  632.         if (kyv2)
  633.         return kvarToVarBind(kyv1,kyv2);        /* k1, k2 variables    */
  634.         else
  635.         return kvarToTypeBind(kyv1,k2,o2);        /* k1 variable, k2 not */
  636.     else
  637.         if (kyv2)
  638.         return kvarToTypeBind(kyv2,k1,o1);        /* k2 variable, k1 not */
  639.     else
  640.         if (k1==STAR && k2==STAR)            /* k1, k2 not vars       */
  641.         return TRUE;
  642.         else if (isAp(k1) && isAp(k2))
  643.         return kunify(fst(k1),o1,fst(k2),o2) &&
  644.                kunify(snd(k1),o1,snd(k2),o2);
  645.     unifyFails = 0;
  646.     return FALSE;
  647. }
  648.  
  649. /*-------------------------------------------------------------------------*/
  650.