parsing - 如何为相互递归的 ADT 编写一个解析器，而不产生递归和副作用？

Question

警告:即将出现又长又复杂的问题。

有些人相信total functional programming这是一个有值(value)的想法，找到实现它的技术也很有值(value)。考虑到这一点，如何为相互递归的 ADT 编写一个解析器，而不产生递归和副作用？在这里，我将任何不是 strongly normalizing 的术语定义为“递归”。 。

我尝试过的:

请注意以下相互递归 ADT:

data Tree = Node Int [Tree]
tree = Node 10 [Node 20 [], Node 30 [], Node 40 []]

值tree可以序列化为:

tree_serial = [0,10,0,0,20,1,0,0,30,1,0,0,40,1,1] :: [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)));

这里，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

这与一元解析器类似，但更明确的是:

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

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

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

这会按预期输出节点 10 [节点 20 []、节点 30 []、节点 40 []]。请注意，这仍然使用递归，并且我必须使用 cont 在两个递归函数之间传递控制。现在，我知道有两种摆脱递归的策略:

1. Use folds.

2. Use church numbers for bounded recursion.

在这里使用折叠显然是不可行的，因为没有可以折叠的结构(我们正在构建它!)。如果我们解析列表而不是树，那么使用教堂编号将是完美的，因为它们的工作方式与有界递归的 Y 组合器完全相同 - 并且，知道列表的长度，我们可以只编写 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)));

请注意 parser 函数内的 50 常量:它作为边界是完全任意的。我不确定对于那些“完全适合”特定可解析值的选择是否存在“正确”选择。

Answer 1

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

列表的正确 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

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

tree -> 0 N list
list -> 0 tree list | 1

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

* N list
0 * list
* tree list
*

我们将折叠最后两个。请注意，这些漏洞之前都没有有趣的信息，因此我们不需要在 THole 中存储任何内容。非终端孔具有以下形式之一:

0 N *
0 * list
0 tree *

在这种情况下，树形成规则中的空洞前面有一个我们稍后需要的数字，而列表形成规则中的第二种空洞前面有一棵我们需要保留的树，所以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)

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

type RawState = (THole, List NTHole)
initRawState = (TreeT0, nilVal)

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

type State = Maybe (Either RawState Tree)
initState = Just (Left initRawState)

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

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)

事实证明，这个解析器实际上是向后运行的，这是不幸的，但不是一个根本的限制。对我来说，朝这个方向思考更容易。根据要求，这里没有递归。我们可以在 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 []]))

我使用 foldr 来构建 x，并且 foldr 是递归的，所以你可能会对此尖叫。但是我们可以轻松地定义 x 而无需 foldr；内置列表语法比长链 consVal 和 nilVal 更方便读写。