From 8619aa285ca8322ab9b209dd4509f5536f2440a1 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 13 Mar 2020 10:19:57 +0100
Subject: [PATCH] New: add the string type.
---
Makefile | 2 +
dune-project | 2 +-
lib/data.ml | 29 +++--
lib/data.mli | 8 +-
lib/mypervasives.ml | 97 ++++++++--------
lib/rifIO.ml | 264 ++++++++++++++++++++++----------------------
6 files changed, 210 insertions(+), 192 deletions(-)
diff --git a/Makefile b/Makefile
index 8f0e968..356e565 100644
--- a/Makefile
+++ b/Makefile
@@ -15,6 +15,8 @@ clean:
dune clean
rm -f lib/lutilsVersion.ml
+odoc:
+ dune build @doc
###############################
# for developpers
diff --git a/dune-project b/dune-project
index f75713f..929c696 100644
--- a/dune-project
+++ b/dune-project
@@ -1 +1 @@
-(lang dune 1.2)
+(lang dune 2.0)
diff --git a/lib/data.ml b/lib/data.ml
index 82d7681..801246c 100644
--- a/lib/data.ml
+++ b/lib/data.ml
@@ -1,9 +1,10 @@
-(* Time-stamp: <modified the 23/08/2019 (at 11:32) by Erwan Jahier> *)
+(* Time-stamp: <modified the 12/03/2020 (at 15:40) by Erwan Jahier> *)
type ident = string
type v = I of int | F of float | B of bool
- | E of ident * int
- | A of v array | S of (ident * v) list | U
+ | E of ident * int
+ | A of v array | S of (ident * v) list | U
+ | Str of string
type t =
| Bool | Int | Real
@@ -13,7 +14,8 @@ type t =
| Array of (t * int)
| Alpha of int
| Alias of (string * t)
-
+ | String
+
let (val_to_string_type : v -> string) =
function
| I _ -> "int"
@@ -23,7 +25,8 @@ let (val_to_string_type : v -> string) =
| S _ -> "struct"
| A _ -> "array"
| U -> "nil"
-
+ | Str _ -> "string"
+
let rec (val_to_string : (float -> string) -> v -> string) =
fun s2f ->
function
@@ -40,6 +43,7 @@ let rec (val_to_string : (float -> string) -> v -> string) =
Array.iteri f a;
(!str^"]")
| U -> "nil"
+ | Str str -> str
let (val_to_rif_string : (float -> string) -> v -> string) =
fun s2f ->
@@ -57,19 +61,21 @@ let (val_to_rif_string : (float -> string) -> v -> string) =
Array.iteri f a;
(!str)
| U -> "nil"
+ | Str str -> str
let rec (type_to_string_gen : bool -> t -> string) =
fun alias v ->
let str =
match v with
+ | String -> "string"
| Bool -> "bool"
- | Int -> "int"
- | Real-> "real"
- | Extern s -> s ^ "(*extern*)"
-(* | Enum (s, sl) -> "enum " ^ s ^ " {" ^ (String.concat ", " sl) ^ "}" *)
- | Enum (s, _sl) -> s
- | Struct (sid,_) -> sid ^ "(*struct*)"
+ | Int -> "int"
+ | Real -> "real"
+ | Extern _s -> "string" (* what else should be done? *)
+ (* | Enum (s, sl) -> "enum " ^ s ^ " {" ^ (String.concat ", " sl) ^ "}" *)
+ | Enum (s, _sl) -> s
+ | Struct (sid,_) -> sid
| Array (ty, sz) -> Printf.sprintf "%s^%d" (type_to_string_gen alias ty) sz
| Alpha nb ->
(* On génère des "types" à la Caml : 'a, 'b, 'c, etc. *)
@@ -98,6 +104,7 @@ let (type_of_string : string -> t) =
| "real" -> Real
| "float" -> Real
| "int" -> Int
+ | "string" -> String
| s -> failwith (s ^ ": unsupported type.\n")
diff --git a/lib/data.mli b/lib/data.mli
index bbe9f79..e9bada8 100644
--- a/lib/data.mli
+++ b/lib/data.mli
@@ -1,9 +1,10 @@
-(* Time-stamp: <modified the 04/04/2019 (at 21:27) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/03/2020 (at 11:51) by Erwan Jahier> *)
type ident = string
type v = I of int | F of float | B of bool
- | E of ident * int
- | A of v array | S of (ident * v) list | U
+ | E of ident * int
+ | A of v array | S of (ident * v) list | U
+ | Str of string
type t =
| Bool | Int | Real
@@ -13,6 +14,7 @@ type t =
| Array of (t * int)
| Alpha of int
| Alias of (string * t)
+ | String
val val_to_string : (float -> string) -> v -> string
diff --git a/lib/mypervasives.ml b/lib/mypervasives.ml
index 807e7ae..82565b8 100644
--- a/lib/mypervasives.ml
+++ b/lib/mypervasives.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 23/08/2019 (at 11:29) by Erwan Jahier> *)
+(* Time-stamp: <modified the 14/02/2020 (at 14:08) by Erwan Jahier> *)
(* Should rather be named misc or utils *)
@@ -64,7 +64,8 @@ let rec (list_split7: ('a * 'b * 'c * 'd * 'e * 'f * 'g) list ->
let list_minus a b = List.filter (fun v -> not (List.mem v b)) a
(* returns a U b *)
-let list_union a b = List.fold_left (fun acc x -> if (List.mem x acc) then acc else x::acc) a b
+let list_union a b =
+ List.fold_left (fun acc x -> if (List.mem x acc) then acc else x::acc) a b
(** Removes duplicates from a list (conserving its order) *)
let (list_rm_dup : 'a list -> 'a list) =
@@ -156,64 +157,64 @@ let (my_create_process :
?(wait = true) prog args ->
try
let pid =
- List.iter (fun x -> output_string stderr (x ^ " ")) (prog::args);
- output_string stderr "\n";
- flush stderr;
- Unix.create_process
- prog
- (Array.of_list (prog::args))
- (std_in)
- (std_out)
- (std_err)
+ List.iter (fun x -> output_string stderr (x ^ " ")) (prog::args);
+ output_string stderr "\n";
+ flush stderr;
+ Unix.create_process
+ prog
+ (Array.of_list (prog::args))
+ (std_in)
+ (std_out)
+ (std_err)
in
- if not wait then PID pid else
- let (_,status) = (Unix.waitpid [Unix.WUNTRACED] pid) in
- ( match status with
- Unix.WEXITED i ->
- if i = 0 || i = 1 then
- (
- output_string stderr (" ... "^prog^" exited normally.\n");
- flush stderr;
- OK
- )
- else
- (
- output_string stderr (
+ if not wait then PID pid else
+ let (_,status) = (Unix.waitpid [Unix.WUNTRACED] pid) in
+ ( match status with
+ Unix.WEXITED i ->
+ if i = 0 || i = 1 then
+ (
+ output_string stderr (" ... "^prog^" exited normally.\n");
+ flush stderr;
+ OK
+ )
+ else
+ (
+ output_string stderr (
"*** Error: " ^ prog ^ " exited abnormally (return code=" ^
(string_of_int i)^").\n");
- flush stderr;
- KO
- )
+ flush stderr;
+ KO
+ )
| Unix.WSIGNALED i->
- output_string stderr (
+ output_string stderr (
"*** Error: " ^ prog ^
" process was killed by signal "^(string_of_int i)^"\n");
- flush stderr;
- KO
+ flush stderr;
+ KO
| Unix.WSTOPPED i ->
- output_string stderr (
+ output_string stderr (
"*** Error: " ^ prog ^ " process was stopped by signal " ^
(string_of_int i)^"\n");
- flush stderr;
- KO
- )
+ flush stderr;
+ KO
+ )
with
| Unix.Unix_error(error, name, arg) ->
- let msg = ( "*** '" ^
- (Unix.error_message error) ^
- "'in the system call: '" ^ name ^ " " ^ arg ^ "'\n")
- in
- output_string stdout msg;
- flush stdout;
- output_string stderr msg;
- flush stderr;
- KO
+ let msg = ( "*** '" ^
+ (Unix.error_message error) ^
+ "'in the system call: '" ^ name ^ " " ^ arg ^ "'\n")
+ in
+ output_string stdout msg;
+ flush stdout;
+ output_string stderr msg;
+ flush stderr;
+ KO
| e ->
- output_string stdout (Printexc.to_string e);
- flush stdout;
- output_string stderr (Printexc.to_string e);
- flush stderr;
- KO
+ output_string stdout (Printexc.to_string e);
+ flush stdout;
+ output_string stderr (Printexc.to_string e);
+ flush stderr;
+ KO
(* run a cmd and collect the stdout lines into a list (requires sed) *)
let (run : string -> (string -> string option) -> string list) =
diff --git a/lib/rifIO.ml b/lib/rifIO.ml
index 05b90e8..99f16f4 100644
--- a/lib/rifIO.ml
+++ b/lib/rifIO.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 23/08/2019 (at 11:35) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/03/2020 (at 10:18) by Erwan Jahier> *)
(*-----------------------------------------------------------------------
** This file may only be copied under the terms of the CeCILL
** Public License
@@ -154,143 +154,149 @@ let (read_interface : ?debug:(bool) -> ?label:(string) -> in_channel ->
(* exported *)
(** Reads input values on ic. It should follow the rif format. *)
let rec (read : ?debug:(bool) -> ?label:(string) -> ?pragma:(string list) ->
- in_channel -> out_channel option -> vntl -> subst list) =
+ in_channel -> out_channel option -> vntl -> subst list) =
fun ?(debug=false) ?(label="") ?(pragma = dflt_pragmas) ic oc vntl ->
- let tbl = [] in
- if vntl = [] then tbl else
- let str,stream = get_stream debug label ic oc in
- parse_rif_stream ~debug:debug label ic oc vntl (str,stream) tbl pragma
-
+ let tbl = [] in
+ if vntl = [] then tbl else
+ let str,stream = get_stream debug label ic oc in
+ parse_rif_stream ~debug:debug label ic oc vntl (str,stream) tbl pragma
+
and (parse_rif_stream :
?debug:(bool) -> string -> in_channel -> out_channel option -> vntl ->
string * stream -> subst list -> string list -> subst list) =
fun ?(debug=false) label ic oc vntl (str,stream) tbl pragma ->
- if vntl = [] then tbl else
- let tok_list = Stream.npeek 2 stream in
- match tok_list with
- | [LocalGenlex.Kwd ("#"); LocalGenlex.Ident (id)] ->
- if List.mem id pragma then (
- Stream.junk stream ;
- Stream.junk stream ;
- if id = "quit" || id = "q" then raise Bye;
- if id = "reset" then raise Reset;
- parse_rif_stream label ic oc vntl (str,stream) tbl pragma
- ) else (
- (* We skip everything that occurs after a [#], until the next eol. *)
- Stream.junk stream ;
- (* prerr_endline (">>" ^str); print the ignored string on stderr *)
- parse_rif_stream label ic oc
- vntl (get_stream debug label ic oc) tbl pragma
- )
- | (LocalGenlex.Kwd ("ERROR"|"Error"|"error"))::_ ->
- print_string ("#ERROR value read. bye! ("^str^")\n");
- flush stdout;
- raise Bye
- | (LocalGenlex.Kwd ("#"))::(LocalGenlex.Kwd ("ERROR"|"Error"|"end"))::_ ->
- print_string ("#ERROR value read. bye! ("^str^")\n");
- flush stdout;
- raise Bye
- | (LocalGenlex.Kwd ("#"))::_ ->
- Stream.junk stream ;
- (* prerr_endline (">>>" ^str); print the ignored string on stderr *)
- parse_rif_stream label ic oc vntl (get_stream debug label ic oc) tbl pragma
- | (LocalGenlex.Kwd ("q"))::_ -> print_string "# bye!\n"; raise Bye
- | (LocalGenlex.Kwd ("#@"))::_ ->
- (* Beginning of multi-line comment. Note that here,
- unlike the rif format, we ignore multi line pragmas;
- namely, we handle them as a multi-line comment. *)
- (
- Stream.junk stream ;
- ignore_toks_until_end_of_pragmas
- debug label ic oc vntl (str,stream) tbl pragma
- )
- | (LocalGenlex.Kwd ("nil"))::_
- | (LocalGenlex.Kwd ("?"))::_ ->
- Stream.junk stream ;
- let tbl = tbl @[fst (hd vntl), U] in
- parse_rif_stream label ic oc (tl vntl) (str,stream) tbl pragma
-
- | (LocalGenlex.Float (f))::_ ->
- (
- Stream.junk stream ;
- (* Hashtbl.add tbl (Var.name (hd vntl)) (N(F(f))) ; *)
- let v =
- match snd (hd vntl) with
- | Data.Bool -> B(f<>0.0)
- | Data.Real -> F(f)
- | Data.Int ->
- let i = int_of_float f in
- print_string ("\n*** Warning: type error, " ^ (string_of_float f)
- ^" is an real, but an int is expected. I convert it to '"^
- (string_of_int i)^"'\n");
- I(i)
- | e ->
- print_string ("\n*** Type Error: float found, "^
- (Data.type_to_string e) ^ "expected\n");
- assert false
- in
- let tbl = tbl@ [fst (hd vntl), v] in
- parse_rif_stream label ic oc (tl vntl) (str,stream) tbl pragma
- )
- | (LocalGenlex.Int (i))::_ -> (
- Stream.junk stream ;
- let v =
- match snd (hd vntl) with
- | Data.Bool -> B(i<>0)
- | Data.Int -> I(i)
- | Data.Real ->
- let f = float_of_int i in
- print_string "\n*** Warning: type error, ";
- print_string ((string_of_int i)
- ^ " is an int, but a real is expected. I convert it to '"^
- (string_of_float f)^"'\n");
- F(f)
- | e ->
- print_string ("\n*** Type Error: int found, "^ (Data.type_to_string e)
- ^ "expected \n");
- assert false
- in
- let tbl = tbl @[fst (hd vntl), v] in
- parse_rif_stream label ic oc (tl vntl) (str,stream) tbl pragma
- )
- | (LocalGenlex.Ident (b))::_ -> (
- Stream.junk stream ;
- let v = if mem b ["f"; "F";"false"] then B(false)
- else if mem b ["t"; "T";"true"] then B(true)
- else if mem b ["nil";"?";" ?"] then assert false
- else failwith ("### rif parse error: `" ^ b ^
- "' read, where a bool was expected ("^str^").\n")
- in
- let tbl = tbl @ [fst (hd vntl), v] in
- parse_rif_stream label ic oc (tl vntl) (str,stream) tbl pragma
- )
- | [] ->
- (* Eol is is reached; proceed with the next one *)
- parse_rif_stream label ic oc vntl (get_stream debug label ic oc)
- tbl pragma
- | _ -> failwith ("### rif parse error: not in RIF format ("^str^").\n")
-
+ if vntl = [] then tbl else
+ let tok_list = Stream.npeek 2 stream in
+ match tok_list with
+ | [LocalGenlex.Kwd ("#"); LocalGenlex.Ident (id)] ->
+ if List.mem id pragma then (
+ Stream.junk stream ;
+ Stream.junk stream ;
+ if id = "quit" || id = "q" then raise Bye;
+ if id = "reset" then raise Reset;
+ parse_rif_stream label ic oc vntl (str,stream) tbl pragma
+ ) else (
+ (* We skip everything that occurs after a [#], until the next eol. *)
+ Stream.junk stream ;
+ (* prerr_endline (">>" ^str); print the ignored string on stderr *)
+ parse_rif_stream label ic oc
+ vntl (get_stream debug label ic oc) tbl pragma
+ )
+ | (LocalGenlex.Kwd ("ERROR"|"Error"|"error"))::_ ->
+ print_string ("#ERROR value read. bye! ("^str^")\n");
+ flush stdout;
+ raise Bye
+ | (LocalGenlex.Kwd ("#"))::(LocalGenlex.Kwd ("ERROR"|"Error"|"end"))::_ ->
+ print_string ("#ERROR value read. bye! ("^str^")\n");
+ flush stdout;
+ raise Bye
+ | (LocalGenlex.Kwd ("#"))::_ ->
+ Stream.junk stream ;
+ (* prerr_endline (">>>" ^str); print the ignored string on stderr *)
+ parse_rif_stream label ic oc vntl (get_stream debug label ic oc) tbl pragma
+ | (LocalGenlex.Kwd ("q"))::_ -> print_string "# bye!\n"; raise Bye
+ | (LocalGenlex.Kwd ("#@"))::_ ->
+ (* Beginning of multi-line comment. Note that here,
+ unlike the rif format, we ignore multi line pragmas;
+ namely, we handle them as a multi-line comment. *)
+ (
+ Stream.junk stream ;
+ ignore_toks_until_end_of_pragmas
+ debug label ic oc vntl (str,stream) tbl pragma
+ )
+ | (LocalGenlex.Kwd ("nil"))::_
+ | (LocalGenlex.Kwd ("?"))::_ ->
+ Stream.junk stream ;
+ let tbl = tbl @[fst (hd vntl), U] in
+ parse_rif_stream label ic oc (tl vntl) (str,stream) tbl pragma
+
+ | (LocalGenlex.Float (f))::_ ->
+ (
+ Stream.junk stream ;
+ (* Hashtbl.add tbl (Var.name (hd vntl)) (N(F(f))) ; *)
+ let v =
+ match snd (hd vntl) with
+ | Data.Bool -> B(f<>0.0)
+ | Data.Real -> F(f)
+ | Data.Int ->
+ let i = int_of_float f in
+ print_string ("\n*** Warning: type error, " ^ (string_of_float f)
+ ^" is an real, but an int is expected. I convert it to '"^
+ (string_of_int i)^"'\n");
+ I(i)
+ | e ->
+ print_string ("\n*** Type Error: float found, "^
+ (Data.type_to_string e) ^ "expected\n");
+ assert false
+ in
+ let tbl = tbl@ [fst (hd vntl), v] in
+ parse_rif_stream label ic oc (tl vntl) (str,stream) tbl pragma
+ )
+ | (LocalGenlex.Int (i))::_ -> (
+ Stream.junk stream ;
+ let v =
+ match snd (hd vntl) with
+ | Data.Bool -> B(i<>0)
+ | Data.Int -> I(i)
+ | Data.Real ->
+ let f = float_of_int i in
+ print_string "\n*** Warning: type error, ";
+ print_string ((string_of_int i)
+ ^ " is an int, but a real is expected. I convert it to '"^
+ (string_of_float f)^"'\n");
+ F(f)
+ | Data.String -> Data.Str (string_of_int i)
+ | e ->
+ print_string ("\n*** Type Error: int found, "^ (Data.type_to_string e)
+ ^ "expected \n");
+ assert false
+ in
+ let tbl = tbl @[fst (hd vntl), v] in
+ parse_rif_stream label ic oc (tl vntl) (str,stream) tbl pragma
+ )
+ | (LocalGenlex.String (b))::_ -> (
+ Stream.junk stream ;
+ let v = Str(b) in
+ let tbl = tbl @ [fst (hd vntl), v] in
+ parse_rif_stream label ic oc (tl vntl) (str,stream) tbl pragma
+ )
+ | (LocalGenlex.Ident (b))::_ -> (
+ Stream.junk stream ;
+ let v = if mem b ["f"; "F";"false"] then B(false)
+ else if mem b ["t"; "T";"true"] then B(true)
+ else if mem b ["nil";"?";" ?"] then assert false
+ else Str(b)
+ in
+ let tbl = tbl @ [fst (hd vntl), v] in
+ parse_rif_stream label ic oc (tl vntl) (str,stream) tbl pragma
+ )
+ | [] ->
+ (* Eol is is reached; proceed with the next one *)
+ parse_rif_stream label ic oc vntl (get_stream debug label ic oc)
+ tbl pragma
+ | _ -> failwith ("### rif parse error: not in RIF format ("^str^").\n")
+
and (ignore_toks_until_end_of_pragmas : bool -> string ->
in_channel -> out_channel option-> vntl -> string * stream -> subst list ->
string list -> subst list) =
fun debug label ic oc vntl (str,stream) tbl pragma ->
- (* ignore all tokens until "@#" is reached *)
- let tok_opt = Stream.peek stream in
- match tok_opt with
- | Some(LocalGenlex.Kwd ("@#")) ->
- (
- Stream.junk stream ;
- parse_rif_stream label ic oc vntl (str,stream) tbl pragma
- )
- | Some(_) ->
- (
- Stream.junk stream ;
- ignore_toks_until_end_of_pragmas debug label ic oc vntl (str,stream) tbl pragma
- )
- | None ->
- (* Eol is is reached; proceed with the next one *)
- (ignore_toks_until_end_of_pragmas debug label ic oc vntl
- (get_stream debug label ic oc) tbl pragma)
+ (* ignore all tokens until "@#" is reached *)
+ let tok_opt = Stream.peek stream in
+ match tok_opt with
+ | Some(LocalGenlex.Kwd ("@#")) ->
+ (
+ Stream.junk stream ;
+ parse_rif_stream label ic oc vntl (str,stream) tbl pragma
+ )
+ | Some(_) ->
+ (
+ Stream.junk stream ;
+ ignore_toks_until_end_of_pragmas debug label ic oc vntl (str,stream) tbl pragma
+ )
+ | None ->
+ (* Eol is is reached; proceed with the next one *)
+ (ignore_toks_until_end_of_pragmas debug label ic oc vntl
+ (get_stream debug label ic oc) tbl pragma)
--
GitLab