[camlp5] Automatic conversion from revised syntax + parsers

`for i in *; do camlp5r pr_o.cmo $i > ../gramlib.auto/$i; done`

1 files changed, 117 insertions, 139 deletions

diff --git a/gramlib/plexing.ml b/gramlib/plexing.ml
index 947e1980b5..db8e9591b7 100644
--- a/gramlib/plexing.ml
+++ b/gramlib/plexing.ml
@@ -2,240 +2,218 @@
 (* plexing.ml,v *)
 (* Copyright (c) INRIA 2007-2017 *)
 
-open Versdep;
+open Versdep
 
-type pattern = (string * string);
+type pattern = string * string
 
-exception Error of string;
+exception Error of string
 
-type location = Ploc.t;
-type location_function = int -> location;
-type lexer_func 'te = Stream.t char -> (Stream.t 'te * location_function);
+type location = Ploc.t
+type location_function = int -> location
+type 'te lexer_func = char Stream.t -> 'te Stream.t * location_function
 
-type lexer 'te =
-  { tok_func : lexer_func 'te;
+type 'te lexer =
+  { tok_func : 'te lexer_func;
     tok_using : pattern -> unit;
     tok_removing : pattern -> unit;
-    tok_match : mutable pattern -> 'te -> string;
+    mutable tok_match : pattern -> 'te -> string;
     tok_text : pattern -> string;
-    tok_comm : mutable option (list location) }
-;
+    mutable tok_comm : location list option }
 
-value make_loc = Ploc.make_unlined;
-value dummy_loc = Ploc.dummy;
+let make_loc = Ploc.make_unlined
+let dummy_loc = Ploc.dummy
 
-value lexer_text (con, prm) =
+let lexer_text (con, prm) =
   if con = "" then "'" ^ prm ^ "'"
   else if prm = "" then con
   else con ^ " '" ^ prm ^ "'"
-;
 
-value locerr () = failwith "Lexer: location function";
-value loct_create () = (ref (array_create 1024 None), ref False);
-value loct_func (loct, ov) i =
+let locerr () = failwith "Lexer: location function"
+let loct_create () = ref (array_create 1024 None), ref false
+let loct_func (loct, ov) i =
   match
-    if i < 0 || i >= Array.length loct.val then
-      if ov.val then Some dummy_loc else None
-    else Array.unsafe_get loct.val i
+    if i < 0 || i >= Array.length !loct then
+      if !ov then Some dummy_loc else None
+    else Array.unsafe_get !loct i
   with
-  [ Some loc -> loc
-  | None -> locerr () ]
-;
-value loct_add (loct, ov) i loc =
-  if i >= Array.length loct.val then
-    let new_tmax = Array.length loct.val * 2 in
-    if new_tmax < Sys.max_array_length then do {
+    Some loc -> loc
+  | None -> locerr ()
+let loct_add (loct, ov) i loc =
+  if i >= Array.length !loct then
+    let new_tmax = Array.length !loct * 2 in
+    if new_tmax < Sys.max_array_length then
       let new_loct = array_create new_tmax None in
-      Array.blit loct.val 0 new_loct 0 (Array.length loct.val);
-      loct.val := new_loct;
-      loct.val.(i) := Some loc
-    }
-    else ov.val := True
-  else loct.val.(i) := Some loc
-;
-
-value make_stream_and_location next_token_loc =
+      Array.blit !loct 0 new_loct 0 (Array.length !loct);
+      loct := new_loct;
+      !loct.(i) <- Some loc
+    else ov := true
+  else !loct.(i) <- Some loc
+
+let make_stream_and_location next_token_loc =
   let loct = loct_create () in
   let ts =
     Stream.from
-      (fun i -> do {
-         let (tok, loc) = next_token_loc () in
-         loct_add loct i loc;
-         Some tok
-       })
+      (fun i ->
+         let (tok, loc) = next_token_loc () in loct_add loct i loc; Some tok)
   in
-  (ts, loct_func loct)
-;
+  ts, loct_func loct
 
-value lexer_func_of_parser next_token_loc cs =
+let lexer_func_of_parser next_token_loc cs =
   let line_nb = ref 1 in
   let bolpos = ref 0 in
   make_stream_and_location (fun () -> next_token_loc (cs, line_nb, bolpos))
-;
 
-value lexer_func_of_ocamllex lexfun cs =
+let lexer_func_of_ocamllex lexfun cs =
   let lb =
     Lexing.from_function
       (fun s n ->
-         try do { string_set s 0 (Stream.next cs); 1 } with
-         [ Stream.Failure -> 0 ])
+         try string_set s 0 (Stream.next cs); 1 with Stream.Failure -> 0)
   in
   let next_token_loc _ =
     let tok = lexfun lb in
     let loc = make_loc (Lexing.lexeme_start lb, Lexing.lexeme_end lb) in
-    (tok, loc)
+    tok, loc
   in
   make_stream_and_location next_token_loc
-;
 
 (* Char and string tokens to real chars and string *)
 
-value buff = ref (string_create 80);
-value store len x = do {
-  if len >= string_length buff.val then
-    buff.val := string_cat buff.val (string_create (string_length buff.val))
-  else ();
-  string_set buff.val len x;
+let buff = ref (string_create 80)
+let store len x =
+  if len >= string_length !buff then
+    buff := string_cat !buff (string_create (string_length !buff));
+  string_set !buff len x;
   succ len
-};
-value get_buff len = string_sub buff.val 0 len;
+let get_buff len = string_sub !buff 0 len
 
-value valch x = Char.code x - Char.code '0';
-value valch_a x = Char.code x - Char.code 'a' + 10;
-value valch_A x = Char.code x - Char.code 'A' + 10;
+let valch x = Char.code x - Char.code '0'
+let valch_a x = Char.code x - Char.code 'a' + 10
+let valch_A x = Char.code x - Char.code 'A' + 10
 
-value rec backslash s i =
+let rec backslash s i =
   if i = String.length s then raise Not_found
   else
     match s.[i] with
-    [ 'n' -> ('\n', i + 1)
-    | 'r' -> ('\r', i + 1)
-    | 't' -> ('\t', i + 1)
-    | 'b' -> ('\b', i + 1)
-    | '\\' -> ('\\', i + 1)
-    | '"' -> ('"', i + 1)
-    | ''' -> (''', i + 1)
+      'n' -> '\n', i + 1
+    | 'r' -> '\r', i + 1
+    | 't' -> '\t', i + 1
+    | 'b' -> '\b', i + 1
+    | '\\' -> '\\', i + 1
+    | '"' -> '"', i + 1
+    | '\'' -> '\'', i + 1
     | '0'..'9' as c -> backslash1 (valch c) s (i + 1)
     | 'x' -> backslash1h s (i + 1)
-    | _ -> raise Not_found ]
+    | _ -> raise Not_found
 and backslash1 cod s i =
-  if i = String.length s then ('\\', i - 1)
+  if i = String.length s then '\\', i - 1
   else
     match s.[i] with
-    [ '0'..'9' as c -> backslash2 (10 * cod + valch c) s (i + 1)
-    | _ -> ('\\', i - 1) ]
+      '0'..'9' as c -> backslash2 (10 * cod + valch c) s (i + 1)
+    | _ -> '\\', i - 1
 and backslash2 cod s i =
-  if i = String.length s then ('\\', i - 2)
+  if i = String.length s then '\\', i - 2
   else
     match s.[i] with
-    [ '0'..'9' as c -> (Char.chr (10 * cod + valch c), i + 1)
-    | _ -> ('\\', i - 2) ]
+      '0'..'9' as c -> Char.chr (10 * cod + valch c), i + 1
+    | _ -> '\\', i - 2
 and backslash1h s i =
-  if i = String.length s then ('\\', i - 1)
+  if i = String.length s then '\\', i - 1
   else
     match s.[i] with
-    [ '0'..'9' as c -> backslash2h (valch c) s (i + 1)
+      '0'..'9' as c -> backslash2h (valch c) s (i + 1)
     | 'a'..'f' as c -> backslash2h (valch_a c) s (i + 1)
     | 'A'..'F' as c -> backslash2h (valch_A c) s (i + 1)
-    | _ -> ('\\', i - 1) ]
+    | _ -> '\\', i - 1
 and backslash2h cod s i =
-  if i = String.length s then ('\\', i - 2)
+  if i = String.length s then '\\', i - 2
   else
     match s.[i] with
-    [ '0'..'9' as c -> (Char.chr (16 * cod + valch c), i + 1)
-    | 'a'..'f' as c -> (Char.chr (16 * cod + valch_a c), i + 1)
-    | 'A'..'F' as c -> (Char.chr (16 * cod + valch_A c), i + 1)
-    | _ -> ('\\', i - 2) ]
-;
+      '0'..'9' as c -> Char.chr (16 * cod + valch c), i + 1
+    | 'a'..'f' as c -> Char.chr (16 * cod + valch_a c), i + 1
+    | 'A'..'F' as c -> Char.chr (16 * cod + valch_A c), i + 1
+    | _ -> '\\', i - 2
 
-value rec skip_indent s i =
+let rec skip_indent s i =
   if i = String.length s then i
   else
     match s.[i] with
-    [ ' ' | '\t' -> skip_indent s (i + 1)
-    | _ -> i ]
-;
+      ' ' | '\t' -> skip_indent s (i + 1)
+    | _ -> i
 
-value skip_opt_linefeed s i =
+let skip_opt_linefeed s i =
   if i = String.length s then i else if s.[i] = '\010' then i + 1 else i
-;
 
-value eval_char s =
+let eval_char s =
   if String.length s = 1 then s.[0]
   else if String.length s = 0 then failwith "invalid char token"
   else if s.[0] = '\\' then
-    if String.length s = 2 && s.[1] = ''' then '''
+    if String.length s = 2 && s.[1] = '\'' then '\''
     else
       try
         let (c, i) = backslash s 1 in
         if i = String.length s then c else raise Not_found
-      with
-      [ Not_found -> failwith "invalid char token" ]
+      with Not_found -> failwith "invalid char token"
   else failwith "invalid char token"
-;
 
-value eval_string loc s =
-  bytes_to_string (loop 0 0) where rec loop len i =
+let eval_string loc s =
+  let rec loop len i =
     if i = String.length s then get_buff len
     else
       let (len, i) =
         if s.[i] = '\\' then
           let i = i + 1 in
           if i = String.length s then failwith "invalid string token"
-          else if s.[i] = '"' then (store len '"', i + 1)
+          else if s.[i] = '"' then store len '"', i + 1
           else
             match s.[i] with
-            [ '\010' -> (len, skip_indent s (i + 1))
-            | '\013' -> (len, skip_indent s (skip_opt_linefeed s (i + 1)))
+              '\010' -> len, skip_indent s (i + 1)
+            | '\013' -> len, skip_indent s (skip_opt_linefeed s (i + 1))
             | c ->
-                try
-                  let (c, i) = backslash s i in
-                  (store len c, i)
-                with
-                [ Not_found -> (store (store len '\\') c, i + 1) ] ]
-        else (store len s.[i], i + 1)
+                try let (c, i) = backslash s i in store len c, i with
+                  Not_found -> store (store len '\\') c, i + 1
+        else store len s.[i], i + 1
       in
       loop len i
-;
-
-value default_match =
-  fun
-  [ ("ANY", "") -> fun (con, prm) -> prm
-  | ("ANY", v) ->
-      fun (con, prm) -> if v = prm then v else raise Stream.Failure
-  | (p_con, "") ->
-      fun (con, prm) -> if con = p_con then prm else raise Stream.Failure
-  | (p_con, p_prm) ->
+  in
+  bytes_to_string (loop 0 0)
+
+let default_match =
+  function
+    "ANY", "" -> (fun (con, prm) -> prm)
+  | "ANY", v ->
+      (fun (con, prm) -> if v = prm then v else raise Stream.Failure)
+  | p_con, "" ->
+      (fun (con, prm) -> if con = p_con then prm else raise Stream.Failure)
+  | p_con, p_prm ->
       fun (con, prm) ->
-        if con = p_con && prm = p_prm then prm else raise Stream.Failure ]
-;
+        if con = p_con && prm = p_prm then prm else raise Stream.Failure
 
-value input_file = ref "";
-value line_nb = ref (ref 0);
-value bol_pos = ref (ref 0);
-value restore_lexing_info = ref None;
+let input_file = ref ""
+let line_nb = ref (ref 0)
+let bol_pos = ref (ref 0)
+let restore_lexing_info = ref None
 
 (* The lexing buffer used by pa_lexer.cmo *)
 
-value rev_implode l =
+let rev_implode l =
   let s = string_create (List.length l) in
-  bytes_to_string (loop (string_length s - 1) l) where rec loop i =
-    fun
-    [ [c :: l] -> do { string_unsafe_set s i c; loop (i - 1) l }
-    | [] -> s ]
-;
+  let rec loop i =
+    function
+      c :: l -> string_unsafe_set s i c; loop (i - 1) l
+    | [] -> s
+  in
+  bytes_to_string (loop (string_length s - 1) l)
 
 module Lexbuf :
   sig
-    type t = 'abstract;
-    value empty : t;
-    value add : char -> t -> t;
-    value get : t -> string;
+    type t
+    val empty : t
+    val add : char -> t -> t
+    val get : t -> string
   end =
   struct
-    type t = list char;
-    value empty = [];
-    value add c l = [c :: l];
-    value get = rev_implode;
+    type t = char list
+    let empty = []
+    let add c l = c :: l
+    let get = rev_implode
   end
-;