X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FParser.y;fp=ghc%2Fcompiler%2Fparser%2FParser.y;h=a4294e13dc5bae1a484e4ec40ee1ed99aa2ff78d;hb=9541ef3440f89f5f275509b1cc64fb9c498dcf73;hp=18021175669ec129fb1e3bc0f8626000cfe67e81;hpb=74fce831a7115e88f374a08d39675c434fbbc07a;p=ghc-hetmet.git diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y index 1802117..a4294e1 100644 --- a/ghc/compiler/parser/Parser.y +++ b/ghc/compiler/parser/Parser.y @@ -1,6 +1,6 @@ {- -*-haskell-*- ----------------------------------------------------------------------------- -$Id: Parser.y,v 1.121 2003/07/16 08:49:05 ross Exp $ +$Id: Parser.y,v 1.122 2003/09/08 11:52:25 simonmar Exp $ Haskell grammar. @@ -18,11 +18,12 @@ import HsTypes ( mkHsTupCon ) import RdrHsSyn import HscTypes ( ParsedIface(..), IsBootInterface, noDependencies ) -import Lex +import Lexer import RdrName import PrelNames ( mAIN_Name, funTyConName, listTyConName, parrTyConName, consDataConName ) -import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon ) +import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, + tupleCon, nilDataCon ) import ForeignCall ( Safety(..), CExportSpec(..), CCallConv(..), CCallTarget(..), defaultCCallConv, ) @@ -33,9 +34,9 @@ import SrcLoc ( SrcLoc ) import Module import CmdLineOpts ( opt_SccProfilingOn, opt_InPackage ) import Type ( Kind, mkArrowKind, liftedTypeKind ) -import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..), - NewOrData(..), StrictnessMark(..), Activation(..), - FixitySig(..) ) +import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), + IPName(..), NewOrData(..), StrictnessMark(..), + Activation(..), FixitySig(..) ) import Panic import GLAEXTS @@ -43,6 +44,7 @@ import CStrings ( CLabelString ) import FastString import Maybes ( orElse ) import Outputable +import Char ( ord ) } @@ -90,170 +92,141 @@ Conflicts: 29 shift/reduce, [SDM 19/9/2002] -} %token - '_' { ITunderscore } -- Haskell keywords - 'as' { ITas } - 'case' { ITcase } - 'class' { ITclass } - 'data' { ITdata } - 'default' { ITdefault } - 'deriving' { ITderiving } - 'do' { ITdo } - 'else' { ITelse } - 'hiding' { IThiding } - 'if' { ITif } - 'import' { ITimport } - 'in' { ITin } - 'infix' { ITinfix } - 'infixl' { ITinfixl } - 'infixr' { ITinfixr } - 'instance' { ITinstance } - 'let' { ITlet } - 'module' { ITmodule } - 'newtype' { ITnewtype } - 'of' { ITof } - 'qualified' { ITqualified } - 'then' { ITthen } - 'type' { ITtype } - 'where' { ITwhere } - '_scc_' { ITscc } -- ToDo: remove - - 'forall' { ITforall } -- GHC extension keywords - 'foreign' { ITforeign } - 'export' { ITexport } - 'label' { ITlabel } - 'dynamic' { ITdynamic } - 'safe' { ITsafe } - 'threadsafe' { ITthreadsafe } - 'unsafe' { ITunsafe } - 'with' { ITwith } - 'mdo' { ITmdo } - 'stdcall' { ITstdcallconv } - 'ccall' { ITccallconv } - 'dotnet' { ITdotnet } - 'proc' { ITproc } -- for arrow notation extension - 'rec' { ITrec } -- for arrow notation extension - '_ccall_' { ITccall (False, False, PlayRisky) } - '_ccall_GC_' { ITccall (False, False, PlaySafe False) } - '_casm_' { ITccall (False, True, PlayRisky) } - '_casm_GC_' { ITccall (False, True, PlaySafe False) } - - '{-# SPECIALISE' { ITspecialise_prag } - '{-# SOURCE' { ITsource_prag } - '{-# INLINE' { ITinline_prag } - '{-# NOINLINE' { ITnoinline_prag } - '{-# RULES' { ITrules_prag } - '{-# CORE' { ITcore_prag } -- hdaume: annotated core - '{-# SCC' { ITscc_prag } - '{-# DEPRECATED' { ITdeprecated_prag } - '#-}' { ITclose_prag } - -{- - '__interface' { ITinterface } -- interface keywords - '__export' { IT__export } - '__instimport' { ITinstimport } - '__forall' { IT__forall } - '__letrec' { ITletrec } - '__coerce' { ITcoerce } - '__depends' { ITdepends } - '__inline' { ITinline } - '__DEFAULT' { ITdefaultbranch } - '__bot' { ITbottom } - '__integer' { ITinteger_lit } - '__float' { ITfloat_lit } - '__rational' { ITrational_lit } - '__addr' { ITaddr_lit } - '__label' { ITlabel_lit } - '__litlit' { ITlit_lit } - '__string' { ITstring_lit } - '__ccall' { ITccall $$ } - '__scc' { IT__scc } - '__sccC' { ITsccAllCafs } - - '__A' { ITarity } - '__P' { ITspecialise } - '__C' { ITnocaf } - '__U' { ITunfold } - '__S' { ITstrict $$ } - '__M' { ITcprinfo $$ } --} - - '..' { ITdotdot } -- reserved symbols - ':' { ITcolon } - '::' { ITdcolon } - '=' { ITequal } - '\\' { ITlam } - '|' { ITvbar } - '<-' { ITlarrow } - '->' { ITrarrow } - '@' { ITat } - '~' { ITtilde } - '=>' { ITdarrow } - '-' { ITminus } - '!' { ITbang } - '*' { ITstar } - '-<' { ITlarrowtail } -- for arrow notation - '>-' { ITrarrowtail } -- for arrow notation - '-<<' { ITLarrowtail } -- for arrow notation - '>>-' { ITRarrowtail } -- for arrow notation - '.' { ITdot } - - '{' { ITocurly } -- special symbols - '}' { ITccurly } - '{|' { ITocurlybar } - '|}' { ITccurlybar } - vccurly { ITvccurly } -- virtual close curly (from layout) - '[' { ITobrack } - ']' { ITcbrack } - '[:' { ITopabrack } - ':]' { ITcpabrack } - '(' { IToparen } - ')' { ITcparen } - '(#' { IToubxparen } - '#)' { ITcubxparen } - '(|' { IToparenbar } - '|)' { ITcparenbar } - ';' { ITsemi } - ',' { ITcomma } - '`' { ITbackquote } - - VARID { ITvarid $$ } -- identifiers - CONID { ITconid $$ } - VARSYM { ITvarsym $$ } - CONSYM { ITconsym $$ } - QVARID { ITqvarid $$ } - QCONID { ITqconid $$ } - QVARSYM { ITqvarsym $$ } - QCONSYM { ITqconsym $$ } - - IPDUPVARID { ITdupipvarid $$ } -- GHC extension - IPSPLITVARID { ITsplitipvarid $$ } -- GHC extension - - CHAR { ITchar $$ } - STRING { ITstring $$ } - INTEGER { ITinteger $$ } - RATIONAL { ITrational $$ } - - PRIMCHAR { ITprimchar $$ } - PRIMSTRING { ITprimstring $$ } - PRIMINTEGER { ITprimint $$ } - PRIMFLOAT { ITprimfloat $$ } - PRIMDOUBLE { ITprimdouble $$ } - CLITLIT { ITlitlit $$ } + '_' { T _ _ ITunderscore } -- Haskell keywords + 'as' { T _ _ ITas } + 'case' { T _ _ ITcase } + 'class' { T _ _ ITclass } + 'data' { T _ _ ITdata } + 'default' { T _ _ ITdefault } + 'deriving' { T _ _ ITderiving } + 'do' { T _ _ ITdo } + 'else' { T _ _ ITelse } + 'hiding' { T _ _ IThiding } + 'if' { T _ _ ITif } + 'import' { T _ _ ITimport } + 'in' { T _ _ ITin } + 'infix' { T _ _ ITinfix } + 'infixl' { T _ _ ITinfixl } + 'infixr' { T _ _ ITinfixr } + 'instance' { T _ _ ITinstance } + 'let' { T _ _ ITlet } + 'module' { T _ _ ITmodule } + 'newtype' { T _ _ ITnewtype } + 'of' { T _ _ ITof } + 'qualified' { T _ _ ITqualified } + 'then' { T _ _ ITthen } + 'type' { T _ _ ITtype } + 'where' { T _ _ ITwhere } + '_scc_' { T _ _ ITscc } -- ToDo: remove + + 'forall' { T _ _ ITforall } -- GHC extension keywords + 'foreign' { T _ _ ITforeign } + 'export' { T _ _ ITexport } + 'label' { T _ _ ITlabel } + 'dynamic' { T _ _ ITdynamic } + 'safe' { T _ _ ITsafe } + 'threadsafe' { T _ _ ITthreadsafe } + 'unsafe' { T _ _ ITunsafe } + 'with' { T _ _ ITwith } + 'mdo' { T _ _ ITmdo } + 'stdcall' { T _ _ ITstdcallconv } + 'ccall' { T _ _ ITccallconv } + 'dotnet' { T _ _ ITdotnet } + 'proc' { T _ _ ITproc } -- for arrow notation extension + 'rec' { T _ _ ITrec } -- for arrow notation extension + '_ccall_' { T _ _ (ITccall (False, False, PlayRisky)) } + '_ccall_GC_' { T _ _ (ITccall (False, False, PlaySafe False)) } + '_casm_' { T _ _ (ITccall (False, True, PlayRisky)) } + '_casm_GC_' { T _ _ (ITccall (False, True, PlaySafe False)) } + + '{-# SPECIALISE' { T _ _ ITspecialise_prag } + '{-# SOURCE' { T _ _ ITsource_prag } + '{-# INLINE' { T _ _ ITinline_prag } + '{-# NOINLINE' { T _ _ ITnoinline_prag } + '{-# RULES' { T _ _ ITrules_prag } + '{-# CORE' { T _ _ ITcore_prag } -- hdaume: annotated core + '{-# SCC' { T _ _ ITscc_prag } + '{-# DEPRECATED' { T _ _ ITdeprecated_prag } + '#-}' { T _ _ ITclose_prag } + + '..' { T _ _ ITdotdot } -- reserved symbols + ':' { T _ _ ITcolon } + '::' { T _ _ ITdcolon } + '=' { T _ _ ITequal } + '\\' { T _ _ ITlam } + '|' { T _ _ ITvbar } + '<-' { T _ _ ITlarrow } + '->' { T _ _ ITrarrow } + '@' { T _ _ ITat } + '~' { T _ _ ITtilde } + '=>' { T _ _ ITdarrow } + '-' { T _ _ ITminus } + '!' { T _ _ ITbang } + '*' { T _ _ ITstar } + '-<' { T _ _ ITlarrowtail } -- for arrow notation + '>-' { T _ _ ITrarrowtail } -- for arrow notation + '-<<' { T _ _ ITLarrowtail } -- for arrow notation + '>>-' { T _ _ ITRarrowtail } -- for arrow notation + '.' { T _ _ ITdot } + + '{' { T _ _ ITocurly } -- special symbols + '}' { T _ _ ITccurly } + '{|' { T _ _ ITocurlybar } + '|}' { T _ _ ITccurlybar } + vocurly { T _ _ ITvocurly } -- virtual open curly (from layout) + vccurly { T _ _ ITvccurly } -- virtual close curly (from layout) + '[' { T _ _ ITobrack } + ']' { T _ _ ITcbrack } + '[:' { T _ _ ITopabrack } + ':]' { T _ _ ITcpabrack } + '(' { T _ _ IToparen } + ')' { T _ _ ITcparen } + '(#' { T _ _ IToubxparen } + '#)' { T _ _ ITcubxparen } + '(|' { T _ _ IToparenbar } + '|)' { T _ _ ITcparenbar } + ';' { T _ _ ITsemi } + ',' { T _ _ ITcomma } + '`' { T _ _ ITbackquote } + + VARID { T _ _ (ITvarid $$) } -- identifiers + CONID { T _ _ (ITconid $$) } + VARSYM { T _ _ (ITvarsym $$) } + CONSYM { T _ _ (ITconsym $$) } + QVARID { T _ _ (ITqvarid $$) } + QCONID { T _ _ (ITqconid $$) } + QVARSYM { T _ _ (ITqvarsym $$) } + QCONSYM { T _ _ (ITqconsym $$) } + + IPDUPVARID { T _ _ (ITdupipvarid $$) } -- GHC extension + IPSPLITVARID { T _ _ (ITsplitipvarid $$) } -- GHC extension + + CHAR { T _ _ (ITchar $$) } + STRING { T _ _ (ITstring $$) } + INTEGER { T _ _ (ITinteger $$) } + RATIONAL { T _ _ (ITrational $$) } + + PRIMCHAR { T _ _ (ITprimchar $$) } + PRIMSTRING { T _ _ (ITprimstring $$) } + PRIMINTEGER { T _ _ (ITprimint $$) } + PRIMFLOAT { T _ _ (ITprimfloat $$) } + PRIMDOUBLE { T _ _ (ITprimdouble $$) } + CLITLIT { T _ _ (ITlitlit $$) } -- Template Haskell -'[|' { ITopenExpQuote } -'[p|' { ITopenPatQuote } -'[t|' { ITopenTypQuote } -'[d|' { ITopenDecQuote } -'|]' { ITcloseQuote } -ID_SPLICE { ITidEscape $$ } -- $x -'$(' { ITparenEscape } -- $( exp ) -REIFY_TYPE { ITreifyType } -REIFY_DECL { ITreifyDecl } -REIFY_FIXITY { ITreifyFixity } - -%monad { P } { thenP } { returnP } -%lexer { lexer } { ITeof } +'[|' { T _ _ ITopenExpQuote } +'[p|' { T _ _ ITopenPatQuote } +'[t|' { T _ _ ITopenTypQuote } +'[d|' { T _ _ ITopenDecQuote } +'|]' { T _ _ ITcloseQuote } +ID_SPLICE { T _ _ (ITidEscape $$) } -- $x +'$(' { T _ _ ITparenEscape } -- $( exp ) +REIFY_TYPE { T _ _ ITreifyType } +REIFY_DECL { T _ _ ITreifyDecl } +REIFY_FIXITY { T _ _ ITreifyFixity } + +%monad { P } { >>= } { return } +%lexer { lexer } { T _ _ ITeof } %name parseModule module %name parseStmt maybe_stmt %name parseIdentifier identifier @@ -274,8 +247,11 @@ REIFY_FIXITY { ITreifyFixity } module :: { RdrNameHsModule } : srcloc 'module' modid maybemoddeprec maybeexports 'where' body { HsModule (Just (mkHomeModule $3)) $5 (fst $7) (snd $7) $4 $1 } - | srcloc body - { HsModule Nothing Nothing (fst $2) (snd $2) Nothing $1 } + | srcloc missing_module_keyword top close + { HsModule Nothing Nothing (fst $3) (snd $3) Nothing $1 } + +missing_module_keyword :: { () } + : {- empty -} {% pushCurrentContext } maybemoddeprec :: { Maybe DeprecTxt } : '{-# DEPRECATED' STRING '#-}' { Just $2 } @@ -283,7 +259,7 @@ maybemoddeprec :: { Maybe DeprecTxt } body :: { ([RdrNameImportDecl], [RdrNameHsDecl]) } : '{' top '}' { $2 } - | layout_on top close { $2 } + | vocurly top close { $2 } top :: { ([RdrNameImportDecl], [RdrNameHsDecl]) } : importdecls { (reverse $1,[]) } @@ -316,7 +292,7 @@ iface :: { ParsedIface } ifacebody :: { [RdrNameTyClDecl] } : '{' ifacedecls '}' { $2 } - | layout_on ifacedecls close { $2 } + | vocurly ifacedecls close { $2 } ifacedecls :: { [RdrNameTyClDecl] } : ifacedecl ';' ifacedecls { $1 : $3 } @@ -464,10 +440,10 @@ syn_hdr :: { (RdrName, [RdrNameHsTyVar]) } -- We don't retain the syntax of an i -- (Eq a, Ord b) => T a b -- Rather a lot of inlining here, else we get reduce/reduce errors tycl_hdr :: { (RdrNameContext, RdrName, [RdrNameHsTyVar]) } - : context '=>' type {% checkTyClHdr $3 `thenP` \ (tc,tvs) -> - returnP ($1, tc, tvs) } - | type {% checkTyClHdr $1 `thenP` \ (tc,tvs) -> - returnP ([], tc, tvs) } + : context '=>' type {% checkTyClHdr $3 >>= \ (tc,tvs) -> + return ($1, tc, tvs) } + | type {% checkTyClHdr $1 >>= \ (tc,tvs) -> + return ([], tc, tvs) } ----------------------------------------------------------------------------- -- Nested declarations @@ -481,7 +457,7 @@ decls :: { [RdrBinding] } -- Reversed decllist :: { [RdrBinding] } -- Reversed : '{' decls '}' { $2 } - | layout_on decls close { $2 } + | vocurly decls close { $2 } where :: { [RdrBinding] } -- Reversed -- No implicit parameters @@ -491,7 +467,7 @@ where :: { [RdrBinding] } -- Reversed binds :: { RdrNameHsBinds } -- May have implicit parameters : decllist { cvBinds $1 } | '{' dbinds '}' { IPBinds $2 False{-not with-} } - | layout_on dbinds close { IPBinds $2 False{-not with-} } + | vocurly dbinds close { IPBinds $2 False{-not with-} } wherebinds :: { RdrNameHsBinds } -- May have implicit parameters : 'where' binds { $2 } @@ -599,7 +575,7 @@ fdecl1DEPRECATED | 'import' callconv STRING STRING safety varid_no_unsafe '::' sigtype {% case $2 of DNCall -> parseError "Illegal format of .NET foreign import" - CCall cconv -> returnP $ + CCall cconv -> return $ let imp = CFunction (StaticTarget $4) in @@ -609,7 +585,7 @@ fdecl1DEPRECATED | 'import' callconv STRING 'unsafe' varid_no_unsafe '::' sigtype {% case $2 of DNCall -> parseError "Illegal format of .NET foreign import" - CCall cconv -> returnP $ + CCall cconv -> return $ let imp = CFunction (StaticTarget $3) in @@ -625,7 +601,7 @@ fdecl1DEPRECATED | 'import' callconv 'dynamic' safety varid_no_unsafe '::' sigtype {% case $2 of DNCall -> parseError "Illegal format of .NET foreign import" - CCall cconv -> returnP $ + CCall cconv -> return $ ForeignImport $5 $7 (CImport cconv $4 nilFS nilFS (CFunction DynamicTarget)) } @@ -640,7 +616,7 @@ fdecl1DEPRECATED | 'export' callconv STRING STRING varid '::' sigtype {% case $2 of DNCall -> parseError "Illegal format of .NET foreign import" - CCall cconv -> returnP $ + CCall cconv -> return $ ForeignExport $5 $7 (CExport (CExportStatic $4 cconv)) } @@ -654,7 +630,7 @@ fdecl1DEPRECATED | 'export' callconv 'dynamic' varid '::' sigtype {% case $2 of DNCall -> parseError "Illegal format of .NET foreign import" - CCall cconv -> returnP $ + CCall cconv -> return $ ForeignImport $4 $6 (CImport cconv (PlaySafe False) nilFS nilFS CWrapper) } ----------- DEPRECATED .NET decls ------------ @@ -948,18 +924,18 @@ infixexp :: { RdrNameHsExpr } exp10 :: { RdrNameHsExpr } : '\\' srcloc aexp aexps opt_asig '->' srcloc exp - {% checkPatterns $2 ($3 : reverse $4) `thenP` \ ps -> - returnP (HsLam (Match ps $5 + {% checkPatterns $2 ($3 : reverse $4) >>= \ ps -> + return (HsLam (Match ps $5 (GRHSs (unguardedRHS $8 $7) EmptyBinds placeHolderType))) } | 'let' binds 'in' exp { HsLet $2 $4 } | 'if' srcloc exp 'then' exp 'else' exp { HsIf $3 $5 $7 $2 } | 'case' srcloc exp 'of' altslist { HsCase $3 $5 $2 } | '-' fexp { mkHsNegApp $2 } - | srcloc 'do' stmtlist {% checkDo $3 `thenP` \ stmts -> - returnP (mkHsDo DoExpr stmts $1) } - | srcloc 'mdo' stmtlist {% checkMDo $3 `thenP` \ stmts -> - returnP (mkHsDo MDoExpr stmts $1) } + | srcloc 'do' stmtlist {% checkDo $3 >>= \ stmts -> + return (mkHsDo DoExpr stmts $1) } + | srcloc 'mdo' stmtlist {% checkMDo $3 >>= \ stmts -> + return (mkHsDo MDoExpr stmts $1) } | '_ccall_' ccallid aexps0 { HsCCall $2 $3 PlayRisky False placeHolderType } | '_ccall_GC_' ccallid aexps0 { HsCCall $2 $3 (PlaySafe False) False placeHolderType } @@ -971,8 +947,8 @@ exp10 :: { RdrNameHsExpr } else HsPar $2 } | 'proc' srcloc aexp '->' srcloc exp - {% checkPattern $2 $3 `thenP` \ p -> - returnP (HsProc p (HsCmdTop $6 [] placeHolderType undefined) $5) } + {% checkPattern $2 $3 >>= \ p -> + return (HsProc p (HsCmdTop $6 [] placeHolderType undefined) $5) } | '{-# CORE' STRING '#-}' exp { HsCoreAnn $2 $4 } -- hdaume: core annotation @@ -1022,8 +998,8 @@ aexp2 :: { RdrNameHsExpr } : ipvar { HsIPVar $1 } | qcname { HsVar $1 } | literal { HsLit $1 } - | INTEGER { HsOverLit (mkHsIntegral $1) } - | RATIONAL { HsOverLit (mkHsFractional $1) } + | INTEGER { HsOverLit $! mkHsIntegral $1 } + | RATIONAL { HsOverLit $! mkHsFractional $1 } | '(' exp ')' { HsPar $2 } | '(' exp ',' texps ')' { ExplicitTuple ($2 : reverse $4) Boxed} | '(#' texps '#)' { ExplicitTuple (reverse $2) Unboxed } @@ -1038,8 +1014,8 @@ aexp2 :: { RdrNameHsExpr } | srcloc '$(' exp ')' { mkHsSplice $3 $1 } -- $( exp ) | srcloc '[|' exp '|]' { HsBracket (ExpBr $3) $1 } | srcloc '[t|' ctype '|]' { HsBracket (TypBr $3) $1 } - | srcloc '[p|' infixexp '|]' {% checkPattern $1 $3 `thenP` \p -> - returnP (HsBracket (PatBr p) $1) } + | srcloc '[p|' infixexp '|]' {% checkPattern $1 $3 >>= \p -> + return (HsBracket (PatBr p) $1) } | srcloc '[d|' cvtopbody '|]' { HsBracket (DecBr (mkGroup $3)) $1 } -- arrow notation extension @@ -1055,7 +1031,7 @@ acmd :: { RdrNameHsCmdTop } cvtopbody :: { [RdrNameHsDecl] } : '{' cvtopdecls '}' { $2 } - | layout_on cvtopdecls close { $2 } + | vocurly cvtopdecls close { $2 } texps :: { [RdrNameHsExpr] } : texps ',' exp { $3 : $1 } @@ -1131,7 +1107,7 @@ parr :: { RdrNameHsExpr } altslist :: { [RdrNameMatch] } : '{' alts '}' { reverse $2 } - | layout_on alts close { reverse $2 } + | vocurly alts close { reverse $2 } alts :: { [RdrNameMatch] } : alts1 { $1 } @@ -1144,8 +1120,8 @@ alts1 :: { [RdrNameMatch] } alt :: { RdrNameMatch } : srcloc infixexp opt_sig ralt wherebinds - {% (checkPattern $1 $2 `thenP` \p -> - returnP (Match [p] $3 + {% (checkPattern $1 $2 >>= \p -> + return (Match [p] $3 (GRHSs $4 $5 placeHolderType)) )} ralt :: { [RdrNameGRHS] } @@ -1163,8 +1139,8 @@ gdpat :: { RdrNameGRHS } -- Statement sequences stmtlist :: { [RdrNameStmt] } - : '{' stmts '}' { $2 } - | layout_on_for_do stmts close { $2 } + : '{' stmts '}' { $2 } + | vocurly stmts close { $2 } -- do { ;; s ; s ; ; s ;; } -- The last Stmt should be a ResultStmt, but that's hard to enforce @@ -1188,13 +1164,13 @@ maybe_stmt :: { Maybe RdrNameStmt } stmt :: { RdrNameStmt } : qual { $1 } - | srcloc infixexp '->' exp {% checkPattern $1 $4 `thenP` \p -> - returnP (BindStmt p $2 $1) } + | srcloc infixexp '->' exp {% checkPattern $1 $4 >>= \p -> + return (BindStmt p $2 $1) } | srcloc 'rec' stmtlist { RecStmt $3 undefined undefined undefined } qual :: { RdrNameStmt } - : srcloc infixexp '<-' exp {% checkPattern $1 $2 `thenP` \p -> - returnP (BindStmt p $4 $1) } + : srcloc infixexp '<-' exp {% checkPattern $1 $2 >>= \p -> + return (BindStmt p $4 $1) } | srcloc exp { ExprStmt $2 placeHolderType $1 } | srcloc 'let' binds { LetStmt $3 } @@ -1215,7 +1191,7 @@ fbind :: { (RdrName, RdrNameHsExpr) } dbinding :: { [(IPName RdrName, RdrNameHsExpr)] } : '{' dbinds '}' { $2 } - | layout_on dbinds close { $2 } + | vocurly dbinds close { $2 } dbinds :: { [(IPName RdrName, RdrNameHsExpr)] } : dbinds ';' dbind { $3 : $1 } @@ -1438,17 +1414,17 @@ consym :: { RdrName } -- Literals literal :: { HsLit } - : CHAR { HsChar $1 } + : CHAR { HsChar (ord $1) } --TODO remove ord | STRING { HsString $1 } | PRIMINTEGER { HsIntPrim $1 } - | PRIMCHAR { HsCharPrim $1 } + | PRIMCHAR { HsCharPrim (ord $1) } --TODO remove ord | PRIMSTRING { HsStringPrim $1 } | PRIMFLOAT { HsFloatPrim $1 } | PRIMDOUBLE { HsDoublePrim $1 } | CLITLIT { HsLitLit $1 placeHolderType } -srcloc :: { SrcLoc } : {% getSrcLocP } - +srcloc :: { SrcLoc } : {% getSrcLoc } + ----------------------------------------------------------------------------- -- Layout @@ -1456,9 +1432,6 @@ close :: { () } : vccurly { () } -- context popped in lexer. | error {% popContext } -layout_on :: { () } : {% layoutOn True{-strict-} } -layout_on_for_do :: { () } : {% layoutOn False } - ----------------------------------------------------------------------------- -- Miscellaneous (mostly renamings) @@ -1478,5 +1451,5 @@ commas :: { Int } { happyError :: P a -happyError buf PState{ loc = loc } = PFailed (srcParseErr buf loc) +happyError = srcParseFail }