ghc/compiler/yaccParser/infix.c

   1 /*
   2  *      Infix operator stuff -- modified from LML
   3  */
   4
   5 #include <stdio.h>
   6
   7 #include "hspincl.h"
   8 #ifdef DPH
   9 #include "hsparser-DPH.tab.h"
  10 #else
  11 #include "hsparser.tab.h"
  12 #endif
  13 #include "constants.h"
  14 #include "utils.h"
  15
  16 static short iscope = 1;
  17
  18 static struct infix {
  19     char *iname;
  20     short ilen;
  21     short ifixity;
  22     short iprecedence;
  23 } infixtab[INFIX_SCOPES][MAX_INFIX] =
  24   {
  25   /*
  26         Name            Len     Fixity          Precedence
  27   */
  28         "$",            1,      INFIXR,         0,
  29         ":=",           2,      INFIX,          1,
  30         "||",           2,      INFIXR,         2,
  31         "&&",           2,      INFIXR,         3,
  32         "==",           2,      INFIX,          4,
  33         "/=",           2,      INFIX,          4,
  34         "<",            1,      INFIX,          4,
  35         "<=",           2,      INFIX,          4,
  36         ">",            1,      INFIX,          4,
  37         ">=",           2,      INFIX,          4,
  38         "elem",         4,      INFIX,          4,
  39         "notElem",      7,      INFIX,          4,
  40         "\\\\",         2,      INFIX,          5,
  41         ":",            1,      INFIXR,         5,
  42         "++",           2,      INFIXR,         5,
  43         "+",            1,      INFIXL,         6,
  44         "-",            1,      INFIXL,         6,
  45         ":+",           2,      INFIX,          6,
  46         "*",            1,      INFIXL,         7,
  47         "/",            1,      INFIXL,         7,
  48         "mod",          3,      INFIXL,         7,
  49         "div",          3,      INFIXL,         7,
  50         "rem",          3,      INFIXL,         7,
  51         "quot",         4,      INFIXL,         7,
  52         ":%",           2,      INFIXL,         7, /* possibly wrong; should be omitted? */
  53         "%",            1,      INFIXL,         7,
  54         "**",           2,      INFIXR,         8,
  55         "^",            1,      INFIXR,         8,
  56         "^^",           2,      INFIXR,         8,
  57         "!",            1,      INFIXL,         9,
  58         "!!",           2,      INFIXL,         9,
  59         "//",           2,      INFIXL,         9,
  60         ".",            1,      INFIXR,         9
  61 };
  62
  63
  64 #define NFIX 31                                         /* The number of predefined operators */
  65 #define ninfix (ninfixtab[iscope])
  66 static int ninfixtab[INFIX_SCOPES] = {NFIX,0};          /* # of predefined operators */
  67 static char infixstr[MAX_ISTR];
  68 static char *infixp = infixstr;
  69
  70 /* An "iscope" is an "infix scope": the scope of infix declarations
  71    (either the main module or an interface) */
  72
  73 void
  74 enteriscope()
  75 {
  76   if(++iscope > INFIX_SCOPES)
  77     {
  78       char errbuf[ERR_BUF_SIZE];
  79       sprintf(errbuf,"Too many infix scopes (> %d)\n",INFIX_SCOPES);
  80     }
  81   ninfix = 0;
  82 }
  83
  84 void
  85 exitiscope()
  86 {
  87   --iscope;
  88 }
  89
  90 void
  91 exposeis()
  92 {
  93   int i;
  94   --iscope;
  95
  96   for (i=0; i < ninfixtab[iscope+1]; ++i)
  97     {
  98       struct infix *ip = infixtab[iscope+1] + i;
  99       makeinfix(install_literal(ip->iname),ip->ifixity,ip->iprecedence);
 100     }
 101 }
 102
 103
 104 static int
 105 ionelookup(name,iscope)
 106   id name;
 107   int iscope;
 108 {
 109   int i;
 110   char *iname = id_to_string(name);
 111
 112   for(i = 0; i < ninfixtab[iscope]; i++)
 113     {
 114       if(strcmp(iname,infixtab[iscope][i].iname)==0)
 115         return(i);
 116     }
 117
 118   return(-1);
 119 }
 120
 121
 122 struct infix *
 123 infixlookup(name)
 124   id name;
 125 {
 126   int i;
 127   for (i=iscope; i >= 0; --i)
 128     {
 129      int n = ionelookup(name,i);
 130       if (n >= 0)
 131         return (infixtab[i]+n);
 132     }
 133   return (NULL);
 134 }
 135
 136 int
 137 nfixes()
 138 {
 139         return ninfix;
 140 }
 141
 142 char *
 143 fixop(n)
 144   int n;
 145 {
 146         return infixtab[iscope][n].iname;
 147 }
 148
 149 char *
 150 fixtype(n)
 151   int n;
 152 {
 153         switch(infixtab[iscope][n].ifixity) {
 154         case INFIXL:
 155                    return "infixl";
 156
 157         case INFIXR:
 158                    return "infixr";
 159
 160         case INFIX:
 161                  return "infix";
 162
 163         default : return 0;
 164         /* Why might it return 0 ?? (WDP 94/11) */
 165         }
 166 }
 167
 168
 169 int
 170 fixity(n)
 171   int n;
 172 {
 173 #ifdef HSP_DEBUG
 174   fprintf(stderr,"fixity of %s (at %d) is %d\n",infixtab[iscope][n].iname,n,infixtab[iscope][n].ifixity);
 175 #endif
 176   return(n < 0? INFIXL: infixtab[iscope][n].ifixity);
 177 }
 178
 179
 180 long int
 181 precedence(n)
 182   int n;
 183 {
 184 #ifdef HSP_DEBUG
 185   fprintf(stderr,"precedence of %s (at %d) is %d\n",infixtab[iscope][n].iname,n,infixtab[iscope][n].iprecedence);
 186 #endif
 187   return(n < 0? 9: infixtab[iscope][n].iprecedence);
 188 }
 189
 190
 191 int
 192 pfixity(ip)
 193   struct infix *ip;
 194 {
 195 #ifdef HSP_DEBUG
 196   fprintf(stderr,"fixity of %s is %d\n",ip->iname,ip->ifixity);
 197 #endif
 198   return(ip == NULL? INFIXL: ip->ifixity);
 199 }
 200
 201 int
 202 pprecedence(ip)
 203   struct infix *ip;
 204 {
 205 #ifdef HSP_DEBUG
 206   fprintf(stderr,"precedence of %s (at %d) is %d\n",ip->iname,ip->iprecedence);
 207 #endif
 208   return(ip == NULL? 9: ip->iprecedence);
 209 }
 210
 211
 212 void
 213 makeinfix(ssi, fixity, precedence)
 214   id ssi;
 215   int fixity, precedence;
 216 {
 217     register int i, l;
 218     char s[1000];
 219     char *ss = id_to_string(ssi);
 220
 221     for(i=0; i < ninfix; ++i)
 222       {
 223         if(strcmp(ss,infixtab[iscope][i].iname)==0)
 224           {
 225             /* Allow duplicate definitions if they are identical */
 226             if(infixtab[iscope][i].ifixity!=fixity ||
 227                infixtab[iscope][i].iprecedence!=precedence )
 228               {
 229                 char errbuf[ERR_BUF_SIZE];
 230                 sprintf(errbuf,"(%s) already declared to be %s %d\n",
 231                         ss,
 232                         fixtype(i),
 233                         infixtab[iscope][i].iprecedence);
 234                 hsperror(errbuf);
 235               }
 236             return;
 237           }
 238       }
 239
 240     strcpy(s, ss);
 241     l = strlen(s);
 242     s[l] = 0;
 243
 244     if (ninfix >= MAX_INFIX || infixp+l+1 >= &infixstr[MAX_ISTR]) {
 245         char errbuf[ERR_BUF_SIZE];
 246         sprintf(errbuf,"Too many Infix identifiers (> %d)",MAX_INFIX);
 247         hsperror(errbuf);
 248     }
 249
 250 #ifdef HSP_DEBUG
 251     fprintf(stderr,"adding %s (was %s), fixity=%d, prec=%d\n",s,ss,fixity,precedence);
 252 #endif
 253     infixtab[iscope][ninfix].iname = infixp;
 254     strcpy(infixp, s);
 255     infixp += l+1;
 256     infixtab[iscope][ninfix].ifixity = fixity;
 257     infixtab[iscope][ninfix].iprecedence = precedence;
 258     infixtab[iscope][ninfix].ilen = l-1;
 259     ninfix++;
 260 }