Commit 9e43e390 authored by MARCHE Claude's avatar MARCHE Claude

Compilation and make bench work on moloch

parent 57de2a14
...@@ -1604,9 +1604,6 @@ endif ...@@ -1604,9 +1604,6 @@ endif
ALTERGODIR=src/trywhy3/alt-ergo ALTERGODIR=src/trywhy3/alt-ergo
JSOCAMLCW=ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml.ppx \
-I src/ide
JSOCAMLC=ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml.syntax \ JSOCAMLC=ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml.syntax \
-syntax camlp4o -I src/trywhy3 \ -syntax camlp4o -I src/trywhy3 \
-I $(ALTERGODIR)/src/util \ -I $(ALTERGODIR)/src/util \
...@@ -1697,6 +1694,16 @@ clean:: ...@@ -1697,6 +1694,16 @@ clean::
CLEANDIRS += src/trywhy3 CLEANDIRS += src/trywhy3
#########
# why3webserver and full web/js interface
#########
ifeq (@HASJSOFOCAML,yes)
JSOCAMLCW=ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml.ppx \
-I src/ide
src/ide/why3_js.cmo: src/ide/why3_js.ml lib/why3/why3.cma src/ide/why3_js.cmo: src/ide/why3_js.ml lib/why3/why3.cma
$(JSOCAMLCW) $(BFLAGS) -c $< $(JSOCAMLCW) $(BFLAGS) -c $<
...@@ -1709,6 +1716,7 @@ src/ide/why3_js.js: src/ide/why3_js.byte ...@@ -1709,6 +1716,7 @@ src/ide/why3_js.js: src/ide/why3_js.byte
opt: lib/why3/why3.cma bin/why3webserver.opt src/ide/why3_js.js opt: lib/why3/why3.cma bin/why3webserver.opt src/ide/why3_js.js
byte: lib/why3/why3.cma bin/why3webserver.byte src/ide/why3_js.js byte: lib/why3/why3.cma bin/why3webserver.byte src/ide/why3_js.js
endif
######## ########
# bench # bench
......
...@@ -484,6 +484,18 @@ dnl AC_CHECK_PROG(enable_ide,lablgtk2,yes,no) not always available (Win32) ...@@ -484,6 +484,18 @@ dnl AC_CHECK_PROG(enable_ide,lablgtk2,yes,no) not always available (Win32)
dnl AC_CHECK_PROG(OCAMLWEB,ocamlweb,ocamlweb,true) dnl AC_CHECK_PROG(OCAMLWEB,ocamlweb,ocamlweb,true)
# js_of_ocaml
JSOFOCAML=$(ocamlfind query js_of_ocaml)
if test -z "$JSOFCAML"; then
HASJSOFOCAML=no
reason_jsofocaml=" (js_of_ocaml not found)"
else
HASJSOFOCAML=yes
fi
# Coq # Coq
enable_coq_support=yes enable_coq_support=yes
...@@ -768,6 +780,8 @@ AC_SUBST(enable_ide) ...@@ -768,6 +780,8 @@ AC_SUBST(enable_ide)
AC_SUBST(LABLGTK2LIB) AC_SUBST(LABLGTK2LIB)
AC_SUBST(LABLGTK2PKG) AC_SUBST(LABLGTK2PKG)
AC_SUBST(HASJSOFOCAML)
AC_SUBST(META_OCAMLGRAPH) AC_SUBST(META_OCAMLGRAPH)
AC_SUBST(enable_zarith) AC_SUBST(enable_zarith)
...@@ -858,7 +872,8 @@ echo " Library path : $OCAMLLIB" ...@@ -858,7 +872,8 @@ echo " Library path : $OCAMLLIB"
echo " Native compilation : $enable_native_code" echo " Native compilation : $enable_native_code"
echo " Profiling : $enable_profiling" echo " Profiling : $enable_profiling"
echo "Components" echo "Components"
echo " IDE command : $enable_ide$reason_ide" echo " GTK IDE : $enable_ide$reason_ide"
echo " Web IDE : $HASJSOFOCAML$reason_jsofocaml"
echo " GMP arithmetic : $enable_zarith$reason_zarith" echo " GMP arithmetic : $enable_zarith$reason_zarith"
echo " Compressed sessions : $enable_zip$reason_zip" echo " Compressed sessions : $enable_zip$reason_zip"
echo " MenhirLib support : $enable_menhirLib$reason_menhirLib" echo " MenhirLib support : $enable_menhirLib$reason_menhirLib"
......
...@@ -96,7 +96,7 @@ let result1 : Call_provers.prover_result = ...@@ -96,7 +96,7 @@ let result1 : Call_provers.prover_result =
Call_provers.wait_on_call Call_provers.wait_on_call
(Driver.prove_task ~limit:Call_provers.empty_limit (Driver.prove_task ~limit:Call_provers.empty_limit
~command:alt_ergo.Whyconf.command ~command:alt_ergo.Whyconf.command
alt_ergo_driver None task1) alt_ergo_driver task1)
(* prints Alt-Ergo answer *) (* prints Alt-Ergo answer *)
let () = printf "@[On task 1, alt-ergo answers %a@." let () = printf "@[On task 1, alt-ergo answers %a@."
...@@ -106,7 +106,7 @@ let result2 : Call_provers.prover_result = ...@@ -106,7 +106,7 @@ let result2 : Call_provers.prover_result =
Call_provers.wait_on_call Call_provers.wait_on_call
(Driver.prove_task ~command:alt_ergo.Whyconf.command (Driver.prove_task ~command:alt_ergo.Whyconf.command
~limit:{Call_provers.empty_limit with Call_provers.limit_time = 10} ~limit:{Call_provers.empty_limit with Call_provers.limit_time = 10}
alt_ergo_driver None task2) alt_ergo_driver task2)
let () = printf "@[On task 2, alt-ergo answers %a in %5.2f seconds@." let () = printf "@[On task 2, alt-ergo answers %a in %5.2f seconds@."
Call_provers.print_prover_answer result1.Call_provers.pr_answer Call_provers.print_prover_answer result1.Call_provers.pr_answer
...@@ -146,7 +146,7 @@ let result3 = ...@@ -146,7 +146,7 @@ let result3 =
Call_provers.wait_on_call Call_provers.wait_on_call
(Driver.prove_task ~limit:Call_provers.empty_limit (Driver.prove_task ~limit:Call_provers.empty_limit
~command:alt_ergo.Whyconf.command ~command:alt_ergo.Whyconf.command
alt_ergo_driver None task3) alt_ergo_driver task3)
let () = printf "@[On task 3, alt-ergo answers %a@." let () = printf "@[On task 3, alt-ergo answers %a@."
Call_provers.print_prover_result result3 Call_provers.print_prover_result result3
...@@ -177,7 +177,7 @@ let result4 = ...@@ -177,7 +177,7 @@ let result4 =
Call_provers.wait_on_call Call_provers.wait_on_call
(Driver.prove_task ~limit:Call_provers.empty_limit (Driver.prove_task ~limit:Call_provers.empty_limit
~command:alt_ergo.Whyconf.command ~command:alt_ergo.Whyconf.command
alt_ergo_driver None task4) alt_ergo_driver task4)
let () = printf "@[On task 4, alt-ergo answers %a@." let () = printf "@[On task 4, alt-ergo answers %a@."
Call_provers.print_prover_result result4 Call_provers.print_prover_result result4
......
...@@ -35,7 +35,7 @@ type printer_mapping = { ...@@ -35,7 +35,7 @@ type printer_mapping = {
} }
type printer_args = { type printer_args = {
name_table : name_tables option; name_table : names_table option;
env : Env.env; env : Env.env;
prelude : prelude; prelude : prelude;
th_prelude : prelude_map; th_prelude : prelude_map;
......
...@@ -36,7 +36,7 @@ type printer_mapping = { ...@@ -36,7 +36,7 @@ type printer_mapping = {
} }
type printer_args = { type printer_args = {
name_table : name_tables option; name_table : names_table option;
env : Env.env; env : Env.env;
prelude : prelude; prelude : prelude;
th_prelude : prelude_map; th_prelude : prelude_map;
......
...@@ -345,7 +345,7 @@ let on_tagged_pr t task = ...@@ -345,7 +345,7 @@ let on_tagged_pr t task =
(* Printing tasks *) (* Printing tasks *)
type id_decl = (Decl.decl list) Ident.Mid.t type id_decl = (Decl.decl list) Ident.Mid.t
type name_tables = { type names_table = {
namespace : namespace; namespace : namespace;
known_map : known_map; known_map : known_map;
printer : ident_printer; printer : ident_printer;
...@@ -353,6 +353,13 @@ type name_tables = { ...@@ -353,6 +353,13 @@ type name_tables = {
id_decl : id_decl; id_decl : id_decl;
} }
let empty_names_table = {
namespace = empty_ns;
known_map = Mid.empty;
printer = create_ident_printer [];
id_decl = Mid.empty;
}
exception Bad_name_table of string exception Bad_name_table of string
(* Exception reporting *) (* Exception reporting *)
...@@ -367,7 +374,7 @@ let () = Exn_printer.register (fun fmt exn -> match exn with ...@@ -367,7 +374,7 @@ let () = Exn_printer.register (fun fmt exn -> match exn with
| NotExclusiveMeta m -> | NotExclusiveMeta m ->
Format.fprintf fmt "Metaproperty '%s' is not exclusive" m.meta_name Format.fprintf fmt "Metaproperty '%s' is not exclusive" m.meta_name
| Bad_name_table s -> | Bad_name_table s ->
Format.fprintf fmt "Name table associated to task was not generated in %s" s Format.fprintf fmt "Names table associated to task was not generated in %s" s
| _ -> raise exn) | _ -> raise exn)
(* task1 : prefix (* task1 : prefix
......
...@@ -129,14 +129,16 @@ val on_tagged_pr : meta -> task -> Spr.t ...@@ -129,14 +129,16 @@ val on_tagged_pr : meta -> task -> Spr.t
(** Printing tasks *) (** Printing tasks *)
type id_decl = (Decl.decl list) Ident.Mid.t type id_decl = (Decl.decl list) Ident.Mid.t
type name_tables = { type names_table = {
namespace : namespace; namespace : namespace;
known_map : known_map; known_map : known_map;
printer : ident_printer; printer : ident_printer;
(* Associate an id to a list of declarations in which it is used *) (* Associate an id to a list of declarations in which it is used *)
id_decl : id_decl; id_decl : id_decl;
} }
val empty_names_table : names_table
(** Exceptions *) (** Exceptions *)
exception Bad_name_table of string exception Bad_name_table of string
......
...@@ -335,8 +335,8 @@ let list_transforms_l () = ...@@ -335,8 +335,8 @@ let list_transforms_l () =
(** transformations with arguments *) (** transformations with arguments *)
type trans_with_args = string list -> Env.env -> Task.name_tables -> task trans type trans_with_args = string list -> Env.env -> Task.names_table -> task trans
type trans_with_args_l = string list -> Env.env -> Task.name_tables -> task tlist type trans_with_args_l = string list -> Env.env -> Task.names_table -> task tlist
let transforms_with_args = Hstr.create 17 let transforms_with_args = Hstr.create 17
let transforms_with_args_l = Hstr.create 17 let transforms_with_args_l = Hstr.create 17
......
...@@ -164,8 +164,8 @@ val named : string -> 'a trans -> 'a trans ...@@ -164,8 +164,8 @@ val named : string -> 'a trans -> 'a trans
*) *)
type trans_with_args = string list -> Env.env -> Task.name_tables -> task trans type trans_with_args = string list -> Env.env -> Task.names_table -> task trans
type trans_with_args_l = string list -> Env.env -> Task.name_tables -> task tlist type trans_with_args_l = string list -> Env.env -> Task.names_table -> task tlist
val list_transforms_with_args : unit -> (string * Pp.formatted) list val list_transforms_with_args : unit -> (string * Pp.formatted) list
val list_transforms_with_args_l : unit -> (string * Pp.formatted) list val list_transforms_with_args_l : unit -> (string * Pp.formatted) list
...@@ -188,5 +188,5 @@ val list_trans : unit -> string list ...@@ -188,5 +188,5 @@ val list_trans : unit -> string list
val apply_transform : string -> Env.env -> task -> task list val apply_transform : string -> Env.env -> task -> task list
(** apply a registered 1-to-1 or a 1-to-n, directly.*) (** apply a registered 1-to-1 or a 1-to-n, directly.*)
val apply_transform_args : string -> Env.env -> string list -> Task.name_tables -> task -> task list val apply_transform_args : string -> Env.env -> string list -> Task.names_table -> task -> task list
(** apply a registered 1-to-1 or a 1-to-n or a trans with args, directly *) (** apply a registered 1-to-1 or a 1-to-n or a trans with args, directly *)
...@@ -46,12 +46,12 @@ val call_on_buffer : ...@@ -46,12 +46,12 @@ val call_on_buffer :
val print_task : val print_task :
?old : in_channel -> ?old : in_channel ->
?cntexample : bool -> ?cntexample : bool ->
?name_table: Task.name_tables -> ?name_table: Task.names_table ->
driver -> Format.formatter -> Task.task -> unit driver -> Format.formatter -> Task.task -> unit
val print_theory : val print_theory :
?old : in_channel -> ?old : in_channel ->
?name_table: Task.name_tables -> ?name_table: Task.names_table ->
driver -> Format.formatter -> Theory.theory -> unit driver -> Format.formatter -> Theory.theory -> unit
(** produce a realization of the given theory using the given driver *) (** produce a realization of the given theory using the given driver *)
...@@ -61,7 +61,7 @@ val prove_task : ...@@ -61,7 +61,7 @@ val prove_task :
?cntexample : bool -> ?cntexample : bool ->
?old : string -> ?old : string ->
?inplace : bool -> ?inplace : bool ->
?name_table : Task.name_tables -> ?name_table : Task.names_table ->
driver -> Task.task -> Call_provers.prover_call driver -> Task.task -> Call_provers.prover_call
(** Split the previous function in two simpler functions *) (** Split the previous function in two simpler functions *)
...@@ -69,7 +69,7 @@ val prepare_task : cntexample:bool -> driver -> Task.task -> Task.task ...@@ -69,7 +69,7 @@ val prepare_task : cntexample:bool -> driver -> Task.task -> Task.task
val print_task_prepared : val print_task_prepared :
?old : in_channel -> ?old : in_channel ->
?name_table: Task.name_tables -> ?name_table: Task.names_table ->
driver -> Format.formatter -> Task.task -> Printer.printer_mapping driver -> Format.formatter -> Task.task -> Printer.printer_mapping
val prove_task_prepared : val prove_task_prepared :
...@@ -77,7 +77,7 @@ val prove_task_prepared : ...@@ -77,7 +77,7 @@ val prove_task_prepared :
limit : Call_provers.resource_limit -> limit : Call_provers.resource_limit ->
?old : string -> ?old : string ->
?inplace : bool -> ?inplace : bool ->
?name_table : Task.name_tables -> ?name_table : Task.names_table ->
driver -> Task.task -> Call_provers.prover_call driver -> Task.task -> Call_provers.prover_call
......
...@@ -435,7 +435,7 @@ let print_task args ?old:_ fmt task = ...@@ -435,7 +435,7 @@ let print_task args ?old:_ fmt task =
(* In trans-based p-printing [forget_all] IST STRENG VERBOTEN *) (* In trans-based p-printing [forget_all] IST STRENG VERBOTEN *)
(* forget_all (); *) (* forget_all (); *)
let tables = match args.name_table with let tables = match args.name_table with
| None -> raise (Bad_name_table "why3printer") | None -> empty_names_table (* raise (Bad_name_table "Why3printer.print_task")*)
| Some tables -> tables in | Some tables -> tables in
print_prelude fmt args.prelude; print_prelude fmt args.prelude;
fprintf fmt "theory Task@\n"; fprintf fmt "theory Task@\n";
...@@ -462,7 +462,7 @@ let print_sequent args ?old:_ fmt task = ...@@ -462,7 +462,7 @@ let print_sequent args ?old:_ fmt task =
info := {info_syn = Discriminate.get_syntax_map task; info := {info_syn = Discriminate.get_syntax_map task;
itp = true}; itp = true};
let tables = match args.name_table with let tables = match args.name_table with
| None -> raise (Bad_name_table "why3printer") | None -> empty_names_table (* raise (Bad_name_table "Why3printer.print_sequent") *)
| Some tables -> tables in | Some tables -> tables in
(* let tables = build_name_tables task in *) (* let tables = build_name_tables task in *)
let ut = Task.used_symbols (Task.used_theories task) in let ut = Task.used_symbols (Task.used_theories task) in
......
...@@ -30,12 +30,12 @@ ...@@ -30,12 +30,12 @@
*) *)
val print_ls : Task.name_tables -> Format.formatter -> Term.lsymbol -> unit val print_ls : Task.names_table -> Format.formatter -> Term.lsymbol -> unit
val print_tv : Task.name_tables -> Format.formatter -> Ty.tvsymbol -> unit val print_tv : Task.names_table -> Format.formatter -> Ty.tvsymbol -> unit
val print_ts : Task.name_tables -> Format.formatter -> Ty.tysymbol -> unit val print_ts : Task.names_table -> Format.formatter -> Ty.tysymbol -> unit
val print_forget_vsty : Task.name_tables -> Format.formatter -> Term.vsymbol -> unit val print_forget_vsty : Task.names_table -> Format.formatter -> Term.vsymbol -> unit
val print_pr : Task.name_tables -> Format.formatter -> Decl.prsymbol -> unit val print_pr : Task.names_table -> Format.formatter -> Decl.prsymbol -> unit
val print_pat : Task.name_tables -> Format.formatter -> Term.pattern -> unit val print_pat : Task.names_table -> Format.formatter -> Term.pattern -> unit
val print_ty : Task.name_tables -> Format.formatter -> Ty.ty -> unit val print_ty : Task.names_table -> Format.formatter -> Ty.ty -> unit
val print_term : Task.name_tables -> Format.formatter -> Term.term -> unit val print_term : Task.names_table -> Format.formatter -> Term.term -> unit
val print_decl : Task.name_tables -> Format.formatter -> Decl.decl -> unit val print_decl : Task.names_table -> Format.formatter -> Decl.decl -> unit
...@@ -467,10 +467,10 @@ let build_prover_call c id pr limit callback = ...@@ -467,10 +467,10 @@ let build_prover_call c id pr limit callback =
config_pr config_pr
~with_steps:Call_provers.(limit.limit_steps <> empty_limit.limit_steps) in ~with_steps:Call_provers.(limit.limit_steps <> empty_limit.limit_steps) in
let task = Session_itp.get_task c.controller_session id in let task = Session_itp.get_task c.controller_session id in
let tables = Session_itp.get_tables c.controller_session id in let table = Session_itp.get_table c.controller_session id in
let call = let call =
Driver.prove_task ?old:None ~cntexample:true ~inplace:false ~command Driver.prove_task ?old:None ~cntexample:true ~inplace:false ~command
~limit ?name_table:tables driver task ~limit ?name_table:table driver task
in in
let pa = (c.controller_session,id,pr,callback,false,call) in let pa = (c.controller_session,id,pr,callback,false,call) in
Queue.push pa prover_tasks_in_progress Queue.push pa prover_tasks_in_progress
...@@ -571,13 +571,13 @@ let schedule_proof_attempt c id pr ~limit ~callback ~notification = ...@@ -571,13 +571,13 @@ let schedule_proof_attempt c id pr ~limit ~callback ~notification =
let schedule_transformation_r c id name args ~callback = let schedule_transformation_r c id name args ~callback =
let apply_trans () = let apply_trans () =
let task = get_task c.controller_session id in let task = get_task c.controller_session id in
let tables = match get_tables c.controller_session id with let table = match get_table c.controller_session id with
| None -> raise (Task.Bad_name_table "schedule_transformation") | None -> raise (Task.Bad_name_table "Controller_itp.schedule_transformation_r")
| Some tables -> tables in | Some table -> table in
begin begin
try try
let subtasks = let subtasks =
Trans.apply_transform_args name c.controller_env args tables task in Trans.apply_transform_args name c.controller_env args table task in
(* if result is same as input task, consider it as a failure *) (* if result is same as input task, consider it as a failure *)
begin begin
match subtasks with match subtasks with
......
...@@ -68,49 +68,49 @@ let loaded_strategies = ref [] ...@@ -68,49 +68,49 @@ let loaded_strategies = ref []
(****** Exception handling *********) (****** Exception handling *********)
let print_term s id fmt t = let print_term s id fmt t =
let tables = match (Session_itp.get_tables s id) with let tables = match (Session_itp.get_table s id) with
| None -> Args_wrapper.build_name_tables (Session_itp.get_task s id) | None -> Args_wrapper.build_name_tables (Session_itp.get_task s id)
| Some tables -> tables in | Some tables -> tables in
Why3printer.print_term tables fmt t Why3printer.print_term tables fmt t
let print_type s id fmt t = let print_type s id fmt t =
let tables = match (Session_itp.get_tables s id) with let tables = match (Session_itp.get_table s id) with
| None -> Args_wrapper.build_name_tables (Session_itp.get_task s id) | None -> Args_wrapper.build_name_tables (Session_itp.get_task s id)
| Some tables -> tables in | Some tables -> tables in
Why3printer.print_ty tables fmt t Why3printer.print_ty tables fmt t
let print_ts s id fmt t = let print_ts s id fmt t =
let tables = match (Session_itp.get_tables s id) with let tables = match (Session_itp.get_table s id) with
| None -> Args_wrapper.build_name_tables (Session_itp.get_task s id) | None -> Args_wrapper.build_name_tables (Session_itp.get_task s id)
| Some tables -> tables in | Some tables -> tables in
Why3printer.print_ts tables fmt t Why3printer.print_ts tables fmt t
let print_ls s id fmt t = let print_ls s id fmt t =
let tables = match (Session_itp.get_tables s id) with let tables = match (Session_itp.get_table s id) with
| None -> Args_wrapper.build_name_tables (Session_itp.get_task s id) | None -> Args_wrapper.build_name_tables (Session_itp.get_task s id)
| Some tables -> tables in | Some tables -> tables in
Why3printer.print_ls tables fmt t Why3printer.print_ls tables fmt t
let print_tv s id fmt t = let print_tv s id fmt t =
let tables = match (Session_itp.get_tables s id) with let tables = match (Session_itp.get_table s id) with
| None -> Args_wrapper.build_name_tables (Session_itp.get_task s id) | None -> Args_wrapper.build_name_tables (Session_itp.get_task s id)
| Some tables -> tables in | Some tables -> tables in
Why3printer.print_tv tables fmt t Why3printer.print_tv tables fmt t
let print_vsty s id fmt t = let print_vsty s id fmt t =
let tables = match (Session_itp.get_tables s id) with let tables = match (Session_itp.get_table s id) with
| None -> Args_wrapper.build_name_tables (Session_itp.get_task s id) | None -> Args_wrapper.build_name_tables (Session_itp.get_task s id)
| Some tables -> tables in | Some tables -> tables in
Why3printer.print_forget_vsty tables fmt t Why3printer.print_forget_vsty tables fmt t
let print_pr s id fmt t = let print_pr s id fmt t =
let tables = match (Session_itp.get_tables s id) with let tables = match (Session_itp.get_table s id) with
| None -> Args_wrapper.build_name_tables (Session_itp.get_task s id) | None -> Args_wrapper.build_name_tables (Session_itp.get_task s id)
| Some tables -> tables in | Some tables -> tables in
Why3printer.print_pr tables fmt t Why3printer.print_pr tables fmt t
let print_pat s id fmt t = let print_pat s id fmt t =
let tables = match (Session_itp.get_tables s id) with let tables = match (Session_itp.get_table s id) with
| None -> Args_wrapper.build_name_tables (Session_itp.get_task s id) | None -> Args_wrapper.build_name_tables (Session_itp.get_task s id)
| Some tables -> tables in | Some tables -> tables in
Why3printer.print_pat tables fmt t Why3printer.print_pat tables fmt t
...@@ -798,7 +798,7 @@ let get_locations t = ...@@ -798,7 +798,7 @@ let get_locations t =
(* -- send the task -- *) (* -- send the task -- *)
let task_of_id d id = let task_of_id d id =
let task = get_task d.cont.controller_session id in let task = get_task d.cont.controller_session id in
let tables = get_tables d.cont.controller_session id in let tables = get_table d.cont.controller_session id in
(* This function also send source locations associated to the task *) (* This function also send source locations associated to the task *)
let loc_color_list = get_locations task in let loc_color_list = get_locations task in
Pp.string_of Pp.string_of
......
...@@ -137,7 +137,7 @@ let search_id _cont task args = ...@@ -137,7 +137,7 @@ let search_id _cont task args =
type query = type query =
| Qnotask of (Controller_itp.controller -> string list -> string) | Qnotask of (Controller_itp.controller -> string list -> string)
| Qtask of (Controller_itp.controller -> Task.name_tables -> string list -> string) | Qtask of (Controller_itp.controller -> Task.names_table -> string list -> string)
let help_on_queries fmt commands = let help_on_queries fmt commands =
let l = Stdlib.Hstr.fold (fun c (h,_) acc -> (c,h)::acc) commands [] in let l = Stdlib.Hstr.fold (fun c (h,_) acc -> (c,h)::acc) commands [] in
...@@ -294,10 +294,10 @@ let interp commands_table config cont id s = ...@@ -294,10 +294,10 @@ let interp commands_table config cont id s =
| Qnotask f, _ -> Query (f cont args) | Qnotask f, _ -> Query (f cont args)
| Qtask _, None -> QError "please select a goal first" | Qtask _, None -> QError "please select a goal first"
| Qtask f, Some id -> | Qtask f, Some id ->
let tables = match Session_itp.get_tables cont.Controller_itp.controller_session id with let table = match Session_itp.get_table cont.Controller_itp.controller_session id with
| None -> raise (Task.Bad_name_table "interp") | None -> raise (Task.Bad_name_table "Server_utils.interp")
| Some tables -> tables in | Some table -> table in
let s = try Query (f cont tables args) with let s = try Query (f cont table args) with
| Undefined_id s -> QError ("No existing id corresponding to " ^ s) | Undefined_id s -> QError ("No existing id corresponding to " ^ s)
| Number_of_arguments -> QError "Bad number of arguments" | Number_of_arguments -> QError "Bad number of arguments"
in s in s
......
...@@ -17,11 +17,11 @@ exception Number_of_arguments ...@@ -17,11 +17,11 @@ exception Number_of_arguments
type query = type query =
| Qnotask of (Controller_itp.controller -> string list -> string)