[project @ 2000-03-22 12:01:57 by rrt]

[ghc-hetmet.git] / ghc / interpreter / parser.y

diff --git a/ghc/interpreter/parser.y b/ghc/interpreter/parser.y
index 9258670..f44848d 100644 (file)
--- a/ghc/interpreter/parser.y
+++ b/ghc/interpreter/parser.y
@@ -12,8 +12,8 @@
  * included in the distribution.
  *
  * $RCSfile: parser.y,v $
- * $Revision: 1.20 $
- * $Date: 2000/01/05 13:53:36 $
+ * $Revision: 1.25 $
+ * $Date: 2000/03/13 11:37:16 $
  * ------------------------------------------------------------------------*/
 
 %{
@@ -33,21 +33,21 @@
 #define yyerror(s)               /* errors handled elsewhere */
 #define YYSTYPE                  Cell
 
-static Cell   local gcShadow     Args((Int,Cell));
-static Void   local syntaxError  Args((String));
-static String local unexpected   Args((Void));
-static Cell   local checkPrec    Args((Cell));
-static Void   local fixDefn      Args((Syntax,Cell,Cell,List));
-static Cell   local buildTuple   Args((List));
-static List   local checkCtxt    Args((List));
-static Cell   local checkPred    Args((Cell));
-static Pair   local checkDo      Args((List));
-static Cell   local checkTyLhs   Args((Cell));
+static Cell   local gcShadow     ( Int,Cell );
+static Void   local syntaxError  ( String );
+static String local unexpected   ( Void );
+static Cell   local checkPrec    ( Cell );
+static Void   local fixDefn      ( Syntax,Cell,Cell,List );
+static Cell   local buildTuple   ( List );
+static List   local checkCtxt    ( List );
+static Cell   local checkPred    ( Cell );
+static Pair   local checkDo      ( List );
+static Cell   local checkTyLhs   ( Cell );
 #if !TREX
-static Void   local noTREX       Args((String));
+static Void   local noTREX       ( String );
 #endif
 #if !IPARAM
-static Void   local noIP        Args((String));
+static Void   local noIP        ( String );
 #endif
 
 /* For the purposes of reasonably portable garbage collection, it is
@@ -98,6 +98,7 @@ static Void   local noIP       Args((String));
 %token EXPORT     UUEXPORT   INTERFACE  REQUIRES   UNSAFE     
 %token INSTIMPORT DYNAMIC    CCALL      STDKALL
 %token UTL        UTR        UUUSAGE
+%token PRIVILEGED
 
 %%
 /*- Top level script/module structure -------------------------------------*/
@@ -227,9 +228,9 @@ ifCtxInst /* __forall [a b] =>     :: [((VarId,Kind))] */
           : ALL ifForall IMPLIES        {$$=gc3($2);}
           |                             {$$=gc0(NIL);}
           ;
-ifInstHd /* { Class aType }    :: (ConId, Type) */
+ifInstHd /* { Class aType }    :: ((ConId, Type)) */
           : '{' ifQCon ifAType '}'      {$$=gc4(ap(DICTAP,
-                                                zpair($2,singleton($3))));}
+                                                zpair($2,$3)));}
           ;
 
 ifInstHdL /* { C a1 } -> { C2 a2 } -> ... -> { Cn an } :: Type */
@@ -356,14 +357,11 @@ ifAType   : ifQTCName                   { $$ = gc1($1); }
           | '(' ifTypeL2 ')'            { $$ = gc3(buildTuple(reverse($2))); }
           | '[' ifType ']'              { $$ = gc3(ap(mkCon(tycon(typeList).text),
                                                       $2));}
-          | '{' ifQTCName ifATypes '}'  { $$ = gc4(ap(DICTAP,
+          | '{' ifQTCName ifAType '}'   { $$ = gc4(ap(DICTAP,
                                                       pair($2,$3))); }
           | '(' ifType ')'              { $$ = gc3($2); }
           | UTL ifTypeL UTR             { $$ = gc3(ap(UNBOXEDTUP,$2)); }
           ;
-ifATypes  :                             { $$ = gc0(NIL);         }
-          | ifAType ifATypes            { $$ = gc2(cons($1,$2)); }
-          ;
 
 
 /*- KW's usage stuff --------------------------------------*/
@@ -383,7 +381,7 @@ ifKindedTyvar /* ((VarId,Kind)) */
           | ifTyvar COCO ifAKind        { $$ = gc3(zpair($1,$3));   }
           ; 
 ifKind    : ifAKind                     { $$ = gc1($1);        }
-          | ifAKind ARROW ifKind        { $$ = gc3(fn($1,$3)); }
+          | ifAKind ARROW ifKind        { $$ = gc3(ap($1,$3)); }
           ;
 ifAKind   : VAROP                       { $$ = gc1(STAR); } 
                                             /* should be '*' */
@@ -531,6 +529,9 @@ impDecl   : IMPORT modid impspec        {addQualImport($2,$2);
           | IMPORT QUALIFIED modid impspec
                                         {addQualImport($3,$3);
                                          $$ = gc4($3);}
+          | IMPORT PRIVILEGED modid '(' imports ')'
+                                       {addUnqualImport($3,ap(STAR,$5));
+                                        $$ = gc6($3);}
           | IMPORT error                {syntaxError("import declaration");}
           ;
 impspec   : /* empty */                 {$$ = gc0(DOTDOT);}
@@ -1204,6 +1205,7 @@ varid     : VARID                       {$$ = $1;}
           | HIDING                      {$$ = gc1(varHiding);}
           | QUALIFIED                   {$$ = gc1(varQualified);}
           | ASMOD                       {$$ = gc1(varAsMod);}
+          | PRIVILEGED                  {$$ = gc1(varPrivileged);}
           ;
 qconid    : QCONID                      {$$ = $1;}
           | CONID                       {$$ = $1;}
@@ -1272,6 +1274,7 @@ varid1    : VARID                       {$$ = gc1($1);}
           | HIDING                      {$$ = gc1(varHiding);}
           | QUALIFIED                   {$$ = gc1(varQualified);}
           | ASMOD                       {$$ = gc1(varAsMod);}
+          | PRIVILEGED                  {$$ = gc1(varPrivileged);}
           ;
 
 /*- Tricks to force insertion of leading and closing braces ---------------*/
@@ -1416,6 +1419,7 @@ static String local unexpected() {     /* find name for unexpected token   */
                          return buffer;
         case HIDING    : return "symbol \"hiding\"";
         case QUALIFIED : return "symbol \"qualified\"";
+       case PRIVILEGED : return "symbol \"privileged\"";
         case ASMOD     : return "symbol \"as\"";
         case NUMLIT    : return "numeric literal";
         case CHARLIT   : return "character literal";