Add some comments on the alternative layout rule state

[ghc-hetmet.git] / compiler / parser / Lexer.x

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index e131e96..cae5349 100644 (file)
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -1135,7 +1135,7 @@ do_layout_left span _buf _len = do
 setLine :: Int -> Action
 setLine code span buf len = do
   let line = parseUnsignedInteger buf len 10 octDecDigit
-  setSrcLoc (mkSrcLoc (srcSpanFile span) (fromIntegral line - 1) 0)
+  setSrcLoc (mkSrcLoc (srcSpanFile span) (fromIntegral line - 1) 1)
        -- subtract one: the line number refers to the *following* line
   _ <- popLexState
   pushLexState code
@@ -1144,6 +1144,7 @@ setLine code span buf len = do
 setFile :: Int -> Action
 setFile code span buf len = do
   let file = lexemeToFastString (stepOn buf) (len-2)
+  setAlrLastLoc noSrcSpan
   setSrcLoc (mkSrcLoc file (srcSpanEndLine span) (srcSpanEndCol span))
   _ <- popLexState
   pushLexState code
@@ -1289,7 +1290,7 @@ finish_char_tok loc ch    -- We've already seen the closing quote
                                return (L (mkSrcSpan loc end) (ITprimchar ch))
                        _other ->
                                return (L (mkSrcSpan loc end) (ITchar ch))
-               else do
+           else do
                   return (L (mkSrcSpan loc end) (ITchar ch))
 
 lex_char :: Char -> AlexInput -> P Char
@@ -1498,10 +1499,19 @@ data PState = PState {
        context    :: [LayoutContext],
        lex_state  :: [Int],
         -- Used in the alternative layout rule:
+        -- These tokens are the next ones to be sent out. They are
+        -- just blindly emitted, without the rule looking at them again:
         alr_pending_implicit_tokens :: [Located Token],
+        -- This is the next token to be considered or, if it is Nothing,
+        -- we need to get the next token from the input stream:
         alr_next_token :: Maybe (Located Token),
+        -- This is what we consider to be the locatino of the last token
+        -- emitted:
         alr_last_loc :: SrcSpan,
+        -- The stack of layout contexts:
         alr_context :: [ALRContext],
+        -- Are we expecting a '{'? If it's Just, then the ALRLayout tells
+        -- us what sort of layout the '{' will open:
         alr_expecting_ocurly :: Maybe ALRLayout
      }
        -- last_loc and last_len are used when generating error messages,
@@ -1981,8 +1991,17 @@ alternativeLayoutRuleToken t
          mExpectingOCurly <- getAlrExpectingOCurly
          let thisLoc = getLoc t
              thisCol = srcSpanStartCol thisLoc
-             newLine = srcSpanStartLine thisLoc > srcSpanEndLine lastLoc
+             newLine = (lastLoc == noSrcSpan)
+                    || (srcSpanStartLine thisLoc > srcSpanEndLine lastLoc)
          case (unLoc t, context, mExpectingOCurly) of
+             -- This case handles a GHC extension to the original H98
+             -- layout rule...
+             (ITocurly, _, Just _) ->
+                 do setAlrExpectingOCurly Nothing
+                    setALRContext (ALRNoLayout (containsCommas ITocurly) : context)
+                    return t
+             -- ...and makes this case unnecessary
+             {-
              -- I think our implicit open-curly handling is slightly
              -- different to John's, in how it interacts with newlines
              -- and "in"
@@ -1990,6 +2009,7 @@ alternativeLayoutRuleToken t
                  do setAlrExpectingOCurly Nothing
                     setNextToken t
                     lexTokenAlr
+             -}
              (_, ALRLayout _ col : ls, Just expectingOCurly)
               | (thisCol > col) ||
                 (thisCol == col &&
@@ -2000,9 +2020,9 @@ alternativeLayoutRuleToken t
                     return (L thisLoc ITocurly)
               | otherwise ->
                  do setAlrExpectingOCurly Nothing
-                    setPendingImplicitTokens [L thisLoc ITccurly]
+                    setPendingImplicitTokens [L lastLoc ITccurly]
                     setNextToken t
-                    return (L thisLoc ITocurly)
+                    return (L lastLoc ITocurly)
              (_, _, Just expectingOCurly) ->
                  do setAlrExpectingOCurly Nothing
                     setALRContext (ALRLayout expectingOCurly thisCol : context)
@@ -2098,6 +2118,10 @@ isNonDecreasingIntentation _           = False
 containsCommas :: Token -> Bool
 containsCommas IToparen = True
 containsCommas ITobrack = True
+-- John doesn't have {} as containing commas, but records contain them,
+-- which caused a problem parsing Cabal's Distribution.Simple.InstallDirs
+-- (defaultInstallDirs).
+containsCommas ITocurly = True
 -- GHC Extensions:
 containsCommas IToubxparen = True
 containsCommas _        = False