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       default:
  64         hsperror ("type2context: totally unexpected input");
  65     }
  66     abort(); /* should never get here! */
  67 }
  68
  69
  70 /* is_context_format is the same as "type2context" except that it just performs checking */
  71 /* ttype is either "tycon" [class] or "tycon (named)tvar" [class var] */
  72
  73 void
  74 is_context_format(t, tyvars)
  75   ttype t;
  76   int tyvars;
  77 {
  78     list  rest_args;
  79     ttype first_arg;
  80
  81     switch (tttype(t))
  82       {
  83         case tname :
  84           /* should be just: ":: C a =>" */
  85
  86           if (tyvars == 0)
  87             hsperror("is_context_format: type missing after class name");
  88
  89           /* tyvars > 0; everything is cool */
  90           break;
  91
  92         case tapp:
  93           is_context_format(gtapp(t), tyvars+1);
  94           break;
  95
  96         case ttuple:
  97           hsperror ("is_context_format: tuple found in a context");
  98
  99         case namedtvar:
 100           hsperror ("is_context_format: unexpected namedtvar found in a context");
 101
 102         case tllist:
 103           hsperror ("is_context_format: list constructor found in a context");
 104
 105         case tfun:
 106           hsperror ("is_context_format: arrow (->) constructor found in a context");
 107         default:
 108             hsperror ("is_context_format: totally unexpected input");
 109       }
 110 }
 111
 112