如何解决使用 Free Monad 实现词法分析器
我正在考虑 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
预设在逆变位置,因此不可能(是吗?)为 Functor
创建有效的 Op
实例。我想出了一些其他想法,即对替代词法分析器的类型进行概括,所以 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
一起工作。但因此,以这种方式编写词法分析器/解析器是否有意义?
解决方法
作为使用自由 monad 时的一般规则,您不想为“monadic 控制”引入原语。例如,SEQUENCE
原语是不明智的,因为自由 monad 本身提供了排序。同样,CHOICE
原语也是不明智的,因为它应该由免费的
MonadPlus
。
现在,free
的现代版本中有 no free MonadPlus
,因为等效的功能由基于列表 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 跟随...无论如何,您现在可以编写如下内容:
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,String)]
parse = runStateT . runLex
main :: IO ()
main = do
let test = parse a_or_b
print $ test "abc"
print $ test "bca"
print $ test "cde"
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。