Add GNUmakefile.

[haskell/symantic.git] / symantic-grammar / Language / Symantic / Grammar / ContextFree.hs

diff --git a/symantic-grammar/Language/Symantic/Grammar/ContextFree.hs b/symantic-grammar/Language/Symantic/Grammar/ContextFree.hs
index 0153405ca6fc57f45f578aa3a573236ec058afc8..5e918da1b29efec369fbb3c87c6aeb0a136032f8 100644 (file)
--- a/symantic-grammar/Language/Symantic/Grammar/ContextFree.hs
+++ b/symantic-grammar/Language/Symantic/Grammar/ContextFree.hs
@@ -16,8 +16,9 @@ import Language.Symantic.Grammar.Regular
 -- | Context-free grammar.
 newtype CF g a = CF { unCF :: g a }
  deriving (IsString, Functor, Gram_Terminal, Applicative, App)
-deriving instance Alter g => Alter (CF g)
-deriving instance Alt g => Alt (CF g)
+deriving instance Alter     g => Alter     (CF g)
+deriving instance Alt       g => Alt       (CF g)
+deriving instance Try       g => Try       (CF g)
 deriving instance Gram_Rule g => Gram_Rule (CF g)
 deriving instance Gram_RegL g => Gram_RegL (CF g)
 deriving instance Gram_RegR g => Gram_RegR (CF g)
@@ -68,15 +69,21 @@ class (Alter g, Applicative g) => Alt g where
        skipMany = void . many
        --manyTill :: g a -> g end -> g [a]
        --manyTill g end = go where go = ([] <$ end) <|> ((:) <$> g <*> go)
-       inside :: (a -> b) -> CF g begin -> CF g a -> CF g end -> CF g b -> CF g b
-       inside f begin i end n =
-               (f <$ begin <*> i <* end) <+> n
+       inside
+        :: (in_ -> next)
+        -> CF g begin
+        -> CF g in_
+        -> CF g end
+        -> CF g next
+        -> CF g next
+       inside f begin in_ end next =
+               (f <$ begin <*> in_ <* end) <+> next
 deriving instance Alt RuleDef
 instance Alt EBNF where
        many (EBNF g) = EBNF $ \rm _po -> "{" <> g rm (op, L) <> "}"  where op = infixN0
        some (EBNF g) = EBNF $ \rm _po -> "{" <> g rm (op, L) <> "}-" where op = infixN0
        option _x (EBNF g) = EBNF $ \rm _po ->
-               "[" <> g rm (op, L) <> "]"  where op = infixN0
+               "[" <> g rm (op, L) <> "]" where op = infixN0
 
 -- ** Class 'App'
 class Applicative g => App g where
@@ -105,14 +112,14 @@ class
  , Gram_Terminal g
  ) => Gram_Lexer g where
        commentable :: g () -> g () -> g () -> g ()
-       commentable = rule3 "commentable" $ \g line block ->
-               skipMany $ choice [g, line, block]
+       commentable = rule3 "commentable" $ \space line block ->
+               skipMany $ choice [space, line, block]
        comment_line :: CF g String -> CF g String
        comment_line prefix = rule "comment_line" $
                prefix *> many (any `minus` (void (char '\n') <+> eoi))
        comment_block :: CF g String -> Reg lr g String -> CF g String
-       comment_block start end = rule "comment_block" $
-               start *> many (any `minus` void end)
+       comment_block begin end = rule "comment_block" $
+               begin *> many (any `minus` end) <* cf_of_Reg end
        lexeme :: CF g a -> CF g a
        lexeme = rule1 "lexeme" $ \g ->
                g <* commentable
@@ -122,8 +129,8 @@ class
        parens :: CF g a -> CF g a
        parens = rule1 "parens" $
                between
-                (lexeme $ string "(")
-                (lexeme $ string ")")
+                (lexeme $ char '(')
+                (lexeme $ char ')')
        symbol :: String -> CF g String
        symbol = lexeme . string
 deriving instance Gram_Lexer g => Gram_Lexer (CF g)
@@ -134,8 +141,8 @@ gram_lexer :: forall g. (Gram_Lexer g, Gram_RuleDef g) => [CF g ()]
 gram_lexer =
  [ void $ commentable (void $ rule_arg "space") (void $ rule_arg "line") (void $ rule_arg "block")
  , void $ comment_line (rule_arg "prefix")
- , void $ comment_block (rule_arg "start") (rule_arg "end" :: RegL g String)
+ , void $ comment_block (rule_arg "begin") (rule_arg "end" :: RegL g String)
  , void $ lexeme (rule_arg "g")
  , void $ parens (rule_arg "g")
- , void $ inside id (rule_arg "begin") (rule_arg "i") (rule_arg "end") (rule_arg "next")
+ , void $ inside id (rule_arg "begin") (rule_arg "in") (rule_arg "end") (rule_arg "next")
  ]