如何在没有递归和副作用的情况下为相互递归的ADT编写解析器?

Mai*_*tor 6 recursion parsing haskell functional-programming

警告:传来长而复杂的问题.

有些人认为全功能编程是一个有价值的想法,因此找到了实现它的技术.注意,如何在没有递归和副作用的情况下为相互递归的ADT编写解析器?在这里,我将任何不强烈正常化的术语定义为"递归" .

我尝试过的:

请注意以下相互递归的ADT:

data Tree = Node Int [Tree]
tree = Node 10 [Node 20 [], Node 30 [], Node 40 []]
Run Code Online (Sandbox Code Playgroud)

值,, tree可以序列化为:

tree_serial = [0,10,0,0,20,1,0,0,30,1,0,0,40,1,1] :: [Int]
Run Code Online (Sandbox Code Playgroud)

为简单起见,使用int,这里0表示一个Node或一个Cons单元格的开头(取决于解析器的状态),1表示Nil,其余表示数据.我们可以使用副作用轻松地为它编写解析器:

var string = [0,10,0,0,20,1,0,0,30,1,0,0,40,1,1];

function parse(string){
    function getInt(){
        return string.shift();
    };
    function parseTree(){
        var chr = getInt();
        if (chr === 0)
            return ["Node",getInt(),parseList()];
    };
    function parseList(){
        var chr = getInt();
        if (chr === 0)
            return ["Cons",parseTree(),parseList()];
        if (chr === 1)
            return "Nil";
    };
    return parseTree();
};

console.log(JSON.stringify(parse(string)));
Run Code Online (Sandbox Code Playgroud)

这里getInt是副作用:它从字符串中获取下一个int.我们可以使用Parsec或类似方法轻松而优雅地将其转换为Haskell - 但为了更好地理解,我跳过了这些并定义了一个精简的解析器类型:

data Parser res = GetInt (Int -> Parser res) | Return res
runParser (GetInt fn) (c:cs) = runParser (fn c) cs
runParser (Return res) c     = res
Run Code Online (Sandbox Code Playgroud)

这类似于monadic解析器,除了更明确:

main = do
    let parsePair = (GetInt (\a -> (GetInt (\b -> Return (a,b)))))
    print $ runParser parsePair [1,2,3,4,5] 
Run Code Online (Sandbox Code Playgroud)

使用它,我们可以定义我们的解析器没有副作用:

data Tree = Node Int [Tree] deriving Show

parseTree = treeParser Return where
    treeParser = (\ cont -> 
        GetInt (\ _ ->  
            GetInt (\ tag -> 
                listParser (\ listParsingResult -> 
                    (cont (Node tag listParsingResult)))))) 
    listParser = (\ cont -> 
        GetInt (\ a -> 
            if a == 0 
                then treeParser (\x -> listParser (\y -> cont (x : y)))
                else cont []))

main = do
    let treeData = [0,10,0,0,20,1,0,0,30,1,0,0,40,1,1]
    print $ runParser parseTree treeData
Run Code Online (Sandbox Code Playgroud)

Node 10 [Node 20 [],Node 30 [],Node 40 []]正如预期的那样输出.请注意,这仍然使用递归,我不得不使用cont两个递归函数之间的控制传递.现在,我有两种策略可以摆脱递归:我知道:

1. Use folds.

2. Use church numbers for bounded recursion.
Run Code Online (Sandbox Code Playgroud)

在这里使用折叠显然是不可行的,因为没有可折叠的结构(我们正在构建它!).如果我们正在解析一个列表而不是一个树,那么使用教会数字将是完美的,因为它们的工作方式与Y-combinator完全相同,用于有界递归 - 并且,知道列表的长度,我们就可以编写toChurch listLength listParser init.但是,这种情况的问题是存在相互递归,并且使用哪个教会号码并不明显.我们有许多层列表和不可预测长度的树.实际上,如果我们使用一个足够大的教会号码,它可以在没有递归的情况下工作,但是会增加工作量.这是一个实际有用程序的最后一个例子,我无法在没有递归的情况下"正确"复制.可以吗?

为了完整起见,这是一个JavaScript程序,它解析该树而不递归,但使用虚构的教堂数字:

function runParser(f){return function(str){
    var a = f(str[0]);
    return a(str.slice(1));
}};
function Const(a){return function(b){return a}};
function toChurch(n){return (function(f){return (function(a){ 
    for (var i=0; i<n; ++i) 
        a  =  f(a); 
    return a; 
}) }) };
function parser(get){
    return toChurch(50)(function(rec){
        return function (res){
            return get(function(a){
                return [get(function(b){
                    return toChurch(50)(function(recl){
                        return function(res){
                            return get(function(a){
                                return [
                                    rec(function(a){
                                        return recl(function(b){
                                            return res(["Cons",a,b])
                                        })
                                    }),
                                    res("Nil")][a];
                            });
                        };
                    })(0)(function(x){return res(["Node",b,x])});
                })][a];
            });
        };
    })(0)(Const);
};
var string = [0,200,0,0,300,0,0,400,1,0,0,500,1,0,0,500,1,1,0,0,600,0,0,700,1,0,0,800,1,0,0,900,1,1,1];
console.log(JSON.stringify(parser(runParser)(string)));
Run Code Online (Sandbox Code Playgroud)

注意函数50内部的常量parser:它完全是任意的绑定.对于那些"完全符合"特定可解析价值的人,我不确定是否有"正确"的选择.

Dan*_*ner 4

tl;dr:对您的输入列表进行教会编码,并使用它来驱动您的递归。

列表的正确 Church 编码需要RankNTypes, 并且看起来有点像这样:

{-# LANGUAGE RankNTypes #-}

data List a = List { runList :: forall r. (a -> r -> r) -> r -> r }
instance Show a => Show (List a) where
    showsPrec n (List xs) = showsPrec n (xs (:) [])

nilVal :: List a
nilVal = List $ \cons nil -> nil

consVal :: a -> List a -> List a
consVal a (List as) = List $ \cons nil -> cons a (as cons nil)

-- handy for pattern-matching
uncons :: List a -> Maybe (a, List a)
uncons (List xs) = xs cons nil where
    cons x Nothing = Just (x, nilVal)
    cons x (Just (x', xs)) = Just (x, consVal x' xs)
    nil = Nothing
Run Code Online (Sandbox Code Playgroud)

现在我们只需要编写我们的解析器。我对解析理论真的很糟糕,所以我把一些糟糕的东西放在一起。也许对这个领域略知一二的人可以在这里给你一些更有原则性的建议。我来解析一下语法:

tree -> 0 N list
list -> 0 tree list | 1
Run Code Online (Sandbox Code Playgroud)

我的解析器状态将跟踪我们当前正在解析的“漏洞”。对于非终结符,我们实际上需要一堆孔。因此,端子孔具有以下形式之一:

* N list
0 * list
* tree list
*
Run Code Online (Sandbox Code Playgroud)

我们将折叠最后两个。请注意,这些漏洞之前都没有有趣的信息,因此我们不需要在THole. 非端子孔具有以下形式之一:

0 N *
0 * list
0 tree *
Run Code Online (Sandbox Code Playgroud)

在这种情况下,树形成规则中的空洞前面有一个我们稍后需要的数字,而列表形成规则中的第二种空洞前面有一棵我们需要保留的树,因此NTHole需要这些在构造函数中。因此:

data Tree = Node Int [Tree]
    deriving (Eq, Ord, Read, Show)

data THole
    = TreeT0
    | TreeT1
    | ListT
    deriving (Eq, Ord, Read, Show)

data NTHole
    = TreeNT Int
    | ListNT0
    | ListNT1 Tree
    deriving (Eq, Ord, Read, Show)
Run Code Online (Sandbox Code Playgroud)

我们当前的解析器状态将是我们当前所处的终端孔,以及随着规则减少而需要填充的非终端孔堆栈。

type RawState = (THole, List NTHole)
initRawState = (TreeT0, nilVal)
Run Code Online (Sandbox Code Playgroud)

...好吧,除了我们还有两个感兴趣的状态:完成列表和错误。

type State = Maybe (Either RawState Tree)
initState = Just (Left initRawState)
Run Code Online (Sandbox Code Playgroud)

现在我们可以编写一个步骤函数来获取良好的状态并处理它。同样,您可能需要一个解析器生成器工具来为您创建其中一个,但这种语言足够小,我可以手动完成。

stepRaw :: Int -> RawState -> State
stepRaw 0 (TreeT0, xs) = Just (Left (TreeT1, xs))
stepRaw n (TreeT1, xs) = Just (Left (ListT , consVal (TreeNT n) xs))
stepRaw 0 (ListT , xs) = Just (Left (TreeT0, consVal ListNT0    xs))
stepRaw 1 (ListT , xs) = fst (runList xs cons nil) [] where
    cons v (f, xs) = flip (,) (consVal v xs) $ case v of
        ListNT1 t -> \acc -> f (t:acc)
        TreeNT  n -> \acc -> let t = Node n acc in case uncons xs of
            Nothing -> Just (Right t)
            Just (ListNT0, xs) -> Just (Left (ListT, consVal (ListNT1 t) xs))
            _ -> Nothing
        _ -> \acc -> Nothing
    nil = (\acc -> Nothing, nilVal)
stepRaw _ _ = Nothing

step :: Int -> State -> State
step n v = v >>= either (stepRaw n) (const Nothing)
Run Code Online (Sandbox Code Playgroud)

事实证明,这个解析器实际上是向后运行的,这是不幸的,但不是一个根本的限制。对我来说,朝这个方向思考更容易。根据要求,这里没有递归。我们可以在 ghci 中对您的样本进行尝试List Int

*Main> let x = foldr consVal nilVal [1,1,40,0,0,1,30,0,0,1,20,0,0,10,0]
*Main> runList x step initState
Just (Right (Node 10 [Node 20 [],Node 30 [],Node 40 []]))
Run Code Online (Sandbox Code Playgroud)

我用来foldr构建x,并且foldr是递归的,所以你可能会对此尖叫。但我们可以很容易地定义x没有foldr; consVal内置列表语法比长链and更方便读写nilVal