Skip to content

GitLab

Commit 9df215d7 authored by Erwan Jahier's avatar Erwan Jahier
Browse files

Split Rif into Rif and Rif_base. 

The idea is that Rif_base does not depend on any other module while
Rif keeps its interface but relies on Rif_base for its implementation.
parent 8591521a
Hide whitespace changes
Inline Side-by-side
Makefile
View file @ 9df215d7
......@@ -24,10 +24,12 @@ build: gen_version
cd source && make clean && make install&& cd ..&&\
ln -sf pre_release/$(HOSTTYPE) && \
cd install && autoconf && cd .. &&\
make lus2lic && \
./RUN_ME
lus2lic:
cp `which lus2lic` $(BIN_INSTALL_DIR)
#
clean:
cd polka; make clean; cd ..
......
source/Lucky/Makefile.luc4c
View file @ 9df215d7
......@@ -130,6 +130,8 @@ SOURCES = $(SOURCES_C) \
$(OBJDIR)/lucFGen.ml \
$(OBJDIR)/print.mli \
$(OBJDIR)/print.ml \
$(OBJDIR)/rif_base.mli \
$(OBJDIR)/rif_base.ml \
$(OBJDIR)/rif.mli \
$(OBJDIR)/rif.ml \
$(OBJDIR)/sim2chro.mli \
......
source/Lucky/Makefile.luc4ocaml
View file @ 9df215d7
......@@ -104,6 +104,8 @@ SOURCES_OCAML = \
$(OBJDIR)/lucFGen.ml \
$(OBJDIR)/print.mli \
$(OBJDIR)/print.ml \
$(OBJDIR)/rif_base.mli \
$(OBJDIR)/rif_base.ml \
$(OBJDIR)/rif.mli \
$(OBJDIR)/rif.ml \
$(OBJDIR)/sim2chro.mli \
......
source/Lucky/Makefile.lucky
View file @ 9df215d7
......@@ -111,6 +111,8 @@ SOURCES_OCAML0:= \
$(OBJDIR)/lucFGen.ml \
$(OBJDIR)/print.mli \
$(OBJDIR)/print.ml \
$(OBJDIR)/rif_base.mli \
$(OBJDIR)/rif_base.ml \
$(OBJDIR)/rif.mli \
$(OBJDIR)/rif.ml \
$(OBJDIR)/sim2chro.mli \
......
source/Lucky/Makefile.show_luc
View file @ 9df215d7
......@@ -110,6 +110,8 @@ SOURCES_OCAML := \
$(OBJDIR)/lucFGen.ml \
$(OBJDIR)/print.mli \
$(OBJDIR)/print.ml \
$(OBJDIR)/rif_base.mli \
$(OBJDIR)/rif_base.ml \
$(OBJDIR)/rif.mli \
$(OBJDIR)/rif.ml \
$(OBJDIR)/sim2chro.mli \
......
source/Lutin/Makefile.lutin
View file @ 9df215d7
......@@ -101,6 +101,8 @@ LURETTE_SOURCES=\
$(OBJDIR)/lucFGen.ml \
$(OBJDIR)/lucky.mli \
$(OBJDIR)/lucky.ml \
$(OBJDIR)/rif_base.mli \
$(OBJDIR)/rif_base.ml \
$(OBJDIR)/rif.mli \
$(OBJDIR)/rif.ml \
......
source/common/Makefile.luckyDraw
View file @ 9df215d7
......@@ -77,6 +77,7 @@ SOURCES_OCAML = \
$(OBJDIR)/fGen.ml \
$(OBJDIR)/lucFGen.ml \
$(OBJDIR)/print.ml \
$(OBJDIR)/rif_base.ml \
$(OBJDIR)/rif.ml \
$(OBJDIR)/sim2chro.ml \
$(OBJDIR)/lucky.ml \
......
source/common/Makefile.lurette4ocaml_II
View file @ 9df215d7
......@@ -87,6 +87,8 @@ SOURCES = \
$(OBJDIR)/lucFGen.ml \
$(OBJDIR)/print.mli \
$(OBJDIR)/print.ml \
$(OBJDIR)/rif_base.mli \
$(OBJDIR)/rif_base.ml \
$(OBJDIR)/rif.mli \
$(OBJDIR)/rif.ml \
$(OBJDIR)/sim2chro.mli \
......
source/common/Makefile.lurette_lib
View file @ 9df215d7
......@@ -111,6 +111,8 @@ SOURCES = $(SOURCES_C) \
$(OBJDIR)/lucFGen.ml \
$(OBJDIR)/print.mli \
$(OBJDIR)/print.ml \
$(OBJDIR)/rif_base.mli \
$(OBJDIR)/rif_base.ml \
$(OBJDIR)/rif.mli \
$(OBJDIR)/rif.ml \
$(OBJDIR)/sim2chro.mli \
......
source/common/rif.ml
View file @ 9df215d7
......@@ -13,218 +13,68 @@ open List
open Value
open Prog
let lexer = Genlex.make_lexer ["q"; "#"; "x"; "load_luc"; "#@"; "@#"]
(* xxx Which pragmas should be defined ? *)
let rif_pragmas = ["inputs"]
(* let rif_pragmas = ["outs";"outputs";"program";"inputs";"step";"reset"] *)
let write_rif = ref (fun str -> ())
let close_rif = ref (fun () -> ())
let flush_rif = ref (fun () -> ())
let (open_rif_file : string -> unit) =
fun file ->
let oc = open_out file in
write_rif := (fun str -> output_string oc str);
close_rif := (fun () -> close_out oc);
flush_rif := (fun () -> flush oc)
let (open_rif_file : string -> unit) = Rif_base.open_rif_file
let (close_rif_file : unit -> unit) =
!close_rif
type stream = Genlex.token Stream.t
let rec (parse_string_list : stream -> string list -> string list) =
fun stream sl ->
try (
match (Stream.next stream) with
(Genlex.String(_, str)) -> parse_string_list stream (str::sl)
| _ -> failwith ("### parse error. A string (wrapped with double" ^
"quotes) was expected. \n")
)
with Stream.Failure ->
sl
(*------------------------------------------------------------------------*)
let (value_to_rif_val : Value.t -> Rif_base.rif_val) =
function
Value.B b -> Rif_base.B b
| Value.N(Value.I i)-> Rif_base.I i
| Value.N(Value.F f)-> Rif_base.F f
let (rif_val_to_value : Rif_base.rif_val -> Value.t) =
function
Rif_base.B b -> Value.B b
| Rif_base.I i -> Value.N(Value.I i)
| Rif_base.F f -> Value.N(Value.F f)
let (to_subst_list : Value.OfIdent.t -> Rif_base.subst list) =
fun x ->
Value.OfIdent.fold
(fun name value acc ->
(name, value_to_rif_val value)::acc
)
x
[]
let read_line ic =
let str = input_line ic in
!write_rif (str);
str
(*------------------------------------------------------------------------*)
(* exported *)
let rec (read : in_channel -> Exp.var list -> Var.env_in) =
fun ic vntl ->
(** Reads input values on ic. It should follow the rif format. *)
let tbl = Value.OfIdent.empty in
if vntl = [] then tbl else
let line = read_line ic in
let stream = lexer (Stream.of_string line) in
parse_rif_stream ic vntl stream tbl
and (parse_rif_stream : in_channel -> Exp.var list -> stream -> Var.env_in -> Var.env_in) =
fun ic vntl stream tbl ->
if vntl = [] then tbl else
let tok_list = Stream.npeek 2 stream in
match tok_list with
| [Genlex.Kwd (_,"#"); Genlex.Ident (_,id)] ->
if List.mem id rif_pragmas then (
Stream.junk stream ;
Stream.junk stream ;
parse_rif_stream ic vntl
(lexer (Stream.of_string (read_line ic))) tbl
) else (
(* We skip everything that occurs after a [#] not followed by a
member of [rif_pragmas], until the next eol. *)
Stream.junk stream ;
parse_rif_stream ic
vntl (lexer (Stream.of_string (read_line ic))) tbl
)
| (Genlex.Kwd (_,"#"))::_ ->
Stream.junk stream ;
parse_rif_stream ic vntl (lexer (Stream.of_string (read_line ic)))
tbl
| (Genlex.Kwd (_,"q"))::_ -> print_string "# bye!\n"; exit 0
| (Genlex.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 ic vntl stream tbl
)
| (Genlex.Float (_,f))::_ ->
(
Stream.junk stream ;
(* Hashtbl.add tbl (Var.name (hd vntl)) (N(F(f))) ; *)
let tbl' = Value.OfIdent.add tbl (Var.name (hd vntl), N(F(f))) in
parse_rif_stream ic (tl vntl) stream tbl'
)
| (Genlex.Int (_,i))::_ -> (
Stream.junk stream ;
let v =
if ((Type.to_string (Var.typ (hd vntl))) = "bool") then (
if (i = 0) then B(false) else B(true)
) else N(I(i))
in
let tbl' = Value.OfIdent.add tbl (Var.name (hd vntl), v) in
parse_rif_stream ic (tl vntl) stream tbl'
)
| (Genlex.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 failwith ("### parse error: `" ^ b ^ "' is not expected.\n")
in
let tbl' = Value.OfIdent.add tbl (Var.name (hd vntl), v) in
parse_rif_stream ic (tl vntl) stream tbl'
)
| [] ->
(* Eol is is reached; proceed with the next one *)
parse_rif_stream ic vntl (lexer (Stream.of_string (read_line ic)))
tbl
| _ -> failwith ("### parse error: not in RIF format.\n")
and (ignore_toks_until_end_of_pragmas :
in_channel -> Exp.var list -> stream -> Var.env_in -> Var.env_in) =
fun ic vntl stream tbl ->
(* ignore all tokens until "@#" is reached *)
let tok_opt = Stream.peek stream in
match tok_opt with
| Some(Genlex.Kwd (_,"@#")) ->
(
Stream.junk stream ;
parse_rif_stream ic vntl stream tbl
)
| Some(_) ->
(
Stream.junk stream ;
ignore_toks_until_end_of_pragmas ic vntl stream tbl
)
| None ->
(* Eol is is reached; proceed with the next one *)
(ignore_toks_until_end_of_pragmas ic vntl
(lexer (Stream.of_string (read_line ic))) tbl)
let (read : in_channel -> Exp.var list -> Var.env_in) =
fun ic vars ->
let sl = Rif_base.read ic
(List.map (fun v -> Var.name v, Type.to_string2 (Var.typ v)) vars)
in
let sl = List.map (fun (n,value) -> (n, rif_val_to_value value)) sl in
Value.OfIdent.from_list sl
(*------------------------------------------------------------------------*)
(* exported *)
let (write : out_channel -> string -> unit) =
fun oc str ->
output_string oc str;
!write_rif str
let (write : out_channel -> string -> unit) = Rif_base.write
let (flush : out_channel -> unit) =
fun oc ->
flush oc;
!flush_rif ()
(* exported *)
let (flush : out_channel -> unit) = Rif_base.flush
(*------------------------------------------------------------------------*)
(* exported *)
let (write_interface : out_channel -> Exp.var list -> Exp.var list -> Exp.var list option -> unit) =
fun oc in_vars out_vars loc_vars_opt ->
let str =
(List.fold_left
(fun acc v ->
acc ^ "\"" ^ (Var.name v) ^ "\":" ^ (Type.to_string2 (Var.typ v)) ^ " ")
"#inputs "
in_vars) ^
"\n#outputs " ^
(List.fold_left
(fun acc v ->
acc ^ "\"" ^ (Var.name v) ^ "\":" ^ (Type.to_string2 (Var.typ v)) ^ " ")
""
out_vars) ^
(match loc_vars_opt with
| None -> "\n"
| Some loc_vars ->
((List.fold_left
(fun acc v ->
acc^"\"" ^ (Var.name v) ^ "\":" ^ (Type.to_string2 (Var.typ v)) ^ " ")
"\n#locals "
(fst (List.partition (fun v -> (Var.alias v) = None) loc_vars ))
) ^ "\n")
)
in
write oc str
Rif_base.write_interface oc
(List.map (fun v -> Var.name v, Type.to_string2 (Var.typ v)) in_vars)
(List.map (fun v -> Var.name v, Type.to_string2 (Var.typ v)) out_vars)
(match loc_vars_opt with
| None -> None
| Some vars ->
Some (List.map (fun v -> Var.name v, Type.to_string2 (Var.typ v)) vars)
)
(*------------------------------------------------------------------------*)
(* exported *)
let (write_outputs : out_channel -> Exp.var list -> Value.OfIdent.t -> unit) =
fun oc vntl sl ->
let str =
List.fold_left
(fun acc v ->
acc^ (if (Var.alias v) <> None
then
(*
Do not show aliased var. Should I?
nb: anyway, they do not appear in [sl]
*)
""
else
(* let _ = assert (List.mem_assoc (Var.name v) sl) in *)
(* print_string ((Var.name v) ^ ":"); *)
try
(* Value.print oc (List.assoc (Var.name v) sl) *)
Value.to_string (Value.OfIdent.get sl (Var.name v))
with Not_found -> assert false
)
)
""
vntl
in
write oc str
let (write_outputs : out_channel -> Exp.var list -> Value.OfIdent.t -> unit) =
fun oc vars x ->
Rif_base.write_outputs oc
(List.map (fun v -> Var.name v, Type.to_string2 (Var.typ v)) vars)
(to_subst_list x)
source/common/rif.mli
View file @ 9df215d7
......@@ -16,8 +16,10 @@
val open_rif_file : string -> unit
(** Reads from stdin the inputs *)
(** Reads the input values *)
val read : in_channel -> Exp.var list -> Var.env_in
(* nb: [read] uses [read_vntl] *)
val write : out_channel -> string -> unit
......
source/common/rif_base.ml 0 → 100644
View file @ 9df215d7
(*-----------------------------------------------------------------------
** Copyright (C) - Verimag.
** This file may only be copied under the terms of the GNU Library General
** Public License
**-----------------------------------------------------------------------
**
** File: rif.ml
** Author: jahier@imag.fr
*)
open List
let lexer = Genlex.make_lexer ["q"; "#"; "x"; "load_luc"; "#@"; "@#"]
(* xxx Which pragmas should be defined ? *)
let rif_pragmas = ["inputs"]
(* let rif_pragmas = ["outs";"outputs";"program";"inputs";"step";"reset"] *)
let write_rif = ref (fun str -> ())
let close_rif = ref (fun () -> ())
let flush_rif = ref (fun () -> ())
let (open_rif_file : string -> unit) =
fun file ->
let oc = open_out file in
write_rif := (fun str -> output_string oc str);
close_rif := (fun () -> close_out oc);
flush_rif := (fun () -> flush oc)
let (close_rif_file : unit -> unit) =
!close_rif
type stream = Genlex.token Stream.t
let rec (parse_string_list : stream -> string list -> string list) =
fun stream sl ->
try (
match (Stream.next stream) with
(Genlex.String(_, str)) -> parse_string_list stream (str::sl)
| _ -> failwith ("### parse error. A string (wrapped with double" ^
"quotes) was expected. \n")
)
with Stream.Failure ->
sl
(* Variable name and type list *)
type vntl = (string * string) list
(* exported *)
type rif_val = B of bool | F of float | I of int
(* exported *)
type subst = (string * rif_val)
let (rif_val_to_string : rif_val -> string) =
function
B true -> "t"
| B false -> "f"
| F f -> Util.my_string_of_float f
| I i -> string_of_int i
(*------------------------------------------------------------------------*)
let read_line ic =
let str = input_line ic in
!write_rif (str);
str
let (rm_blank : string -> string) =
fun s ->
let buff = ref "" in
for i = 0 to String.length s - 1 do
match s.[i] with
| ' ' | '\t' | '\n' | '\"' -> ()
| c -> buff:=!buff^(String.make 1 c)
done;
!buff
let (to_pair : string -> string * string) =
fun s ->
match Str.split (Str.regexp ":") s with
| [n;t] -> rm_blank n, rm_blank t
| _ -> failwith ("Rif: Cannot split "^s)
let _ = assert (to_pair "T:bool" = ("T","bool"))
let rec (read_until_pragma_end : in_channel -> string -> string) =
fun ic str ->
let line = read_line ic in
if String.sub line 0 2 = "@#" then str else
read_until_pragma_end ic (str^" "^line)
(* exported *)
let rec (read_interface : in_channel -> (string * string) list * (string * string) list) =
fun ic ->
let rec loop ins outs =
let line = read_line ic in
if Str.string_match (Str.regexp "#step") line 0 then
ins, outs
else if Str.string_match (Str.regexp "#inputs") line 0 then
let str = String.sub line 8 (String.length line - 8) in
let l = Str.split (Str.regexp " ") str in
loop (List.map to_pair l) outs
else if Str.string_match (Str.regexp "#@inputs") line 0 then
let str = String.sub line 8 (String.length line - 8) in
let str = read_until_pragma_end ic str in
let l = Str.split (Str.regexp " ") str in
loop (List.map to_pair l) outs
else if Str.string_match (Str.regexp "#outputs") line 0 then
let str = String.sub line 9 (String.length line - 9) in
let l = Str.split (Str.regexp " ") str in
loop ins (List.map to_pair l)
else if Str.string_match (Str.regexp "#@outputs") line 0 then
let str = String.sub line 9 (String.length line - 9) in
let str = read_until_pragma_end ic str in
let l = Str.split (Str.regexp " ") str in
loop ins (List.map to_pair l)
else
loop ins outs
in
loop [] []
(* exported *)
let rec (read : ?pragma:(string list) -> in_channel -> vntl -> subst list) =
fun ?(pragma = []) ic vntl ->
(** Reads input values on ic. It should follow the rif format. *)
let tbl = [] in
if vntl = [] then tbl else
let line = read_line ic in
let stream = lexer (Stream.of_string line) in
parse_rif_stream ic vntl stream tbl pragma
and (parse_rif_stream : in_channel -> vntl -> stream -> subst list -> string list -> subst list) =
fun ic vntl stream tbl pragma ->
if vntl = [] then tbl else
let tok_list = Stream.npeek 2 stream in
match tok_list with
| [Genlex.Kwd (_,"#"); Genlex.Ident (_,id)] ->
if List.mem id pragma then (
Stream.junk stream ;
Stream.junk stream ;
parse_rif_stream ic vntl stream tbl pragma
) else (
(* We skip everything that occurs after a [#], until the next eol. *)
Stream.junk stream ;
parse_rif_stream ic
vntl (lexer (Stream.of_string (read_line ic))) tbl pragma
)
| (Genlex.Kwd (_,"#"))::_ ->
Stream.junk stream ;
parse_rif_stream ic vntl (lexer (Stream.of_string (read_line ic)))
tbl pragma
| (Genlex.Kwd (_,"q"))::_ -> print_string "# bye!\n"; exit 0
| (Genlex.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 ic vntl stream tbl pragma
)
| (Genlex.Float (_,f))::_ ->
(
Stream.junk stream ;
(* Hashtbl.add tbl (Var.name (hd vntl)) (N(F(f))) ; *)
let tbl = tbl@ [fst (hd vntl), F(f)] in
parse_rif_stream ic (tl vntl) stream tbl pragma
)
| (Genlex.Int (_,i))::_ -> (
Stream.junk stream ;
let v =
if (((snd (hd vntl))) = "bool") then (
if (i = 0) then B(false) else B(true)
) else I(i)
in
let tbl = tbl @[fst (hd vntl), v] in
parse_rif_stream ic (tl vntl) stream tbl pragma
)
| (Genlex.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 failwith ("### parse error: `" ^ b ^ "' is not expected.\n")
in
let tbl = tbl @ [fst (hd vntl), v] in
parse_rif_stream ic (tl vntl) stream tbl pragma
)
| [] ->
(* Eol is is reached; proceed with the next one *)
parse_rif_stream ic vntl (lexer (Stream.of_string (read_line ic)))
tbl pragma
| _ -> failwith ("### parse error: not in RIF format.\n")
and (ignore_toks_until_end_of_pragmas :
in_channel -> vntl -> stream -> subst list -> string list -> subst list) =
fun ic vntl stream tbl pragma ->
(* ignore all tokens until "@#" is reached *)
let tok_opt = Stream.peek stream in
match tok_opt with
| Some(Genlex.Kwd (_,"@#")) ->
(
Stream.junk stream ;
parse_rif_stream ic vntl stream tbl pragma
)
| Some(_) ->
(
Stream.junk stream ;
ignore_toks_until_end_of_pragmas ic vntl stream tbl pragma
)
| None ->
(* Eol is is reached; proceed with the next one *)
(ignore_toks_until_end_of_pragmas ic vntl
(lexer (Stream.of_string (read_line ic))) tbl pragma)
(*------------------------------------------------------------------------*)
(* exported *)
let (write : out_channel -> string -> unit) =
fun oc str ->