Commit 4e9d4711 authored by POGODALLA Sylvain's avatar POGODALLA Sylvain

Answers to feature request #7

parent 235d5742
......@@ -291,9 +291,7 @@ struct
| None,_ ->
let () = Logs.warn (fun m -> m "Parsing is not implemented for non 2nd order ACG.") in
SharedForest.SharedForest.empty
(* | Some (prog,_), (Lambda.Atom _ as dist_type) -> *)
| Some {prog}, (Lambda.Atom _ as dist_type) ->
(* let pre_parse_time = Sys.time () in *)
Log.info (fun m -> m "Before parsing. Program is currently:");
DatalogAbstractSyntax.Program.log_content Logs.Info (Datalog.Program.to_abstract prog) ;
Log.info (fun m -> m "That's all.");
......@@ -359,6 +357,8 @@ struct
t),
resume
let is_empty = SharedForest.SharedForest.is_empty
let to_string ({name=n,_;dico=d;abstract_sig=abs_sg;object_sig=obj_sg} as lex) =
let buff=Buffer.create 80 in
let () = Printf.bprintf
......
......@@ -107,6 +107,7 @@ sig
val check : t -> unit
val parse : Signature.term -> Signature.stype -> t -> resume
val get_analysis : resume -> t -> Lambda.term option * resume
val is_empty : resume -> bool
val compose: t -> t -> (string*Abstract_syntax.location) -> t
val program_to_buffer : t -> Buffer.t
val program_to_log : Logs.src -> Logs.level -> t -> unit
......
......@@ -277,6 +277,10 @@ module type Lexicon_sig =
[(Some t,r')] where [t] is another solution, and [r'] a new
resumption. Otherwise it returns [(None,r')].*)
val get_analysis : resume -> t -> Lambda.term option * resume
(** [is_empty r] tells whether there is another solution to look in
the resumption *)
val is_empty : resume -> bool
(** [compose l2 l1 (name,loc)] returns a new lexicon which is the
composition of [l2] and [l1 ] ([l2] after [l1]) such that the
......
......@@ -651,14 +651,15 @@ module Functions =
let rec ask_for_next_parse f param =
let rec no_interaction f p =
match f p with
| None -> Logs.app (fun m -> m "No other possible value")
| None -> Logs.app (fun m -> m "No other solution")
| Some new_param -> no_interaction f new_param in
let msg = Printf.sprintf "Do you want to look for another solution?\n\ty/yes\n\tn/no\n\ta/all\n(Default: yes):" in
match interact msg return_input with
| Next ->
(match f param with
| None -> Logs.app (fun m -> m "No other possible value")
| Some new_param -> ask_for_next_parse f new_param)
| None -> Logs.app (fun m -> m "No other solution")
| Some new_param when Env.Lexicon.is_empty new_param -> Logs.app (fun m -> m "No other solution")
| Some new_param-> ask_for_next_parse f new_param)
| All -> no_interaction f param
| Stop -> ()
......@@ -681,15 +682,14 @@ module Functions =
let parse ?name e data l =
let lex = get_lex name "parse" e l in
(* let abs,_=Env.Lexicon.get_sig lex in *)
match Data_parser.parse_heterogenous_term ~output:false data lex with
| None -> ()
| Some (obj_t,abs_ty) ->
let resume = get_parse_tree (Env.Lexicon.parse obj_t abs_ty lex) abs_ty lex in
match resume with
| None -> Logs.app (fun m -> m "No solution.")
| Some resume ->
ask_for_next_parse (fun res -> get_parse_tree res abs_ty lex) resume
| Some resume when Env.Lexicon.is_empty resume -> Logs.app (fun m -> m "No other solution.")
| Some resume -> ask_for_next_parse (fun res -> get_parse_tree res abs_ty lex) resume
let idb ?name e l =
......
Markdown is supported
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