Реализация `read` для левоассоциативного дерева в Haskell

Мне трудно реализоватьЧитать для древовидной структуры. Я хочу взять левоассоциативную строку (с паренами), какABC(DE)F и преобразовать его в дерево. Этот конкретный пример соответствует дереву

tree.

Вот тип данных, который я использую (хотя я открыт для предложений):

<code>data Tree = Branch Tree Tree | Leaf Char deriving (Eq)
</code>

Это конкретное дерево будет в Хаскеле:

<code>example = Branch (Branch (Branch (Branch (Leaf 'A')
                                         (Leaf 'B'))
                                 (Leaf 'C'))
                         (Branch (Leaf 'D')
                                 (Leaf 'E')))
                 (Leaf 'F')
</code>

мойshow функция выглядит так:

<code>instance Show Tree where
    show (Branch l r@(Branch _ _)) = show l ++ "(" ++ show r ++ ")"
    show (Branch l r) = show l ++ show r
    show (Leaf x) = [x]
</code>

Я хочу сделатьread функционировать так, чтобы

<code>read "ABC(DE)F" == example
</code>

Ответы на вопрос(3)

коуровневого» подхода приведен рукописный синтаксический анализатор, который использует продолжение успеха для обработки левоассоциативного построения дерева:

instance Read Tree where readsPrec _prec s = maybeToList (readTree s)

type TreeCont = (Tree,String) -> Maybe (Tree,String)

readTree :: String -> Maybe (Tree,String)
readTree = read'top Just where
  valid ')' = False
  valid '(' = False
  valid _ = True

  read'top :: TreeCont -> String -> Maybe (Tree,String)
  read'top acc s@(x:ys) | valid x =
    case ys of
      [] -> acc (Leaf x,[])
      (y:zs) -> read'branch acc s
  read'top _ _ = Nothing

  -- The next three are mutually recursive

  read'branch :: TreeCont -> String -> Maybe (Tree,String)
  read'branch acc (x:y:zs) | valid x = read'right (combine (Leaf x) >=> acc) y zs
  read'branch _ _ = Nothing

  read'right :: TreeCont -> Char -> String -> Maybe (Tree,String)
  read'right acc y ys | valid y = acc (Leaf y,ys)
  read'right acc '(' ys = read'branch (drop'close >=> acc) ys
     where drop'close (b,')':zs) = Just (b,zs)
           drop'close _ = Nothing
  read'right _ _ _ = Nothing  -- assert y==')' here

  combine :: Tree -> TreeCont
  combine build (t, []) = Just (Branch build t,"")
  combine build (t, ys@(')':_)) = Just (Branch build t,ys)  -- stop when lookahead shows ')'
  combine build (t, y:zs) = read'right (combine (Branch build t)) y zs

когда использование библиотеки синтаксического анализа делает код удивительно коротким и чрезвычайно выразительным. (Я был поражен, что это былота аккуратно, когда я экспериментировал, чтобы ответить на это!)

Я собираюсь использовать Парсек (эта статья содержит несколько ссылок для получения дополнительной информации) и использования ее в «аппликативном режиме» (а не в монадическом), поскольку нам не нужна дополнительная способность монад к мощным способностям к стрельб

Ко

Сначала различные варианты импорта и определения:

import Text.Parsec

import Control.Applicative ((<*), (<
import Text.Parsec

import Control.Applicative ((<*), (<$>))

data Tree = Branch Tree Tree | Leaf Char deriving (Eq, Show)

paren, tree, unit :: Parsec String st Tree
gt;)) data Tree = Branch Tree Tree | Leaf Char deriving (Eq, Show) paren, tree, unit :: Parsec String st Tree

Теперь базовая единица дерева - это один символ (это не скобка) или дерево в скобках. Обращенное в скобки дерево - это просто нормальное дерево между( а также). А нормальное дерево - это просто единицы, помещенные в ветки слева (это очень саморекурсивно). В Haskell с Parsec:

-- parenthesised tree or `Leaf <character>`
unit = paren <|> (Leaf <
-- parenthesised tree or `Leaf <character>`
unit = paren <|> (Leaf <$> noneOf "()") <?> "group or literal"

-- normal tree between ( and )
paren = between (char '(') (char ')') tree  

-- all the units connected up left-associatedly
tree = foldl1 Branch <$> many1 unit

-- attempt to parse the whole input (don't short-circuit on the first error)
onlyTree = tree <* eof
gt; noneOf "()") <?> "group or literal" -- normal tree between ( and ) paren = between (char '(') (char ')') tree -- all the units connected up left-associatedly tree = foldl1 Branch <
-- parenthesised tree or `Leaf <character>`
unit = paren <|> (Leaf <$> noneOf "()") <?> "group or literal"

-- normal tree between ( and )
paren = between (char '(') (char ')') tree  

-- all the units connected up left-associatedly
tree = foldl1 Branch <$> many1 unit

-- attempt to parse the whole input (don't short-circuit on the first error)
onlyTree = tree <* eof
gt; many1 unit -- attempt to parse the whole input (don't short-circuit on the first error) onlyTree = tree <* eof

(Да, это весь парсер!)

Если бы мы хотели, мы могли бы обойтись безparen а такжеunit но приведенный выше код очень выразителен, поэтому мы можем оставить все как есть.

В качестве краткого объяснения (я предоставил ссылки на документацию):

(<|>) в основном означает «левый парсер или правый парсер»;(<?>) позволяет делать более приятные сообщения об ошибках;noneOf будет анализировать все, что не входит в данный список символов;between принимает три синтаксических анализатора и возвращает значение третьего синтаксического анализатора, если он разделен первым и вторым;char буквально разбирает аргумент.many1 разбирает один или несколько аргументов в списке (кажется, что пустая строка недопустима, следовательно,many1, скорее, чемmany который разбирает ноль или более);eof соответствует концу ввода.

Мы можем использоватьparse функция для запуска парсера (возвращаетEither ParseError Tree, Left это ошибка иRight - правильный анализ).

Какread

Используя это какread like функция может быть что-то вроде:

read' str = case parse onlyTree "" str of
   Right tr -> tr
   Left er -> error (show er)

(Я использовалread' чтобы не конфликтовать сPrelude.read; если вы хотитеRead Например, вам придется проделать немного больше работы, чтобы реализоватьreadPrec (или все, что требуется), но это не должно быть слишком сложно с фактическим анализом уже завершен.)

Пример

Некоторые базовые примеры:

*Tree> read' "A"
Leaf 'A'

*Tree> read' "AB"
Branch (Leaf 'A') (Leaf 'B')

*Tree> read' "ABC"
Branch (Branch (Leaf 'A') (Leaf 'B')) (Leaf 'C')

*Tree> read' "A(BC)"
Branch (Leaf 'A') (Branch (Leaf 'B') (Leaf 'C'))

*Tree> read' "ABC(DE)F" == example
True

*Tree> read' "ABC(DEF)" == example
False

*Tree> read' "ABCDEF" == example
False

Демонстрация ошибок:

*Tree> read' ""
***Exception: (line 1, column 1):
unexpected end of input
expecting group or literal

*Tree> read' "A(B"
***Exception: (line 1, column 4):
unexpected end of input
expecting group or literal or ")"

И, наконец, разница междуtree а такжеonlyTree:

*Tree> parse tree "" "AB)CD"     -- success: ignores ")CD"
Right (Branch (Leaf 'A') (Leaf 'B'))

*Tree> parse onlyTree "" "AB)CD" -- fail: can't parse the ")"
Left (line 1, column 3):
unexpected ')'
expecting group or literal or end of input
Выво

Parsec это потрясающе! Этот ответ может быть длинным, но суть всего 5 или 6 строк кода, которые выполняют всю работу.

одной строкой"ABC(DE)F", тыLeaf любой атом, который вы найдете (без скобок) и поместите его в список аккумуляторов. Когда у вас есть 2 элемента в списке, выBranch они вместе. Это может быть сделано с помощью чего-то вроде (обратите внимание, не проверено, просто чтобы дать идею):

read' [r,l] str  = read' [Branch l r] str
read' acc (c:cs) 
   -- read the inner parenthesis
   | c == '('  = let (result, rest) = read' [] cs 
                 in read' (result : acc) rest
   -- close parenthesis, return result, should be singleton
   | c == ')'  = (acc, cs) 
   -- otherwise, add a leaf
   | otherwise = read' (Leaf c : acc) cs
read' [result] [] = (result, [])
read' _ _  = error "invalid input"

Это может потребовать некоторых изменений, но я думаю, что этого достаточно, чтобы вы встали на правильный путь.

ВАШ ОТВЕТ НА ВОПРОС