projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2000-10-24 08:40:09 by simonpj]
[ghc-hetmet.git] / ghc / compiler / parser / Parser.y
diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 9f7ef43..d82fe3f 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.37 2000/10/03 08:43:02 simonpj Exp $
+$Id: Parser.y,v 1.43 2000/10/24 08:40:10 simonpj Exp $
 
 Haskell grammar.
 
@@ -332,14 +332,12 @@ topdecl :: { RdrBinding }
        | srcloc 'data' ctype '=' constrs deriving
                {% checkDataHeader $3 `thenP` \(cs,c,ts) ->
                   returnP (RdrHsDecl (TyClD
-                     (mkTyData DataType cs c ts (reverse $5) (length $5) $6
-                       NoDataPragmas $1))) }
+                     (mkTyData DataType cs c ts (reverse $5) (length $5) $6 $1))) }
 
        | srcloc 'newtype' ctype '=' newconstr deriving
                {% checkDataHeader $3 `thenP` \(cs,c,ts) ->
                   returnP (RdrHsDecl (TyClD
-                     (mkTyData NewType cs c ts [$5] 1 $6
-                       NoDataPragmas $1))) }
+                     (mkTyData NewType cs c ts [$5] 1 $6 $1))) }
 
        | srcloc 'class' ctype fds where
                {% checkDataHeader $3 `thenP` \(cs,c,ts) ->
@@ -347,8 +345,7 @@ topdecl :: { RdrBinding }
                        (binds,sigs) = cvMonoBindsAndSigs cvClassOpSig (groupBindings $5) 
                   in
                   returnP (RdrHsDecl (TyClD
-                     (mkClassDecl cs c ts $4 sigs binds 
-                       NoClassPragmas $1))) }
+                     (mkClassDecl cs c ts $4 sigs binds $1))) }
 
        | srcloc 'instance' inst_type where
                { let (binds,sigs) 
@@ -451,7 +448,7 @@ deprecations :: { RdrBinding }
 
 -- SUP: TEMPORARY HACK, not checking for `module Foo'
 deprecation :: { RdrBinding }
-       : srcloc exportlist STRING
+       : srcloc depreclist STRING
                { foldr RdrAndBindings RdrNullBind 
                        [ RdrHsDecl (DeprecD (Deprecation n $3 $1)) | n <- $2 ] }
 
@@ -570,6 +567,11 @@ varids0    :: { [RdrName] }
 -----------------------------------------------------------------------------
 -- Datatype declarations
 
+newconstr :: { RdrNameConDecl }
+       : srcloc conid atype    { mkConDecl $2 [] [] (VanillaCon [Unbanged $3]) $1 }
+       | srcloc conid '{' var '::' type '}'
+                               { mkConDecl $2 [] [] (RecCon [([$4], Unbanged $6)]) $1 }
+
 constrs :: { [RdrNameConDecl] }
        : constrs '|' constr            { $3 : $1 }
        | constr                        { [$1] }
@@ -588,34 +590,22 @@ context :: { RdrNameContext }
        : btype '=>'                    {% checkContext $1 }
 
 constr_stuff :: { (RdrName, RdrNameConDetails) }
-       : scontype                      { (fst $1, VanillaCon (snd $1)) }
+       : btype                         {% mkVanillaCon $1 []               }
+       | btype '!' atype satypes       {% mkVanillaCon $1 (Banged $3 : $4) }
+       | gtycon '{' fielddecls '}'     {% mkRecCon $1 $3 }
        | sbtype conop sbtype           { ($2, InfixCon $1 $3) }
-       | con '{' fielddecls '}'        { ($1, RecCon (reverse $3)) }
-
-newconstr :: { RdrNameConDecl }
-       : srcloc conid atype    { mkConDecl $2 [] [] (VanillaCon [Unbanged $3]) $1 }
-       | srcloc conid '{' var '::' type '}'
-                               { mkConDecl $2 [] [] (RecCon [([$4], Unbanged $6)]) $1 }
 
-scontype :: { (RdrName, [RdrNameBangType]) }
-       : btype                         {% splitForConApp $1 [] }
-       | scontype1                     { $1 }
-
-scontype1 :: { (RdrName, [RdrNameBangType]) }
-       : btype '!' atype               {% splitForConApp $1 [Banged $3] }
-       | scontype1 satype              { (fst $1, snd $1 ++ [$2] ) }
-        | '(' consym ')'               { ($2,[]) }
-
-satype :: { RdrNameBangType }
-       : atype                         { Unbanged $1 }
-       | '!' atype                     { Banged   $2 }
+satypes        :: { [RdrNameBangType] }
+       : atype satypes                 { Unbanged $1 : $2 }
+       | '!' atype satypes             { Banged   $2 : $3 }
+       | {- empty -}                   { [] }
 
 sbtype :: { RdrNameBangType }
        : btype                         { Unbanged $1 }
        | '!' atype                     { Banged   $2 }
 
 fielddecls :: { [([RdrName],RdrNameBangType)] }
-       : fielddecls ',' fielddecl      { $3 : $1 }
+       : fielddecl ',' fielddecls      { $1 : $3 }
        | fielddecl                     { [$1] }
 
 fielddecl :: { ([RdrName],RdrNameBangType) }
@@ -883,8 +873,17 @@ dbind      : ipvar '=' exp                 { ($1, $3) }
 -----------------------------------------------------------------------------
 -- Variables, Constructors and Operators.
 
+depreclist :: { [RdrName] }
+depreclist : deprec_var                        { [$1] }
+          | deprec_var ',' depreclist  { $1 : $2 }
+
+deprec_var :: { RdrName }
+deprec_var : var                       { $1 }
+          | tycon                      { $1 }
+
 gtycon         :: { RdrName }
        : qtycon                        { $1 }
+       | '(' qtyconop ')'              { $2 }
        | '(' ')'                       { unitTyCon_RDR }
        | '(' '->' ')'                  { funTyCon_RDR }
        | '[' ']'                       { listTyCon_RDR }
@@ -909,11 +908,7 @@ qvar       :: { RdrName }
 -- *after* we see the close paren.
 
 ipvar  :: { RdrName }
-       : IPVARID               { (mkSrcUnqual ipName (tailFS $1)) }
-
-con    :: { RdrName }
-       : conid                 { $1 }
-       | '(' consym ')'        { $2 }
+       : IPVARID               { (mkUnqual ipName (tailFS $1)) }
 
 qcon   :: { RdrName }
        : qconid                { $1 }
@@ -959,21 +954,21 @@ qopm      :: { RdrNameHsExpr }   -- used in sections
 
 qvarid :: { RdrName }
        : varid                 { $1 }
-       | QVARID                { mkSrcQual varName $1 }
+       | QVARID                { mkQual varName $1 }
 
 varid :: { RdrName }
        : varid_no_unsafe       { $1 }
-       | 'unsafe'              { mkSrcUnqual varName SLIT("unsafe") }
+       | 'unsafe'              { mkUnqual varName SLIT("unsafe") }
 
 varid_no_unsafe :: { RdrName }
-       : VARID                 { mkSrcUnqual varName $1 }
-       | special_id            { mkSrcUnqual varName $1 }
-       | 'forall'              { mkSrcUnqual varName SLIT("forall") }
+       : VARID                 { mkUnqual varName $1 }
+       | special_id            { mkUnqual varName $1 }
+       | 'forall'              { mkUnqual varName SLIT("forall") }
 
 tyvar  :: { RdrName }
-       : VARID                 { mkSrcUnqual tvName $1 }
-       | special_id            { mkSrcUnqual tvName $1 }
-       | 'unsafe'              { mkSrcUnqual tvName SLIT("unsafe") }
+       : VARID                 { mkUnqual tvName $1 }
+       | special_id            { mkUnqual tvName $1 }
+       | 'unsafe'              { mkUnqual tvName SLIT("unsafe") }
 
 -- These special_ids are treated as keywords in various places, 
 -- but as ordinary ids elsewhere.   A special_id collects all thsee
@@ -994,20 +989,20 @@ special_id
 
 qconid :: { RdrName }
        : conid                 { $1 }
-       | QCONID                { mkSrcQual dataName $1 }
+       | QCONID                { mkQual dataName $1 }
 
 conid  :: { RdrName }
-       : CONID                 { mkSrcUnqual dataName $1 }
+       : CONID                 { mkUnqual dataName $1 }
 
 -----------------------------------------------------------------------------
 -- ConSyms
 
 qconsym :: { RdrName }
        : consym                { $1 }
-       | QCONSYM               { mkSrcQual dataName $1 }
+       | QCONSYM               { mkQual dataName $1 }
 
 consym :: { RdrName }
-       : CONSYM                { mkSrcUnqual dataName $1 }
+       : CONSYM                { mkUnqual dataName $1 }
 
 -----------------------------------------------------------------------------
 -- VarSyms
@@ -1021,15 +1016,15 @@ qvarsym_no_minus :: { RdrName }
        | qvarsym1              { $1 }
 
 qvarsym1 :: { RdrName }
-qvarsym1 : QVARSYM             { mkSrcQual varName $1 }
+qvarsym1 : QVARSYM             { mkQual varName $1 }
 
 varsym :: { RdrName }
        : varsym_no_minus       { $1 }
-       | '-'                   { mkSrcUnqual varName SLIT("-") }
+       | '-'                   { mkUnqual varName SLIT("-") }
 
 varsym_no_minus :: { RdrName } -- varsym not including '-'
-       : VARSYM                { mkSrcUnqual varName $1 }
-       | special_sym           { mkSrcUnqual varName $1 }
+       : VARSYM                { mkUnqual varName $1 }
+       | special_sym           { mkUnqual varName $1 }
 
 
 -- See comments with special_id
@@ -1069,14 +1064,18 @@ modid   :: { ModuleName }
        : CONID                 { mkSrcModuleFS $1 }
 
 tycon  :: { RdrName }
-       : CONID                 { mkSrcUnqual tcClsName $1 }
+       : CONID                 { mkUnqual tcClsName $1 }
 
 tyconop        :: { RdrName }
-       : CONSYM                { mkSrcUnqual tcClsName $1 }
+       : CONSYM                { mkUnqual tcClsName $1 }
 
 qtycon :: { RdrName }
        : tycon                 { $1 }
-       | QCONID                { mkSrcQual tcClsName $1 }
+       | QCONID                { mkQual tcClsName $1 }
+
+qtyconop :: { RdrName }
+         : tyconop             { $1 }
+         | QCONSYM             { mkQual tcClsName $1 }
 
 qtycls         :: { RdrName }
        : qtycon                { $1 }
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)