ghc/compiler/parser/type2context.c

   1 /**********************************************************************
   2 *                                                                     *
   3 *                                                                     *
   4 *      Convert Types to Contexts                                      *
   5 *                                                                     *
   6 *                                                                     *
   7 **********************************************************************/
   8
   9
  10 #include <stdio.h>
  11 #include "hspincl.h"
  12 #include "constants.h"
  13 #include "utils.h"
  14
  15 /*
  16     partain: see also the comment by "decl" in hsparser.y.
  17
  18     Here, we've been given a type that must be of the form
  19     "C a" or "(C1 a, C2 a, ...)" [otherwise an error]
  20
  21     Convert it to a list.
  22 */
  23
  24
  25 list
  26 type2context(t)
  27   ttype t;
  28 {
  29     list  args;
  30
  31     switch (tttype(t)) {
  32       case ttuple:
  33         /* returning the list is OK, but ensure items are right format */
  34         args = gttuple(t);
  35
  36         if (tlist(args) == lnil)
  37           hsperror ("type2context: () found instead of a context");
  38
  39         while (tlist(args) != lnil)
  40           {
  41             is_context_format(lhd(args), 0);
  42             args = ltl(args);
  43           }
  44
  45         return(gttuple(t)); /* args */
  46
  47
  48       case tapp:
  49       case tname:
  50         /* a single item, ensure correct format */
  51         is_context_format(t, 0);
  52         return(lsing(t));
  53
  54       case namedtvar:
  55         hsperror ("type2context: unexpected namedtvar found in a context");
  56
  57       case tllist:
  58         hsperror ("type2context: list constructor found in a context");
  59
  60       case tfun:
  61         hsperror ("type2context: arrow (->) constructor found in a context");
  62
  63       case context:
  64         hsperror ("type2context: unexpected context-thing found in a context");
  65
  66       default:
  67         hsperror ("type2context: totally unexpected input");
  68     }
  69     abort(); /* should never get here! */
  70 }
  71
  72
  73 /* is_context_format is the same as "type2context" except that it just performs checking */
  74 /* ttype is either "tycon" [class] or "tycon (named)tvar" [class var] */
  75
  76 void
  77 is_context_format(t, tyvars)
  78   ttype t;
  79   int tyvars;
  80 {
  81     list  rest_args;
  82     ttype first_arg;
  83
  84     switch (tttype(t))
  85       {
  86         case tname :
  87           /* should be just: ":: C a =>" */
  88
  89           if (tyvars == 0)
  90             hsperror("is_context_format: type missing after class name");
  91
  92           /* tyvars > 0; everything is cool */
  93           break;
  94
  95         case tapp:
  96           is_context_format(gtapp(t), tyvars+1);
  97           break;
  98
  99         case ttuple:
 100           hsperror ("is_context_format: tuple found in a context");
 101
 102         case namedtvar:
 103           hsperror ("is_context_format: unexpected namedtvar found in a context");
 104
 105         case tllist:
 106           hsperror ("is_context_format: list constructor found in a context");
 107
 108         case tfun:
 109           hsperror ("is_context_format: arrow (->) constructor found in a context");
 110
 111         case context:
 112           hsperror ("is_context_format: unexpected context-thing found in a context");
 113
 114         default:
 115             hsperror ("is_context_format: totally unexpected input");
 116       }
 117 }
 118
 119