X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=1bb8a636e40c39d531a14d8b84249f61f3265874;hp=fbc4821f16c92f0563ffd8e227db8fed7dc1a56e;hb=9568347eb0ae5d11354e0e4744c0f6af8b65b0be;hpb=de865a1c13352b239bcbad64a3b70e66a9bcba86 diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index fbc4821..1bb8a63 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -1998,26 +1998,29 @@ alternativeLayoutRuleToken t setALRContext (ALRLayout expectingOCurly thisCol : context) setNextToken t return (L thisLoc ITocurly) + -- We do the [] cases earlier than in the spec, as we + -- have an actual EOF token + (ITeof, ALRLayout _ _ : ls, _) -> + do setALRContext ls + setNextToken t + return (L thisLoc ITccurly) + (ITeof, _, _) -> + return t + -- the other ITeof case omitted; general case below covers it (ITin, ALRLayout ALRLayoutLet _ : ls, _) | newLine -> do setPendingImplicitTokens [t] setALRContext ls return (L thisLoc ITccurly) - (_, ls@(ALRLayout _ col : _), _) - | newLine && thisCol <= col -> - do let f ls'@(ALRLayout _ col' : ls'') - | thisCol < col' = case f ls'' of - (ts, ls''') -> - (L thisLoc ITccurly : ts, ls''') - | thisCol == col' = ([L thisLoc ITsemi], ls') - | otherwise = ([], ls') - f ls' = ([], ls') - case f ls of - (t' : ts, ls') -> - do setPendingImplicitTokens ts - setNextToken t - return t' - _ -> panic "Layout rule: [] when considering newline" + (_, ALRLayout _ col : ls, _) + | newLine && thisCol == col -> + do setNextToken t + return (L thisLoc ITsemi) + | newLine && thisCol < col -> + do setALRContext ls + -- Note that we use lastLoc, as we may need to close + -- more layouts, or give a semicolon + return (L lastLoc ITccurly) (u, _, _) | isALRopen u -> do setALRContext (ALRNoLayout (containsCommas u) : context) @@ -2040,7 +2043,7 @@ alternativeLayoutRuleToken t do setALRContext ls setPendingImplicitTokens [t] return (L thisLoc ITccurly) - (ITin, _ : ls, _) -> + (ITin, ALRLayout _ _ : ls, _) -> do setALRContext ls setNextToken t return (L thisLoc ITccurly) @@ -2055,13 +2058,6 @@ alternativeLayoutRuleToken t setPendingImplicitTokens [t] return (L thisLoc ITccurly) -- the other ITwhere case omitted; general case below covers it - -- The first [] case comes before the general case, as we - -- have an actual EOF token - (ITeof, ALRLayout _ _ : ls, _) -> - do setALRContext ls - setNextToken t - return (L thisLoc ITccurly) - -- the other ITeof case omitted; general case below covers it (_, _, _) -> return t isALRopen :: Token -> Bool @@ -2070,6 +2066,8 @@ isALRopen ITif = True isALRopen IToparen = True isALRopen ITobrack = True isALRopen ITocurly = True +-- GHC Extensions: +isALRopen IToubxparen = True isALRopen _ = False isALRclose :: Token -> Bool @@ -2078,11 +2076,15 @@ isALRclose ITthen = True isALRclose ITcparen = True isALRclose ITcbrack = True isALRclose ITccurly = True +-- GHC Extensions: +isALRclose ITcubxparen = True isALRclose _ = False containsCommas :: Token -> Bool containsCommas IToparen = True containsCommas ITobrack = True +-- GHC Extensions: +containsCommas IToubxparen = True containsCommas _ = False topNoLayoutContainsCommas :: [ALRContext] -> Bool