module BNFC.Backend.Haskell.CFtoLayout where
import Data.Maybe ( fromMaybe )
import BNFC.CF
import BNFC.Options ( TokenText )
import BNFC.PrettyPrint
import BNFC.Utils ( caseMaybe, for, whenJust )
data TokSymbol = TokSymbol String Int
deriving Int -> TokSymbol -> ShowS
[TokSymbol] -> ShowS
TokSymbol -> [Char]
(Int -> TokSymbol -> ShowS)
-> (TokSymbol -> [Char])
-> ([TokSymbol] -> ShowS)
-> Show TokSymbol
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TokSymbol] -> ShowS
$cshowList :: [TokSymbol] -> ShowS
show :: TokSymbol -> [Char]
$cshow :: TokSymbol -> [Char]
showsPrec :: Int -> TokSymbol -> ShowS
$cshowsPrec :: Int -> TokSymbol -> ShowS
Show
data LayoutDelimiters = LayoutDelimiters TokSymbol (Maybe TokSymbol) (Maybe TokSymbol)
deriving Int -> LayoutDelimiters -> ShowS
[LayoutDelimiters] -> ShowS
LayoutDelimiters -> [Char]
(Int -> LayoutDelimiters -> ShowS)
-> (LayoutDelimiters -> [Char])
-> ([LayoutDelimiters] -> ShowS)
-> Show LayoutDelimiters
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LayoutDelimiters] -> ShowS
$cshowList :: [LayoutDelimiters] -> ShowS
show :: LayoutDelimiters -> [Char]
$cshow :: LayoutDelimiters -> [Char]
showsPrec :: Int -> LayoutDelimiters -> ShowS
$cshowsPrec :: Int -> LayoutDelimiters -> ShowS
Show
cf2Layout :: String -> String -> CF -> String
cf2Layout :: [Char] -> [Char] -> CF -> [Char]
cf2Layout [Char]
layName [Char]
lexName CF
cf = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ [Char]
"-- Generated by the BNF Converter"
, [Char]
""
, [Char]
"{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}"
, [Char]
""
, [Char]
"{-# LANGUAGE LambdaCase #-}"
, [Char]
"{-# LANGUAGE PatternGuards #-}"
, [Char]
"{-# LANGUAGE OverloadedStrings #-}"
, [Char]
""
, [Char]
"module " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
layName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" where"
, [Char]
""
, [Char]
"import Prelude"
, [Char]
"import Data.Maybe ( fromMaybe, listToMaybe, mapMaybe )"
, [Char]
"import qualified Data.List as List"
, [Char]
""
, [Char]
"import " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
lexName
, [Char]
" ( Posn(..), Tok(..), Token(..), TokSymbol(..)"
, [Char]
" , prToken, tokenLineCol, tokenPos, tokenPosn"
, [Char]
" )"
, [Char]
""
, [Char]
"-- local parameters"
, [Char]
""
, [Char]
"data LayoutDelimiters"
, [Char]
" = LayoutDelimiters"
, [Char]
" { delimSep :: TokSymbol"
, [Char]
" , delimOpen :: Maybe TokSymbol -- ^ Nothing for toplevel layout."
, [Char]
" , delimClose :: Maybe TokSymbol -- ^ Nothing for toplevel layout."
, [Char]
" }"
, [Char]
""
, [Char]
"layoutWords :: [(TokSymbol, LayoutDelimiters)]"
, Doc -> [Char]
render (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc -> Doc -> Doc -> [Doc] -> Doc
prettyList Int
2 Doc
"layoutWords =" Doc
"[" Doc
"]" Doc
"," ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
[(TokSymbol, LayoutDelimiters)]
-> ((TokSymbol, LayoutDelimiters) -> Doc) -> [Doc]
forall a b. [a] -> (a -> b) -> [b]
for [(TokSymbol, LayoutDelimiters)]
lay (((TokSymbol, LayoutDelimiters) -> Doc) -> [Doc])
-> ((TokSymbol, LayoutDelimiters) -> Doc) -> [Doc]
forall a b. (a -> b) -> a -> b
$ \ (TokSymbol
kw, LayoutDelimiters
delims) ->
Int -> Doc -> Doc -> Doc -> Doc -> [Doc] -> Doc
prettyList Int
0 Doc
empty Doc
"(" Doc
")" Doc
"," ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
([Char] -> Doc) -> [[Char]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc
text [ TokSymbol -> [Char]
forall a. Show a => a -> [Char]
show TokSymbol
kw, LayoutDelimiters -> [Char]
forall a. Show a => a -> [Char]
show LayoutDelimiters
delims ]
, [Char]
""
, [Char]
"layoutStopWords :: [TokSymbol]"
, Doc -> [Char]
render (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc -> Doc -> Doc -> [Doc] -> Doc
prettyList Int
2 Doc
"layoutStopWords =" Doc
"[" Doc
"]" Doc
"," ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (TokSymbol -> Doc) -> [TokSymbol] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Doc
text ([Char] -> Doc) -> (TokSymbol -> [Char]) -> TokSymbol -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokSymbol -> [Char]
forall a. Show a => a -> [Char]
show) [TokSymbol]
stop
, [Char]
""
, [Char]
"-- layout separators"
, [Char]
""
, [Char]
"layoutOpen, layoutClose, layoutSep :: [TokSymbol]"
, [Char]
"layoutOpen = List.nub $ mapMaybe (delimOpen . snd) layoutWords"
, [Char]
"layoutClose = List.nub $ mapMaybe (delimClose . snd) layoutWords"
, [[Char]] -> [Char]
unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ [Char]
"layoutSep = List.nub $" ]
, Maybe TokSymbol -> (TokSymbol -> [[Char]]) -> [[Char]]
forall m a. Monoid m => Maybe a -> (a -> m) -> m
whenJust Maybe TokSymbol
top ((TokSymbol -> [[Char]]) -> [[Char]])
-> (TokSymbol -> [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ \ TokSymbol
sep -> [ TokSymbol -> [Char]
forall a. Show a => a -> [Char]
show TokSymbol
sep, [Char]
":" ]
, [ [Char]
"map (delimSep . snd) layoutWords" ]
]
, [Char]
""
, [Char]
"-- | Replace layout syntax with explicit layout tokens."
, [Char]
"resolveLayout :: Bool -- ^ Whether to use top-level layout."
, [Char]
" -> [Token] -> [Token]"
]
, Maybe LayoutDelimiters
-> [[Char]] -> (LayoutDelimiters -> [[Char]]) -> [[Char]]
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe LayoutDelimiters
topDelim
[ [Char]
"resolveLayout _topLayout = res Nothing [Explicit]"
, [Char]
" where"
]
(\ LayoutDelimiters
delim ->
[ [Char]
"resolveLayout topLayout ="
, [Char]
" res Nothing [if topLayout then Implicit topDelim Definitive 1 else Explicit]"
, [Char]
" where"
, [Char]
" topDelim :: LayoutDelimiters"
, [Char]
" topDelim = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ LayoutDelimiters -> [Char]
forall a. Show a => a -> [Char]
show LayoutDelimiters
delim
])
, [ [Char]
""
, [Char]
" res :: Maybe Token -- ^ The previous token, if any."
, [Char]
" -> [Block] -- ^ A stack of layout blocks."
, [Char]
" -> [Token] -> [Token]"
, [Char]
""
, [Char]
" -- The stack should never be empty."
, [Char]
" res _ [] ts = error $ \"Layout error: stack empty. Tokens: \" ++ show ts"
, [Char]
""
, [Char]
" -- Handling explicit blocks:"
, [Char]
" res _ st (t0 : ts)"
, [Char]
" -- We found an open brace in the input,"
, [Char]
" -- put an explicit layout block on the stack."
, [Char]
" -- This is done even if there was no layout word,"
, [Char]
" -- to keep opening and closing braces."
, [Char]
" | isLayoutOpen t0"
, [Char]
" = t0 : res (Just t0) (Explicit : st) ts"
, [Char]
""
, [Char]
" -- If we encounter a closing brace, exit the first explicit layout block."
, [Char]
" | isLayoutClose t0"
, [Char]
" , let (imps, rest) = span isImplicit st"
, [Char]
" , let st' = drop 1 rest"
, [Char]
" = if null st'"
, [Char]
" then error $ unwords"
, [Char]
" [ \"Layout error: Found\", prToken t0, \"at\" , tokenPos [t0]"
, [Char]
" , \"without an explicit layout block.\""
, [Char]
" ]"
, [Char]
" else map (closingToken (tokenPosn t0)) imps ++ t0 : res (Just t0) st' ts"
, [Char]
""
, [Char]
" -- Ending or confirming implicit layout blocks:"
, [Char]
" res pt (b@(Implicit delim status col) : bs) (t0 : ts)"
, [Char]
""
, [Char]
" -- End of implicit block by a layout stop word."
, [Char]
" | isStop t0"
, [Char]
" -- Exit the current block and all implicit blocks"
, [Char]
" -- more indented than the current token."
, [Char]
" , let (ebs, st') = span ((column t0 <) . indentation) bs"
, [Char]
" -- Insert block-closers after the previous token."
, [Char]
" = map (closingToken (afterPrev pt)) (b : ebs) ++ t0 : res (Just t0) st' ts"
, [Char]
""
, [Char]
" -- End of an implicit layout block by dedentation."
, [Char]
" | newLine pt t0"
, [Char]
" , column t0 < col"
, [Char]
" -- Insert a block closer after the previous token."
, [Char]
" -- Repeat, with the current block removed from the stack."
, [Char]
" , let c = closingToken (afterPrev pt) b"
, [Char]
" = c : res (Just c) bs (t0 : ts)"
, [Char]
""
, [Char]
" -- If we are on a newline, confirm the last tentative blocks."
, [Char]
" | newLine pt t0, Tentative{} <- status"
, [Char]
" = res pt (Implicit delim Definitive col : confirm col bs) (t0 : ts)"
, [Char]
""
, [Char]
" -- Starting and processing implicit layout blocks:"
, [Char]
" res pt st (t0 : ts)"
, [Char]
" -- Start a new layout block if the first token is a layout word."
, [Char]
" | Just delim@(LayoutDelimiters _ mopen _) <- isLayout t0"
, [Char]
" = maybeInsertSeparator pt t0 st $"
, [Char]
" case ts of"
, [Char]
" -- Explicit layout, just move on. The next step"
, [Char]
" -- will push an explicit layout block."
, [Char]
" t1 : _ | isLayoutOpen t1 ->"
, [Char]
" t0 : res (Just t0) st ts"
, [Char]
" -- Otherwise, insert an open brace after the layout word"
, [Char]
" _ ->"
, [Char]
" t0 : b : res (Just b) (addImplicit delim (tokenPosn t0) pos st) ts"
, [Char]
" where"
, [Char]
" b = sToken (nextPos t0) $ fromMaybe undefined mopen"
, [Char]
" -- At the end of the file, the start column does not matter."
, [Char]
" -- So if there is no token t1 after t0, just use the position of t0."
, [Char]
" pos = tokenPosn $ fromMaybe t0 $ listToMaybe ts"
, [Char]
""
, [Char]
" -- Insert separator if necessary."
, [Char]
" | otherwise"
, [Char]
" = maybeInsertSeparator pt t0 st $"
, [Char]
" t0 : res (Just t0) st ts"
, [Char]
""
, [Char]
" -- At EOF: skip explicit blocks."
, [Char]
" res (Just _) [Explicit] [] = []"
, [Char]
" res (Just t) (Explicit : bs) [] = res (Just t) bs []"
, [Char]
""
, [Char]
" -- If we are using top-level layout, insert a semicolon after"
, [Char]
" -- the last token, if there isn't one already"
, [Char]
" res (Just t) [Implicit (LayoutDelimiters sep _ _) _ _] []"
, [Char]
" | isLayoutSep t = []"
, [Char]
" | otherwise = [sToken (nextPos t) sep]"
, [Char]
""
, [Char]
" -- At EOF in an implicit, non-top-level block: close the block"
, [Char]
" res (Just t) (Implicit (LayoutDelimiters _ _ (Just close)) _ _ : bs) []"
, [Char]
" = b : res (Just b) bs []"
, [Char]
" where b = sToken (nextPos t) close"
, [Char]
""
, [Char]
" -- This should only happen if the input is empty."
, [Char]
" res Nothing _st []"
, [Char]
" = []"
, [Char]
""
, [Char]
" -- | Insert a 'layoutSep' if we are on a new line on the current"
, [Char]
" -- implicit layout column."
, [Char]
" maybeInsertSeparator"
, [Char]
" :: Maybe Token -- ^ The previous token."
, [Char]
" -> Token -- ^ The current token."
, [Char]
" -> [Block] -- ^ The layout stack."
, [Char]
" -> [Token] -- ^ The result token stream."
, [Char]
" -> [Token] -- ^ Maybe prepended with a 'layoutSep'."
, [Char]
" maybeInsertSeparator pt t0 = \\case"
, [Char]
" Implicit (LayoutDelimiters sep _ _) _ n : _"
, [Char]
" | newLine pt t0"
, [Char]
" , column t0 == n"
, [Char]
" , maybe False (not . isTokenIn (layoutSep ++ layoutOpen)) pt"
, [Char]
" -- Insert a semicolon after the previous token"
, [Char]
" -- unless we are the beginning of the file,"
, [Char]
" -- or the previous token is a semicolon or open brace."
, [Char]
" -> (sToken (afterPrev pt) sep :)"
, [Char]
" _ -> id"
, [Char]
""
, [Char]
" closingToken :: Position -> Block -> Token"
, [Char]
" closingToken pos = sToken pos . \\case"
, [Char]
" Implicit (LayoutDelimiters _ _ (Just sy)) _ _ -> sy"
, [Char]
""
, [Char]
"type Position = Posn"
, [Char]
"type Line = Int"
, [Char]
"type Column = Int"
, [Char]
""
, [Char]
"-- | Entry of the layout stack."
, [Char]
"data Block"
, [Char]
" = Implicit LayoutDelimiters Status Column"
, [Char]
" -- ^ An implicit layout block with its start column."
, [Char]
" | Explicit"
, [Char]
""
, [Char]
"-- | Get current indentation. 0 if we are in an explicit block."
, [Char]
"indentation :: Block -> Column"
, [Char]
"indentation = \\case"
, [Char]
" Implicit _ _ n -> n"
, [Char]
" Explicit -> 0"
, [Char]
""
, [Char]
"-- | Check if s block is implicit."
, [Char]
"isImplicit :: Block -> Bool"
, [Char]
"isImplicit = \\case"
, [Char]
" Implicit{} -> True"
, [Char]
" Explicit{} -> False"
, [Char]
""
, [Char]
"data Status"
, [Char]
" = Tentative -- ^ A layout column that has not been confirmed by a line break"
, [Char]
" | Definitive -- ^ A layout column that has been confirmed by a line break."
, [Char]
""
, [Char]
"-- | Add a new implicit layout block."
, [Char]
"addImplicit"
, [Char]
" :: LayoutDelimiters -- ^ Delimiters of the new block."
, [Char]
" -> Position -- ^ Position of the layout keyword."
, [Char]
" -> Position -- ^ Position of the token following the layout keword."
, [Char]
" -> [Block]"
, [Char]
" -> [Block]"
, [Char]
"addImplicit delim (Pn _ l0 _) (Pn _ l1 c1) st"
, [Char]
" -- Case: layout keyword was at the end of the line:"
, [Char]
" -- New implicit block is definitive."
, [Char]
" | l1 > l0 = Implicit delim Definitive (col st') : st'"
, [Char]
" -- Case: staying on the same line:"
, [Char]
" -- New implicit block is tentative."
, [Char]
" | otherwise = Implicit delim Tentative (col st) : st"
, [Char]
" where"
, [Char]
" st' = confirm c1 st"
, [Char]
" col bs = max c1 $ 1 + definiteIndentation bs"
, [Char]
" -- The column of the next token determines the starting column"
, [Char]
" -- of the implicit layout block."
, [Char]
" -- However, the next block needs to be strictly more indented"
, [Char]
" -- than the previous block."
, [Char]
""
, [Char]
" -- | Get the current confirmed indentation level."
, [Char]
" definiteIndentation :: [Block] -> Int"
, [Char]
" definiteIndentation bs ="
, [Char]
" case dropWhile isTentative bs of"
, [Char]
" Implicit _ Definitive n : _ -> n"
, [Char]
" _ -> 0 -- 0 enables a first unindented block, see 194_layout/good05.in"
, [Char]
""
, [Char]
" isTentative :: Block -> Bool"
, [Char]
" isTentative = \\case"
, [Char]
" Implicit _ Tentative _ -> True"
, [Char]
" _ -> False"
, [Char]
""
, [Char]
"-- | Confirm tentative blocks that are not more indented than @col@."
, [Char]
"confirm :: Column -> [Block] -> [Block]"
, [Char]
"confirm c0 = loop"
, [Char]
" where"
, [Char]
" loop = \\case"
, [Char]
" Implicit delim Tentative c : bs"
, [Char]
" | c <= c0 -> Implicit delim Definitive c : loop bs"
, [Char]
" bs -> bs"
, [Char]
""
, [Char]
"-- | Get the position immediately to the right of the given token."
, [Char]
"-- If no token is given, gets the first position in the file."
, [Char]
"afterPrev :: Maybe Token -> Position"
, [Char]
"afterPrev = maybe (Pn 0 1 1) nextPos"
, [Char]
""
, [Char]
"-- | Get the position immediately to the right of the given token."
, [Char]
"nextPos :: Token -> Position"
, [Char]
"nextPos t = Pn (g + s) l (c + s + 1)"
, [Char]
" where"
, [Char]
" Pn g l c = tokenPosn t"
, [Char]
" s = tokenLength t"
, [Char]
""
, [Char]
"-- | Get the number of characters in the token."
, [Char]
"tokenLength :: Token -> Int"
, [Char]
"tokenLength = length . prToken"
, [Char]
""
, [Char]
"-- | Create a position symbol token."
, [Char]
"sToken :: Position -> TokSymbol -> Token"
, [Char]
"sToken p t = PT p $ TK t"
, [Char]
""
, [Char]
"-- | Get the line number of a token."
, [Char]
"line :: Token -> Line"
, [Char]
"line = fst . tokenLineCol"
, [Char]
""
, [Char]
"-- | Get the column number of a token."
, [Char]
"column :: Token -> Column"
, [Char]
"column = snd . tokenLineCol"
, [Char]
""
, [Char]
"-- | Is the following token on a new line?"
, [Char]
"newLine :: Maybe Token -> Token -> Bool"
, [Char]
"newLine pt t0 = maybe True ((line t0 >) . line) pt"
, [Char]
""
, [Char]
"-- | Check if a word is a layout start token."
, [Char]
"isLayout :: Token -> Maybe LayoutDelimiters"
, [Char]
"isLayout = \\case"
, [Char]
" PT _ (TK t) -> lookup t layoutWords"
, [Char]
" _ -> Nothing"
, [Char]
""
, [Char]
"-- | Check if a token is one of the given symbols."
, [Char]
"isTokenIn :: [TokSymbol] -> Token -> Bool"
, [Char]
"isTokenIn ts = \\case"
, [Char]
" PT _ (TK t) -> t `elem` ts"
, [Char]
" _ -> False"
, [Char]
""
, [Char]
"-- | Check if a token is a layout stop token."
, [Char]
"isStop :: Token -> Bool"
, [Char]
"isStop = isTokenIn layoutStopWords"
, [Char]
""
, [Char]
"-- | Check if a token is the layout open token."
, [Char]
"isLayoutOpen :: Token -> Bool"
, [Char]
"isLayoutOpen = isTokenIn layoutOpen"
, [Char]
""
, [Char]
"-- | Check if a token is the layout separator token."
, [Char]
"isLayoutSep :: Token -> Bool"
, [Char]
"isLayoutSep = isTokenIn layoutSep"
, [Char]
""
, [Char]
"-- | Check if a token is the layout close token."
, [Char]
"isLayoutClose :: Token -> Bool"
, [Char]
"isLayoutClose = isTokenIn layoutClose"
]
]
where
(Maybe [Char]
top0, LayoutKeyWords
lay0, [[Char]]
stop0) = CF -> (Maybe [Char], LayoutKeyWords, [[Char]])
layoutPragmas CF
cf
top :: Maybe TokSymbol
top = ([Char] -> TokSymbol) -> Maybe [Char] -> Maybe TokSymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> TokSymbol
mkTokSymbol Maybe [Char]
top0
topDelim :: Maybe LayoutDelimiters
topDelim = (TokSymbol -> LayoutDelimiters)
-> Maybe TokSymbol -> Maybe LayoutDelimiters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ TokSymbol
sep -> TokSymbol -> Maybe TokSymbol -> Maybe TokSymbol -> LayoutDelimiters
LayoutDelimiters TokSymbol
sep Maybe TokSymbol
forall a. Maybe a
Nothing Maybe TokSymbol
forall a. Maybe a
Nothing) Maybe TokSymbol
top
lay :: [(TokSymbol, LayoutDelimiters)]
lay = LayoutKeyWords
-> (([Char], Delimiters) -> (TokSymbol, LayoutDelimiters))
-> [(TokSymbol, LayoutDelimiters)]
forall a b. [a] -> (a -> b) -> [b]
for LayoutKeyWords
lay0 ((([Char], Delimiters) -> (TokSymbol, LayoutDelimiters))
-> [(TokSymbol, LayoutDelimiters)])
-> (([Char], Delimiters) -> (TokSymbol, LayoutDelimiters))
-> [(TokSymbol, LayoutDelimiters)]
forall a b. (a -> b) -> a -> b
$ \ ([Char]
kw, Delimiters [Char]
sep [Char]
open [Char]
close) ->
( [Char] -> TokSymbol
mkTokSymbol [Char]
kw
, TokSymbol -> Maybe TokSymbol -> Maybe TokSymbol -> LayoutDelimiters
LayoutDelimiters ([Char] -> TokSymbol
mkTokSymbol [Char]
sep) (TokSymbol -> Maybe TokSymbol
forall a. a -> Maybe a
Just (TokSymbol -> Maybe TokSymbol) -> TokSymbol -> Maybe TokSymbol
forall a b. (a -> b) -> a -> b
$ [Char] -> TokSymbol
mkTokSymbol [Char]
open) (TokSymbol -> Maybe TokSymbol
forall a. a -> Maybe a
Just (TokSymbol -> Maybe TokSymbol) -> TokSymbol -> Maybe TokSymbol
forall a b. (a -> b) -> a -> b
$ [Char] -> TokSymbol
mkTokSymbol [Char]
close)
)
stop :: [TokSymbol]
stop = ([Char] -> TokSymbol) -> [[Char]] -> [TokSymbol]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> TokSymbol
mkTokSymbol [[Char]]
stop0
mkTokSymbol :: String -> TokSymbol
mkTokSymbol :: [Char] -> TokSymbol
mkTokSymbol [Char]
x = [Char] -> Int -> TokSymbol
TokSymbol [Char]
x Int
n
where
n :: Int
n = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ [Char] -> [([Char], Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
x [([Char], Int)]
tokens
tokens :: [([Char], Int)]
tokens = CF -> [([Char], Int)]
forall f. CFG f -> [([Char], Int)]
cfTokens CF
cf