    {-# Language BlockArguments #-}
    {-# Language OverloadedStrings #-}
    module Cryptol.Parser.Layout where

    import Cryptol.Utils.Panic(panic)
    import Cryptol.Parser.Position
    import Cryptol.Parser.Token

    {-

    We assume the existence of an explicit EOF token at the end of the input.  This token is *less* indented
    than all other tokens (i.e., it is at column 0)

    Explicit Layout Blocks

      * The symbols `(`, `{`, and `[` start an explicit layout block.
      * While in an explicit layout block we pass through tokens, except:
          - We may start new implicit or explicit layout blocks
          - A `,` terminates any *nested* layout blocks
          - We terminate the current layout block if we encounter the matching
            closing symbol `)`, `}`, `]`

    Implicit Layout Blocks

      * The keywords `where`, `private`, and `parameter` start an implicit
        layout block.
      * The layout block starts at the column of the *following* token and we
        insert "virtual start block" between the current and the following tokens.
      * While in an implicit layout block:
        - We may start new implicit or explicit layout blocks
        - We insert a "virtual separator" before tokens starting at the same
          column as the layout block, EXCEPT:
            * we do not insert a separator if the previous token was a
              "documentation comment"
            * we do not insert a separator before the first token in the block

        - The implicit layout block is ended by:
              * a token than is less indented that the block, or
              * `)`, `}`, `]`, or
              * ',' but only if there is an outer paren block
              block's column.
        - When an implicit layout block ends, we insert a "virtual end block"
          token just before the token that caused the block to end.

    Examples:

    f = x where x = 0x1         -- end implicit layout by layout
    g = 0x3                     -- (`g` is less indented than `x`)

    f (x where x = 2)           -- end implicit layout by `)`

    [ x where x = 2, 3 ]        -- end implicit layout by `,`

    module A where              -- two implicit layout blocks with the
    private                     -- *same* indentation (`where` and `private`)
    x = 0x2
    -}

    layout :: Bool -> [Located Token] -> [Located Token]
    layout :: Bool -> [Located Token] -> [Located Token]
    layout Bool
    isMod [Located Token]
    ts0

      -- Star an implicit layout block at the top of the module
      | let t :: Located Token
    t         = [Located Token] -> Located Token
    forall a. HasCallStack => [a] -> a
    head [Located Token]
    ts0
            rng :: Range
    rng       = Located Token -> Range
    forall a. Located a -> Range
    srcRange Located Token
    t
            blockCol :: Int
    blockCol  = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    1 (Position -> Int
    col (Range -> Position
    from Range
    rng)) -- see startImplicitBlock
            implictMod :: Bool
    implictMod = case (Located Token -> TokenT) -> [Located Token] -> [TokenT]
    forall a b. (a -> b) -> [a] -> [b]
    map (Token -> TokenT
    tokenType (Token -> TokenT)
    -> (Located Token -> Token) -> Located Token -> TokenT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Located Token -> Token
    forall a. Located a -> a
    thing) [Located Token]
    ts0 of
                           KW TokenKW
    KW_module : [TokenT]
    _                   -> Bool
    False
                           KW TokenKW
    KW_interface : KW TokenKW
    KW_module : [TokenT]
    _ -> Bool
    False
                           [TokenT]
    _                                  -> Bool
    True
      , Bool
    isMod Bool -> Bool -> Bool
    && Bool
    implictMod =
        Range -> TokenV -> Located Token
    virt Range
    rng TokenV
    VCurlyL Located Token -> [Located Token] -> [Located Token]
    forall a. a -> [a] -> [a]
    : [Block] -> Int -> Bool -> [Located Token] -> [Located Token]
    go [ Int -> Block
    Virtual Int
    blockCol ] Int
    blockCol Bool
    True [Located Token]
    ts0

      | Bool
    otherwise =
        [Block] -> Int -> Bool -> [Located Token] -> [Located Token]
    go [] Int
    0 Bool
    False [Located Token]
    ts0

      where

      {- State parameters for `go`:

           stack:
              The stack of implicit and explicit blocks

           lastVirt:
              The indentation of the outer most implicit block, or 0 if none.
              This can be computed from the stack but we cache
              it here as we need to check it on each token.

           noVirtSep:
              Do not emit a virtual separator even if token matches block alignment.
              This is enabled at the beginning of a block, or after a doc string,
              or if we just emitted a separtor, but have not yet consumed the
              next token.

           tokens:
              remaining tokens to process
      -}

      go :: [Block] -> Int -> Bool -> [Located Token] -> [Located Token]
    go [Block]
    stack Int
    lastVirt Bool
    noVirtSep [Located Token]
    tokens

        -- End implicit layout due to indentation.  If the outermost block
        -- is a lyout block we just end it.   If the outermost block is an
        -- explicit layout block we report a lexical error.
        | Position -> Int
    col Position
    curLoc Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    lastVirt =
          [Located Token]
    endImplictBlock

        -- End implicit layout block due to a symbol
        | Just (Virtual {}) <- Maybe Block
    curBlock, TokenT -> Bool
    endsLayout TokenT
    curTokTy =
          [Located Token]
    endImplictBlock

        -- End implicit layout block due to a comma
        | Just (Virtual {}) <- Maybe Block
    curBlock
        , Sym TokenSym
    Comma <- TokenT
    curTokTy
        , Bool -> Bool
    not ([()] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ () | Explicit TokenT
    _ <- [Block]
    popStack ]) =
          [Located Token]
    endImplictBlock

        -- Insert a virtual separator
        | Just (Virtual {}) <- Maybe Block
    curBlock
        , Position -> Int
    col Position
    curLoc Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    lastVirt Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    noVirtSep =
          Range -> TokenV -> Located Token
    virt Range
    curRange TokenV
    VSemi Located Token -> [Located Token] -> [Located Token]
    forall a. a -> [a] -> [a]
    : [Block] -> Int -> Bool -> [Located Token] -> [Located Token]
    go [Block]
    stack Int
    lastVirt Bool
    True [Located Token]
    tokens

        -- Start a new implicit layout. Advances token position.
        | TokenT -> Bool
    startsLayout TokenT
    curTokTy = [Located Token]
    startImplicitBlock

        -- Start a paren block.  Advances token position
        | Just TokenT
    close <- TokenT -> Maybe TokenT
    startsParenBlock TokenT
    curTokTy =
          Located Token
    curTok Located Token -> [Located Token] -> [Located Token]
    forall a. a -> [a] -> [a]
    : [Block] -> Int -> Bool -> [Located Token] -> [Located Token]
    go (TokenT -> Block
    Explicit TokenT
    close Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : [Block]
    stack) Int
    lastVirt Bool
    False [Located Token]
    advanceTokens

        -- End a paren block. Advances token position
        | Just (Explicit TokenT
    close) <- Maybe Block
    curBlock, TokenT
    close TokenT -> TokenT -> Bool
    forall a. Eq a => a -> a -> Bool
    == TokenT
    curTokTy =
          Located Token
    curTok Located Token -> [Located Token] -> [Located Token]
    forall a. a -> [a] -> [a]
    : [Block] -> Int -> Bool -> [Located Token] -> [Located Token]
    go [Block]
    popStack Int
    lastVirt Bool
    False [Located Token]
    advanceTokens

        -- Disable virtual separator after doc string. Advances token position
        | White TokenW
    DocStr <- TokenT
    curTokTy =
          Located Token
    curTok Located Token -> [Located Token] -> [Located Token]
    forall a. a -> [a] -> [a]
    : [Block] -> Int -> Bool -> [Located Token] -> [Located Token]
    go [Block]
    stack Int
    lastVirt Bool
    True [Located Token]
    advanceTokens

        -- Check to see if we are done.  Note that if we got here, implicit layout
        -- blocks should have already been closed, as `EOF` is less indented than
        -- all other tokens
        | TokenT
    EOF <- TokenT
    curTokTy =
          [Located Token
    curTok]

        -- Any other token, just emit.  Advances token position
        | Bool
    otherwise =
          Located Token
    curTok Located Token -> [Located Token] -> [Located Token]
    forall a. a -> [a] -> [a]
    : [Block] -> Int -> Bool -> [Located Token] -> [Located Token]
    go [Block]
    stack Int
    lastVirt Bool
    False [Located Token]
    advanceTokens

        where
        (Located Token
    curTok, [Located Token]
    advanceTokens) = case [Located Token]
    tokens of
                                    (Located Token
    curTok' : [Located Token]
    advanceTokens') -> (Located Token
    curTok', [Located Token]
    advanceTokens')
                                    [] -> [Char] -> (Located Token, [Located Token])
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "layout: Unexpected empty list of tokens"
        curTokTy :: TokenT
    curTokTy               = Token -> TokenT
    tokenType (Located Token -> Token
    forall a. Located a -> a
    thing Located Token
    curTok)
        curRange :: Range
    curRange               = Located Token -> Range
    forall a. Located a -> Range
    srcRange Located Token
    curTok
        curLoc :: Position
    curLoc                 = Range -> Position
    from Range
    curRange

        (Maybe Block
    curBlock,[Block]
    popStack) =
          case [Block]
    stack of
            Block
    a : [Block]
    b -> (Block -> Maybe Block
    forall a. a -> Maybe a
    Just Block
    a,[Block]
    b)
            []    -> (Maybe Block
    forall a. Maybe a
    Nothing, [Char] -> [[Char]] -> [Block]
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "layout" [[Char]
    "pop empty stack"])

        startImplicitBlock :: [Located Token]
    startImplicitBlock =
          let nextRng :: Range
    nextRng  = Located Token -> Range
    forall a. Located a -> Range
    srcRange ([Located Token] -> Located Token
    forall a. HasCallStack => [a] -> a
    head [Located Token]
    advanceTokens)
              nextLoc :: Position
    nextLoc  = Range -> Position
    from Range
    nextRng
              blockCol :: Int
    blockCol = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    1 (Position -> Int
    col Position
    nextLoc)
              -- the `max` ensuraes that indentation is always at least 1,
              -- in case we are starting a block at the very end of the input

          in Located Token
    curTok
           Located Token -> [Located Token] -> [Located Token]
    forall a. a -> [a] -> [a]
    : Range -> TokenV -> Located Token
    virt Range
    nextRng TokenV
    VCurlyL
           Located Token -> [Located Token] -> [Located Token]
    forall a. a -> [a] -> [a]
    : [Block] -> Int -> Bool -> [Located Token] -> [Located Token]
    go (Int -> Block
    Virtual Int
    blockCol Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : [Block]
    stack) Int
    blockCol Bool
    True [Located Token]
    advanceTokens

        endImplictBlock :: [Located Token]
    endImplictBlock =
          case Maybe Block
    curBlock of
            Just (Virtual {}) ->
               Range -> TokenV -> Located Token
    virt Range
    curRange TokenV
    VCurlyR
               Located Token -> [Located Token] -> [Located Token]
    forall a. a -> [a] -> [a]
    : [Block] -> Int -> Bool -> [Located Token] -> [Located Token]
    go [Block]
    popStack Int
    newVirt Bool
    False [Located Token]
    tokens
              where newVirt :: Int
    newVirt = case [ Int
    n | Virtual Int
    n <- [Block]
    popStack ] of
                                Int
    n : [Int]
    _ -> Int
    n
                                [Int]
    _     -> Int
    0

            Just (Explicit TokenT
    c) ->
              Range -> TokenErr -> Located Token
    errTok Range
    curRange (TokenT -> TokenErr
    InvalidIndentation TokenT
    c) Located Token -> [Located Token] -> [Located Token]
    forall a. a -> [a] -> [a]
    : [Located Token]
    advanceTokens

            Maybe Block
    Nothing -> [Char] -> [[Char]] -> [Located Token]
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "layout" [[Char]
    "endImplictBlock with empty stack"]

    --------------------------------------------------------------------------------

    data Block =
        Virtual Int     -- ^ Virtual layout block
      | Explicit TokenT -- ^ An explicit layout block, expecting this ending token.
        deriving (Int -> Block -> ShowS
    [Block] -> ShowS
    Block -> [Char]
    (Int -> Block -> ShowS)
    -> (Block -> [Char]) -> ([Block] -> ShowS) -> Show Block
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Block -> ShowS
    showsPrec :: Int -> Block -> ShowS
    $cshow :: Block -> [Char]
    show :: Block -> [Char]
    $cshowList :: [Block] -> ShowS
    showList :: [Block] -> ShowS
    Show)

    -- | These tokens start an implicit layout block
    startsLayout :: TokenT -> Bool
    startsLayout :: TokenT -> Bool
    startsLayout TokenT
    ty =
      case TokenT
    ty of
        KW TokenKW
    KW_where       -> Bool
    True
        KW TokenKW
    KW_private     -> Bool
    True
        KW TokenKW
    KW_parameter   -> Bool
    True
        TokenT
    _                 -> Bool
    False

    -- | These tokens end an implicit layout block
    endsLayout :: TokenT -> Bool
    endsLayout :: TokenT -> Bool
    endsLayout TokenT
    ty =
      case TokenT
    ty of
        Sym TokenSym
    BracketR -> Bool
    True
        Sym TokenSym
    ParenR   -> Bool
    True
        Sym TokenSym
    CurlyR   -> Bool
    True
        TokenT
    _            -> Bool
    False

    -- | These tokens start an explicit "paren" layout block.
    -- If so, the result contains the corresponding closing paren.
    startsParenBlock :: TokenT -> Maybe TokenT
    startsParenBlock :: TokenT -> Maybe TokenT
    startsParenBlock TokenT
    ty =
      case TokenT
    ty of
        Sym TokenSym
    BracketL -> TokenT -> Maybe TokenT
    forall a. a -> Maybe a
    Just (TokenSym -> TokenT
    Sym TokenSym
    BracketR)
        Sym TokenSym
    ParenL   -> TokenT -> Maybe TokenT
    forall a. a -> Maybe a
    Just (TokenSym -> TokenT
    Sym TokenSym
    ParenR)
        Sym TokenSym
    CurlyL   -> TokenT -> Maybe TokenT
    forall a. a -> Maybe a
    Just (TokenSym -> TokenT
    Sym TokenSym
    CurlyR)
        TokenT
    _            -> Maybe TokenT
    forall a. Maybe a
    Nothing

    --------------------------------------------------------------------------------

    -- | Make a virtual token of the given type
    virt :: Range -> TokenV -> Located Token
    virt :: Range -> TokenV -> Located Token
    virt Range
    rng TokenV
    x = Located { srcRange :: Range
    srcRange = Range
    rng { to :: Position
    to = Range -> Position
    from Range
    rng }, thing :: Token
    thing = Token
    t }
      where
      t :: Token
    t = TokenT -> Text -> Token
    Token (TokenV -> TokenT
    Virt TokenV
    x)
          case TokenV
    x of
            TokenV
    VCurlyL -> Text
    "beginning of layout block"
            TokenV
    VCurlyR -> Text
    "end of layout block"
            TokenV
    VSemi   -> Text
    "layout block separator"

    errTok :: Range -> TokenErr -> Located Token
    errTok :: Range -> TokenErr -> Located Token
    errTok Range
    rng TokenErr
    x = Located { srcRange :: Range
    srcRange = Range
    rng { to :: Position
    to = Range -> Position
    from Range
    rng }, thing :: Token
    thing = Token
    t }
      where
      t :: Token
    t = Token { tokenType :: TokenT
    tokenType = TokenErr -> TokenT
    Err TokenErr
    x, tokenText :: Text
    tokenText = Text
    "" }