diff --git a/README.adoc b/README.adoc index 1376e355..1578eaa8 100644 --- a/README.adoc +++ b/README.adoc @@ -432,3 +432,39 @@ klist:: `'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]` is a lazy list printer:: `'a printer = Format.formatter -> 'a -> unit` is a pretty-printer to be used with the standard module `Format`. In particular, in many cases, `"foo: %a" Foo.print foo` will type-check. + +=== Parser Combinator + +The module `CCParse` defines basic parser combinators on strings. +Adapting https://github.com/inhabitedtype/angstrom#usage[angstrom's tutorial example] gives the following snippet. +Note that backtracking is explicit in `CCParse`, hence +the use of `try_` to allow it in some places. +Explicit memoization with `memo` and `fix_memo` is also possible. + +[source,OCaml] +---- +open CCParse.Infix;; +module P = CCParse;; + +let parens p = P.try_ (P.char '(') *> p <* P.char ')' ;; +let add = P.char '+' *> P.return (+) ;; +let sub = P.char '-' *> P.return (-) ;; +let mul = P.char '*' *> P.return ( * ) ;; +let div = P.char '/' *> P.return ( / ) ;; +let integer = + P.chars1_if (function '0'..'9'->true|_->false) >|= int_of_string ;; + +let chainl1 e op = + P.fix (fun r -> + e >>= fun x -> P.try_ (op <*> P.return x <*> r) <|> P.return x) ;; + +let expr : int P.t = + P.fix (fun expr -> + let factor = parens expr <|> integer in + let term = chainl1 factor (mul <|> div) in + chainl1 term (add <|> sub)) ;; + +P.parse_string expr "4*1+2";; (* Ok 6 *) +P.parse_string expr "4*(1+2)";; (* Ok 12 *) + +---- diff --git a/src/core/CCParse.mli b/src/core/CCParse.mli index e47ca6f0..18aaea5e 100644 --- a/src/core/CCParse.mli +++ b/src/core/CCParse.mli @@ -118,6 +118,34 @@ *) +(*$R + let open CCParse.Infix in + let module P = CCParse in + + let parens p = P.try_ (P.char '(') *> p <* P.char ')' in + let add = P.char '+' *> P.return (+) in + let sub = P.char '-' *> P.return (-) in + let mul = P.char '*' *> P.return ( * ) in + let div = P.char '/' *> P.return ( / ) in + let integer = + P.chars1_if (function '0'..'9'->true|_->false) >|= int_of_string in + + let chainl1 e op = + P.fix (fun r -> + e >>= fun x -> P.try_ (op <*> P.return x <*> r) <|> P.return x) in + + let expr : int P.t = + P.fix (fun expr -> + let factor = parens expr <|> integer in + let term = chainl1 factor (mul <|> div) in + chainl1 term (add <|> sub)) in + + assert_equal (Ok 6) (P.parse_string expr "4*1+2"); + assert_equal (Ok 12) (P.parse_string expr "4*(1+2)"); + () +*) + + type 'a or_error = ('a, string) Result.result type line_num = int