diff --git a/langfilter/Ebnf.hs b/langfilter/Ebnf.hs index 5a83209..6dc4450 100644 --- a/langfilter/Ebnf.hs +++ b/langfilter/Ebnf.hs @@ -14,19 +14,20 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NonEmpty data Rule = - Rule Text Def + Rule Text [Text] Def | RCom Text -- ^ @(* comment *)@ deriving (Eq, Show) data Def = - N Text -- ^ @nonterminal@ - | T Text -- ^ @\'terminal\'@ or @\"terminal\"@ - | S Text -- ^ @?special?@ - | Or (NonEmpty Def) -- ^ choice @a | b | c@ - | Seq (NonEmpty Def) -- ^ sequence @a, b, c@ - | Sub Def Def -- ^ difference @a - b@ - | Opt Def -- ^ opt @[a]@ - | Many Def -- ^ repetition @{a}@ - | Com Text -- ^ comment + N Text -- ^ @nonterminal@ + | T Text -- ^ @\'terminal\'@ or @\"terminal\"@ + | S Text -- ^ @?special?@ + | C Text (NonEmpty Def) -- ^ @param(X, Y)@ + | Or (NonEmpty Def) -- ^ choice @a | b | c@ + | Seq (NonEmpty Def) -- ^ sequence @a, b, c@ + | Sub Def Def -- ^ difference @a - b@ + | Opt Def -- ^ opt @[a]@ + | Many Def -- ^ repetition @{a}@ + | Com Text -- ^ comment deriving (Eq, Show) @@ -49,10 +50,16 @@ render rs = render1 :: Rule -> [Row] render1 (RCom txt) = - [Row mempty [Cell mempty AlignLeft (RowSpan 1) (ColSpan 3) [Plain [Str txt]]]] -render1 (Rule name def) = - row' [span "ebnf-nt" name] "=" d : map (row' [] "|") ds + [Row mempty [Cell mempty AlignLeft (RowSpan 1) (ColSpan 3) + [Plain [span "ebnf-com" txt]]]] +render1 (Rule name args def) = + row' lhs "=" d : map (row' [] "|") ds where + lhs = case args of + [] -> [span "ebnf-nt" name] + _ -> [span "ebnf-f" name, punc "("] ++ + intercalate [punc ";", Space] [[span "ebnf-nt" x] | x <- args] ++ + [punc ")"] d :| ds = splitOrs def splitOrs (Or ds) = ds splitOrs d = NonEmpty.singleton d @@ -77,6 +84,10 @@ renderDefAt p = \case N txt -> [span "ebnf-nt" txt] T txt -> [span "ebnf-t" txt] S txt -> [span "ebnf-s" txt] + C f xs -> + [span "ebnf-f" f, punc "("] ++ + intercalate [punc ";", Space] (renderDefAt OUTER <$> NonEmpty.toList xs) ++ + [punc ")"] Or ds -> renderParens (p > OR) $ intercalate [Space, punc "|", Space] $ renderDefAt OR <$> NonEmpty.toList ds Seq ds -> renderParens (p > SEQ) $ @@ -100,9 +111,14 @@ parse' = many rule rule :: P Rule rule = choice - [Rule <$> nt <* sym "=" <*> def <* sym ";", + [Rule <$> nt <*> lhsArgs <* sym "=" <*> def <* sym ";", RCom <$> comment] +lhsArgs :: P [Text] +lhsArgs = + sym "(" *> nt `sepBy1` sym ";" <* sym ")" + <|> pure [] + nt :: P Text nt = Text.unwords <$> some (word <* space) where word = Text.cons <$> first <*> takeWhileP Nothing isWordChar @@ -113,10 +129,10 @@ def :: P Def def = ors ors :: P Def -ors = list1 Or <$> seqs `sepBy1'` (sym "|") +ors = list1 Or <$> seqs `sepBy1'` sym "|" seqs :: P Def -seqs = list1 Seq <$> sub `sepBy1'` (sym ",") +seqs = list1 Seq <$> sub `sepBy1'` sym "," sepBy1' :: P a -> P z -> P (NonEmpty a) sepBy1' a b = NonEmpty.fromList <$> sepBy1 a b @@ -129,12 +145,18 @@ sub = do adef :: P Def adef = choice $ - [N <$> nt, T <$> term, S <$> special, + [call, T <$> term, S <$> special, Com <$> comment, bracketed id '(' ')', bracketed Opt '[' ']', bracketed Many '{' '}'] +call :: P Def +call = do + f <- nt + args <- optional $ sym "(" *> def `sepBy1` (sym ";") <* sym ")" + pure $ maybe (N f) (C f . NonEmpty.fromList) args + term :: P Text term = choice [str '\'', str '"'] @@ -147,7 +169,7 @@ str c = lexeme $ between (char c) (char c) (takeWhileP Nothing (/= c)) comment :: P Text comment = do try (string_ "(*"); go ["(*"] 1 where go :: [Text] -> Int -> P Text - go acc 0 = pure $ mconcat $ reverse acc + go acc 0 = mconcat (reverse acc) <$ space go acc i = choice [fragment (string "(*") (+ 1) acc i, fragment (string "*)") (subtract 1) acc i, @@ -171,7 +193,7 @@ char' :: Char -> P Char char' c = lexeme $ char c lexeme :: P a -> P a -lexeme p = p <* space +lexeme p = try $ p <* space optMaybe :: P a -> P (Maybe a) optMaybe = option Nothing . fmap Just