Source

ocaml-lib / dcg / dcg.ml

Diff from to

dcg/dcg.ml

 let get_trace () = !trace
 let set_trace b = trace := b
 
+let union_msgs msgs1 msgs2 =
+  List.filter (fun msg1 -> not (List.mem msg1 msgs2)) msgs1 @ msgs2
+
 
 type ('cursor, 'ctx, 'res, 'msg) result = Parsed of 'ctx * 'res * 'cursor | Failed of 'msg list
 
 
 type ('ctx, 'res, 'cursor, 'msg) parse = 'ctx -> 'cursor -> ('ctx, 'res, 'cursor, 'msg) p
 
-class ['ctx,'res,'cursor,'msg] fail (cursor : 'cursor) =
+class ['ctx,'res,'cursor,'msg] fail (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
     method next : ('cursor, 'ctx, 'res, 'msg) result =
       Failed ([] : 'msg list)
 	  ( match p2 # next with
 	  | Parsed _ as x -> x
 	  | Failed msgs2 ->
-	      state <- `End (msgs2 @ msgs);
+	      state <- `End (union_msgs msgs2 msgs);
 	      self # next)
       | `End msgs -> Failed msgs
   end
 	      state <- `Second (msgs, p1, parse2 res1 ctx1 cursor1);
 	      self # next
 	  | Failed msgs1 ->
-	      state <- `End (msgs1 @ msgs);
+	      state <- `End (union_msgs msgs1 msgs);
 	      self # next)
       | `Second (msgs, p1,p2) ->
 	  ( match p2 # next with
 	  | Parsed _ as x -> x
 	  | Failed msgs2 ->
-	      state <- `First (msgs2 @ msgs, p1);
+	      state <- `First (union_msgs msgs2 msgs, p1);
 	      self # next)
       | `End msgs -> Failed msgs
   end
 	  ( match p3 # next with
 	  | Parsed _ as x -> x
 	  | Failed msgs3 ->
-	      state <- `End (msgs3 @ msgs);
+	      state <- `End (union_msgs msgs3 msgs);
 	      self#next)
       | `End msgs -> Failed msgs
   end
 	      let coord = cursor#coord in
 	      let msg = Msg.make name [||] (Msg.Locator.Point coord) in
 *)
-	      state <- `End (msgs1 @ msgs);
+	      state <- `End (union_msgs msgs1 msgs);
 	      self#next)
       | `End msgs -> Failed msgs
   end
 
 let check = new check
 
+class ['ctx,'res,'cursor,'msg] trial (f : unit -> 'res) (ctx : 'ctx) (cursor : 'cursor) =
+  object (self)
+    val mutable state = `Begin
+
+    method next =
+      match state with
+      | `Begin ->
+	  state <- `End;
+	  begin
+	    try
+	      let x = f () in
+	      Parsed (ctx, x, cursor)
+	    with exn ->
+	      let name = Printexc.to_string exn in
+	      let coord = cursor#coord in
+	      let msg = Msg.make name [||] (Msg.Locator.Point coord) in
+	      Failed [msg]
+	  end
+      | `End -> Failed []
+  end
+
+let trial = new trial
+
 class ['ctx,'res,'cursor,'msg] enum (name : string) (f : unit -> 'res list) (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
     val mutable state : 'res list option = None