Merge pull request #30 from lemaetech/promise

Implement Promise and Input based functorial parser implementation

.ocamlformat

@@ -1,21 +1,3 @@
-profile=conventional
-break-infix-before-func
-break-infix=fit-or-vertical
-break-separators=before
-dock-collection-brackets=false
-break-sequences=true
-doc-comments=before
-field-space=loose
-let-and=sparse
-sequence-style=terminator
-type-decl=sparse
-wrap-comments=true
-if-then-else=k-r
-let-and=sparse
-space-around-records
-space-around-lists
-space-around-arrays
-cases-exp-indent=2
-break-cases=all
-indicate-nested-or-patterns=unsafe-no
+profile=compact
+break-collection-expressions=fit-or-vertical
 parse-docstrings=true

CHANGES.md

@@ -1,10 +1,12 @@
 ## v3.0.0 2021-08-06 UK
 
-- Overhaul parser implementation. 
+- Overhaul parser implementation - use functor based implementation. Introduce, `Make_buffered_input`, `Make_unbuffered_input` and `Make` functors. 
 - Remove `reparse-unix` package
 - Remove base dependency
 - Facilitate IO promise monads such as `Lwt` and `Async`
 - Add package `reparse-lwt` which defines `Lwt_stream.t` as one of the input sources.
+- Add package 'reparse-lwt-unix' which defines `Lwt_unix.file_descr` and `Lwt_io.input_channel` as parser input sources.
+- 
 
 ## v2.1.0 2021-04-06 UK
 

README.md

@@ -76,11 +76,11 @@ let rec eval : expr -> int = function
 ```
 
 ```ocaml
-# let ast = parse expr (input_of_string "1*2-4+3");;
+# let ast = parse (create_input_from_string "1*2-4+3") expr ;;
 val ast : (expr, string) result =
   Ok (Sub (Mult (Int 1, Int 2), Add (Int 4, Int 3)))
 
-# eval @@ Result.get_ok (parse expr (input_of_string "12+1*10"));;
+# eval @@ Result.get_ok (parse (create_input_from_string "12+1*10") expr);;
 - : int = 22
 ```
 

examples/calc.ml

@@ -43,22 +43,22 @@ let integer : expr t =
 
 let factor : expr t -> expr t =
  fun expr ->
-  any [ char '(' *> skip_spaces *> expr <* skip_spaces <* char ')'; integer ]
+  any [char '(' *> skip_spaces *> expr <* skip_spaces <* char ')'; integer]
 
 let term : expr t -> expr t =
  fun factor ->
   recur (fun term ->
       let mult = binop factor '*' term (fun e1 e2 -> Mult (e1, e2)) in
       let div = binop factor '/' term (fun e1 e2 -> Div (e1, e2)) in
-      mult <|> div <|> factor)
+      mult <|> div <|> factor )
 
 let expr : expr t =
   recur (fun expr ->
       let factor = factor expr in
       let term = term factor in
       let add = binop term '+' expr (fun e1 e2 -> Add (e1, e2)) in
       let sub = binop term '-' expr (fun e1 e2 -> Sub (e1, e2)) in
-      any [ add; sub; term ] <?> "expr")
+      any [add; sub; term] <?> "expr" )
 
 let rec eval : expr -> int = function
   | Int i -> i
@@ -69,13 +69,15 @@ let rec eval : expr -> int = function
 
 (* Test AST *)
 let r =
-  let actual = parse expr (input_of_string "1*2-4+3") in
+  let actual = parse (create_input_from_string "1*2-4+3") expr in
   let expected = Ok (Sub (Mult (Int 1, Int 2), Add (Int 4, Int 3))) in
   Bool.equal (expected = actual) true
 
 (* Run and test the evaluator. *)
 let exp_result =
-  let v = eval @@ Result.get_ok (parse expr @@ input_of_string "12+1*10") in
+  let v =
+    eval @@ Result.get_ok (parse (create_input_from_string "12+1*10") expr)
+  in
   Int.equal 22 v
 
 (*-------------------------------------------------------------------------

examples/json.ml

@@ -27,100 +27,63 @@ type value =
   | Object of (string * value) list
   | Array of value list
   | Number of
-      { negative : bool
-      ; int : string
-      ; frac : string option
-      ; exponent : string option
-      }
+      {negative: bool; int: string; frac: string option; exponent: string option}
   | String of string
   | False
   | True
   | Null
 
 let ws =
-  skip
-    (char_if (function
-      | ' '
-      | '\t'
-      | '\n'
-      | '\r' ->
-        true
-      | _ -> false))
+  skip (char_if (function ' ' | '\t' | '\n' | '\r' -> true | _ -> false))
 
 let struct_char c = ws *> char c <* ws
-
 let null_value = ws *> string_cs "null" *> ws *> return Null
-
 let false_value = ws *> string_cs "false" *> ws *> return False
-
 let true_value = ws *> string_cs "true" *> ws *> return True
 
 let number_value =
   let* negative =
-    optional (char '-')
-    >>| function
-    | Some '-' -> true
-    | _ -> false
+    optional (char '-') >>| function Some '-' -> true | _ -> false
   in
   let* int =
-    let digits1_to_9 =
-      char_if (function
-        | '1' .. '9' -> true
-        | _ -> false)
-    in
+    let digits1_to_9 = char_if (function '1' .. '9' -> true | _ -> false) in
     let num =
       map2
         (fun first_ch digits -> Format.sprintf "%c%s" first_ch digits)
-        digits1_to_9 digits
-    in
-    any [ string_cs "0"; num ]
+        digits1_to_9 digits in
+    any [string_cs "0"; num]
   in
   let* frac = optional (char '.' *> digits) in
   let+ exponent =
     optional
       (let* e = char 'E' <|> char 'e' in
        let* sign = optional (char '-' <|> char '+') in
        let sign =
-         match sign with
-         | Some c -> Format.sprintf "%c" c
-         | None -> ""
-       in
+         match sign with Some c -> Format.sprintf "%c" c | None -> "" in
        let+ digits = digits in
        Format.sprintf "%c%s%s" e sign digits)
   in
-  Number { negative; int; frac; exponent }
+  Number {negative; int; frac; exponent}
 
 let string =
   let escaped =
     let ch =
       char '\\'
       *> char_if (function
-           | '"'
-           | '\\'
-           | '/'
-           | 'b'
-           | 'f'
-           | 'n'
-           | 'r'
-           | 't' ->
-             true
-           | _ -> false)
-      >>| Format.sprintf "\\%c"
-    in
+           | '"' | '\\' | '/' | 'b' | 'f' | 'n' | 'r' | 't' -> true
+           | _ -> false )
+      >>| Format.sprintf "\\%c" in
     let hex4digit =
       let+ hex =
         string_cs "\\u" *> take ~at_least:4 ~up_to:4 hex_digit
         >>= string_of_chars
       in
-      Format.sprintf "\\u%s" hex
-    in
-    any [ ch; hex4digit ]
-  in
+      Format.sprintf "\\u%s" hex in
+    any [ch; hex4digit] in
   let unescaped =
-    take_while ~while_:(is_not (any [ char '\\'; control; dquote ])) any_char
-    >>= string_of_chars
-  in
-  let+ str = dquote *> take (any [ escaped; unescaped ]) <* dquote in
+    take_while ~while_:(is_not (any [char '\\'; control; dquote])) any_char
+    >>= string_of_chars in
+  let+ str = dquote *> take (any [escaped; unescaped]) <* dquote in
   String.concat "" str
 
 let string_value = string >>| fun s -> String s
@@ -132,30 +95,26 @@ let json_value =
         let member =
           let* nm = string <* struct_char ':' in
           let+ v = value in
-          (nm, v)
-        in
+          (nm, v) in
         let+ object_value =
           struct_char '{' *> take member ~sep_by:value_sep <* struct_char '}'
         in
-        Object object_value
-      in
+        Object object_value in
       let array_value =
         let+ vals =
           struct_char '[' *> take value ~sep_by:value_sep <* struct_char ']'
         in
-        Array vals
-      in
+        Array vals in
       any
         [ object_value
         ; array_value
         ; number_value
         ; string_value
         ; false_value
         ; true_value
-        ; null_value
-        ])
+        ; null_value ] )
 
-let parse s = parse json_value s
+let parse s = parse s json_value
 
 (*------------------------------------------------------------------------- *
   Copyright (c) 2020 Bikal Gurung. All rights reserved. * * This Source Code