1 files changed, 96 insertions, 102 deletions

diff --git a/gramlib/fstream.ml b/gramlib/fstream.ml
index 928df3b0c4..94e25ffd54 100644
--- a/gramlib/fstream.ml
+++ b/gramlib/fstream.ml
@@ -2,151 +2,145 @@
 (* fstream.ml,v *)
 (* Copyright (c) INRIA 2007-2017 *)
 
-exception Cut;
-
-type mlazy_c 'a =
-  [ Lfun of unit -> 'a
-  | Lval of 'a ]
-;
-type mlazy 'a =
-  [ Cval of 'a
-  | Clazy of ref (mlazy_c 'a) ]
-;
-value mlazy f = Clazy (ref (Lfun f));
-value mlazy_force l =
+exception Cut
+
+type 'a mlazy_c =
+    Lfun of (unit -> 'a)
+  | Lval of 'a
+type 'a mlazy =
+    Cval of 'a
+  | Clazy of 'a mlazy_c ref
+let mlazy f = Clazy (ref (Lfun f))
+let mlazy_force l =
   match l with
-  [ Cval v -> v
+    Cval v -> v
   | Clazy l ->
-      match l.val with
-      [ Lfun f -> do { let x = f () in l.val := Lval x; x }
-      | Lval v -> v ] ]
-;
-value mlazy_is_val l =
+      match !l with
+        Lfun f -> let x = f () in l := Lval x; x
+      | Lval v -> v
+let mlazy_is_val l =
   match l with
-  [ Cval _ -> True
+    Cval _ -> true
   | Clazy l ->
-      match l.val with
-      [ Lval _ -> True
-      | Lfun _ -> False ] ]
-;
-
-type t 'a = { count : int; data : mlazy (data 'a) }
-and data 'a =
-  [ Nil
-  | Cons of 'a and t 'a
-  | App of t 'a and t 'a ]
-;
-
-value from f =
-  loop 0 where rec loop i =
+      match !l with
+        Lval _ -> true
+      | Lfun _ -> false
+
+type 'a t = { count : int; data : 'a data mlazy }
+and 'a data =
+    Nil
+  | Cons of 'a * 'a t
+  | App of 'a t * 'a t
+
+let from f =
+  let rec loop i =
     {count = 0;
      data =
        mlazy
          (fun () ->
             match f i with
-            [ Some x -> Cons x (loop (i + 1))
-            | None -> Nil ])}
-;
+              Some x -> Cons (x, loop (i + 1))
+            | None -> Nil)}
+  in
+  loop 0
 
-value rec next s =
+let rec next s =
   let count = s.count + 1 in
   match mlazy_force s.data with
-  [ Nil -> None
-  | Cons a s -> Some (a, {count = count; data = s.data})
-  | App s1 s2 ->
+    Nil -> None
+  | Cons (a, s) -> Some (a, {count = count; data = s.data})
+  | App (s1, s2) ->
       match next s1 with
-      [ Some (a, s1) ->
-          Some (a, {count = count; data = mlazy (fun () -> App s1 s2)})
+        Some (a, s1) ->
+          Some (a, {count = count; data = mlazy (fun () -> App (s1, s2))})
       | None ->
           match next s2 with
-          [ Some (a, s2) -> Some (a, {count = count; data = s2.data})
-          | None -> None ] ] ]
-;
+            Some (a, s2) -> Some (a, {count = count; data = s2.data})
+          | None -> None
 
-value empty s =
+let empty s =
   match next s with
-  [ Some _ -> None
-  | None -> Some ((), s) ]
-;
+    Some _ -> None
+  | None -> Some ((), s)
 
-value nil = {count = 0; data = Cval Nil};
-value cons a s = Cons a s;
-value app s1 s2 = App s1 s2;
-value flazy f = {count = 0; data = mlazy f};
+let nil = {count = 0; data = Cval Nil}
+let cons a s = Cons (a, s)
+let app s1 s2 = App (s1, s2)
+let flazy f = {count = 0; data = mlazy f}
 
-value of_list l =
-  List.fold_right (fun x s -> flazy (fun () -> cons x s)) l nil
-;
+let of_list l = List.fold_right (fun x s -> flazy (fun () -> cons x s)) l nil
 
-value of_string s =
+let of_string s =
   from (fun c -> if c < String.length s then Some s.[c] else None)
-;
 
-value of_channel ic =
-  from (fun _ -> try Some (input_char ic) with [ End_of_file -> None ])
-;
+let of_channel ic =
+  from (fun _ -> try Some (input_char ic) with End_of_file -> None)
 
-value iter f =
-  do_rec where rec do_rec strm =
+let iter f =
+  let rec do_rec strm =
     match next strm with
-    [ Some (a, strm) ->
-        let _ = f a in
-        do_rec strm
-    | None -> () ]
-;
+      Some (a, strm) -> let _ = f a in do_rec strm
+    | None -> ()
+  in
+  do_rec
 
-value count s = s.count;
+let count s = s.count
 
-value count_unfrozen s =
-  loop 0 s where rec loop cnt s =
+let count_unfrozen s =
+  let rec loop cnt s =
     if mlazy_is_val s.data then
       match mlazy_force s.data with
-      [ Cons _ s -> loop (cnt + 1) s
-      | _ -> cnt ]
+        Cons (_, s) -> loop (cnt + 1) s
+      | _ -> cnt
     else cnt
-;
+  in
+  loop 0 s
 
 (* backtracking parsers *)
 
-type kont 'a 'b = [ K of unit -> option ('b * t 'a * kont 'a 'b) ];
-type bp 'a 'b = t 'a -> option ('b * t 'a * kont 'a 'b);
+type ('a, 'b) kont =
+    K of (unit -> ('b * 'a t * ('a, 'b) kont) option)
+type ('a, 'b) bp = 'a t -> ('b * 'a t * ('a, 'b) kont) option
 
-value bcontinue = fun [ (K k) -> k () ];
+let bcontinue =
+  function
+    K k -> k ()
 
-value bparse_all p strm =
-  loop (fun () -> p strm) where rec loop p =
+let bparse_all p strm =
+  let rec loop p =
     match p () with
-    [ Some (r, _, K k) -> [r :: loop k]
-    | None -> [] ]
-;
+      Some (r, _, K k) -> r :: loop k
+    | None -> []
+  in
+  loop (fun () -> p strm)
 
-value b_seq a b strm =
+let b_seq a b strm =
   let rec app_a kont1 () =
     match kont1 () with
-    [ Some (x, strm, K kont1) -> app_b (fun () -> b x strm) kont1 ()
-    | None -> None ]
+      Some (x, strm, K kont1) -> app_b (fun () -> b x strm) kont1 ()
+    | None -> None
   and app_b kont2 kont1 () =
     match kont2 () with
-    [ Some (y, strm, K kont2) -> Some (y, strm, K (app_b kont2 kont1))
-    | None -> app_a kont1 () ]
+      Some (y, strm, K kont2) -> Some (y, strm, K (app_b kont2 kont1))
+    | None -> app_a kont1 ()
   in
   app_a (fun () -> a strm) ()
-;
 
-value b_or a b strm =
-  loop (fun () -> a strm) () where rec loop kont () =
+let b_or a b strm =
+  let rec loop kont () =
     match kont () with
-    [ Some (x, strm, K kont) -> Some (x, strm, K (loop kont))
-    | None -> b strm ]
-;
+      Some (x, strm, K kont) -> Some (x, strm, K (loop kont))
+    | None -> b strm
+  in
+  loop (fun () -> a strm) ()
 
-value b_term f strm =
+let b_term f strm =
   match next strm with
-  [ Some (x, strm) ->
-      match f x with
-      [ Some y -> Some (y, strm, K (fun _ -> None))
-      | None -> None ]
-  | None -> None ]
-;
-
-value b_act a strm = Some (a, strm, K (fun _ -> None));
+    Some (x, strm) ->
+      begin match f x with
+        Some y -> Some (y, strm, K (fun _ -> None))
+      | None -> None
+      end
+  | None -> None
+
+let b_act a strm = Some (a, strm, K (fun _ -> None))