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

lurette perso.1 Wed, 31 Oct 2001 10:17:34 +0100 by jahier

Parent-Version:      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-Description: Lurette
parent 6e693ab4
......@@ -3,16 +3,20 @@
(Created-By-Prcs-Version 1 3 3)
(env.mli 3428 1003932490 15_env.mli 1.2)
(test.aut 644 1003928781 22_test.aut 1.1)
(interface/generate_lurette_interface.mli 2054 1004519854 23_generate_l 1.1)
(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 21466 1003932490 16_env.ml 1.2)
(env.ml 22049 1004519854 16_env.ml 1.3)
(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)
(OcamlMakefile 14977 1003928781 17_OcamlMakef 1.1)
(interface/generate_lurette_interface.ml 8266 1004519854 24_generate_l 1.1)
(interface/Makefile 127 1004519854 25_Makefile 1.1)
(OcamlMakefile 15015 1004519854 17_OcamlMakef 1.2)
(interface/TAGS 608 1004519854 26_TAGS 1.1)
(README 0 1002791390 10_README 1.1)
(Mercury/env.m 9937 1003928781 4_env_automa 1.5)
(Mercury/dot_automata.m 5814 1002546062 9_dot_automa 1.1)
......@@ -21,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 1048 1003928781 21_TAGS 1.1)
(TAGS 4544 1004519854 21_TAGS 1.2)
(lurette.ml 180 1003928781 12_lurette.ml 1.1)
......@@ -5,7 +5,7 @@
# For updates see:
# http://miss.wu-wien.ac.at/~mottl/ocaml_sources
#
# $Id: OcamlMakefile 1.1 Wed, 24 Oct 2001 15:06:21 +0200 jahier $
# $Id: OcamlMakefile 1.2 Wed, 31 Oct 2001 10:17:34 +0100 jahier $
#
###########################################################################
......@@ -369,6 +369,7 @@ endif
###########################################################################
# USER RULES
# generates byte-code (default)
byte-code: $(PRE_TARGETS)
@$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
......@@ -456,6 +457,14 @@ profiling-native-code-library: $(PRE_TARGETS)
make_deps=yes
pncl: profiling-native-code-library
# R1
tags:
otags -v $(SOURCES)
###########################################################################
# LOW LEVEL RULES
......
dot_automata.mli,0
graph.mli,219
Graph1,0
tt16,425
val createcreate19,443
val add_transadd_trans25,508
val get_list_of_target_nodesget_list_of_target_nodes32,709
val get_all_nodesget_all_nodes41,1078
val get_all_transget_all_trans46,1179
env.mli,301
type automata automata30,984
type var_typevar_type31,999
type datedate32,1013
type formula_epsformula_eps33,1023
type formulaformula34,1040
type weigth = intweigth35,1053
type node = intnode37,1072
type arc = node * nodearc38,1088
type arc_info = weigth * formula_epsarc_info39,1111
graph.ml,346
Graph1,0
tt18,513
mutabletable19,533
mutable nodesnodes20,586
mutable transtrans21,614
let (createcreate26,659
let (add_transadd_trans37,824
exception GraphErrorGraphError55,1575
let (get_list_of_target_nodesget_list_of_target_nodes58,1608
let (get_all_nodesget_all_nodes70,2116
let (get_all_transget_all_trans77,2242
graph.mli,25
type ('a, 'b) tt16,426
env.mli,768
Env1,0
type var_name_and_typevar_name_and_type38,1293
type datedate39,1316
type formula_epsformula_eps40,1326
type formulaformula41,1343
type weigthweigth42,1356
type nodenode44,1375
type arcarc45,1391
type arc_infoarc_info46,1414
type memory_eltmemory_elt47,1451
type substsubst48,1468
type env_inenv_in49,1480
type env_outenv_out50,1505
type env_locenv_loc51,1531
type env_stateTenv_stateT54,1559
mutable current_nodecurrent_node55,1579
mutable graphgraph56,1610
mutable inputinput61,1723
mutable outputoutput62,1750
mutable locallocal63,1778
val read_env_stateread_env_state69,1884
val env__tryenv__try80,2342
val env__stepenv__step90,2776
val generate_env_graphgenerate_env_graph99,3044
val gvgv112,3405
lurette.mli,0
env.ml,3055
Env1,0
type weigthweigth16,420
type exprexpr18,439
| SumSum19,452
| DiffDiff20,477
| ProdProd21,502
| QuotQuot22,527
| ModMod23,552
| DivDiv24,577
| VarVar25,602
| ValVal26,620
| Pre_ePre_e27,689
type formulaformula29,708
| AndAnd30,723
| OrOr31,752
| NotNot32,781
| TrueTrue33,800
| FalseFalse34,809
| BoolBool35,819
| EqEq37,869
| GeGe38,901
| GG38,901
| Pre_fPre_f40,965
type formula_epsformula_eps42,989
| EpsEps43,1009
| FF44,1017
type nodenode48,1113
type arcarc50,1130
type arc_infoarc_info52,1154
type var_namevar_name54,1192
type memory_eltmemory_elt55,1215
type memory_elt = BB55,1215
type memory_elt = B of bool | VV55,1215
type memory_elt = B of bool | V of string | UU55,1215
type substsubst56,1261
type env_inenv_in57,1298
type env_outenv_out58,1324
type env_locenv_loc59,1350
type env_stateTenv_stateT62,1378
mutable current_nodecurrent_node63,1398
mutable graphgraph64,1429
mutable inputinput69,1542
mutable outputoutput70,1569
mutable locallocal71,1597
let (env_stateenv_state75,1628
type datedate83,1775
type var_typevar_type88,1878
type var_name_and_typevar_name_and_type89,1901
type read_arcread_arc91,1947
type read_arc = ArcArc91,1947
type read_automataread_automata93,1994
type read_automata = AutomataAutomata93,1994
exception EnvErrorEnvError102,2334
let lexerlexer111,2498
type aut_tokenaut_token117,2688
let rec (parse_automataparse_automata119,2728
and (parse_list_varparse_list_var132,3178
and (parse_list_var_tailparse_list_var_tail138,3418
and (parse_varparse_var144,3683
and (parse_list_arcparse_list_arc150,3855
and (parse_list_arc_tailparse_list_arc_tail156,4055
and (parse_arcparse_arc162,4276
and (parse_arc_infoparse_arc_info168,4524
and (parse_formula_epsparse_formula_eps173,4688
and (parse_formulaparse_formula179,4853
and (parse_more_formulaparse_more_formula190,5461
and (parse_expr_rightparse_expr_right196,5700
and (parse_exprparse_expr208,6088
and (parse_more_addsparse_more_adds212,6221
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
sut.mli,0
lurette.mli,31
Lurette1,0
val mainmain2,1
lurette.ml,185
type memory_element = B of bool | Val of stringmemory_element2,3
type memory = (string, memory_element) Hashtbl.tmemory4,52
let memory_init n = Hashtbl.create n lmemory_init6,103
graph.ml,342
type ('a, 'b) t = {t18,514
let (create: unit -> ('a, 'b) t) = t26,660
let (add_trans: ('a, 'b) t -> 'a -> 'b -> 'a -> unit) = t37,825
let (get_arc_label_list_from_node: ('a, 'b) t -> 'a -> 'b list) =t56,1535
let (get_all_nodes: ('a, 'b) t -> 'a list) = t64,1809
let (get_all_trans: ('a, 'b) t -> ('a * 'b * 'a) list ) = t71,1935
dot_automata.ml,64
type trans = (Env.node * Env.arc_info * Env.node)trans34,1012
lurette.ml,33
Lurette1,0
let (mainmain5,14
......@@ -252,15 +252,26 @@ let (read_env_state : string -> var_name_and_type list * var_name_and_type list
** [readfile file] outputs the whole contents of the file `file' in a
** string.
*)
let rec readfile_ic ic str =
let line = try (input_line ic) with End_of_file -> (close_in ic) ; "end_of_file"
in
if (line = "end_of_file") then str else (readfile_ic ic (str ^ line))
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
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_string (readfile file)))
parse_automata(lexer(Stream.of_channel (open_in file)))
in
let (add_arc: read_arc -> unit) =
fun arc ->
......@@ -508,7 +519,11 @@ let (env__try : int -> env_in -> (node * env_out * env_loc) list) =
let arc_label_list = (weigthed_list_to_list arc_label_weighted_list) in
let n = Random.int (List.length arc_label_list) in
let (node_to, f) = (List.nth arc_label_list n) in
if (f = Eps) then (choose_transition node_to) else (node_to, f)
if (f = Eps) then
(* If the chosen transition is Eps, we chose again from the new node *)
(choose_transition node_to)
else
(node_to, f)
in
let (solve_formula: formula -> env_out * env_loc) =
......
OCAMLMAKEFILE = ../OcamlMakefile
SOURCES = generate_lurette_interface.ml
RESULT = geni
LIBS = str
-include $(OCAMLMAKEFILE)
generate_lurette_interface.ml,572
Generate_lurette_interface1,0
type file_namefile_name36,1362
type module_namemodule_name37,1386
type var_typevar_type38,1412
type var_namevar_name39,1435
type input_varsinput_vars41,1459
type output_varsoutput_vars42,1505
type pragmaspragmas44,1552
let lexerlexer52,1662
type tokentoken54,1727
(parse_pragmasparse_pragmas58,1774
(parse_module_nameparse_module_name71,2131
(parse_module_name_moreparse_module_name_more82,2412
(parse_varsparse_vars98,2710
let (read_pragma_in_c_fileread_pragma_in_c_file119,3192
let (mainmain155,3850
(*-----------------------------------------------------------------------
** Copyright (C) 2001 - Verimag.
** This file may only be copied under the terms of the GNU Library General
** Public License
**-----------------------------------------------------------------------
**
** File: generate_lurette_interface.ml
** Main author: jahier@imag.fr
**
**
** Implements a program that takes as input the string "sut"
** (resp. "oracle") as well as a C header file `<foo>.h' to interface,
** and which outputs stub files named `lurette_sut.h' and
** `lurette_sut.c' (resp. `lurette_oracle.h' and `lurette_oracle.c').
** Those files are used by the lurette Makefile to interface the sut
** (resp. the oracle).
**
** Note that <foo>.h should follows the poc convention (e.g., generated
** by a lustre compiler) Namely, it should contain the following pragmas:
**
** //MODULE: <module name> n m
** // where `n' is the input var number, and `m' the output var one
** //IN: <C type of the first input var> <a C identifier for the first input var>
** .
** .
** .
** //IN: <C type of the nth input var> <a C identifier for the nth input var>
** //OUT: <C type of the first output var> <a C identifier for the first output var>
** .
** .
** .
** //OUT: <C type of the mth output var> <a C identifier for the mth output var>
*)
type file_name = string
type module_name = string
type var_type = string
type var_name = string
type input_vars = (var_type * var_name) list
type output_vars = (var_type * var_name) list
type pragmas = module_name * input_vars * output_vars
(*
** Parsing the pragmas in C files.
*)
let (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 ^ "\n" ^ line))
in
fun file -> readfile_ic (open_in file) ""
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_cr = Str.regexp "\n"
let rec (read_pragma_in_c_file: file_name -> module_name * input_vars * output_vars) =
fun file ->
let str = readfile file in
let (mod_name, ni, no, str_ptr1) = find_module_name str in
let (vi, str_ptr2) = find_var_list reg_IN str str_ptr1 [] in
let (vo, _) = find_var_list reg_OUT str str_ptr2 [] in
if (List.length vi = ni && List.length vo = no) then
(mod_name, vi, vo)
else
failwith ("Inconsistent pragmas found in `" ^ file ^
"'. The number of variables is wrong: " ^
(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 ->
let beg = Str.search_forward reg_MOD str 0 in
let mod_name_beg = Str.search_forward reg_blank str beg in
let mod_name_end = Str.search_forward reg_blank str (mod_name_beg+1) in
let mod_name = String.sub str (mod_name_beg+1) (mod_name_end - mod_name_beg - 1) in
let vi_nb_end = Str.search_forward reg_blank str (mod_name_end+1) in
let vi_nb_str = String.sub str (mod_name_end+1) (vi_nb_end - mod_name_end - 1) in
let vi_nb =
try (int_of_string vi_nb_str)
with _ -> failwith ("*** `" ^ vi_nb_str ^ "'is not an int")
in
let vo_nb_end = Str.search_forward reg_cr str (vi_nb_end + 1) in
let vo_nb_str = String.sub str (vi_nb_end+1) (vo_nb_end - vi_nb_end - 1) in
let vo_nb =
try(int_of_string vo_nb_str)
with _ -> failwith ("*** `" ^ vo_nb_str ^ "'is not an int")
in
(mod_name, vi_nb, vo_nb, vo_nb_end)
and
(find_var_list: Str.regexp -> string -> int -> input_vars -> input_vars * int) =
fun reg str sptr vars ->
try
let beg = Str.search_forward reg str sptr in
let var_type_b = Str.search_forward reg_blank str beg in
let var_name_b = Str.search_forward reg_blank str (var_type_b + 1) in
let var_name_e = Str.search_forward reg_cr str (var_name_b + 1) in
let var_type = String.sub str (var_type_b + 1) (var_name_b - var_type_b - 1) in
let var_name = String.sub str (var_name_b + 1) (var_name_e - var_name_b - 1) in
find_var_list reg str var_name_e ((var_type, var_name)::vars)
with _ -> (vars, sptr)
let (generate_stub : module_name -> string -> input_vars -> output_vars -> unit) =
(*
** [generate_stub mod_name str vi vo] generates a file named `<mod_name>_<str>.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 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
(*
** Compiler directive
*)
put ("// Automatically generated file. Do not edit.\n" ^
"#include <stdlib.h>\n" ^
"#include \"" ^ mod_name ^ ".h\" \n" ^
" \n") ;
(*
** 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" ^
" struct " ^ mod_name ^ "_ctx* prg = " ^ mod_name ^ "_new_ctx(NULL); }\n") ;
put "\n" ;
(*
** Output procedures
*)
put "// Output procedures (get the output values) \n" ;
List.iter
(fun (t, v) ->
put ("void " ^ mod_name ^ "_O_" ^ v ^ "(void* client_data, " ^ t ^ " " ^ v ^ "_toto) {\n" ^
" " ^ v ^ " = " ^ v ^ "_toto ; }\n\n")
)
vo ;
(*
** Step
*)
put "\n" ;
put "// Step \n" ;
put ("void " ^ mod_name ^ "_" ^ str ^ "_step(") ;
List.iter
(fun (t, v) ->
put (t ^ " " ^ v ^ ", ")
)
vi ;
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 "}\n" ;
(*
** Try
*)
put "\n" ;
put "// Try \n" ;
put ("void " ^ mod_name ^ "_" ^ str ^ "_try(") ;
List.iter
(fun (t, v) ->
put (t ^ " " ^ v ^ ", ")
)
vi ;
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(" ;
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) =
(*
** [generate_idl mod_name str li lo] generates an idl file named `<mod_name>_idl.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
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
(*
** Compiler directive
*)
put ("// Automatically generated file. Do not edit.\n" ^
"#include <stdlib.h>\n" ^
"#include \"" ^ mod_name ^ ".h\" \n" ^
" \n") ;
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
;;
main ();;
(*-----------------------------------------------------------------------
** Copyright (C) 2001 - Verimag.
** This file may only be copied under the terms of the GNU Library General
** Public License
**-----------------------------------------------------------------------
**
** File: generate_lurette_interface.ml
** Main author: jahier@imag.fr
**
**
** Implements a program that takes as input the string "sut"
** (resp. "oracle") as well as a C header file `<foo>.h' to interface,
** and which outputs stub files named `lurette_sut.h' and
** `lurette_sut.c' (resp. `lurette_oracle.h' and `lurette_oracle.c').
** Those files are used by the lurette Makefile to interface the sut
** (resp. the oracle).
**
** Note that <foo>.h should follows the poc convention (e.g., generated
** by a lustre compiler) Namely, it should contain the following pragmas:
**
** //MODULE: <module name> n m
** // where `n' is the input var number, and `m' the output var one
** //IN: <C type of the first input var> <a C identifier for the first input var>
** .
** .
** .
** //IN: <C type of the nth input var> <a C identifier for the nth input var>
** //OUT: <C type of the first output var> <a C identifier for the first output var>
** .
** .
** .
** //OUT: <C type of the mth output var> <a C identifier for the mth output var>
*)
type file_name = string
type module_name = string
type var_type = string
type var_name = string
type input_vars = (var_type * var_name) list
type