diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2013-02-27 09:57:09 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2013-02-27 09:57:09 +0000 |
| commit | 47d226544fc3fb11d024740a162f8ae4e1d044c9 (patch) | |
| tree | 8a024b97de71216f6b3606d3cda7bf16ae1f98a6 /compiler/parser | |
| parent | 7b5e514d85c086be8dc6d938b526c97b6ced56eb (diff) | |
| parent | 0ee31659afe7a6819f9eb5e233f98e5592f1b439 (diff) | |
| download | haskell-tc-arrows.tar.gz | |
Merge remote-tracking branch 'origin/master' into tc-arrowstc-arrows
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Lexer.x | 9 | ||||
| -rw-r--r-- | compiler/parser/Parser.y.pp | 12 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.lhs | 4 |
3 files changed, 14 insertions, 11 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 2746faa34e..fdf75cf003 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -339,7 +339,7 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") } } <0> { - "(#" / { ifExtension unboxedTuplesEnabled `alexAndPred` notFollowedBySymbol } + "(#" / { ifExtension unboxedTuplesEnabled } { token IToubxparen } "#)" / { ifExtension unboxedTuplesEnabled } { token ITcubxparen } @@ -2389,8 +2389,11 @@ dispatch_pragmas prags span buf len = case Map.lookup (clean_pragma (lexemeToStr Nothing -> lexError "unknown pragma" known_pragma :: Map String Action -> AlexAccPred Int -known_pragma prags _ _ len (AI _ buf) = (isJust $ Map.lookup (clean_pragma (lexemeToString (offsetBytes (- len) buf) len)) prags) - && (nextCharIsNot buf (\c -> isAlphaNum c || c == '_')) +known_pragma prags _ (AI _ startbuf) _ (AI _ curbuf) + = isKnown && nextCharIsNot curbuf pragmaNameChar + where l = lexemeToString startbuf (byteDiff startbuf curbuf) + isKnown = isJust $ Map.lookup (clean_pragma l) prags + pragmaNameChar c = isAlphaNum c || c == '_' clean_pragma :: String -> String clean_pragma prag = canon_ws (map toLower (unprefix prag)) diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 72537a9a1b..18651b97c2 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1617,12 +1617,12 @@ tup_tail :: { [HsTupArg RdrName] } -- avoiding another shift/reduce-conflict. list :: { LHsExpr RdrName } - : texp { L1 $ ExplicitList placeHolderType [$1] } - | lexps { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) } - | texp '..' { LL $ ArithSeq noPostTcExpr (From $1) } - | texp ',' exp '..' { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) } - | texp '..' exp { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) } - | texp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) } + : texp { L1 $ ExplicitList placeHolderType Nothing [$1] } + | lexps { L1 $ ExplicitList placeHolderType Nothing (reverse (unLoc $1)) } + | texp '..' { LL $ ArithSeq noPostTcExpr Nothing (From $1) } + | texp ',' exp '..' { LL $ ArithSeq noPostTcExpr Nothing (FromThen $1 $3) } + | texp '..' exp { LL $ ArithSeq noPostTcExpr Nothing (FromTo $1 $3) } + | texp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr Nothing (FromThenTo $1 $3 $5) } | texp '|' flattenedpquals {% checkMonadComp >>= \ ctxt -> return (sL (comb2 $1 $>) $ diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index f7236b89c8..3695daef58 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -619,8 +619,8 @@ checkAPat msg loc e0 = do _ -> patFail msg loc e0 HsPar e -> checkLPat msg e >>= (return . ParPat) - ExplicitList _ es -> do ps <- mapM (checkLPat msg) es - return (ListPat ps placeHolderType) + ExplicitList _ _ es -> do ps <- mapM (checkLPat msg) es + return (ListPat ps placeHolderType Nothing) ExplicitPArr _ es -> do ps <- mapM (checkLPat msg) es return (PArrPat ps placeHolderType) |