ghc/compiler/parser/infix.c

   1 /*
   2  *      Infix operator stuff -- modified from LML
   3  */
   4
   5 #include <stdio.h>
   6
   7 #include "hspincl.h"
   8 #include "hsparser.tab.h"
   9 #include "constants.h"
  10 #include "utils.h"
  11
  12 static struct infix {
  13     char *imod;
  14     char *iop;
  15     short thismod;
  16     short unqualok;
  17     short ifixity;
  18     short iprecedence;
  19 } infixtab[MAX_INFIX];
  20
  21 static int ninfix = 0;
  22
  23 void
  24 makeinfix(opid, fixity, precedence, modid, imported,
  25           withas, impmodid, impasid, withqual,
  26           withspec, withhiding, importspec)
  27   id opid;
  28   int fixity, precedence;
  29   long imported, withas, withqual, withspec, withhiding;
  30   id modid, impmodid, impasid;
  31   list importspec;
  32 /*
  33   ToDo: Throw away infix operator if hidden by importspec!
  34 */
  35 {
  36     int i;
  37     char *op = id_to_string(opid);
  38     char *mod = id_to_string(imported ? (withas ? impasid : impmodid) : modid);
  39     short thismod = ! imported;
  40     short unqualok = ! (imported && withqual);
  41
  42     for(i=0; i < ninfix; ++i)
  43       {
  44         if(strcmp(op,infixtab[i].iop)==0 &&
  45            strcmp(mod,infixtab[i].imod)==0 &&
  46            unqualok==infixtab[i].unqualok)
  47           {
  48             /* Allow duplicate definitions if they are identical */
  49             if (infixtab[i].ifixity==fixity &&
  50                 infixtab[i].iprecedence==precedence)
  51               {
  52                 return;
  53               }
  54
  55             /* Allow local definition to override an import */
  56             else if(thismod && !infixtab[i].thismod)
  57               {
  58                 /*continue*/
  59               }
  60
  61             else
  62               {
  63                 char errbuf[ERR_BUF_SIZE];
  64                 sprintf(errbuf,"%s.%s %s already declared to be %s %d\n",
  65                         mod, op, unqualok ? "(unqualified)" : "(qualified)",
  66                         infixstr(infixtab[i].ifixity),
  67                         infixtab[i].iprecedence);
  68                 hsperror(errbuf);
  69               }
  70           }
  71       }
  72
  73     if (ninfix >= MAX_INFIX) {
  74         char errbuf[ERR_BUF_SIZE];
  75         sprintf(errbuf,"Too many Infix identifiers (> %d)",MAX_INFIX);
  76         hsperror(errbuf);
  77     }
  78
  79 #ifdef HSP_DEBUG
  80     fprintf(stderr,"makeinfix: %s.%s, fixity=%d prec=%d\n",mod,op,infixint(fixity),precedence);
  81 #endif
  82     infixtab[ninfix].imod = mod;
  83     infixtab[ninfix].iop = op;
  84     infixtab[ninfix].thismod = thismod;
  85     infixtab[ninfix].unqualok = unqualok;
  86     infixtab[ninfix].ifixity = fixity;
  87     infixtab[ninfix].iprecedence = precedence;
  88     ninfix++;
  89 }
  90
  91 struct infix *
  92 infixlookup(name)
  93   qid name;
  94 {
  95     int i;
  96     struct infix *found = NULL;
  97     char *op  = qid_to_string(name);
  98     char *mod = qid_to_mod(name);
  99     short unqual = mod == NULL;
 100
 101     for(i = 0; i < ninfix; i++)
 102       {
 103         if(strcmp(op,infixtab[i].iop)==0 &&
 104            ( (unqual && infixtab[i].unqualok) ||
 105              (!unqual && strcmp(mod,infixtab[i].imod)==0)
 106            ))
 107           {
 108             if (! found)
 109               {
 110                 /* first find */
 111                 found = infixtab+i;
 112               }
 113             else if (found && ! found->thismod && infixtab[i].thismod)
 114               {
 115                 /* new find for this module; overrides */
 116                 found = infixtab+i;
 117               }
 118             else if (found && found->thismod && ! infixtab[i].thismod)
 119               {
 120                 /* prev find for this module */
 121               }
 122             else if (found->ifixity == infixtab[i].ifixity &&
 123                      found->iprecedence == infixtab[i].iprecedence)
 124               {
 125                 /* finds are identical */
 126               }
 127             else
 128               {
 129                 char errbuf[ERR_BUF_SIZE];
 130                 sprintf(errbuf,"conflicting infix declarations for %s.%s\n  %s.%s %s (%s,%d) and %s.%s %s (%s,%d)\n",
 131                         qid_to_pmod(name), op,
 132                         found->imod, found->iop, found->unqualok ? "(unqualified)" : "(qualified)",
 133                            infixstr(found->ifixity),found->iprecedence,
 134                         infixtab[i].imod, infixtab[i].iop, infixtab[i].unqualok ? "(unqualified)" : "(qualified)",
 135                            infixstr(infixtab[i].ifixity),infixtab[i].iprecedence);
 136                 hsperror(errbuf);
 137
 138               }
 139           }
 140       }
 141
 142 #ifdef HSP_DEBUG
 143   fprintf(stderr,"infixlookup: %s.%s = fixity=%d prec=%d\n",qid_to_pmod(name),op,infixint(pfixity(found)),pprecedence(found));
 144 #endif
 145
 146   return(found);
 147 }
 148
 149 int
 150 pfixity(ip)
 151   struct infix *ip;
 152 {
 153   return(ip == NULL? INFIXL: ip->ifixity);
 154 }
 155
 156 int
 157 pprecedence(ip)
 158   struct infix *ip;
 159 {
 160   return(ip == NULL? 9: ip->iprecedence);
 161 }
 162
 163 char *
 164 infixstr(n)
 165   int n;
 166 {
 167   switch(n) {
 168     case INFIXL:
 169       return "infixl";
 170
 171     case INFIXR:
 172       return "infixr";
 173
 174     case INFIX:
 175       return "infix";
 176
 177     default:
 178       hsperror("infixstr");
 179   }
 180 }
 181
 182 long
 183 infixint(n)
 184   int n;
 185 {
 186   switch(n) {
 187     case INFIXL:
 188       return -1;
 189
 190     case INFIX:
 191       return 0;
 192
 193     case INFIXR:
 194       return 1;
 195
 196     default:
 197       hsperror("infixint");
 198   }
 199 }
 200