使用 Free Monad 实现词法分析器

Question

我正在考虑 free monad 的一个用例，它是一个简单的词法分析 DSL。到目前为止，我想出了一些原始操作：

data LexF r where
  POP  :: (Char -> r) -> LexF r
  PEEK :: (Char -> r) -> LexF r
  FAIL :: LexF r
  ...

instance Functor LexF where
  ...

type Lex = Free LexF

我遇到的问题是我想要一个 CHOICE 原语来描述尝试执行一个解析器并在失败时回退到另一个解析器的操作。像 CHOICE :: LexF r -> LexF r -> (r -> r) -> LexF r...

...楼梯从这里开始。由于 r 预设在逆变位置，因此不可能（是吗？）为 Op 创建有效的 Functor 实例。我想出了一些其他的想法，即概括替代词法分析器的类型，所以 CHOICE :: LexF a -> LexF a -> (a -> r) -> LexF r – 现在它作为 Functor 工作，尽管问题在于将其解冻为 Free ，就像我通常用 liftF:

做的那样

choice :: OpF a -> OpF a -> OpF a
choice c1 c2 = liftF $ CHOICE _ _ id  -- how to fill the holes :: Op a ?

我真的运行没主意了。这当然可以推广到几乎所有其他组合器，我只是发现 CHOICE 是一个很好的最小案例。如何应对？我很高兴听到这个例子完全坏了，它不能像我想的那样与 Free 一起工作。但是因此，以这种方式编写 lexers/parsers 是否有意义？

Answer 1

作为使用自由 monad 的一般规则，您不想为“monadic 控制”引入原语。例如，SEQUENCE 原语是不明智的，因为免费的 monad 本身提供了排序。同样，不建议使用 CHOICE 原语，因为这应该由免费提供 MonadPlus.

现在，free 的现代版本中有，因为等效的功能由基于列表的 monad 的免费 monad 转换器提供，即 FreeT f []。所以，您可能想要定义：

data LexF r where
  POP  :: (Char -> r) -> LexF r
  PEEK :: (Char -> r) -> LexF r
deriving instance Functor LexF
type Lex = FreeT LexF []

pop :: (Char -> a) -> Lex a
pop f = liftF $ POP f

peek :: (Char -> a) -> Lex a
peek f = liftF $ PEEK f

但没有 FAIL 或 CHOICE 原语。

如果您要定义 fail 和 choice 组合器，它们将通过使用变换器魔法的列表基 monad 来定义：

fail :: Lex a
fail = empty

choice :: Lex a -> Lex a -> Lex a
choice = (<|>)

虽然没有真正的理由来定义这些。

SPOILERS follow...无论如何，你现在可以这样写：

anyChar :: Lex Char
anyChar = pop id

char :: Char -> Lex Char
char c = do
  c' <- anyChar
  guard $ c == c'
  return c'

a_or_b :: Lex Char
a_or_b = char 'a' <|> char 'b'

为您的 monad 基元提供解释器，在本例中将它们解释为 StateT String [] AKA String -> [(a,String)] monad:

type Parser = StateT String []
runLex :: Lex a -> Parser a
runLex = iterTM go
  where go :: LexF (Parser a) -> Parser a
        go (POP f) = StateT pop' >>= f
          where pop' (c:cs) = [(c,cs)]
                pop' _      = []
        go (PEEK f) = StateT peek' >>= f
          where peek' (c:cs) = [(c,c:cs)]
                peek' _      = []
parse :: Lex a -> String -> [(a, String)]
parse = runStateT . runLex

然后您可以：

main :: IO ()
main = do
  let test = parse a_or_b
  print $ test "abc"
  print $ test "bca"
  print $ test "cde"

完整示例：

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -Wall #-}

import Control.Monad.State
import Control.Applicative
import Control.Monad.Trans.Free

data LexF r where
  POP  :: (Char -> r) -> LexF r
  PEEK :: (Char -> r) -> LexF r
deriving instance Functor LexF
type Lex = FreeT LexF []

pop :: (Char -> a) -> Lex a
pop f = liftF $ POP f

peek :: (Char -> a) -> Lex a
peek f = liftF $ PEEK f

anyChar :: Lex Char
anyChar = pop id

char :: Char -> Lex Char
char c = do
  c' <- anyChar
  guard $ c == c'
  return c'

a_or_b :: Lex Char
a_or_b = char 'a' <|> char 'b'

type Parser = StateT String []
runLex :: Lex a -> Parser a
runLex = iterTM go
  where go :: LexF (Parser a) -> Parser a
        go (POP f) = StateT pop' >>= f
          where pop' (c:cs) = [(c,cs)]
                pop' _      = []
        go (PEEK f) = StateT peek' >>= f
          where peek' (c:cs) = [(c,c:cs)]
                peek' _      = []
parse :: Lex a -> String -> [(a, String)]
parse = runStateT . runLex

main :: IO ()
main = do
  let test = parse a_or_b
  print $ test "abc"
  print $ test "bca"
  print $ test "cde"

使用 Free Monad 实现词法分析器

Implementing a lexer using the Free Monad

monads

parsing

haskell

lexer

free-monad