Commit 8619aa28 authored by erwan's avatar erwan
Browse files

New: add the string type.

parent 5bac6a12
Pipeline #71270 failed with stages
in 53 seconds
......@@ -15,6 +15,8 @@ clean:
dune clean
rm -f lib/lutilsVersion.ml
odoc:
dune build @doc
###############################
# for developpers
......
(lang dune 1.2)
(lang dune 2.0)
(* 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")
......
(* 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
......
(* 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) =
......
(* 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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment