Создание синтаксического анализатора с `inverse`, с ограничениями по грамматике

Question

Недавно я последовал через A Taste of Curry, а потом решили поставить тривиальный арифметический пример синтаксического анализа, чтобы проверить, написав несколько более существенный парсер: примитивный, но правильно и функциональный анализатор HTML.

я закончил с рабочей node2string функции для работы на Node (с атрибутами и детей), которые я потом inverse д, чтобы получить parse функцию, как проиллюстрировано в статье.

Первая наивная реализация была ошибкой в ​​том, что она разбирала что-либо, кроме, например, тривиальный фрагмент HTML <input/> в виде одного Node; все остальное недетерминистически давало недопустимые вещи, такие как

Node { name = "input", attrs = [Attr "type" "submit"] } 
Node { name = "input type=\"submit\"", attrs = [] } 

и так далее.

После некоторых первоначальных наивных попыток исправить что изнутри node2string, я понял, что момент, который я считаю, все закаленные логика программистов видеть мгновенно, что parse = inverse node2string был прав более правильным и проницательным о sitatution, чем я: выше 2 синтаксического анализа результаты <input type="submit"/> действительно были 2 правильными и конструктивными значениями Node, которые приведут к представлениям HTML.

Я понял, что мне пришлось ограничивать Node, чтобы разрешить прохождение в алфавитном порядке - ну не совсем, но давайте будем простыми именами (и, конечно же, для Attr). В менее фундаментальной настройке, чем в логической программе (например, в регулярном Haskell с гораздо большим количеством рукописных и «обучающих» в отличие от чисто декларативного программирования), я просто спрятал бы конструктор Node позади, например, a mkNode функция дозорного устройства, но у меня такое чувство, что в Curry это не сработает из-за того, как работает движок вывода или решатель ограничений (я могу ошибаться в этом, и на самом деле я надеюсь, что это так).

Таким образом, я оказался вместо этого следующим. Я думаю, что метапрограммирование Карри (или Template Haskell, если бы Карри поддержал его), можно было бы использовать для очистки ручного оружия, но косметическая обработка - это только один выход из ситуации.

data Name = Name [NameChar] -- newtype crashes the compiler 
data NameChar = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z 

name2char :: NameChar -> Char 
name2char c = case c of A -> 'a'; B -> 'b'; C -> 'c'; D -> 'd'; E -> 'e'; F -> 'f'; G -> 'g'; H -> 'h'; I -> 'i'; J -> 'j'; K -> 'k'; L -> 'l'; M -> 'm'; N -> 'n'; O -> 'o'; P -> 'p'; Q -> 'q'; R -> 'r'; S -> 's'; T -> 't'; U -> 'u'; V -> 'v'; W -> 'w'; X -> 'x'; Y -> 'y'; Z -> 'z' 

name2string :: Name -> String 
name2string (Name s) = map name2char s 

-- for "string literal" support 
nameFromString :: String -> Name 
nameFromString = inverse name2string 

data Node = Node { nodeName :: Name, attrs :: [Attr], children :: [Node] } 
data Attr = Attr { attrName :: Name, value :: String } 

attr2string :: Attr -> String 
attr2string (Attr name value) = name2string name ++ "=\"" ++ escape value ++ "\"" 
    where escape = concatMap (\c -> if c == '"' then "\\\"" else [c]) 

node2string :: Node -> String 
node2string (Node name attrs children) | null children = "<" ++ name' ++ attrs' ++ "/>" 
             | otherwise  = "<" ++ name' ++ attrs' ++ ">" ++ children' ++ "</" ++ name' ++ ">" 
    where name'  = name2string name 
     attrs' = (concatMap ((" " ++) . attr2string) attrs) 
     children' = intercalate "" $ map (node2string) children 

inverse :: (a -> b) -> (b -> a) 
inverse f y | f x =:= y = x where x free 

parse :: String -> Node 
parse = inverse node2string 

Это, по сути, работает отлично (на мой взгляд):

Parser> parse "<input type=\"submit\"/>" 
(Node [I,N,P,U,T] [(Attr [T,Y,P,E] "submit")] []) 

Parser> parse "<input type=\"submit\" name=\"btn1\"/>" 
(Node [I,N,P,U,T] [(Attr [T,Y,P,E] "submit"),(Attr [N,A,M,E] "btn1")] []) 

(Карри не имеет классы типа, так что я не знаю еще, как сделать [NameChar] печать более красиво)

Однако мой вопрос:

есть способ использовать что-то вроде isAlpha (или функцию более реалистичного к фактическому HTML спецификации, конечно), чтобы достичь Реза ult эквивалентно этому, без необходимости проходить подробный шаблон, который NameChar и его «поддерживающие элементы»? Кажется, что нет никакого способа разместить «функциональное ограничение» в любом месте ADT.

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

Answer 1

Вы можете достичь тех же результатов, используя только Char.Как вы уже указали, вы можете использовать isAlpha для определения name2char как частичного удостоверения личности. Я изменил следующие строки вашего кода.

type NameChar = Char 

name2char :: NameChar -> Char 
name2char c | isAlpha c = c 

Два примерных выражения затем оценивают следующим образом.

test> parse "<input type=\"submit\" name=\"btn1\"/>" 
(Node (Name "input") [(Attr (Name "type") "submit"),(Attr (Name "name") "btn1")] []) 

test> parse "<input type=\"submit\"/>" 
(Node (Name "input") [(Attr (Name "type") "submit")] []) 

В качестве побочного эффекта, имена с не алфавитных символов молча завершаться nameFromString.

test> nameFromString "input " 

Edit: Так как вы, кажется, быть фанатом шаблонов функций, можно определить генераторы для Node с и Attr с и использовать их в своей функции преобразования.

attr :: Name -> String -> Attr 
attr name val 
    | name `elem` ["type", "src", "alt", "name"] = Attr name val 

node :: String -> [Attr] -> [Node] -> Node 
node name [] nodes 
    | name `elem` ["a", "p"] = Node name [] nodes 
node name attrPairs@(_:_) nodes 
    | name `elem` ["img", "input"] = Node name attrPairs nodes 

node2string :: Node -> String 
node2string (node name attrs children) 
    | null children = "<" ++ name ++ attrs' ++ "/>" 
    | otherwise  = "<" ++ name ++ attrs' ++ ">" 
        ++ children' ++ "</" ++ name' ++ ">" 
where 
    name'  = name 
    attrs' = concatMap ((" " ++) . attr2string) attrs 
    children' = intercalate "" $ map (node2string) children 

attr2string :: Attr -> String 
attr2string (attr name val) = name ++ "=\"" ++ escape val ++ "\"" 
where 
    escape = concatMap (\c -> if c == '"' then "\\\"" else [c]) 

Этот подход имеет свои недостатки; он работает достаточно хорошо для определенного набора допустимых имен, но терпит неудачу, когда вы используете предикат, как раньше (например, all isAlpha name).

Edit2: Помимо того, что решение с условием isAlpha вполне «симпатичнее», чем ваше многословное решение, оно также определяется декларативно. Без ваших комментариев не становится ясно (что легко), что вы кодируете алфавитные символы с помощью вашего типа данных NameChar. С другой стороны, условие isAlpha является хорошим примером декларативной спецификации требуемого свойства. Ответит ли это на ваш вопрос? Я не уверен, к чему вы стремитесь.