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