Играюсь с монадическими парсерами, в смысле пытаюсь реализовать на F# (в теме функциональногог порграммирования недавно, сильно прошу не пинать). Сделал такой набросок:
#light
type Result<'s,'r> = seq<list<'s> * 'r>
type Parser<'s,'r> = Parser of (list<'s> -> Result<'s, 'r>)
let parserFun (Parser(f)) = f
let succeed v : Parser<'s,'r> = Parser(fun i -> seq{yield (i,v)})
let fail : Parser<'s,'r> = Parser(fun _ -> Seq.empty)
let satisfy p = Parser(fun i -> match i with
| h::t when p h -> seq{yield (t, h)}
| _ -> Seq.empty)
let symbol c = satisfy (fun s -> c = s)
let (<|>) (p1:Parser<'s,'r>) (p2:Parser<'s,'r>) : Parser<'s,'r> =
Parser(fun i -> Seq.append (parserFun p1 i) (parserFun p2 i))
let (<*>) (p1:Parser<'s,'r>) (p2:Parser<'s,'t>) : Parser<'s,'r*'t> =
Parser(fun i ->
i |> parserFun p1
|> Seq.map (fun (rest1, result1) ->
rest1 |> parserFun p2
|> Seq.map(fun (rest2,result2) -> (rest2,(result1,result2))))
|> Seq.concat)
let (=>>) (p:Parser<'s,'r>) (f:'r->'t) : Parser<'s,'t> =
Parser(fun i -> i |> parserFun p
|> Seq.map (fun (rest, result) -> (rest, f result)))
let bindP (p:Parser<'s,'r>) (f:'r->Parser<'s,'t>) : Parser<'s,'t>=
Parser(fun i -> i |> parserFun p
|> Seq.map (fun (rest, result) -> rest |> parserFun(f result))
|> Seq.concat)
let rec many (p:Parser<'s,'r>) : Parser<'s,'r list> =
Parser(fun i -> i |> parserFun p
|> Seq.map (fun (rest1, result1) ->
rest1 |> parserFun (many p)
|> Seq.map (fun (rest2, result2) -> (rest2, result1::result2)))
|> Seq.concat)
<|> succeed []
let many1 p : Parser<'s,'r list> = (p <*> many p) =>> (fun (a,b) -> a::b)
type ParserBuilder() =
member b.Return(v) = succeed v
member b.Bind(p,f) = bindP p f
member b.Zero() = fail
let parser = ParserBuilder()
Можно ли как-то переписать функцию many, чтобы рекурсия стала хвостовой, а то она отваливается на совершенно смешных размерах входных данных?
P.S.:
Параллельно пытаюсь смотреть на реализацию таких парсеров на Haskell, так смотрю там как-то все проще получается и при этом орудуют только понятием списка. Стоило мне seq результатов заменить на list, как отжирания памяти стали просто громадными. Ну я подозреваю почему это происходит — вычисления списка-результата происходят энергично на каждом этапе, потому заменил его на seq. В Haskell видимо с этим проще из-за ленивости.
Здравствуйте, Димчанский, Вы писали:
Д>Играюсь с монадическими парсерами, в смысле пытаюсь реализовать на F# (в теме функциональногог порграммирования недавно, сильно прошу не пинать). Сделал такой набросок: Д>
С каррингом разберись, не должны many/many1 быть такими страшными в записи.
(по некоторому чтению понял, что many/many1, которые должны быть выражены через bind/return/(mplus/|||), у тебя выражены напрямую. это неправильно.)
Д>Можно ли как-то переписать функцию many, чтобы рекурсия стала хвостовой, а то она отваливается на совершенно смешных размерах входных данных?
many p = many1 p ||| return []
many1 p = pure (:) <*> p <*> many p
-- many1 p = do { x <- p; xs <- many p; return (x:xs)}
Попробуй many переписать, как чуть выше. А то она у тебя записана в терминах самой же себя.
Д>P.S.: Д>Параллельно пытаюсь смотреть на реализацию таких парсеров на Haskell, так смотрю там как-то все проще получается и при этом орудуют только понятием списка. Стоило мне seq результатов заменить на list, как отжирания памяти стали просто громадными. Ну я подозреваю почему это происходит — вычисления списка-результата происходят энергично на каждом этапе, потому заменил его на seq. В Haskell видимо с этим проще из-за ленивости.
Да-да.
Разбор в Хаскеле осуществляется "в глубину" по самой левой ветке за счёт ленивости. У тебя энергичные вычисления превращают его в разбор в ширину, все варианты параллельно и одновременно.
Yours truly, Serguey Zefirov (thesz NA mail TOCHKA ru)
Здравствуйте, thesz, Вы писали:
T>С каррингом разберись, не должны many/many1 быть такими страшными в записи. T>(по некоторому чтению понял, что many/many1, которые должны быть выражены через bind/return/(mplus/|||), у тебя выражены напрямую. это неправильно.)
T>
T>many p = many1 p ||| return []
T>many1 p = pure (:) <*> p <*> many p
T>-- many1 p = do { x <- p; xs <- many p; return (x:xs)}
T>
T>Попробуй many переписать, как чуть выше. А то она у тебя записана в терминах самой же себя.
Ну можно переписать красивее, когда уже имеем ParserBuilder:
let rec many1 p = parser { let! x = p
let! xs = many p
return (x::xs) }
and many p = (many1 p) <|> succeed []
Д>>Только от этого хвостовая рекурсия не исчезает. Д>Хотел сказать не появляется. Д>А как Haskell это место разруливает? Сам определяет как скомпилировать это так, чтобы рекурсия была б хвостовой?
Там сплошные отложенные вычисления и нет никакой хвостовой рекурсии.
Скорее всего, у тебя накапливаются отложенные вычисления: одна из веток <|> никогда не вычисляется, а входной поток, который она ждёт, продолжает висеть.
Yours truly, Serguey Zefirov (thesz NA mail TOCHKA ru)
Ага, это и хотел сказать.
T>Но её и не должно быть. Но не должно быть и излишнего потребления памяти.
Так если провести de-sugaring написанного с использованием parser{} то думаю, что получится то же самое, что у меня было.
Так а неужели здесь нельзя сделать хвостовой рекурсии?
Т.к. простой запуск
[for i in 0..10000 -> ' ']
|> parserFun (many (satisfy (fun s -> s=' ')))
|> Seq.nth 1;;
T>>Но её и не должно быть. Но не должно быть и излишнего потребления памяти. Д>Так если провести de-sugaring написанного с использованием parser{} то думаю, что получится то же самое, что у меня было. Д>Так а неужели здесь нельзя сделать хвостовой рекурсии?
А смысл? Всё равно они у тебя отрабатывают и отдают наружу функции высших порядков.
Д>Т.к. простой запуск Д>
Д>[for i in 0..10000 -> ' ']
Д> |> parserFun (many (satisfy (fun s -> s=' ')))
Д> |> Seq.nth 1;;
Д>
Д>уводит интерпретатор в stack overflow.
Прошу тебя, сделай левосторонне-перекошенный комбинатор !||, перепиши с его использованием many и сообщи о результатах.
Yours truly, Serguey Zefirov (thesz NA mail TOCHKA ru)
Д>Так если провести de-sugaring написанного с использованием parser{} то думаю, что получится то же самое, что у меня было. Д>Так а неужели здесь нельзя сделать хвостовой рекурсии? Д>Т.к. простой запуск Д>
Д>[for i in 0..10000 -> ' ']
Д> |> parserFun (many (satisfy (fun s -> s=' ')))
Д> |> Seq.nth 1;;
Д>
Д>уводит интерпретатор в stack overflow.
import Control.Monad
data P a = P {unP :: String -> [(a,String)]}
instance Monad P where
return a = P $ \s -> [(a,s)]
(P a) >>= q = P $ \s -> concat [(unP (q b)) s' | (b,s') <- a s]
fail _ = P $ const []
item = P $ \s -> case s of
[] -> []
(c:cs) -> [(c,cs)]
sat p = item >>= \c -> if p c then return c else fail "miserably"
(P a) ||| (P b) = P $ \s -> a s ++ b s
(P a) !|| (P b) = P $ \s -> case a s of
[] -> b s
xs -> xs
many p = many1 p ||| return []
many1 p = p >>= \x -> many p >>= \ xs -> return (x:xs)
many' p = many1' p !|| return []
many1' p = p >>= \x -> many' p >>= \ xs -> return (x:xs)
many'' p = run []
where
run acc = do
r <- liftM Just p !|| return Nothing
case r of
Just x -> run (x:acc)
Nothing -> return $ reverse acc
test many = length $ fst $ head $ (unP (many (sat (==' ')))) (replicate 100000 ' ')
{-
*Main> test many''
100000
(4.39 secs, 142657128 bytes)
*Main> test many'
*** Exception: stack overflow
*Main> test many
*** Exception: stack overflow
-}
Приём с аккумулятором работает до сих пор.
Хотя шут его знает, что там с этим энергичным F#.
Yours truly, Serguey Zefirov (thesz NA mail TOCHKA ru)
Здравствуйте, thesz, Вы писали:
T>Прошу тебя, сделай левосторонне-перекошенный комбинатор !||, перепиши с его использованием many и сообщи о результатах.
Я написал такой оператор (он из результата первого парсера возвращает первый элемент, если такой есть, иначе пытается возвратить первый элемент из второго парсера):
let (<!|>) (p1:Parser<'s,'r>) (p2:Parser<'s,'r>) : Parser<'s,'r> =
Parser(fun i ->
seq {use e1 = (parserFun p1 i).GetEnumerator()
if e1.MoveNext()
then yield e1.Current
else use e2 = (parserFun p2 i).GetEnumerator()
if e2.MoveNext()
then yield e2.Current})
код для many стал таким:
let rec many1 p = parser { let! x = p
let! xs = many p
return (x::xs) }
and many p = (many1 p) <!|> succeed []
Stack overflow остался для строк длиной 10000, хотя many вроде стал пошустрее
Я думаю, что проблема в том, что в many на стеке сохраняется результат от первого прохода парсера, затем рекурсивно вызывается many, в котором происходит то же самое и т.д., а затем, когда результат от рекурсивного вызова получен, все склеивается. Наверное надо как-то с аккумулатором тут поиграться, я просто себе еще не сломал имеративное мышление, потому прошу помощи зала.
Здравствуйте, thesz, Вы писали:
T>{- T>*Main> test many'' T>100000 T>(4.39 secs, 142657128 bytes) T>*Main> test many' T>*** Exception: stack overflow T>*Main> test many T>*** Exception: stack overflow T>-} T>[/haskell]
T>Приём с аккумулятором работает до сих пор. T>Хотя шут его знает, что там с этим энергичным F#.
Ну т.е. у Haskell те же проблемы (stack overflow) в many, если не использовать аккумулятор?
Я думаю, что у F# с применением аккумулятора, тоже должны порешиться проблемы.
T>>Приём с аккумулятором работает до сих пор. T>>Хотя шут его знает, что там с этим энергичным F#.
Д>Ну т.е. у Haskell те же проблемы (stack overflow) в many, если не использовать аккумулятор?
Ага. Я думал, что они магически решаются, ан нет.
Д>Я думаю, что у F# с применением аккумулятора, тоже должны порешиться проблемы.
Судя по всему, мы нашли-таки святой грааль (с маленькой буквы).
Yours truly, Serguey Zefirov (thesz NA mail TOCHKA ru)
Здравствуйте, thesz, Вы писали:
Д>>Я думаю, что у F# с применением аккумулятора, тоже должны порешиться проблемы.
T>Судя по всему, мы нашли-таки святой грааль (с маленькой буквы).
Таки поборол проблему с применением аккумулятора:
let (<!|>) (p1:Parser<'s,'r>) (p2:Parser<'s,'r>) : Parser<'s,'r> =
Parser(fun i ->
seq {use e1 = (parserFun p1 i).GetEnumerator()
if e1.MoveNext()
then yield e1.Current
else use e2 = (parserFun p2 i).GetEnumerator()
if e2.MoveNext()
then yield e2.Current})
let many (p:Parser<'s,'r>) : Parser<'s,'r list> =
let rec many_aux (acc:'r list) : Parser<'s,'r list> =
Parser(fun i -> let (rest,sres) = i |> parserFun ((p =>> (fun r -> Some(r))) <!|> succeed None) |> Seq.nth 0
match sres with
| Some(res) -> rest |> parserFun (many_aux (res::acc))
| None -> rest |> parserFun (succeed (List.rev acc)))
many_aux [] <!|> succeed []
let many1 (p:Parser<'s,'r>) : Parser<'s,'r list> =
p <*> many p =>> (fun (a, b) -> a::b)
Теперь хоть сто тысяч символов суешь — не отваливается с переполнением стека.
let many (p:Parser<'s,'r>) : Parser<'s,'r list> =
let rec many_aux (acc:'r list) : Parser<'s,'r list> =
Parser(fun i -> let (rest,sres) = i |> parserFun ((p =>> (fun r -> Some(r))) <!|> succeed None) |> Seq.nth 0
match sres with
| Some(res) -> rest |> parserFun (many_aux (res::acc))
| None -> rest |> parserFun (succeed (List.rev acc)))
many_aux [] // этот <!|> succeed [] не нужен, т.к. и так будет результат с пустым множеством, если парсер не сработает
Здравствуйте, Димчанский, Вы писали:
Д>Играюсь с монадическими парсерами, в смысле пытаюсь реализовать на F# (в теме функциональногог порграммирования недавно, сильно прошу не пинать).
можно еще посмотреть fparsec
Здравствуйте, Mirrorer, Вы писали:
M>Здравствуйте, Димчанский, Вы писали:
Д>>Играюсь с монадическими парсерами, в смысле пытаюсь реализовать на F# (в теме функциональногог порграммирования недавно, сильно прошу не пинать). M>можно еще посмотреть fparsec
Спасиб за совет, но я знаю про этот порт с Haskell'я. Просто, чтобы эффективней использовать такие библиотеки, хочется для начала понять самому, как они работают, где могут быть грабли и т.п.
