Commits

Sébastien Ferré committed 130c8fc

[dcg] Serious bug fix in last optimization of Dcg.many and Dcg.list1

Comments (0)

Files changed (1)

   
 let enum_context = new enum_context
 
+(* repetitions, favoring longest ones *)
 class ['ctx, 'elt, 'cursor] many (parse : ('ctx,'elt,'cursor) parse) (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
-    val mutable state = `Loop (ctx, [], cursor)
+    val mutable state = `Loop (ctx, cursor, [], parse ctx cursor, `End)
 
     method next =
       match state with
-      | `Loop (ctx,rev_l,cursor) ->
-	  ( match (parse ctx cursor) # next with
-	  | Parsed (ctx1, elt, cursor1) ->
-	      state <- `Loop (ctx1, elt::rev_l, cursor1);
-	      self # next
-	  | Failed _ ->
-	      state <- `End;
-	      Parsed (ctx, List.rev rev_l, cursor) )
-      | `End -> Failed []
+	| `Loop (ctx, cursor, rev_le, p, state1) ->
+	  ( match p # next with
+	    | Parsed (ctx1, elt, cursor1) ->
+	        state <- `Loop (ctx1, cursor1, elt::rev_le, parse ctx1 cursor1, state);
+	        self # next
+	    | Failed _msgs ->
+	        state <- state1;
+	        Parsed (ctx, List.rev rev_le, cursor) )
+	| `End -> Failed []
   end
 
 let many = new many
 let some parse = parse |> fun x -> many parse --> (fun xs -> x::xs)
 
-class ['ctx, 'elt, 'sep, 'cursor] list1_aux (p_elt : ('ctx,'elt,'cursor) parse) (p_sep : ('ctx,'sep,'cursor) parse) (ctx : 'ctx) (cursor : 'cursor) =
+(* non-empty repetitions with separators, favoring longest repetitions *)
+class ['ctx, 'elt, 'sep, 'cursor] list1 (p_elt : ('ctx,'elt,'cursor) parse) (p_sep : ('ctx,'sep,'cursor) parse) (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
-    val mutable state = `Loop (ctx, [], cursor)
+    val mutable state = `Elt (ctx, cursor, [], p_elt ctx cursor, `End)
 
     method next =
       match state with
-      | `Loop (ctx,rev_l,cursor) ->
-	  ( match (p_sep ctx cursor) # next with
-	  | Parsed (ctx1,_,cursor1) ->
-	      ( match (p_elt ctx1 cursor1) # next with
-	      | Parsed (ctx2,elt,cursor2) ->
-		  state <- `Loop (ctx2, elt::rev_l, cursor2);
-		  self#next
-	      | Failed msgs2 ->
-		  state <- `End;
-		  Parsed (ctx, List.rev rev_l, cursor) )
-	  | Failed msgs1 ->
-	      state <- `End;
-	      Parsed (ctx, List.rev rev_l, cursor) )
-      | `End -> Failed []
+	| `Elt (ctx, cursor, rev_le, p, state1) ->
+	  ( match p # next with
+	    | Parsed (ctx1, e, cursor1) ->
+	        state <- `Sep (ctx1, cursor1, e::rev_le, p_sep ctx1 cursor1, state);
+	        self # next
+	    | Failed _msgs ->
+	        state <- state1;
+	        self # next )
+	| `Sep (ctx, cursor, rev_le, p, state1) ->
+	  ( match p # next with
+	    | Parsed (ctx1, _, cursor1) ->
+	        state <- `Elt (ctx1, cursor1, rev_le, p_elt ctx1 cursor1, state);
+	        self # next
+	    | Failed _msgs ->
+	        state <- state1;
+	        Parsed (ctx, List.rev rev_le, cursor) )
+	| `End -> Failed []
   end
 
-let list1_aux = new list1_aux
-
-let list1 p_elt p_sep = p_elt |> fun x -> list1_aux p_elt p_sep --> (fun xs -> x::xs)
+let list1 p_elt p_sep = new list1 p_elt p_sep (* p_elt |> fun x -> list1_aux p_elt p_sep --> (fun xs -> x::xs) *)
 let list0 p_elt p_sep = (list1 p_elt p_sep) <|> (ret [])