X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FParser.y;h=481500f53dd862ca1bc68f8f8a5cd35c1c7d8636;hb=bf4363c03d80ae9aa376bfceb88c6137031c1236;hp=746987f8ab59aa44f94d0fac9f1441d2dab441bb;hpb=91c750cbd18e3d610b0db498ded38d5b3c5adfac;p=ghc-hetmet.git diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y index 746987f..481500f 100644 --- a/ghc/compiler/parser/Parser.y +++ b/ghc/compiler/parser/Parser.y @@ -1,6 +1,6 @@ -{- +{- -*-haskell-*- ----------------------------------------------------------------------------- -$Id: Parser.y,v 1.80 2001/12/20 11:19:08 simonpj Exp $ +$Id: Parser.y,v 1.91 2002/03/03 03:59:03 sof Exp $ Haskell grammar. @@ -18,16 +18,18 @@ import RdrHsSyn import Lex import ParseUtil import RdrName -import PrelNames ( mAIN_Name, unitTyCon_RDR, funTyCon_RDR, listTyCon_RDR, - tupleTyCon_RDR, unitCon_RDR, nilCon_RDR, tupleCon_RDR - ) -import ForeignCall ( Safety(..), CExportSpec(..), CCallSpec(..), +import PrelNames ( mAIN_Name, unitTyCon_RDR, funTyCon_RDR, + listTyCon_RDR, parrTyCon_RDR, tupleTyCon_RDR, + unitCon_RDR, nilCon_RDR, tupleCon_RDR ) +import ForeignCall ( Safety(..), CExportSpec(..), CCallConv(..), CCallTarget(..), defaultCCallConv, - DNCallSpec(..) ) + ) import OccName ( UserFS, varName, tcName, dataName, tcClsName, tvName ) +import TyCon ( DataConDetails(..) ) import SrcLoc ( SrcLoc ) import Module import CmdLineOpts ( opt_SccProfilingOn ) +import Type ( Kind, mkArrowKind, liftedTypeKind ) import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..), NewOrData(..), StrictnessMark(..), Activation(..) ) import Panic @@ -43,13 +45,16 @@ import Outputable {- ----------------------------------------------------------------------------- -Conflicts: 14 shift/reduce - (note: it's currently 21 -- JRL, 31/1/2000) +Conflicts: 21 shift/reduce, -=chak[4Feb2] -8 for abiguity in 'if x then y else z + 1' +9 for abiguity in 'if x then y else z + 1' (shift parses as 'if x then y else (z + 1)', as per longest-parse rule) + 8 because op might be: - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM 1 for ambiguity in 'if x then y else z :: T' (shift parses as 'if x then y else (z :: T)', as per longest-parse rule) +1 for ambiguity in 'if x then y else z with ?x=3' + (shift parses as 'if x then y else (z with ?x=3)' + 3 for ambiguity in 'case x of y :: a -> b' (don't know whether to reduce 'a' as a btype or shift the '->'. conclusion: bogus expression anyway, doesn't matter) @@ -66,6 +71,9 @@ Conflicts: 14 shift/reduce Only sensible parse is 'x @ (Rec{..})', which is what resolving to shift gives us. +6 for conflicts between `fdecl' and `fdeclDEPRECATED', which are resolved + correctly, and moreover, should go away when `fdeclDEPRECATED' is removed. + ----------------------------------------------------------------------------- -} @@ -102,15 +110,17 @@ Conflicts: 14 shift/reduce 'export' { ITexport } 'label' { ITlabel } 'dynamic' { ITdynamic } + 'safe' { ITsafe } + 'threadsafe' { ITthreadsafe } 'unsafe' { ITunsafe } 'with' { ITwith } 'stdcall' { ITstdcallconv } 'ccall' { ITccallconv } 'dotnet' { ITdotnet } '_ccall_' { ITccall (False, False, PlayRisky) } - '_ccall_GC_' { ITccall (False, False, PlaySafe) } + '_ccall_GC_' { ITccall (False, False, PlaySafe False) } '_casm_' { ITccall (False, True, PlayRisky) } - '_casm_GC_' { ITccall (False, True, PlaySafe) } + '_casm_GC_' { ITccall (False, True, PlaySafe False) } '{-# SPECIALISE' { ITspecialise_prag } '{-# SOURCE' { ITsource_prag } @@ -163,6 +173,7 @@ Conflicts: 14 shift/reduce '=>' { ITdarrow } '-' { ITminus } '!' { ITbang } + '*' { ITstar } '.' { ITdot } '{' { ITocurly } -- special symbols @@ -172,6 +183,8 @@ Conflicts: 14 shift/reduce vccurly { ITvccurly } -- virtual close curly (from layout) '[' { ITobrack } ']' { ITcbrack } + '[:' { ITopabrack } + ':]' { ITcpabrack } '(' { IToparen } ')' { ITcparen } '(#' { IToubxparen } @@ -336,30 +349,28 @@ topdecls :: { [RdrBinding] } | topdecl { [$1] } topdecl :: { RdrBinding } - : srcloc 'type' simpletype '=' ctype + : srcloc 'type' tycon tv_bndrs '=' ctype -- Note ctype, not sigtype. -- We allow an explicit for-all but we don't insert one -- in type Foo a = (b,b) -- Instead we just say b is out of scope - { RdrHsDecl (TyClD (TySynonym (fst $3) (snd $3) $5 $1)) } + { RdrHsDecl (TyClD (TySynonym $3 $4 $6 $1)) } - | srcloc 'data' ctype constrs deriving - {% checkDataHeader "data" $3 `thenP` \(cs,c,ts) -> - returnP (RdrHsDecl (TyClD - (mkTyData DataType cs c ts (reverse $4) (length $4) $5 $1))) } - | srcloc 'newtype' ctype '=' newconstr deriving - {% checkDataHeader "newtype" $3 `thenP` \(cs,c,ts) -> - returnP (RdrHsDecl (TyClD - (mkTyData NewType cs c ts [$5] 1 $6 $1))) } + | srcloc 'data' tycl_hdr constrs deriving + {% returnP (RdrHsDecl (TyClD + (mkTyData DataType $3 (DataCons (reverse $4)) $5 $1))) } - | srcloc 'class' ctype fds where - {% checkDataHeader "class" $3 `thenP` \(cs,c,ts) -> - let + | srcloc 'newtype' tycl_hdr '=' newconstr deriving + {% returnP (RdrHsDecl (TyClD + (mkTyData NewType $3 (DataCons [$5]) $6 $1))) } + + | srcloc 'class' tycl_hdr fds where + {% let (binds,sigs) = cvMonoBindsAndSigs cvClassOpSig (groupBindings $5) in returnP (RdrHsDecl (TyClD - (mkClassDecl cs c ts $4 sigs (Just binds) $1))) } + (mkClassDecl $3 $4 sigs (Just binds) $1))) } | srcloc 'instance' inst_type where { let (binds,sigs) @@ -367,45 +378,38 @@ topdecl :: { RdrBinding } (groupBindings $4) in RdrHsDecl (InstD (InstDecl $3 binds sigs Nothing $1)) } - | srcloc 'default' '(' types0 ')' { RdrHsDecl (DefD (DefaultDecl $4 $1)) } - | 'foreign' fordecl { RdrHsDecl $2 } + | srcloc 'default' '(' comma_types0 ')' { RdrHsDecl (DefD (DefaultDecl $4 $1)) } + | 'foreign' fdecl { RdrHsDecl $2 } | '{-# DEPRECATED' deprecations '#-}' { $2 } | '{-# RULES' rules '#-}' { $2 } | decl { $1 } -fordecl :: { RdrNameHsDecl } -fordecl : srcloc 'label' ext_name varid '::' sigtype - { ForD (ForeignImport $4 $6 (LblImport ($3 `orElse` mkExtName $4)) $1) } - - - ----------- ccall/stdcall decls ------------ - | srcloc 'import' ccallconv ext_name unsafe_flag varid_no_unsafe '::' sigtype - { let - call_spec = CCallSpec (StaticTarget ($4 `orElse` mkExtName $6)) $3 $5 - in - ForD (ForeignImport $6 $8 (CImport call_spec) $1) - } - - | srcloc 'import' ccallconv 'dynamic' unsafe_flag varid_no_unsafe '::' sigtype - { let - call_spec = CCallSpec DynamicTarget $3 $5 - in - ForD (ForeignImport $6 $8 (CImport call_spec) $1) - } - - | srcloc 'export' ccallconv ext_name varid '::' sigtype - { ForD (ForeignExport $5 $7 (CExport (CExportStatic ($4 `orElse` mkExtName $5) $3)) $1) } - - | srcloc 'export' ccallconv 'dynamic' varid '::' sigtype - { ForD (ForeignImport $5 $7 (CDynImport $3) $1) } - - - ----------- .NET decls ------------ - | srcloc 'import' 'dotnet' ext_name varid '::' sigtype - { ForD (ForeignImport $5 $7 (DNImport (DNCallSpec ($4 `orElse` mkExtName $5))) $1) } - - | srcloc 'import' 'dotnet' 'type' ext_name tycon - { TyClD (ForeignType $6 $5 DNType $1) } +-- tycl_hdr parses the header of a type or class decl, +-- which takes the form +-- T a b +-- Eq a => T a +-- (Eq a, Ord b) => T a b +-- Rather a lot of inlining here, else we get reduce/reduce errors +tycl_hdr :: { (RdrNameContext, RdrName, [RdrNameHsTyVar]) } + : '(' comma_types1 ')' '=>' gtycon tv_bndrs {% mapP checkPred $2 `thenP` \ cxt -> + returnP (cxt, $5, $6) } + -- qtycon for the class below name would lead to many s/r conflicts + -- FIXME: does the renamer pick up all wrong forms and raise an + -- error + | gtycon atypes1 '=>' gtycon atypes0 {% checkTyVars $5 `thenP` \ tvs -> + returnP ([HsClassP $1 $2], $4, tvs) } + | gtycon atypes0 {% checkTyVars $2 `thenP` \ tvs -> + returnP ([], $1, tvs) } + -- We have to have qtycon in this production to avoid s/r + -- conflicts with the previous one. The renamer will complain + -- if we use a qualified tycon. + -- + -- Using a `gtycon' throughout. This enables special syntax, + -- such as "[]" for tycons as well as tycon ops in + -- parentheses. This is beyond H98, but used repeatedly in + -- the Prelude modules. (So, it would be a good idea to raise + -- an error in the renamer if some non-H98 form is used and + -- -fglasgow-exts is not given.) -=chak decls :: { [RdrBinding] } : decls ';' decl { $3 : $1 } @@ -459,11 +463,15 @@ rule :: { RdrBinding } activation :: { Activation } -- Omitted means AlwaysActive : {- empty -} { AlwaysActive } - | '[' INTEGER ']' { ActiveAfter (fromInteger $2) } + | explicit_activation { $1 } inverse_activation :: { Activation } -- Omitted means NeverActive : {- empty -} { NeverActive } - | '[' INTEGER ']' { ActiveAfter (fromInteger $2) } + | explicit_activation { $1 } + +explicit_activation :: { Activation } -- In brackets + : '[' INTEGER ']' { ActiveAfter (fromInteger $2) } + | '[' '~' INTEGER ']' { ActiveBefore (fromInteger $3) } rule_forall :: { [RdrNameRuleBndr] } : 'forall' rule_var_list '.' { $2 } @@ -492,18 +500,149 @@ deprecation :: { RdrBinding } { foldr RdrAndBindings RdrNullBind [ RdrHsDecl (DeprecD (Deprecation n $3 $1)) | n <- $2 ] } ------------------------------------------------------------------------------ --- Foreign import/export - -ccallconv :: { CCallConv } - : 'stdcall' { StdCallConv } - | 'ccall' { CCallConv } - | {- empty -} { defaultCCallConv } - -unsafe_flag :: { Safety } - : 'unsafe' { PlayRisky } - | {- empty -} { PlaySafe } +----------------------------------------------------------------------------- +-- Foreign import and export declarations + +-- for the time being, the following accepts foreign declarations conforming +-- to the FFI Addendum, Version 1.0 as well as pre-standard declarations +-- +-- * a flag indicates whether pre-standard declarations have been used and +-- triggers a deprecation warning further down the road +-- +-- NB: The first two rules could be combined into one by replacing `safety1' +-- with `safety'. However, the combined rule conflicts with the +-- DEPRECATED rules. +-- +fdecl :: { RdrNameHsDecl } +fdecl : srcloc 'import' callconv safety1 fspec {% mkImport $3 $4 $5 $1 } + | srcloc 'import' callconv fspec {% mkImport $3 (PlaySafe False) $4 $1 } + | srcloc 'export' callconv fspec {% mkExport $3 $4 $1 } + -- the following syntax is DEPRECATED + | srcloc fdecl1DEPRECATED { ForD ($2 True $1) } + | srcloc fdecl2DEPRECATED { $2 $1 } + +fdecl1DEPRECATED :: { Bool -> SrcLoc -> ForeignDecl RdrName } +fdecl1DEPRECATED + ----------- DEPRECATED label decls ------------ + : 'label' ext_name varid '::' sigtype + { ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) _NIL_ _NIL_ + (CLabel ($2 `orElse` mkExtName $3))) } + + ----------- DEPRECATED ccall/stdcall decls ------------ + -- + -- NB: This business with the case expression below may seem overly + -- complicated, but it is necessary to avoid some conflicts. + + -- DEPRECATED variant #1: lack of a calling convention specification + -- (import) + | 'import' {-no callconv-} ext_name safety varid_no_unsafe '::' sigtype + { let + target = StaticTarget ($2 `orElse` mkExtName $4) + in + ForeignImport $4 $6 (CImport defaultCCallConv $3 _NIL_ _NIL_ + (CFunction target)) } + + -- DEPRECATED variant #2: external name consists of two separate strings + -- (module name and function name) (import) + | 'import' callconv STRING STRING safety varid_no_unsafe '::' sigtype + {% case $2 of + DNCall -> parseError "Illegal format of .NET foreign import" + CCall cconv -> returnP $ + let + imp = CFunction (StaticTarget $4) + in + ForeignImport $6 $8 (CImport cconv $5 _NIL_ _NIL_ imp) } + + -- DEPRECATED variant #3: `unsafe' after entity + | 'import' callconv STRING 'unsafe' varid_no_unsafe '::' sigtype + {% case $2 of + DNCall -> parseError "Illegal format of .NET foreign import" + CCall cconv -> returnP $ + let + imp = CFunction (StaticTarget $3) + in + ForeignImport $5 $7 (CImport cconv PlayRisky _NIL_ _NIL_ imp) } + + -- DEPRECATED variant #4: use of the special identifier `dynamic' without + -- an explicit calling convention (import) + | 'import' {-no callconv-} 'dynamic' safety varid_no_unsafe '::' sigtype + { ForeignImport $4 $6 (CImport defaultCCallConv $3 _NIL_ _NIL_ + (CFunction DynamicTarget)) } + + -- DEPRECATED variant #5: use of the special identifier `dynamic' (import) + | 'import' callconv 'dynamic' safety varid_no_unsafe '::' sigtype + {% case $2 of + DNCall -> parseError "Illegal format of .NET foreign import" + CCall cconv -> returnP $ + ForeignImport $5 $7 (CImport cconv $4 _NIL_ _NIL_ + (CFunction DynamicTarget)) } + + -- DEPRECATED variant #6: lack of a calling convention specification + -- (export) + | 'export' {-no callconv-} ext_name varid '::' sigtype + { ForeignExport $3 $5 (CExport (CExportStatic ($2 `orElse` mkExtName $3) + defaultCCallConv)) } + + -- DEPRECATED variant #7: external name consists of two separate strings + -- (module name and function name) (export) + | 'export' callconv STRING STRING varid '::' sigtype + {% case $2 of + DNCall -> parseError "Illegal format of .NET foreign import" + CCall cconv -> returnP $ + ForeignExport $5 $7 + (CExport (CExportStatic $4 cconv)) } + + -- DEPRECATED variant #8: use of the special identifier `dynamic' without + -- an explicit calling convention (export) + | 'export' {-no callconv-} 'dynamic' varid '::' sigtype + { ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) _NIL_ _NIL_ + CWrapper) } + + -- DEPRECATED variant #9: use of the special identifier `dynamic' (export) + | 'export' callconv 'dynamic' varid '::' sigtype + {% case $2 of + DNCall -> parseError "Illegal format of .NET foreign import" + CCall cconv -> returnP $ + ForeignImport $4 $6 (CImport cconv (PlaySafe False) _NIL_ _NIL_ CWrapper) } + + ----------- DEPRECATED .NET decls ------------ + -- NB: removed the .NET call declaration, as it is entirely subsumed + -- by the new standard FFI declarations + +fdecl2DEPRECATED :: { SrcLoc -> RdrNameHsDecl } +fdecl2DEPRECATED + : 'import' 'dotnet' 'type' ext_name tycon + { \loc -> TyClD (ForeignType $5 $4 DNType loc) } + -- left this one unchanged for the moment as type imports are not + -- covered currently by the FFI standard -=chak + + +callconv :: { CallConv } + : 'stdcall' { CCall StdCallConv } + | 'ccall' { CCall CCallConv } + | 'dotnet' { DNCall } + +safety :: { Safety } + : 'unsafe' { PlayRisky } + | 'safe' { PlaySafe False } + | 'threadsafe' { PlaySafe True } + | {- empty -} { PlaySafe False } + +safety1 :: { Safety } + : 'unsafe' { PlayRisky } + | 'safe' { PlaySafe False } + | 'threadsafe' { PlaySafe True } + -- only needed to avoid conflicts with the DEPRECATED rules + +fspec :: { (FAST_STRING, RdrName, RdrNameHsType) } + : STRING varid '::' sigtype { ($1 , $2, $4) } + | varid '::' sigtype { (SLIT(""), $1, $3) } + -- if the entity string is missing, it defaults to the empty string; + -- the meaning of an empty entity string depends on the calling + -- convention + +-- DEPRECATED syntax ext_name :: { Maybe CLabelString } : STRING { Just $1 } | STRING STRING { Just $2 } -- Ignore "module name" for now @@ -526,7 +665,7 @@ sigtypes :: { [RdrNameHsType] } | sigtypes ',' sigtype { $3 : $1 } sigtype :: { RdrNameHsType } - : ctype { (mkHsForAllTy Nothing [] $1) } + : ctype { mkHsForAllTy Nothing [] $1 } sig_vars :: { [RdrName] } : sig_vars ',' var { $3 : $1 } @@ -537,11 +676,18 @@ sig_vars :: { [RdrName] } -- A ctype is a for-all type ctype :: { RdrNameHsType } - : 'forall' tyvars '.' ctype { mkHsForAllTy (Just $2) [] $4 } + : 'forall' tv_bndrs '.' ctype { mkHsForAllTy (Just $2) [] $4 } | context '=>' type { mkHsForAllTy Nothing $1 $3 } -- A type of form (context => type) is an *implicit* HsForAllTy | type { $1 } +-- We parse a context as a btype so that we don't get reduce/reduce +-- errors in ctype. The basic problem is that +-- (Eq a, Ord a) +-- looks so much like a tuple type. We can't tell until we find the => +context :: { RdrNameContext } + : btype {% checkContext $1 } + type :: { RdrNameHsType } : gentype '->' type { HsFunTy $1 $3 } | ipvar '::' type { mkHsIParamTy $1 $3 } @@ -553,16 +699,18 @@ gentype :: { RdrNameHsType } | atype tyconop atype { HsOpTy $1 $2 $3 } btype :: { RdrNameHsType } - : btype atype { (HsAppTy $1 $2) } + : btype atype { HsAppTy $1 $2 } | atype { $1 } atype :: { RdrNameHsType } : gtycon { HsTyVar $1 } | tyvar { HsTyVar $1 } - | '(' type ',' types ')' { HsTupleTy (mkHsTupCon tcName Boxed ($2:$4)) ($2 : reverse $4) } - | '(#' types '#)' { HsTupleTy (mkHsTupCon tcName Unboxed $2) (reverse $2) } + | '(' type ',' comma_types1 ')' { HsTupleTy (mkHsTupCon tcName Boxed ($2:$4)) ($2:$4) } + | '(#' comma_types1 '#)' { HsTupleTy (mkHsTupCon tcName Unboxed $2) $2 } | '[' type ']' { HsListTy $2 } + | '[:' type ':]' { HsPArrTy $2 } | '(' ctype ')' { $2 } + | '(' ctype '::' kind ')' { HsKindSig $2 $4 } -- Generics | INTEGER { HsNumTy $1 } @@ -573,21 +721,30 @@ atype :: { RdrNameHsType } inst_type :: { RdrNameHsType } : ctype {% checkInstType $1 } -types0 :: { [RdrNameHsType] } - : types { reverse $1 } +comma_types0 :: { [RdrNameHsType] } + : comma_types1 { $1 } | {- empty -} { [] } -types :: { [RdrNameHsType] } +comma_types1 :: { [RdrNameHsType] } : type { [$1] } - | types ',' type { $3 : $1 } - -simpletype :: { (RdrName, [RdrNameHsTyVar]) } - : tycon tyvars { ($1, reverse $2) } + | type ',' comma_types1 { $1 : $3 } -tyvars :: { [RdrNameHsTyVar] } - : tyvars tyvar { UserTyVar $2 : $1 } +atypes0 :: { [RdrNameHsType] } + : atypes1 { $1 } | {- empty -} { [] } +atypes1 :: { [RdrNameHsType] } + : atype { [$1] } + | atype atypes1 { $1 : $2 } + +tv_bndrs :: { [RdrNameHsTyVar] } + : tv_bndr tv_bndrs { $1 : $2 } + | {- empty -} { [] } + +tv_bndr :: { RdrNameHsTyVar } + : tyvar { UserTyVar $1 } + | '(' tyvar '::' kind ')' { IfaceTyVar $2 $4 } + fds :: { [([RdrName], [RdrName])] } : {- empty -} { [] } | '|' fds1 { reverse $2 } @@ -604,6 +761,18 @@ varids0 :: { [RdrName] } | varids0 tyvar { $2 : $1 } ----------------------------------------------------------------------------- +-- Kinds + +kind :: { Kind } + : akind { $1 } + | akind '->' kind { mkArrowKind $1 $3 } + +akind :: { Kind } + : '*' { liftedTypeKind } + | '(' kind ')' { $2 } + + +----------------------------------------------------------------------------- -- Datatype declarations newconstr :: { RdrNameConDecl } @@ -626,15 +795,13 @@ constr :: { RdrNameConDecl } { mkConDecl (fst $3) $2 [] (snd $3) $1 } forall :: { [RdrNameHsTyVar] } - : 'forall' tyvars '.' { $2 } + : 'forall' tv_bndrs '.' { $2 } | {- empty -} { [] } -context :: { RdrNameContext } - : btype {% checkContext $1 } - constr_stuff :: { (RdrName, RdrNameConDetails) } : btype {% mkVanillaCon $1 [] } | btype '!' atype satypes {% mkVanillaCon $1 (BangType MarkedUserStrict $3 : $4) } + | gtycon '{' '}' {% mkRecCon $1 [] } | gtycon '{' fielddecls '}' {% mkRecCon $1 $3 } | sbtype conop sbtype { ($2, InfixCon $1 $3) } @@ -733,9 +900,9 @@ exp10 :: { RdrNameHsExpr } returnP (HsDo DoExpr stmts $1) } | '_ccall_' ccallid aexps0 { HsCCall $2 $3 PlayRisky False placeHolderType } - | '_ccall_GC_' ccallid aexps0 { HsCCall $2 $3 PlaySafe False placeHolderType } + | '_ccall_GC_' ccallid aexps0 { HsCCall $2 $3 (PlaySafe False) False placeHolderType } | '_casm_' CLITLIT aexps0 { HsCCall $2 $3 PlayRisky True placeHolderType } - | '_casm_GC_' CLITLIT aexps0 { HsCCall $2 $3 PlaySafe True placeHolderType } + | '_casm_GC_' CLITLIT aexps0 { HsCCall $2 $3 (PlaySafe False) True placeHolderType } | scc_annot exp { if opt_SccProfilingOn then HsSCC $1 $2 @@ -756,7 +923,7 @@ fexp :: { RdrNameHsExpr } | aexp { $1 } aexps0 :: { [RdrNameHsExpr] } - : aexps { (reverse $1) } + : aexps { reverse $1 } aexps :: { [RdrNameHsExpr] } : aexps aexp { $2 : $1 } @@ -782,6 +949,7 @@ aexp1 :: { RdrNameHsExpr } | '(' exp ',' texps ')' { ExplicitTuple ($2 : reverse $4) Boxed} | '(#' texps '#)' { ExplicitTuple (reverse $2) Unboxed } | '[' list ']' { $2 } + | '[:' parr ':]' { $2 } | '(' infixexp qop ')' { (SectionL $2 (HsVar $3)) } | '(' qopm infixexp ')' { (SectionR $2 $3) } | qvar '@' aexp { EAsPat $1 $3 } @@ -831,6 +999,35 @@ quals :: { [RdrNameStmt] } | stmt { [$1] } ----------------------------------------------------------------------------- +-- Parallel array expressions + +-- The rules below are little bit contorted; see the list case for details. +-- Note that, in contrast to lists, we only have finite arithmetic sequences. +-- Moreover, we allow explicit arrays with no element (represented by the nil +-- constructor in the list case). + +parr :: { RdrNameHsExpr } + : { ExplicitPArr placeHolderType [] } + | exp { ExplicitPArr placeHolderType [$1] } + | lexps { ExplicitPArr placeHolderType + (reverse $1) } + | exp '..' exp { PArrSeqIn (FromTo $1 $3) } + | exp ',' exp '..' exp { PArrSeqIn (FromThenTo $1 $3 $5) } + | exp srcloc pquals {% let { + body [qs] = qs; + body qss = [ParStmt + (map reverse qss)]} + in + returnP $ + HsDo PArrComp + (reverse (ResultStmt $1 $2 + : body $3)) + $2 + } + +-- We are reusing `lexps' and `pquals' from the list case. + +----------------------------------------------------------------------------- -- Case alternatives altslist :: { [RdrNameMatch] } @@ -854,7 +1051,7 @@ alt :: { RdrNameMatch } ralt :: { [RdrNameGRHS] } : '->' srcloc exp { [GRHS [ResultStmt $3 $2] $2] } - | gdpats { (reverse $1) } + | gdpats { reverse $1 } gdpats :: { [RdrNameGRHS] } : gdpats gdpat { $2 : $1 } @@ -946,13 +1143,15 @@ gtycon :: { RdrName } | '(' ')' { unitTyCon_RDR } | '(' '->' ')' { funTyCon_RDR } | '[' ']' { listTyCon_RDR } + | '[:' ':]' { parrTyCon_RDR } | '(' commas ')' { tupleTyCon_RDR $2 } -gcon :: { RdrName } +gcon :: { RdrName } -- Data constructor namespace : '(' ')' { unitCon_RDR } | '[' ']' { nilCon_RDR } | '(' commas ')' { tupleCon_RDR $2 } | qcon { $1 } +-- the case of '[:' ':]' is part of the production `parr' var :: { RdrName } : varid { $1 } @@ -1019,6 +1218,8 @@ qvarid :: { RdrName } varid :: { RdrName } : varid_no_unsafe { $1 } | 'unsafe' { mkUnqual varName SLIT("unsafe") } + | 'safe' { mkUnqual varName SLIT("safe") } + | 'threadsafe' { mkUnqual varName SLIT("threadsafe") } varid_no_unsafe :: { RdrName } : VARID { mkUnqual varName $1 } @@ -1029,9 +1230,11 @@ tyvar :: { RdrName } : VARID { mkUnqual tvName $1 } | special_id { mkUnqual tvName $1 } | 'unsafe' { mkUnqual tvName SLIT("unsafe") } + | 'safe' { mkUnqual tvName SLIT("safe") } + | 'threadsafe' { mkUnqual tvName SLIT("threadsafe") } -- These special_ids are treated as keywords in various places, --- but as ordinary ids elsewhere. A special_id collects all thsee +-- but as ordinary ids elsewhere. 'special_id' collects all these -- except 'unsafe' and 'forall' whose treatment differs depending on context special_id :: { UserFS } special_id @@ -1047,7 +1250,7 @@ special_id ----------------------------------------------------------------------------- -- ConIds -qconid :: { RdrName } +qconid :: { RdrName } -- Qualified or unqualifiedb : conid { $1 } | QCONID { mkQual dataName $1 } @@ -1057,7 +1260,7 @@ conid :: { RdrName } ----------------------------------------------------------------------------- -- ConSyms -qconsym :: { RdrName } +qconsym :: { RdrName } -- Qualified or unqualifiedb : consym { $1 } | QCONSYM { mkQual dataName $1 } @@ -1091,6 +1294,7 @@ varsym_no_minus :: { RdrName } -- varsym not including '-' special_sym :: { UserFS } special_sym : '!' { SLIT("!") } | '.' { SLIT(".") } + | '*' { SLIT("*") } ----------------------------------------------------------------------------- -- Literals @@ -1134,16 +1338,13 @@ tycon :: { RdrName } tyconop :: { RdrName } : CONSYM { mkUnqual tcClsName $1 } -qtycon :: { RdrName } - : tycon { $1 } - | QCONID { mkQual tcClsName $1 } - -qtyconop :: { RdrName } - : tyconop { $1 } - | QCONSYM { mkQual tcClsName $1 } +qtycon :: { RdrName } -- Qualified or unqualified + : QCONID { mkQual tcClsName $1 } + | tycon { $1 } -qtycls :: { RdrName } - : qtycon { $1 } +qtyconop :: { RdrName } -- Qualified or unqualified + : QCONSYM { mkQual tcClsName $1 } + | tyconop { $1 } commas :: { Int } : commas ',' { $1 + 1 }