{-# Language BlockArguments #-}
{-# Language OverloadedStrings #-}
module Cryptol.Parser.Layout where
import Cryptol.Utils.Panic(panic)
import Cryptol.Parser.Position
import Cryptol.Parser.Token
layout :: Bool -> [Located Token] -> [Located Token]
layout :: Bool -> [Located Token] -> [Located Token]
layout Bool
isMod [Located Token]
ts0
| let t :: Located Token
t = [Located Token] -> Located Token
forall a. [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))
, Bool
isMod Bool -> Bool -> Bool
&& Token -> TokenT
tokenType (Located Token -> Token
forall a. Located a -> a
thing Located Token
t) TokenT -> TokenT -> Bool
forall a. Eq a => a -> a -> Bool
/= TokenKW -> TokenT
KW TokenKW
KW_module =
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
go :: [Block] -> Int -> Bool -> [Located Token] -> [Located Token]
go [Block]
stack Int
lastVirt Bool
noVirtSep [Located Token]
tokens
| Position -> Int
col Position
curLoc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lastVirt =
[Located Token]
endImplictBlock
| Just (Virtual {}) <- Maybe Block
curBlock, TokenT -> Bool
endsLayout TokenT
curTokTy =
[Located Token]
endImplictBlock
| Just (Virtual {}) <- Maybe Block
curBlock
, Sym TokenSym
Comma <- TokenT
curTokTy
, Bool -> Bool
not ([()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ () | Explicit TokenT
_ <- [Block]
popStack ]) =
[Located Token]
endImplictBlock
| 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
| TokenT -> Bool
startsLayout TokenT
curTokTy = [Located Token]
startImplicitBlock
| 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
| 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
| 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
| TokenT
EOF <- TokenT
curTokTy =
[Located Token
curTok]
| 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
(curTok' : 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
a : 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. [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)
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 n <- [Block]
popStack ] of
Int
n : [Int]
_ -> Int
n
[Int]
_ -> Int
0
Just (Explicit 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
| Explicit TokenT
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
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> [Char]
$cshow :: Block -> [Char]
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show)
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
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
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
virt :: Range -> TokenV -> Located Token
virt :: Range -> TokenV -> Located Token
virt Range
rng TokenV
x = Located :: forall a. Range -> a -> Located a
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 :: forall a. Range -> a -> Located a
Located { srcRange :: Range
srcRange = Range
rng { to :: Position
to = Range -> Position
from Range
rng }, thing :: Token
thing = Token
t }
where
t :: Token
t = Token :: TokenT -> Text -> Token
Token { tokenType :: TokenT
tokenType = TokenErr -> TokenT
Err TokenErr
x, tokenText :: Text
tokenText = Text
"" }