这与解析问题非常相似,所以让我们借鉴解析器单子的提示:
match
应该返回解析的所有可能继续
- 如果匹配失败,它应该返回空列表
- 当前的赋值集将是必须在计算中传递的状态
为了看清我们的方向,假设我们有这个神奇的单子。 尝试将“abba”与字符串匹配将如下所示:
matchAbba = do
var 'a'
var 'b'
var 'b'
var 'a'
return () -- or whatever you want to return
test = runMatch matchAbba "redbluebluered"
原来这个monad是基于List monad的State monad。List monad提供了回溯功能,而State monad则负责携带当前的分配和输入。
下面是代码:
import Data.List
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans
import Data.Maybe
import qualified Data.Map as M
import Data.Monoid
type Assigns = M.Map Char String
splits xs = tail $ zip (inits xs) (tails xs)
var p = do
(assigns,input) <- get
guard $ (not . null) input
case M.lookup p assigns of
Nothing -> do (a,b) <- lift $ splits input
let assigns' = M.insert p a assigns
put (assigns', b)
return a
Just t -> do guard $ isPrefixOf t input
let inp' = drop (length t) input
put (assigns, inp')
return t
matchAbba :: StateT (Assigns, String) [] Assigns
matchAbba = do
var 'a'
var 'b'
var 'b'
var 'a'
(assigns,_) <- get
return assigns
test1 = evalStateT matchAbba (M.empty, "xyyx")
test2 = evalStateT matchAbba (M.empty, "xyy")
test3 = evalStateT matchAbba (M.empty, "redbluebluered")
matches :: String -> String -> [Assigns]
matches pattern input = evalStateT monad (M.empty,input)
where monad :: StateT (Assigns, String) [] Assigns
monad = do sequence $ map var pattern
(assigns,_) <- get
return assigns
比如尝试以下操作:
matches "ab" "xyz"
还有一件需要指出的事情是,将类似于"abba"的字符串转换为单子值do var'a'; var'b'; var 'b'; var 'a'
的代码非常简单:
sequence $ map var "abba"
更新:正如 @Sassa NF 指出的那样,为了匹配输入的结尾,您需要定义:
matchEnd :: StateT (Assigns,String) [] ()
matchEnd = do
(assigns,input) <- get
guard $ null input
然后将其插入到单子中:
monad = do sequence $ map var pattern
matchEnd
(assigns,_) <- get
return assigns
(assigns, r) <- get; guard $ r == []; return assigns
。 - Sassa NFsequence . map f
就是mapM f
。 - Cactus