[project @ 1999-01-14 17:58:41 by sof]

[ghc-hetmet.git] / ghc / compiler / parser / type2context.c

diff --git a/ghc/compiler/parser/type2context.c b/ghc/compiler/parser/type2context.c
index 029da1a..fd142cd 100644 (file)
--- a/ghc/compiler/parser/type2context.c
+++ b/ghc/compiler/parser/type2context.c
@@ -12,8 +12,6 @@
 #include "constants.h"
 #include "utils.h"
 
-static void is_context_format PROTO((ttype, int)); /* forward */
-
 /* 
     partain: see also the comment by "decl" in hsparser.y.
 
@@ -46,14 +44,22 @@ type2context(t)
 
        return(gttuple(t)); /* args */
        
-
-      case tapp:
       case tname:
+       switch(tqid(gtypeid(t))) {
+         case gid:
+            if (strcmp("()",gidname(gtypeid(t))) == 0)
+              return (Lnil);
+          default: ;
+        }
+      case tapp:
        /* a single item, ensure correct format */
        is_context_format(t, 0);
        return(lsing(t));
 
       case namedtvar:
+       fprintf(stderr, "namedtvar: %d %s\n", hashIds, gnamedtvar(t));
+        if (strcmp("()", gnamedtvar(t)) == 0)
+              return (Lnil);
        hsperror ("type2context: unexpected namedtvar found in a context");
 
       case tllist:
@@ -62,9 +68,6 @@ type2context(t)
       case tfun:
        hsperror ("type2context: arrow (->) constructor found in a context");
 
-      case context:
-       hsperror ("type2context: unexpected context-thing found in a context");
-
       default:
        hsperror ("type2context: totally unexpected input");
     }
@@ -75,7 +78,7 @@ type2context(t)
 /* is_context_format is the same as "type2context" except that it just performs checking */
 /* ttype is either "tycon" [class] or "tycon (named)tvar" [class var] */
 
-static void
+void
 is_context_format(t, tyvars)
   ttype t;
   int tyvars;
@@ -89,18 +92,12 @@ is_context_format(t, tyvars)
          /* should be just: ":: C a =>" */
 
          if (tyvars == 0)
-           hsperror("is_context_format: variable missing after class name");
+           hsperror("is_context_format: type missing after class name");
 
-         else if (tyvars > 1)
-           hsperror ("is_context_format: too many variables after class name");
-
-         /* tyvars == 1; everything is cool */
+         /* tyvars > 0; everything is cool */
          break;
 
        case tapp:
-         if (tttype(gtarg(t)) != namedtvar)
-             hsperror ("is_context_format: something wrong with variable after class name");
-
          is_context_format(gtapp(t), tyvars+1);
          break;
 
@@ -115,12 +112,9 @@ is_context_format(t, tyvars)
 
        case tfun:
          hsperror ("is_context_format: arrow (->) constructor found in a context");
-
-       case context:
-         hsperror ("is_context_format: unexpected context-thing found in a context");
-
        default:
            hsperror ("is_context_format: totally unexpected input");
       }
 }
 
+