Claus Reinke claus.reinke at talk21.com
Sun Jul 1 09:44:43 EDT 2007

```> When you pretend you've never heard of monads or arrows, and
> write down the types what do you get?

this question made me wonder whether i could still recall how i used
to write parsers before i heard of monads or arrows. it is difficult not
to fall back into the pattern of state transformer monads, but -just for fun-
here's an quick approximation of double-continuation-based parser
combinators, where each parser takes a success and a failure continuation.

the success continuation takes a parse result and the remaining text,
the failure continuation takes the remaining text. the basic combinators
are 'litP predicate' (parsing a literal/character), '.>' (sequence of two
parsers), '.|' (alternative of two parsers), '.:' and '..:' (process and
combine parse results before passing them to the success continuation).
'?>' ignores its first result, '#>' pairs its two results (i'm sure i didn't use
as many cute combinators at the time:-).

[ to those of you writing debuggers for haskell:
this kind of functional programming -programming with functions-
could be a good stress test for your tool ]

claus

------------------------------------------------
import Data.Char

infixr .>,.|,?>,#>

type Parser a t = (a->String->t) -> (String->t) -> (String->t)

empty    s f = \cs-> s () cs
eot      s f = \cs-> case cs of { "" -> s '\EOT' ""; '\EOT':_ -> s '\EOT' ""; _ -> f cs }
litP p   s f = \cs-> case cs of { c:cs' | p c -> s c cs'; _ -> f cs }
but x    s f = \cs-> x (\_ _->f cs) (\_->s undefined cs) cs

(a ?> b) s f = \cs->a (\ar->b s (\_->f cs)) f cs
(a #> b) s f = \cs->a (\ar->b (s . ((,)ar)) (\_->f cs)) f cs
(a .> b) s f = \cs->a (\ar->b (s ar) (\_->f cs)) f cs
(a .| b) s f = a s (b s f)

(parse  .: build) s f = parse (s . build) f
(parse ..: build) s f = parse ((s .) . build) f

parse p = ((p .> eot) ..: const) (const . Right) Left

many p = (( p .> many p ) ..: (:) ) .| ( p .: return )

digit  = litP isDigit .: digitToInt
digits = many digit
num    = digits .: (foldl ((+) . (10*)) 0)

space    = litP isSpace
anyChar  = litP (const True)
nonSpace = ( but space ?> anyChar )
sep      = litP (==':')
field    = ( many nonSpace #> many space ?> sep ?> many space ?> many nonSpace )
nonField = but field ?> many anyChar

```