X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FParserCore.y;h=1cd7d6a6bf66f627d4558ff094cd3a3a37d548d9;hb=d28ba8c800901bea01f70c4719278c2a364cf9fc;hp=9318892847a5f955fa7bc87bb16a30e83eba5140;hpb=42b63073fb5e71fcd539ab80289cf6cf2a5b9641;p=ghc-hetmet.git diff --git a/ghc/compiler/parser/ParserCore.y b/ghc/compiler/parser/ParserCore.y index 9318892..1cd7d6a 100644 --- a/ghc/compiler/parser/ParserCore.y +++ b/ghc/compiler/parser/ParserCore.y @@ -68,7 +68,7 @@ import Outputable module :: { RdrNameHsModule } : '%module' modid tdefs vdefgs - { HsModule (mkHomeModule $2) Nothing Nothing + { HsModule (Just (mkHomeModule $2)) Nothing [] ($3 ++ concat $4) Nothing noSrcLoc} tdefs :: { [RdrNameHsDecl] } @@ -79,11 +79,15 @@ tdef :: { RdrNameHsDecl } : '%data' q_tc_name tbinds '=' '{' cons1 '}' { TyClD (mkTyData DataType ([], $2, $3) (DataCons $6) Nothing noSrcLoc) } | '%newtype' q_tc_name tbinds trep - { TyClD (mkTyData NewType ([], $2, $3) ($4 $2 $3) Nothing noSrcLoc) } - -trep :: { (RdrName -> [HsTyVarBndr RdrName] -> DataConDetails (ConDecl RdrName)) } - : {- empty -} { (\ x ts -> Unknown) } - | '=' ty { (\ x ts -> DataCons [ConDecl x ts [] (PrefixCon [unbangedType $2]) noSrcLoc]) } + { TyClD (mkTyData NewType ([], $2, $3) ($4 $2) Nothing noSrcLoc) } + +-- 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 +trep :: { (RdrName -> DataConDetails (ConDecl RdrName)) } + : {- empty -} { (\ tc_name -> Unknown) } + | '=' ty { (\ tc_name -> let { dc_name = setRdrNameSpace tc_name dataName ; + con_info = PrefixCon [unbangedType $2] } + in DataCons [ConDecl dc_name [] [] con_info noSrcLoc]) } tbind :: { HsTyVarBndr RdrName } : name { IfaceTyVar $1 liftedTypeKind }