Answers to feature request #7

src/acg-data/acg_lexicon.ml

@@ -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

src/acg-data/interface.ml

@@ -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

src/acg-data/interface.mli

@@ -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

src/scripting/functions.ml

@@ -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 =