Tweak alternative layout rule

[ghc-hetmet.git] / compiler / parser / ParserCore.y

diff --git a/compiler/parser/ParserCore.y b/compiler/parser/ParserCore.y
index 6d302fb..6839fa2 100644 (file)
--- a/compiler/parser/ParserCore.y
+++ b/compiler/parser/ParserCore.y
@@ -1,5 +1,5 @@
 {
-{-# OPTIONS -w #-}
+{-# OPTIONS -Wwarn -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
@@ -29,7 +29,7 @@ import TysPrim( wordPrimTyCon, intPrimTyCon, charPrimTyCon,
 import TyCon ( TyCon, tyConName )
 import FastString
 import Outputable
-import Char
+import Data.Char
 import Unique
 
 #include "../HsVersions.h"
@@ -37,6 +37,7 @@ import Unique
 }
 
 %name parseCore
+%expect 0
 %tokentype { Token }
 
 %token
@@ -123,18 +124,18 @@ tdefs     :: { [TyClDecl RdrName] }
 
 tdef   :: { TyClDecl RdrName }
        : '%data' q_tc_name tv_bndrs '=' '{' cons '}' ';'
-                { mkTyData DataType ( noLoc []
-                                   , noLoc (ifaceExtRdrName $2)
-                                   , map toHsTvBndr $3
-                                   , Nothing
-                                   ) Nothing $6 Nothing }
+       { TyData { tcdND = DataType, tcdCtxt = noLoc [] 
+                , tcdLName = noLoc (ifaceExtRdrName $2)
+                , tcdTyVars = map toHsTvBndr $3
+                , tcdTyPats = Nothing, tcdKindSig = Nothing
+                , tcdCons = $6, tcdDerivs = Nothing } }
        | '%newtype' q_tc_name tv_bndrs trep ';'
                { let tc_rdr = ifaceExtRdrName $2 in
-                  mkTyData NewType ( noLoc []
-                                  , noLoc tc_rdr
-                                  , map toHsTvBndr $3
-                                  , Nothing
-                                  ) Nothing ($4 (rdrNameOcc tc_rdr)) Nothing }
+                   TyData { tcdND = NewType, tcdCtxt = noLoc []
+                            , tcdLName = noLoc tc_rdr
+                            , tcdTyVars = map toHsTvBndr $3
+                            , tcdTyPats = Nothing, tcdKindSig = Nothing
+                            , tcdCons = $4 (rdrNameOcc tc_rdr), tcdDerivs = Nothing } }
 
 -- For a newtype we have to invent a fake data constructor name
 -- It doesn't matter what it is, because it won't be used
@@ -142,8 +143,8 @@ trep    :: { OccName -> [LConDecl RdrName] }
         : {- empty -}   { (\ tc_occ -> []) }
         | '=' ty        { (\ tc_occ -> let { dc_name  = mkRdrUnqual (setOccNameSpace dataName tc_occ) ;
                                             con_info = PrefixCon [toHsType $2] }
-                                       in [noLoc $ ConDecl (noLoc dc_name) Explicit []
-                                          (noLoc []) con_info ResTyH98 Nothing]) }
+                                       in [noLoc $ mkSimpleConDecl (noLoc dc_name) []
+                                                      (noLoc []) con_info]) }
 
 cons   :: { [LConDecl RdrName] }
        : {- empty -}   { [] } -- 20060420 Empty data types allowed. jds
@@ -152,15 +153,8 @@ cons       :: { [LConDecl RdrName] }
 
 con    :: { LConDecl RdrName }
        : d_pat_occ attv_bndrs hs_atys 
-               { noLoc $ ConDecl (noLoc (mkRdrUnqual $1)) Explicit $2 (noLoc []) (PrefixCon $3) ResTyH98 Nothing }
-        | d_pat_occ '::' ty
-                -- XXX - audreyt - $3 needs to be split into argument and return types!
-                -- also not sure whether the [] below (quantified vars) appears.
-                -- also the "PrefixCon []" is wrong.
-                -- also we want to munge $3 somehow.
-                -- extractWhatEver to unpack ty into the parts to ConDecl
-                -- XXX - define it somewhere in RdrHsSyn
-               { noLoc $ ConDecl (noLoc (mkRdrUnqual $1)) Explicit [] (noLoc []) (PrefixCon []) (undefined $3) Nothing }
+               { noLoc $ mkSimpleConDecl (noLoc (mkRdrUnqual $1)) $2 (noLoc []) (PrefixCon $3) }
+-- ToDo: parse record-style declarations
 
 attv_bndrs :: { [LHsTyVarBndr RdrName] }
        : {- empty -}            { [] }
@@ -275,11 +269,12 @@ exp       :: { IfaceExpr }
        | '%case' '(' ty ')' aexp '%of' id_bndr
          '{' alts1 '}'               { IfaceCase $5 (fst $7) $3 $9 }
         | '%cast' aexp aty { IfaceCast $2 $3 }
-       | '%note' STRING exp       
-           { case $2 of
-              --"SCC"      -> IfaceNote (IfaceSCC "scc") $3
-              "InlineMe"   -> IfaceNote IfaceInlineMe $3
-            }
+-- No InlineMe any more
+--     | '%note' STRING exp       
+--         { case $2 of
+--            --"SCC"      -> IfaceNote (IfaceSCC "scc") $3
+--            "InlineMe"   -> IfaceNote IfaceInlineMe $3
+--            }
         | '%external' STRING aty   { IfaceFCall (ForeignCall.CCall 
                                                     (CCallSpec (StaticTarget (mkFastString $2)) 
                                                                CCallConv (PlaySafe False)))