Commit 53770edf authored by Erwan Jahier's avatar Erwan Jahier
Browse files

lurette 0.129 Tue, 04 Mar 2003 10:01:27 +0100 by jahier

Parent-Version:      0.128
Version-Log:

source/parse_env.ml:
   Enhance parsing error messages.

source/util.ml:
source/lurettetop.ml:
   check for LURETTE_PATH only in lurettetop because it is
   the only one that really needs it. Also moves show_luc, gen_stubs,
   and co there for the same reason.

Project-Description: Lurette
parent 8d595778
......@@ -12,7 +12,7 @@
(doc/ocamldoc.sty 1380 1008328137 b/12_ocamldoc.s 1.1)
(mlcuddidl/Makefile 7150 1034006019 d/9_Makefile 1.1)
(test/tram_simple.h 1746 1013519411 b/25_tram_simpl 1.1)
(test/time-ossau.res 8312 1046682069 b/49_time.res 1.36)
(test/time-ossau.res 8309 1046768487 b/49_time.res 1.37)
(mlcuddidl/session.ml 603 1034006019 c/37_session.ml 1.1)
(cuddaux/cuddauxGenCof.c 12011 1034006019 c/29_cuddauxGen 1.1)
(mlcuddidl/rdd.idl 14806 1034006019 c/42_rdd.idl 1.1)
......@@ -24,13 +24,13 @@
(source/ne.ml 9281 1046682069 c/21_ne.ml 1.6)
(source/store.mli 2891 1046074449 b/26_rnumsolver 1.16)
(source/prevar.ml 981 1037192189 d/18_prevar.ml 1.1)
(test/time-ecrins.exp 8320 1046682069 d/21_time-ecrin 1.10)
(test/time-ecrins.exp 8274 1046768487 d/21_time-ecrin 1.11)
(source/value.mli 1101 1033723811 c/24_value.mli 1.1)
(user-rules.skel 1167 1040226023 c/25_user-rules 1.2)
(source/Makefile.gen_stubs 212 1036048863 b/42_Makefile.g 1.5)
(test/heater_float.rif.exp 1116 1045834161 b/30_heater_flo 1.12)
(test/temp_int.luc 698 1046682069 b/50_temp_int.e 1.5)
(source/luc_exe.ml 13432 1046682069 b/32_ima_exe.ml 1.27)
(source/luc_exe.ml 13434 1046768487 b/32_ima_exe.ml 1.28)
(source/prevar.mli 623 1037192189 d/19_prevar.mli 1.1)
(source/graph.ml 2339 1037625990 14_graph.ml 1.8)
(ihm/xlurette/makefile 1601 1040226023 c/16_makefile 1.7)
......@@ -42,14 +42,14 @@
(source/env.ml 8013 1027349504 16_env.ml 1.29)
(demo/chaudiere/buggy_chaudiere_ctrl.lus 219 1031732392 c/10_buggy_chau 1.1)
(source/Makefile.show_luc 1026 1037192189 b/40_Makefile.s 1.8)
(test/losange.luc 444 1046682069 d/27_losange.lu 1.1)
(test/losange.luc 410 1046768487 d/27_losange.lu 1.2)
(source/env_state.mli 6937 1046682069 50_env_state. 1.28)
(mlcuddidl/idd.ml 7061 1034006019 d/0_idd.ml 1.1)
(test/time-ossau.exp 8312 1046682069 b/48_time.exp 1.33)
(test/time-ossau.exp 8309 1046768487 b/48_time.exp 1.34)
(source/print.mli 1136 1045558187 46_print.mli 1.13)
(mlcuddidl/rdd.mli 7174 1034006019 c/40_rdd.mli 1.1)
(test/Makefile 32 1035531408 c/0_Makefile 1.8)
(source/parse_env.ml 36957 1046682069 41_parse_env. 1.39)
(source/parse_env.ml 39633 1046768487 41_parse_env. 1.40)
(ihm/xlurette/xlurette_glade_main.ml 23620 1046074449 c/12_xlurette_g 1.16)
(demo/chaudiere/chaudiere_oracle.lus 107 1031732392 c/8_chaudiere_ 1.1)
(source/solver.ml 30947 1046682069 39_solver.ml 1.45)
......@@ -57,18 +57,18 @@
(test/ControleurPorte.lus 3219 1032940601 c/17_Controleur 1.1)
(source/gen_fake_lutin.ml 3449 1036048863 d/16_gen_fake_l 1.1)
(source/lurette.ml 14452 1046074449 12_lurette.ml 1.63)
(TODO 5509 1046682069 d/22_TODO 1.7)
(TODO 5467 1046768487 d/22_TODO 1.8)
(source/Makefile 1627 1044958837 c/20_Makefile 1.10)
(source/util.ml 21073 1045849760 35_util.ml 1.40)
(source/util.ml 18985 1046768487 35_util.ml 1.41)
(mlcuddidl/manager.mli 7912 1034006019 c/46_manager.ml 1.1)
(doc/Interface_draft 5232 1003928781 19_Interface_ 1.1)
(source/sim2chro.mli 1524 1037625990 b/23_sim2chro.m 1.6)
(source/command_line_luc_exe.mli 1130 1046682069 b/34_command_li 1.9)
(test/giro/onlyroll.lus 18298 1031732392 c/7_onlyroll.l 1.1)
(source/Makefile.lucky 2562 1045834161 b/41_Makefile.i 1.14)
(source/Makefile.lucky 2599 1046768487 b/41_Makefile.i 1.15)
(TAGS 9825 1007379917 21_TAGS 1.6)
(mlcuddidl/rdd.ml 8746 1034006019 c/41_rdd.ml 1.1)
(source/Makefile.lurette_lib 2023 1045834161 c/2_Makefile.l 1.14)
(source/Makefile.lurette_lib 2051 1046768487 c/2_Makefile.l 1.15)
(source/parse_env.mli 1186 1046682069 40_parse_env. 1.13)
(source/gen_stubs.ml 27065 1036048863 24_generate_l 1.41)
(OcamlMakefile 22765 1045558187 17_OcamlMakef 1.47)
......@@ -81,7 +81,7 @@
(make_lurette 1306 1034006019 27_make_luret 1.17)
(source/control.ml 4445 1036675177 c/4_control.ml 1.4)
(ihm/xlurette/xlurette_glade_interface.ml 32810 1046682069 c/15_xlurette_g 1.10)
(source/lurettetop.ml 31026 1046074449 c/1_lurettetop 1.26)
(source/lurettetop.ml 33132 1046768487 c/1_lurettetop 1.27)
(mlcuddidl/README 1574 1034006019 d/8_README 1.1)
(cuddaux/README 1427 1034006019 c/34_README 1.1)
(source/Makefile.lurettetop 368 1037192189 d/14_Makefile.l 1.2)
......@@ -94,7 +94,7 @@
(source/env.mli 2026 1040290175 15_env.mli 1.17)
(mlcuddidl/rdd_caml.c 41613 1034006019 c/39_rdd_caml.c 1.1)
(Makefile.common.in 528 1034951022 d/12_Makefile.c 1.2)
(user-rules 16167 1046682069 c/14_myrules 1.26)
(user-rules 16165 1046768487 c/14_myrules 1.27)
(doc/archi.fig 3693 1003928781 20_archi.fig 1.1)
(source/lurette.mli 448 1016027474 11_lurette.ml 1.12)
(source/store.ml 30658 1046074449 b/27_rnumsolver 1.23)
......@@ -142,7 +142,7 @@
(configure.in 5208 1034351455 d/11_configure. 1.1)
(cuddaux/cuddauxBridge.c 6099 1034006019 c/31_cuddauxBri 1.1)
(source/show_env.ml 3642 1037192189 43_show_env.m 1.16)
(test/losange-3d.luc 561 1046682069 d/28_losange-3d 1.1)
(test/losange-3d.luc 555 1046768487 d/28_losange-3d 1.2)
(mlcuddidl/Changes 64 1034006019 d/10_Changes 1.1)
(source/parse_poc.ml 7093 1036048863 d/15_parse_poc. 1.1)
(cuddaux/cuddauxAddIte.c 12812 1034006019 c/32_cuddauxAdd 1.1)
......@@ -151,7 +151,7 @@
(mlcuddidl/cudd_caml.h 1210 1034006019 d/2_cudd_caml. 1.1)
(source/value.ml 2361 1045849760 c/23_value.ml 1.3)
(test/giro/allocator.lus 1087 1031732392 c/5_allocator. 1.1)
(test/time-ecrins.res 8320 1046682069 d/20_time-ecrin 1.10)
(test/time-ecrins.res 8274 1046768487 d/20_time-ecrin 1.11)
(lurette.depfull.dot 49 1007651448 b/5_lurette.de 1.2)
(mlcuddidl/idd.mli 5470 1034006019 c/51_idd.mli 1.1)
(ID_EN_VRAC 2184 1002196285 0_ID_EN_VRAC 1.1)
......@@ -5,9 +5,8 @@
*********** A faire maintenant
* Messages d'erreurs par terribles dans le parseur quand :
- il manque une virgule
- il y a une erreur dans l'un des mots clefs de champs
* le losange ne passe pas avec polkai et passe avec polkag.
Regarder pourquoi et dire à Bertrand
* Traiter les variables stables (signaux purs)
......
;; -*- Prcs -*-
(Created-By-Prcs-Version 1 3 3)
(Project-Description "Lurette")
(Project-Version lurette 0 128)
(Parent-Version lurette 0 127)
(Project-Version lurette 0 129)
(Parent-Version lurette 0 128)
(Version-Log "
source/parse_env.ml:
source/env_state.ml:
source/env_state.mli:
Add support for transient /recurrent nodes (not plugged yet).
source/parse_env.ml:
source/solver.ml:
source/formula.ml
source/formula.mli:
test/*.luc:
Add the possibity to define formula and num expr aliases
(a request from Bertrand).
test/losange.luc: [new file]
test/losange-3d.luc: [new file]
test/test_losange.lus: [new file]
user-rules:
Add the losange in the non-regression test
source/luc_exe.ml:
source/command_line_luc_exe.ml:
Add an option that lets one see local vars in lucky output.
Enhance parsing error messages.
source/util.ml:
source/lurettetop.ml:
check for LURETTE_PATH only in lurettetop because it is
the only one that really needs it. Also moves show_luc, gen_stubs,
and co there for the same reason.
")
(New-Version-Log ""
)
(Checkin-Time "Mon, 03 Mar 2003 10:01:09 +0100")
(Checkin-Time "Tue, 04 Mar 2003 10:01:27 +0100")
(Checkin-Login jahier)
(Populate-Ignore ())
(Project-Keywords)
......@@ -43,7 +30,7 @@ source/command_line_luc_exe.ml:
;; Sources files for luc_exe
(source/luc_exe.mli (lurette/b/31_ima_exe.ml 1.2 644))
(source/luc_exe.ml (lurette/b/32_ima_exe.ml 1.27 644))
(source/luc_exe.ml (lurette/b/32_ima_exe.ml 1.28 644))
(source/command_line_luc_exe.ml (lurette/b/33_command_li 1.12 644))
(source/command_line_luc_exe.mli (lurette/b/34_command_li 1.9 644))
......@@ -62,7 +49,7 @@ source/command_line_luc_exe.ml:
(source/env.mli (lurette/15_env.mli 1.17 644))
(source/env.ml (lurette/16_env.ml 1.29 644))
(source/util.ml (lurette/35_util.ml 1.40 444))
(source/util.ml (lurette/35_util.ml 1.41 444))
(source/solver.mli (lurette/38_solver.mli 1.14 644))
(source/solver.ml (lurette/39_solver.ml 1.45 644))
......@@ -77,7 +64,7 @@ source/command_line_luc_exe.ml:
(source/pnumsolver.mli (lurette/d/24_pnumsolver 1.2 644))
(source/parse_env.mli (lurette/40_parse_env. 1.13 644))
(source/parse_env.ml (lurette/41_parse_env. 1.39 644))
(source/parse_env.ml (lurette/41_parse_env. 1.40 644))
(source/show_env.mli (lurette/42_show_env.m 1.8 644))
(source/show_env.ml (lurette/43_show_env.m 1.16 644))
......@@ -103,7 +90,7 @@ source/command_line_luc_exe.ml:
(source/gne.mli (lurette/b/36_gne.mli 1.5 644))
(source/gne.ml (lurette/b/37_gne.ml 1.5 644))
(source/lurettetop.ml (lurette/c/1_lurettetop 1.26 644))
(source/lurettetop.ml (lurette/c/1_lurettetop 1.27 644))
(source/gen_stubs.ml (lurette/24_generate_l 1.41 644))
(source/control.mli (lurette/c/3_control.ml 1.3 644))
......@@ -132,16 +119,16 @@ source/command_line_luc_exe.ml:
(Makefile.common.in (lurette/d/12_Makefile.c 1.2 644))
(OcamlMakefile (lurette/17_OcamlMakef 1.47 644))
(Makefile.lurette (lurette/b/38_Makefile.l 1.16 644))
(user-rules (lurette/c/14_myrules 1.26 644))
(user-rules (lurette/c/14_myrules 1.27 644))
(user-rules.skel (lurette/c/25_user-rules 1.2 644))
(Makefile (lurette/d/13_Makefile 1.1 644))
(source/Makefile.lurettetop (lurette/d/14_Makefile.l 1.2 644))
(source/Makefile.gen_fake_lutin (lurette/d/17_Makefile.g 1.1 644))
(source/Makefile.show_luc (lurette/b/40_Makefile.s 1.8 644))
(source/Makefile.lucky (lurette/b/41_Makefile.i 1.14 644))
(source/Makefile.lucky (lurette/b/41_Makefile.i 1.15 644))
(source/Makefile.gen_stubs (lurette/b/42_Makefile.g 1.5 644))
(source/Makefile.lurette_lib (lurette/c/2_Makefile.l 1.14 644))
(source/Makefile.lurette_lib (lurette/c/2_Makefile.l 1.15 644))
(source/Makefile (lurette/c/20_Makefile 1.10 644))
;; Documentation
......@@ -159,10 +146,10 @@ source/command_line_luc_exe.ml:
(lurette.depfull.dot (lurette/b/5_lurette.de 1.2 644))
(TAGS (lurette/21_TAGS 1.6 644))
(test/time-ossau.exp (lurette/b/48_time.exp 1.33 644))
(test/time-ossau.res (lurette/b/49_time.res 1.36 644))
(test/time-ecrins.res (lurette/d/20_time-ecrin 1.10 644))
(test/time-ecrins.exp (lurette/d/21_time-ecrin 1.10 644))
(test/time-ossau.exp (lurette/b/48_time.exp 1.34 644))
(test/time-ossau.res (lurette/b/49_time.res 1.37 644))
(test/time-ecrins.res (lurette/d/20_time-ecrin 1.11 644))
(test/time-ecrins.exp (lurette/d/21_time-ecrin 1.11 644))
;; Various files used for testing purposes
(test/usager.luc (lurette/b/14_usager.env 1.11 644))
......@@ -249,18 +236,18 @@ source/command_line_luc_exe.ml:
(mlcuddidl/Changes (lurette/d/10_Changes 1.1 644))
(TODO (lurette/d/22_TODO 1.7 644))
(TODO (lurette/d/22_TODO 1.8 644))
;; Files added by populate at Tue, 25 Feb 2003 11:30:11 +0100,
;; to version 0.127(w), by jahier:
(test/losange.luc (lurette/d/27_losange.lu 1.1 644))
(test/losange.luc (lurette/d/27_losange.lu 1.2 644))
;; Files added by populate at Tue, 25 Feb 2003 11:34:13 +0100,
;; to version 0.127(w), by jahier:
(test/losange-3d.luc (lurette/d/28_losange-3d 1.1 644))
(test/losange-3d.luc (lurette/d/28_losange-3d 1.2 644))
)
(Merge-Parents)
(New-Merge-Parents)
......@@ -13,6 +13,7 @@ endif
CC=gcc #g++
#POLKA_CLIB = polkai_caml polkai gmp
POLKA_CLIB = polkag_caml polkag gmp
#POLKA_CLIB = polkag_caml david_polkag_print parme gmpxx
......
......@@ -13,8 +13,10 @@ endif
CC=gcc #g++
POLKA_CLIB = polkag_caml polkag gmp
LIBS = str nums polka
CLIBS = cudd_caml cuddaux cudd polkai_caml polkai gmp camlidl mtr st epd util
CLIBS = cudd_caml cuddaux cudd $(POLKA_CLIB) camlidl mtr st epd util
# CLIBS = cudd_caml cuddaux cudd polkag_caml david_polkag parme gmpxx camlidl mtr st epd util
USE_CAMLP4 = yes
......
......@@ -223,7 +223,7 @@ let (write_rif : vnt list -> subst list -> unit) =
fun vntl output ->
List.iter
(fun (vn, _) ->
let _ = assert List.mem_assoc vn output in
let _ = assert (List.mem_assoc vn output) in
Value.print stdout (List.assoc vn output)
)
vntl
......
......@@ -220,10 +220,102 @@ let rec speclist =
""
]
(************************************************************************)
let lurette_path =
try Sys.getenv "LURETTE_PATH"
with _ ->
print_string "Environment var LURETTE_PATH is unset.\n";
print_string "You can either quit (ctrl-c), set it, and restart or type ";
print_string "it here now.\nLURETTE_PATH=" ;
let path = read_line () in
if path = "" then exit 2 else path
let (gen_stubs : string -> string -> string -> string -> unit) =
fun sut sut_node oracle oracle_node ->
(* XXX use Unix.create_process *)
let gen_stubs_cmd =
(lurette_path ^ "/bin/gen_stubs " ^ sut ^ " "
^ sut_node ^ " " ^ oracle ^ " " ^ oracle_node
^ " \n")
in
output_string stderr gen_stubs_cmd;
flush stderr ;
if ((Sys.command gen_stubs_cmd) <> 0)
then
failwith "*** gen_stubs failed.\n"
else
(
output_string stderr " ... gen_stubs ok.\n";
flush stderr
)
let (show_luc : string -> unit) =
fun luc_file ->
let cmd =
(lurette_path ^ "/bin/show_luc " ^ luc_file ^ " \n")
in
output_string stderr cmd ;
if
((Sys.command cmd) <> 0)
then
(
output_string stdout ("*** show_luc failed.\n" ^ cmd ^ "\n");
flush stdout
)
else
(
output_string stderr ("\n ... show_luc ok.\n");
flush stderr
)
let (gen_fake_lutin : string -> unit) =
fun hfile ->
let cmd =
(lurette_path ^ "/bin/gen_fake_lutin " ^ hfile ^ " \n")
in
output_string stderr cmd ;
if
((Sys.command cmd) <> 0)
then
(
output_string stdout ("*** gen_fake_lutin failed.\n" ^ cmd ^ "\n");
flush stdout
)
else
(
output_string stderr ("\n ... gen_fake_lutin ok.\n");
flush stderr
)
let (lutin : string -> string -> unit) =
fun lutfile outputfile ->
let cmd =
(lurette_path ^ "/bin/lutin " ^ lutfile ^ " > " ^ outputfile ^ " \n")
in
output_string stderr cmd ;
if
((Sys.command cmd) <> 0)
then
(
output_string stdout ("*** lutin failed.\n" ^ cmd ^ "\n");
flush stdout
)
else
(
output_string stderr ("\n ... lutin ok.\n");
flush stderr
)
(************************************************************************)
let (build : string -> string -> string -> bool) =
fun user_dir lurette_tmp_dir lurette_dir ->
fun user_dir lurette_tmp_dir lurette_path ->
let sut =
if Filename.is_relative flag.sut
then (user_dir ^ flag.sut)
......@@ -263,7 +355,7 @@ let (build : string -> string -> string -> bool) =
let make_cmd =
(* XXX Not portable !! *)
("make -I " ^ user_dir ^ " -f "
^ lurette_dir ^ "/Makefile.lurette " ^ flag.make_opt ^ "> "
^ lurette_path ^ "/Makefile.lurette " ^ flag.make_opt ^ "> "
^ user_dir ^ "/make_lurette.log \n")
in
if oracle2 <> (lurette_tmp_dir ^ "/always_true")
......@@ -299,7 +391,7 @@ let (build : string -> string -> string -> bool) =
else flag.oracle_node
in
try
Util.gen_stubs sut sut_node oracle oracle_node;
gen_stubs sut sut_node oracle oracle_node;
output_string stderr make_cmd ;
flush stderr ;
flush stdout;
......@@ -355,7 +447,7 @@ let (run : string -> int) =
if lut = "x" then () else
if Util.get_extension lut = ".lut" then
let file = Filename.chop_extension lut in
Util.lutin lut (file ^ ".luc")
lutin lut (file ^ ".luc")
)
lut_list;
List.map
......@@ -774,7 +866,7 @@ sim2chro
let (read_commands : string -> string -> string -> (unit -> string) -> bool) =
fun user_dir lurette_tmp_dir lurette_dir readline ->
fun user_dir lurette_tmp_dir lurette_path readline ->
try
( match (read_cmd (lexer (Stream.of_string (readline ())))) with
Sut(str, node) ->
......@@ -847,7 +939,7 @@ let (read_commands : string -> string -> string -> (unit -> string) -> bool) =
flag.to_build := true;
true
| Build ->
let build_ok = build user_dir lurette_tmp_dir lurette_dir in
let build_ok = build user_dir lurette_tmp_dir lurette_path in
if
not build_ok
then
......@@ -857,7 +949,7 @@ let (read_commands : string -> string -> string -> (unit -> string) -> bool) =
flush stdout;
true
| Run ->
if (not !(flag.to_build) or (build user_dir lurette_tmp_dir lurette_dir))
if (not !(flag.to_build) or (build user_dir lurette_tmp_dir lurette_path))
then
(
flag.to_build := false;
......@@ -879,7 +971,7 @@ let (read_commands : string -> string -> string -> (unit -> string) -> bool) =
| Show ->
Unix.chdir user_dir;
Util.show_luc flag.env;
show_luc flag.env;
Unix.chdir lurette_tmp_dir;
true
| CallSim2chro ->
......@@ -930,7 +1022,7 @@ let (read_commands : string -> string -> string -> (unit -> string) -> bool) =
let rec (main_loop : string -> string -> string -> int -> unit) =
fun user_dir lurette_tmp_dir lurette_dir cpt ->
fun user_dir lurette_tmp_dir lurette_path cpt ->
let _ =
print_string
(
......@@ -940,9 +1032,9 @@ let rec (main_loop : string -> string -> string -> int -> unit) =
) ;
flush stdout
in
let continue = read_commands user_dir lurette_tmp_dir lurette_dir (read_line) in
let continue = read_commands user_dir lurette_tmp_dir lurette_path (read_line) in
if continue
then main_loop user_dir lurette_tmp_dir lurette_dir (cpt+1)
then main_loop user_dir lurette_tmp_dir lurette_path (cpt+1)
else print_string "bye!\n"
......@@ -979,12 +1071,6 @@ let (rm_dir : string -> unit) =
let _ =
let user_dir = (Unix.getcwd ()) ^ "/" in
let lurette_dir =
try Sys.getenv "LURETTE_PATH"
with _ ->
print_string "Environment var LURETTE_PATH is unset.\n";
exit 2
in
let tmp_dir = get_fresh_dir () in
let lurette_tmp_dir =
match flag.restore with
......@@ -1019,7 +1105,7 @@ let _ =
try
while true do
let _ =
read_commands user_dir lurette_tmp_dir lurette_dir
read_commands user_dir lurette_tmp_dir lurette_path
(fun _ -> (input_line ic))
in
()
......@@ -1062,8 +1148,8 @@ let _ =
in
(* XXX Not portable !! *)
let _ = Sys.command ("cp " ^ lurette_dir ^ "/source/lurette.ml " ^ lurette_tmp_dir ^
" ; cp " ^ lurette_dir ^ "/source/lurette.mli " ^ lurette_tmp_dir)
let _ = Sys.command ("cp " ^ lurette_path ^ "/source/lurette.ml " ^ lurette_tmp_dir ^
" ; cp " ^ lurette_path ^ "/source/lurette.mli " ^ lurette_tmp_dir)
in
Unix.chdir lurette_tmp_dir;
if
......@@ -1071,7 +1157,7 @@ let _ =
then
(
if
build user_dir lurette_tmp_dir lurette_dir
build user_dir lurette_tmp_dir lurette_path
then
(
Unix.chdir user_dir;
......@@ -1094,7 +1180,7 @@ let _ =
else
(* flag.go *)
(
main_loop user_dir lurette_tmp_dir lurette_dir 1;
main_loop user_dir lurette_tmp_dir lurette_path 1;
Unix.chdir user_dir;
rm_dir lurette_tmp_dir
)
......
......@@ -46,13 +46,13 @@ type aut_token = Genlex.token Stream.t
XXX What should be the default values ???
Too big values migth break other tools (e.g., sim2chro...)
*)
let default_max_float = (float_of_int max_int) /. 2.**(float_of_int (!Util.precision + 1))
let default_max_int = max_int/10
let default_min_int = min_int/10
(* let default_max_float = (float_of_int max_int) /. 2.**(float_of_int (!Util.precision + 1)) *)
(* let default_max_int = max_int/10 *)
(* let default_min_int = min_int/10 *)
(* let default_max_float = 10000. *)
(* let default_max_int = 10000 *)
(* let default_min_int = -10000 *)
let default_max_float = 10000.
let default_max_int = 10000
let default_min_int = -10000
let print_err_msg ic tok tok_list func msg msg2 =
......@@ -81,7 +81,7 @@ let print_err_msg ic tok tok_list func msg msg2 =
let add_quotes str =
let str2 = ("`" ^ (Str.global_replace (Str.regexp "[ ]") "' `" str) ^ "'") in
let str3 = Str.global_replace (Str.regexp "[\n]") "'\n" str2 in
let str4 = Str.global_replace (Str.regexp "[\t]") "\t`" str3 in
let str4 = Str.global_replace (Str.regexp "[\t]") "\t | `" str3 in
str4
(* let str5 = Str.global_replace (Str.regexp "`<") "<" str4 in *)
(* Str.global_replace (Str.regexp ">'") ">" str5 *)
......@@ -119,9 +119,13 @@ let print_err_msg ic tok tok_list func msg msg2 =
);
with _ -> ()
in
let rec junk_n_toks n tokens =
if n > 0 then (Stream.junk tokens; junk_n_toks (n-1) tokens) else ()
in
let _ = seek_in ic 0 in
let new_tok = lexer (Stream.of_channel ic) in
let first_n_toks = Stream.npeek n new_tok in
let new_tok_list = junk_n_toks n new_tok; Stream.npeek 10 new_tok in
let str = String.concat "" (List.map (string_of_genlex_token) first_n_toks) in
let s = String.length str in
let _ = seek_in ic 0 in
......@@ -131,19 +135,20 @@ let print_err_msg ic tok tok_list func msg msg2 =
(Stream.count char_stream)
in
print_string ("\n*** Parse error (" ^ func ^ ") ");
print_string ("around character " ^ (string_of_int char_pos) ^ ". ");
print_string ("\n*** The next 10 tokens are: ");
List.iter (print_genlex_token) tok_list ;
print_string ("\n*** The next 10 tokens are:\n\t ");
List.iter (print_genlex_token) new_tok_list ;
print_string
("\n" ^
(if msg = ""
then ""
else ("*** whereas either one of the following token(s) was (were) expected:\n\t" ^
else ("*** and they do not match the current grammar rule which is:\n\t " ^
(add_quotes msg) ^ " \n")) ^
(if msg2 = ""
then ""
else ("*** " ^ msg2)
else ("*** " ^ msg2 ^ "\n")
)
);
flush stdout
......@@ -301,12 +306,12 @@ let rec (parse_automata: in_channel -> aut_token -> read_automata) =
la = parse_list_alias_types_opt ic ;
adl = parse_list_aliases_def_opt ic (li @ lo @ ll @ lpre @ la);
'Genlex.Ident "start_node"; 'Genlex.Kwd "=";
'Genlex.Int node_id; 'Genlex.Kwd "," ;
'Genlex.Int node_id; 'Genlex.Kwd "," ;
arcs_nb = parse_arcs_nb_opt ic;
nodes_nb = parse_nodes_nb_opt ic;
transient_nodes = parse_list_nodes_opt ic;
'Genlex.Ident "arcs"; 'Genlex.Kwd "=";
larcs = parse_list_arc ic (li @ lo @ ll @ lpre @ la) ;
larcs = parse_list_arc ic (li @ lo @ ll @ lpre @ la) ;
'Genlex.Kwd ".";
>]
-> Automata(node_id, li, lo, ll, lpre, llabel_ce,
......@@ -316,100 +321,180 @@ let rec (parse_automata: in_channel -> aut_token -> read_automata) =
Failure "" -> flush stdout ; failwith ""
| e ->
print_err_msg ic tok tok_list "parse_automata"
("{inputs = <var list> ,}?\n\t" ^
"{outputs = <var list> ,}?\n\t" ^
"{locals = <var list> ,}?\n\t" ^
"{pre = <pre var list> ,}?\n\t" ^
"{ctrl_expr = <ctrl expr list> ,}?\n\t" ^
"{alias = <var list> ,}?\n\t" ^
"{alias_def = <alias def list> ,}?\n\t" ^
("inputs = <var_list> ,\n\t" ^
"outputs = <var_list> ,\n\t" ^
"locals = <var_list> ,\n\t" ^
"pre = <pre_var_list> ,\n\t" ^
"ctrl_expr = <ctrl_expr_list> ,\n\t" ^
"alias = <var_list> ,\n\t" ^
"alias_def = <alias_def_list> ,\n\t" ^
"start_node = <int> ,\n\t" ^
"{arc_nb = <int> ,}?\n\t" ^
"{node_nb = <int> ,}?\n\t" ^
"transient_nodes = <int list> ,\n\t" ^
"arcs = <arc list> .") "" ;
"arc_nb = <int> ,\n\t" ^
"node_nb = <int> ,\n\t" ^
"transient_nodes = <int_list> ,\n\t" ^
"arcs = <arc_list> .")
("Note that the order into which fields appear matters. \n*** " ^
"Note also that stat_node and arcs fields are mandatory.") ;
failwith ""
and parse_list_inputs_opt ic tok =
match tok with parser
[<'Genlex.Ident "inputs"; 'Genlex.Kwd "="; l = parse_list_var ic ;
'Genlex.Kwd ","
>] -> l
| [< >] -> []
let _ = print_debug ic ("parse_list_inputs_opt \n") in
let tok_list = Stream.npeek 10 tok in
try