The Backpack patch.
[ghc.git] / utils / genprimopcode / Parser.y
index 07f1a84..51ca9ad 100644 (file)
@@ -1,12 +1,4 @@
-
 {
-{-# OPTIONS_GHC -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
--- for details
-
 module Parser (parse) where
 
 import Lexer (lex_tok)
@@ -16,12 +8,14 @@ import Syntax
 }
 
 %name      parsex
+%expect    0
 %tokentype { Token }
 %monad     { ParserM }
 %lexer     { lex_tok } { TEOF }
 
 %token
     '->'            { TArrow }
+    '=>'            { TDArrow }
     '='             { TEquals }
     ','             { TComma }
     '('             { TOpenParen }
@@ -30,6 +24,10 @@ import Syntax
     '#)'            { THashCloseParen }
     '{'             { TOpenBrace }
     '}'             { TCloseBrace }
+    '['             { TOpenBracket }
+    ']'             { TCloseBracket }
+    '<'             { TOpenAngle }
+    '>'             { TCloseAngle }
     section         { TSection }
     primop          { TPrimop }
     pseudoop        { TPseudoop }
@@ -42,10 +40,20 @@ import Syntax
     monadic         { TMonadic }
     compare         { TCompare }
     genprimop       { TGenPrimOp }
+    fixity          { TFixity }
+    infix           { TInfixN }
+    infixl          { TInfixL }
+    infixr          { TInfixR }
+    nothing         { TNothing }
+    vector          { TVector }
+    SCALAR          { TSCALAR }
+    VECTOR          { TVECTOR }
+    VECTUPLE        { TVECTUPLE }
     thats_all_folks { TThatsAllFolks }
     lowerName       { TLowerName $$ }
     upperName       { TUpperName $$ }
     string          { TString $$ }
+    integer         { TInteger $$ }
     noBraces        { TNoBraces $$ }
 
 %%
@@ -64,6 +72,16 @@ pOption :: { Option }
 pOption : lowerName '=' false               { OptionFalse  $1 }
         | lowerName '=' true                { OptionTrue   $1 }
         | lowerName '=' pStuffBetweenBraces { OptionString $1 $3 }
+        | lowerName '=' integer             { OptionInteger $1 $3 }
+        | vector    '=' pVectorTemplate     { OptionVector $3 }
+        | fixity    '=' pInfix              { OptionFixity $3 }
+
+pInfix :: { Maybe Fixity }
+pInfix : infix  integer { Just $ Fixity (show $2) $2 InfixN }
+       | infixl integer { Just $ Fixity (show $2) $2 InfixL }
+       | infixr integer { Just $ Fixity (show $2) $2 InfixR }
+       | nothing        { Nothing }
+
 
 pEntries :: { [Entry] }
 pEntries : pEntry pEntries { $1 : $2 }
@@ -124,8 +142,20 @@ pInside :: { String }
 pInside : '{' pInsides '}' { "{" ++ $2 ++ "}" }
         | noBraces         { $1 }
 
+pVectorTemplate :: { [(String, String, Int)] }
+pVectorTemplate : '[' pVectors ']' { $2 }
+
+pVectors :: { [(String, String, Int)] }
+pVectors : pVector ',' pVectors { [$1] ++ $3 }
+         | pVector              { [$1] }
+         | {- empty -}          { [] }
+
+pVector :: { (String, String, Int) }
+pVector : '<' upperName ',' upperName ',' integer '>' { ($2, $4, $6) }
 pType :: { Ty }
 pType : paT '->' pType { TyF $1 $3 }
+      | paT '=>' pType { TyC $1 $3 }
       | paT            { $1 }
 
 -- Atomic types
@@ -151,9 +181,12 @@ ppT :: { Ty }
 ppT : lowerName { TyVar $1 }
     | pTycon    { TyApp $1 [] }
 
-pTycon :: { String }
-pTycon : upperName { $1 }
-       | '(' ')'   { "()" }
+pTycon :: { TyCon }
+pTycon : upperName { TyCon $1 }
+       | '(' ')'   { TyCon "()" }
+       | SCALAR    { SCALAR }
+       | VECTOR    { VECTOR }
+       | VECTUPLE  { VECTUPLE }
 
 {
 parse :: String -> Either String Info