Commit eb3e0007 authored by Erwan Jahier's avatar Erwan Jahier
Browse files

lurette perso.2 Wed, 31 Oct 2001 15:51:05 +0100 by jahier

Parent-Version:      perso.1
Version-Log:         empty
Project-Description: Lurette
parent fb6edaab
......@@ -7,13 +7,13 @@
(Mercury/graph.m 15076 1002205313 7_graph.m 1.1)
(Mercury/lurette.m 4239 1002789994 5_lurette.m 1.5)
(ID_EN_VRAC 2184 1002196285 0_ID_EN_VRAC 1.1)
(env.ml 22049 1004519854 16_env.ml 1.3)
(env.ml 21601 1004539865 16_env.ml 1.4)
(Mercury/test.aut 1231 1002546062 8_test2.aut 1.1)
(doc/Interface_draft 5232 1003928781 19_Interface_ 1.1)
(Mercury/Mmakefile 102 1002789994 1_Mmakefile 1.3)
(doc/archi.fig 3693 1003928781 20_archi.fig 1.1)
(Makefile 145 1003928781 18_Makefile 1.1)
(interface/generate_lurette_interface.ml 8266 1004519854 24_generate_l 1.1)
(Makefile 212 1004539865 18_Makefile 1.2)
(interface/generate_lurette_interface.ml 10950 1004539865 24_generate_l 1.2)
(interface/Makefile 127 1004519854 25_Makefile 1.1)
(OcamlMakefile 15015 1004519854 17_OcamlMakef 1.2)
(interface/TAGS 608 1004519854 26_TAGS 1.1)
......@@ -25,5 +25,5 @@
(graph.mli 1305 1003932490 13_graph.mli 1.2)
(graph.ml 2397 1003932490 14_graph.ml 1.2)
(lurette.mli 514 1003928781 11_lurette.ml 1.1)
(TAGS 4544 1004519854 21_TAGS 1.2)
(lurette.ml 180 1003928781 12_lurette.ml 1.1)
(TAGS 4544 1004539865 21_TAGS 1.3)
(lurette.ml 477 1004539865 12_lurette.ml 1.2)
OCAMLMAKEFILE = ./OcamlMakefile
SOURCES = graph.mli graph.ml env.mli env.ml lurette.mli lurette.ml
SOURCES = edge.c edge.h \
sut_stub.c sut_idl_stub.idl \
graph.mli graph.ml env.mli env.ml lurette.mli lurette.ml
RESULT = lurette
-include $(OCAMLMAKEFILE)
......@@ -122,25 +122,25 @@ and (parse_multparse_mult218,6493
and (parse_more_multsparse_more_mults222,6629
and (parse_simpleparse_simple230,7083
let (read_env_stateread_env_state243,7514
let (lookuplookup286,9149
let (lookup_memlookup_mem290,9239
let rec (evaleval298,9400
(eval_pre_formulaeval_pre_formula355,11263
(eval_pre_expreval_pre_expr378,12268
(formula_eps_to_stringformula_eps_to_string430,14115
(formula_to_stringformula_to_string435,14249
(expr_to_stringexpr_to_string448,14894
let (arc_info_to_stringarc_info_to_string460,15566
let rec (gen_listgen_list468,15804
let (env__tryenv__try476,16024
let (env__stepenv__step543,18410
let (gvgv558,18901
let (dump_nodes_listdump_nodes_list565,19108
type transtrans582,19716
let (dump_trans_listdump_trans_list584,19755
let (dump_graphdump_graph600,20342
let (generate_graphgenerate_graph608,20695
let (generate_env_graphgenerate_env_graph623,21225
let (lookuplookup297,9593
let (lookup_memlookup_mem301,9683
let rec (evaleval309,9844
(eval_pre_formulaeval_pre_formula366,11707
(eval_pre_expreval_pre_expr389,12712
(formula_eps_to_stringformula_eps_to_string441,14559
(formula_to_stringformula_to_string446,14693
(expr_to_stringexpr_to_string459,15338
let (arc_info_to_stringarc_info_to_string471,16010
let rec (gen_listgen_list479,16248
let (env__tryenv__try487,16468
let (env__stepenv__step554,18854
let (gvgv569,19345
let (dump_nodes_listdump_nodes_list576,19552
type transtrans593,20160
let (dump_trans_listdump_trans_list595,20199
let (dump_graphdump_graph611,20786
let (generate_graphgenerate_graph619,21139
let (generate_env_graphgenerate_env_graph634,21669
lurette.mli,31
Lurette1,0
......
......@@ -258,17 +258,7 @@ let (read_env_state : string -> var_name_and_type list * var_name_and_type list
if (line = "end_of_file") then acc else (readfile_ic ic (acc ^ line))
in
fun file -> readfile_ic (open_in file) ""
inlet (readfile: string -> string) =
(*
** [readfile file] outputs the whole contents of the file `file' in a
** string.
*)
let rec (readfile_ic : in_channel -> string -> string) =
fun ic acc ->
let line = try (input_line ic) with End_of_file -> (close_in ic) ; "end_of_file" in
if (line = "end_of_file") then acc else (readfile_ic ic (acc ^ line))
in
fun file -> readfile_ic (open_in file) ""
in
let Automata(init_node, list_in, list_out, list_loc, list_arcs) =
parse_automata(lexer(Stream.of_channel (open_in file)))
......
......@@ -32,6 +32,8 @@
** //OUT: <C type of the mth output var> <a C identifier for the mth output var>
*)
(****************************************************************************)
(****************************************************************************)
type file_name = string
type module_name = string
......@@ -43,12 +45,13 @@ type output_vars = (var_type * var_name) list
type pragmas = module_name * input_vars * output_vars
type typedef_alias = (string * string) list
(*
** Parsing the pragmas in C files.
*)
(****************************************************************************)
(****************************************************************************)
(* XXX to put in util.ml *)
let (readfile: string -> string) =
(*
** [readfile file] outputs the whole contents of the file `file' in a
......@@ -61,16 +64,55 @@ let (readfile: string -> string) =
in
fun file -> readfile_ic (open_in file) ""
(****************************************************************************)
(****************************************************************************)
let reg_typedef = Str.regexp "^typedef"
let reg_blank = Str.regexp " "
let reg_semicol = Str.regexp ";"
let rec
(read_typedef: file_name -> typedef_alias) =
(*
** [read_typedef file] reads `file' and search for typedef C expressions
** and returns the list of (alias_type, C_type) found in `file'.
*)
fun file ->
let str = readfile file in
find_typedef_list str 0 []
and
(find_typedef_list: string -> int -> typedef_alias -> typedef_alias) =
fun str sptr list ->
try
let (alias, sptr1) = find_next_typedef str sptr in
find_typedef_list str sptr1 (alias::list)
with Not_found -> list
and
(find_next_typedef: string -> int -> ((string * string) * int)) =
fun str sptr ->
let sptr1 = Str.search_forward reg_typedef str sptr in
let sptr2 = Str.search_forward reg_blank str (sptr1+1) in
let sptr3 = Str.search_forward reg_blank str (sptr2+1) in
let sptr4 = Str.search_forward reg_semicol str (sptr3+1) in
let c_type = String.sub str (sptr2 + 1) (sptr3 - sptr2 - 1) in
let alias_type = String.sub str (sptr3 + 1) (sptr4 - sptr3 - 1) in
((alias_type, c_type), sptr4)
(****************************************************************************)
(****************************************************************************)
let reg_MOD = Str.regexp "^//MODULE:"
let reg_IN = Str.regexp "^//IN:"
let reg_OUT = Str.regexp "^//OUT:"
(* let reg_ident = Str.regexp "[a-z\|A-Z\|_][a-z\|A-Z\|_\|0-9]*" *)
(* let reg_int = Str.regexp "[0-9]+" *)
let reg_blank = Str.regexp "[ ]"
(* let reg_ident = Str.regexp "[a-z\|A-Z\|_][a-z\|A-Z\|_\|0-9]*" *)
(* let reg_int = Str.regexp "[0-9]+" *)
let reg_cr = Str.regexp "\n"
let rec (read_pragma_in_c_file: file_name -> module_name * input_vars * output_vars) =
(*
** Parsing the pragmas in C files.
*)
fun file ->
let str = readfile file in
let (mod_name, ni, no, str_ptr1) = find_module_name str in
......@@ -84,6 +126,7 @@ let rec (read_pragma_in_c_file: file_name -> module_name * input_vars * output_v
(string_of_int ni) ^ " and " ^ (string_of_int no) ^
" were declared whereas " ^ (string_of_int (List.length vi)) ^
" and " ^ (string_of_int (List.length vo)) ^ " were counted")
and
(find_module_name: string -> module_name * int * int * int) =
fun str ->
......@@ -119,13 +162,16 @@ and
with _ -> (vars, sptr)
let (generate_stub : module_name -> string -> input_vars -> output_vars -> unit) =
(****************************************************************************)
(****************************************************************************)
let (generate_stub_c : module_name -> string -> input_vars -> output_vars -> unit) =
(*
** [generate_stub mod_name str vi vo] generates a file named `<mod_name>_<str>.c'
** [generate_stub_c mod_name str vi vo] generates a file named `<str>_stub.c'
** that interfaces the sut and the oracle with Lurette.
*)
fun mod_name str vi vo ->
let oc = open_out (mod_name ^ "_" ^ str ^ ".c") in
let oc = open_out (str ^ "_stub.c") in
let put s = output_string oc s in
let ov = rev vo in
let (lo_t, lo_v) = List.hd ov in
......@@ -134,7 +180,7 @@ let (generate_stub : module_name -> string -> input_vars -> output_vars -> unit)
(*
** Compiler directive
*)
put ("// Automatically generated file. Do not edit.\n" ^
put ("// Automatically generated file (from " ^ mod_name ^ ".h).\n" ^
"#include <stdlib.h>\n" ^
"#include \"" ^ mod_name ^ ".h\" \n" ^
" \n") ;
......@@ -143,21 +189,18 @@ let (generate_stub : module_name -> string -> input_vars -> output_vars -> unit)
** variable declarations
*)
List.iter (fun (t, v) -> put (t ^ "\t" ^ v ^ ";\n")) vi ;
put "\n" ;
List.iter (fun (t, v) -> put (t ^ "\t" ^ v ^ ";\n")) vo ;
put "\n" ;
put ("struct " ^ mod_name ^ "_ctx* prg; \n") ;
put ("struct " ^ mod_name ^ "_ctx* prg_copy; \n") ;
put "\n" ;
(*
** Program state initialisation
*)
put "// Program state initialisation \n" ;
put ("void " ^ mod_name ^ "_" ^ str ^ "_init() {\n" ^
put ("void " ^ str ^ "_init() {\n" ^
" struct " ^ mod_name ^ "_ctx* prg = " ^ mod_name ^ "_new_ctx(NULL); }\n") ;
put "\n" ;
......@@ -175,31 +218,20 @@ let (generate_stub : module_name -> string -> input_vars -> output_vars -> unit)
(*
** Step
*)
put "\n" ;
put "// Step \n" ;
put ("void " ^ mod_name ^ "_" ^ str ^ "_step(") ;
List.iter
(fun (t, v) ->
put (t ^ " " ^ v ^ ", ")
)
vi ;
put ("void " ^ str ^ "_step(") ;
List.iter (fun (t, v) -> put (t ^ " " ^ v ^ ", ")) vi ;
List.iter
(fun (t, v) ->
put (t ^ "* " ^ v ^ "_ptr, ")
)
vo_pre ;
List.iter (fun (t, v) -> put (t ^ "* " ^ v ^ "_ptr, ")) vo_pre ;
put (lo_t ^ "* " ^ lo_v ^ "_ptr) {\n");
List.iter
(fun (t, v) -> put (" " ^ mod_name ^ "_I_" ^ v ^ "(prg, " ^ v ^ ");\n"))
vi ;
put "\n" ;
put (" " ^ mod_name ^ "_try(prg);\n\n") ;
List.iter
(fun (t, v) -> put (" " ^ v ^ "_ptr = &" ^ v ^ ";\n"))
vo ;
put (" " ^ mod_name ^ "_step(prg);\n") ;
List.iter (fun (t, v) -> put (" " ^ v ^ "_ptr = &" ^ v ^ ";\n")) vo ;
put "}\n" ;
(*
......@@ -207,59 +239,70 @@ let (generate_stub : module_name -> string -> input_vars -> output_vars -> unit)
*)
put "\n" ;
put "// Try \n" ;
put ("void " ^ mod_name ^ "_" ^ str ^ "_try(") ;
List.iter
(fun (t, v) ->
put (t ^ " " ^ v ^ ", ")
)
vi ;
put ("void " ^ str ^ "_try(") ;
List.iter (fun (t, v) -> put (t ^ " " ^ v ^ ", ")) vi ;
List.iter
(fun (t, v) ->
put (t ^ "* " ^ v ^ "_ptr, ")
)
vo_pre ;
List.iter (fun (t, v) -> put (t ^ "* " ^ v ^ "_ptr, ")) vo_pre ;
put (lo_t ^ "* " ^ lo_v ^ "_ptr) {\n");
put " prg_copy = prg ;\n" ;
put " step(" ;
put (" " ^ str ^ "_step(") ;
List.iter (fun (t, v) -> put (v ^ ", ")) vi ;
List.iter (fun (t, v) -> put (v ^ "_ptr, ")) vo_pre ;
put (lo_v ^ "_ptr); \n");
put " prg = prg_copy;\n" ;
put "}\n" ;
close_out oc
let (generate_idl : module_name -> string -> input_vars -> output_vars -> unit) =
(****************************************************************************)
(****************************************************************************)
let (generate_idl : module_name -> string -> typedef_alias -> input_vars -> output_vars -> unit) =
(*
** [generate_idl mod_name str li lo] generates an idl file named `<mod_name>_idl.idl'
** [generate_idl mod_name str type_alias li lo] generates an idl file named `<str>_idl_stub.idl'
** that camlidl will use to interface C and ocaml.
*)
fun mod_name str vi vo ->
let oc = open_out (mod_name ^ "_idl" ^ str ^ ".idl") in
fun mod_name str type_alias vi vo ->
let oc = open_out (str ^ "_idl_stub.idl") in
let put s = output_string oc s in
let ov = rev vo in
let (lo_t, lo_v) = List.hd ov in
let vo_pre = List.tl ov in
put ("// Automatically generated file (from " ^ mod_name ^ ".h).\n") ;
put "\n" ;
(*
** Compiler directive
** Program state initialisation
*)
put ("// Automatically generated file. Do not edit.\n" ^
"#include <stdlib.h>\n" ^
"#include \"" ^ mod_name ^ ".h\" \n" ^
" \n") ;
put ("void " ^ str ^ "_init(); \n") ;
put "\n" ;
(*
** Step
*)
put ("void " ^ str ^ "_step(\n") ;
List.iter (fun (t, v) -> put (" [in] " ^ (List.assoc t type_alias) ^ " \t" ^ v ^ ", \n")) vi ;
List.iter (fun (t, v) -> put (" [out] " ^ (List.assoc t type_alias) ^ "* \t" ^ v ^ "_ptr,\n")) vo_pre ;
put (" [out] " ^ (List.assoc lo_t type_alias) ^ "* \t" ^ lo_v ^ "_ptr\n); \n");
close_out oc
(****************************************************************************)
(****************************************************************************)
(****************************************************************************)
let (main : unit -> 'a) =
fun () ->
let (m, vi, vo) = read_pragma_in_c_file "edge.h" in
generate_stub m "sut" vi vo ;
generate_stub m "oracle" vi vo
let (m, vi, vo) = read_pragma_in_c_file "edge.h" in
let alias = read_typedef "edge.h" in
generate_stub_c m "sut" vi vo ;
generate_idl m "sut" alias vi vo
;;
main ();;
open Env
let (main : unit -> unit) =
open Sut_idl_stub
let (main : unit -> 'a) =
fun () ->
let l = Env.read_env_state "test.aut" in
generate_env_graph (0, 1) "toto" ;
gv "toto.ps";
(* let l = Env.read_env_state "test.aut" in *)
(* generate_env_graph (0, 1) "toto" ; *)
(* gv "toto.ps"; *)
(* main ();; *)
Sut_idl_stub.sut_init ();
print_int (sut_step 1);
print_string "\n";
print_int (sut_step 0);
print_string "\n";
print_int (sut_step 0);
print_string "\n";
print_int (sut_step 1);
print_string "\n\n";
;;
main ();;
;; -*- Prcs -*-
(Created-By-Prcs-Version 1 3 3)
(Project-Description "Lurette")
(Project-Version lurette perso 1)
(Parent-Version lurette 0 8)
(Version-Log "
Add a module that will generate stubs to interface pac C files
with ocaml. Does not work, i just add it now to be able bactrack.
")
(Project-Version lurette perso 2)
(Parent-Version lurette perso 1)
(Version-Log "")
(New-Version-Log "")
(Checkin-Time "Wed, 31 Oct 2001 09:17:34 +0000")
(Checkin-Time "Wed, 31 Oct 2001 14:51:05 +0000")
(Checkin-Login jahier)
(Populate-Ignore ())
(Project-Keywords)
......@@ -20,20 +17,20 @@ with ocaml. Does not work, i just add it now to be able bactrack.
;; Sources files
(lurette.mli (lurette/11_lurette.ml 1.1 644))
(lurette.ml (lurette/12_lurette.ml 1.1 644))
(lurette.ml (lurette/12_lurette.ml 1.2 644))
(graph.mli (lurette/13_graph.mli 1.2 644))
(graph.ml (lurette/14_graph.ml 1.2 644))
(env.mli (lurette/15_env.mli 1.2 644))
(env.ml (lurette/16_env.ml 1.3 644))
(env.ml (lurette/16_env.ml 1.4 644))
(interface/generate_lurette_interface.mli (lurette/23_generate_l 1.1 644))
(interface/generate_lurette_interface.ml (lurette/24_generate_l 1.1 644))
(interface/generate_lurette_interface.ml (lurette/24_generate_l 1.2 644))
;; Make files
(OcamlMakefile (lurette/17_OcamlMakef 1.2 644))
(Makefile (lurette/18_Makefile 1.1 644))
(Makefile (lurette/18_Makefile 1.2 644))
(interface/Makefile (lurette/25_Makefile 1.1 644))
......@@ -44,7 +41,7 @@ with ocaml. Does not work, i just add it now to be able bactrack.
;; Misc
(README (lurette/10_README 1.1 644))
(ID_EN_VRAC (lurette/0_ID_EN_VRAC 1.1 644))
(TAGS (lurette/21_TAGS 1.2 644))
(TAGS (lurette/21_TAGS 1.3 644))
(interface/TAGS (lurette/26_TAGS 1.1 644))
(test.aut (lurette/22_test.aut 1.1 644))
......
Supports Markdown
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