Commits

Sébastien Ferré committed 45e2163

Using 'null' constant parser to free references to parsers.

Comments (0)

Files changed (1)

 let set_trace b = trace := b
 
 
-type ('str, 'ctx, 'res, 'msg) result = Parsed of 'ctx * 'res * 'str | Failed of 'msg list
+type ('cursor, 'ctx, 'res, 'msg) result = Parsed of 'ctx * 'res * 'cursor | Failed of 'msg list
 
-class type ['ctx, 'res, 'str, 'msg] p =
+class type ['ctx, 'res, 'cursor, 'msg] p =
   object
-    method next : ('str, 'ctx, 'res, 'msg) result
+    method next : ('cursor, 'ctx, 'res, 'msg) result
   end
 
-type ('ctx, 'res, 'str, 'msg) parse = 'ctx -> 'str -> ('ctx, 'res, 'str, 'msg) p
+type ('ctx, 'res, 'cursor, 'msg) parse = 'ctx -> 'cursor -> ('ctx, 'res, 'cursor, 'msg) p
 
-class ['ctx,'res,'str,'msg] fail (str : 'str) =
+let null =
+  object
+    method next = Failed []
+  end
+
+class ['ctx,'res,'cursor,'msg] fail (cursor : 'cursor) =
   object (self)
-    method next : ('str, 'ctx, 'res, 'msg) result =
+    method next : ('cursor, 'ctx, 'res, 'msg) result =
       Failed ([] : 'msg list)
   end
 
 let fail = new fail
 
-class ['ctx, 'str,'msg] rise (ctx : 'ctx) (str : 'str) =
+class ['ctx, 'cursor,'msg] rise (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
     val mutable state = `Begin
 
       match state with
       | `Begin ->
 	  state <- `End;
-	  Parsed (ctx, str, str)
+	  Parsed (ctx, cursor, cursor)
       | `End ->
 	  Failed ([] : 'msg list)
   end
 let rise = new rise
 
 
-class ['ctx, 'res0, 'res, 'str, 'msg] map (parse : ('ctx, 'res0, 'str, 'msg) parse) (f : 'res0 -> 'res) (ctx : 'ctx) (str : 'str) =
+class ['ctx, 'res0, 'res, 'cursor, 'msg] map (parse : ('ctx, 'res0, 'cursor, 'msg) parse) (f : 'res0 -> 'res) (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
-    val mutable p = parse ctx str
+    val mutable p = parse ctx cursor
 
     method next =
       match p # next with
-      | Parsed (ctx1, res0, str') -> Parsed (ctx1, f res0, str')
-      | Failed msgs -> Failed msgs
+      | Parsed (ctx1, res0, cursor') ->
+	  Parsed (ctx1, f res0, cursor')
+      | Failed msgs ->
+	  p <- null; (* to help GC *)
+	  Failed msgs
   end
 
 let map = new map
 let (-->) = map
 
-class ['ctx, 'res, 'str, 'msg] ret (res : 'res) (ctx : 'ctx) (str : 'str) =
+class ['ctx, 'res, 'cursor, 'msg] ret (res : 'res) (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
     val mutable state = `Begin
 
-    method next : ('str,'ctx,'res,'msg) result =
+    method next : ('cursor,'ctx,'res,'msg) result =
       match state with
       | `Begin ->
 	  state <- `End;
-	  Parsed (ctx, res, str)
+	  Parsed (ctx, res, cursor)
       | `End ->
 	  Failed ([] : 'msg list) 
   end
    --> expr ==> ret expr
 *)
 
-class ['ctx, 'res, 'str, 'msg] alt (parse1 : ('ctx, 'res, 'str, 'msg) parse) (parse2 : ('ctx, 'res, 'str, 'msg) parse) (ctx : 'ctx) (str : 'str) =
+class ['ctx, 'res, 'cursor, 'msg] alt (parse1 : ('ctx, 'res, 'cursor, 'msg) parse) (parse2 : ('ctx, 'res, 'cursor, 'msg) parse) (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
     val mutable state = `First
-    val mutable p = parse1 ctx str
+    val mutable p = parse1 ctx cursor
     val mutable msgs = []
 
     method next =
 	  | Parsed _ as x -> x
 	  | Failed msgs1 ->
 	      state <- `Second;
-	      p <- parse2 ctx str;
+	      p <- parse2 ctx cursor;
 	      msgs <- msgs1 @ msgs;
 	      self # next)
       | `Second ->
 	  | Parsed _ as x -> x
 	  | Failed msgs2 ->
 	      state <- `End;
+	      p <- null; (* to help GC *)
 	      msgs <- msgs2 @ msgs;
 	      self # next)
       | `End ->
    p1 | p2 ==> alt p1 p2
 *)
 
-class ['ctx, 'res1, 'res, 'str, 'msg] seq (parse1 : ('ctx,'res1,'str,'msg) parse) (parse2 : 'res1 -> ('ctx,'res,'str,'msg) parse) (ctx : 'ctx) (str : 'str) =
+class ['ctx, 'res1, 'res, 'cursor, 'msg] seq (parse1 : ('ctx,'res1,'cursor,'msg) parse) (parse2 : 'res1 -> ('ctx,'res,'cursor,'msg) parse) (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
     val mutable state = `First
-    val p1 = parse1 ctx str
+    val mutable p1 = parse1 ctx cursor
     val mutable p2_opt = None (* delaying the creation of p2 because of possible loops *)
     val mutable msgs = []
 
       match state with
       | `First ->
 	  ( match p1 # next with
-	  | Parsed (ctx1, res1, str1) ->
+	  | Parsed (ctx1, res1, cursor1) ->
 	      state <- `Second;
-	      p2_opt <- Some (parse2 res1 ctx1 str1);
+	      p2_opt <- Some (parse2 res1 ctx1 cursor1);
 	      self # next
 	  | Failed msgs1 ->
 	      state <- `End;
+	      p1 <- null;
 	      msgs <- msgs1 @ msgs;
 	      self # next)
       | `Second ->
 	      | Parsed _ as x -> x
 	      | Failed msgs2 ->
 		  state <- `First;
+		  p2_opt <- None;
 		  msgs <- msgs2 @ msgs;
 		  self # next)
 	  | None -> assert false)
    param = p1; p2 ==> seq p1 (fun param -> p2)
 *)
 
-class ['ctx,'res1,'res,'str,'msg] cut (parse1 : ('ctx,'res1,'str,'msg) parse) (parse2 : 'res1 -> ('ctx,'res,'str,'msg) parse) (parse3 : ('ctx,'res,'str,'msg) parse) (ctx : 'ctx) (str : 'str) =
+class ['ctx,'res1,'res,'cursor,'msg] cut (parse1 : ('ctx,'res1,'cursor,'msg) parse) (parse2 : 'res1 -> ('ctx,'res,'cursor,'msg) parse) (parse3 : ('ctx,'res,'cursor,'msg) parse) (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
     val mutable state = `First
-    val p1 = parse1 ctx str
+    val mutable p1 = parse1 ctx cursor
     val mutable p_opt = None
 
     method next =
       match state with
       | `First ->
 	  ( match p1 # next with
-	  | Parsed (ctx1, res1, str1) ->
+	  | Parsed (ctx1, res1, cursor1) ->
 	      state <- `Second;
-	      p_opt <- Some (parse2 res1 ctx1 str1);
+	      p_opt <- Some (parse2 res1 ctx1 cursor1);
 	      self # next
 	  | Failed _ ->
 	      state <- `Third;
-	      p_opt <- Some (parse3 ctx str);
+	      p_opt <- Some (parse3 ctx cursor);
 	      self # next)
       | `Second ->
 	  ( match p_opt with
-	  | Some p -> p # next
+	  | Some p -> 
+	      ( match p # next with
+	      | Parsed _ as x -> x
+	      | Failed _ as x ->
+		  state <- `End;
+		  p_opt <- None;
+		  p1 <- null;
+		  x)
 	  | None -> assert false)
       | `Third ->
 	  ( match p_opt with
-	  | Some p -> p # next
+	  | Some p ->
+	      ( match p # next with
+	      | Parsed _ as x -> x
+	      | Failed _ as x ->
+		  state <- `End;
+		  p_opt <- None;
+		  p1 <- null;
+		  x)
 	  | None -> assert false)
+      | `End -> Failed ([] : 'msg list)
   end
 
 let cut = new cut
    if p1 then p2 else p3 ==> cut p1 (fun _ -> p2) p3
 *)
 
-class ['ctx,'res,'str,'msg] guard (parse : ('ctx,'res,'str,'msg) parse) (name : string) (pred : 'res -> bool) (ctx : 'ctx) (str : 'str) =
+class ['ctx,'res,'cursor,'msg] guard (parse : ('ctx,'res,'cursor,'msg) parse) (name : string) (pred : 'res -> bool) (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
-    val p = parse ctx str
+    val mutable p = parse ctx cursor
 
     method next =
       match p # next with
-      | Parsed (ctx1, res1, str1) as x ->
+      | Parsed (ctx1, res1, cursor1) as x ->
 	  if pred res1
 	  then x
 	  else self # next
       | Failed msgs ->
-	  let coord = str#coord in
+	  p <- null;
+	  let coord = cursor#coord in
 	  let msg = Msg.make name [||] (Msg.Locator.Point coord) in
 	  Failed (msg::msgs)
   end
    param = p1 when expr_bool else expr_string ==> guard p1 expr_string (fun param -> expr_bool)
 *)
 
-class ['ctx,'str,'msg] check (name : string) (pred : unit -> bool) (ctx : 'ctx) (str : 'str) =
+class ['ctx,'cursor,'msg] check (name : string) (pred : unit -> bool) (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
     val mutable state = `Begin
 
 	  state <- `End;
 	  if pred ()
 	  then
-	    Parsed (ctx, (), str)
+	    Parsed (ctx, (), cursor)
 	  else
-	    let coord = str#coord in
+	    let coord = cursor#coord in
 	    let msg = Msg.make name [||] (Msg.Locator.Point coord) in
 	    Failed [msg]
       | `End -> Failed []
 
 let check = new check
 
-class ['ctx,'res,'str,'msg] enum (name : string) (f : unit -> 'res list) (ctx : 'ctx) (str : 'str) =
+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
 
 	  state <- Some (f ());
 	  if state = Some []
 	  then
-	    let coord = str#coord in
+	    let coord = cursor#coord in
 	    let msg = Msg.make name [||] (Msg.Locator.Point coord) in
 	    Failed [msg]
 	  else self#next
       | Some (x::xs) ->
 	  state <- Some xs;
-	  Parsed (ctx, x, str)
+	  Parsed (ctx, x, cursor)
       | Some [] -> Failed []
   end
 
 let enum = new enum
 
-class ['ctx,'str,'msg] get_context (ctx : 'ctx) (str : 'str) =
+class ['ctx,'cursor,'msg] get_context (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
     val mutable state = `Begin
 
       match state with
       | `Begin ->
 	  state <- `End;
-	  Parsed (ctx, ctx, str)
+	  Parsed (ctx, ctx, cursor)
       | `End -> Failed ([] : 'msg list)
   end
 
 let get_context = new get_context
 
-class ['ctx,'str,'msg] set_context (ctx1 : 'ctx) (ctx : 'ctx) (str : 'str) =
+class ['ctx,'cursor,'msg] set_context (ctx1 : 'ctx) (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
     val mutable state = `Begin
 
       match state with
       | `Begin ->
 	  state <- `End;
-	  Parsed (ctx1, (), str)
+	  Parsed (ctx1, (), cursor)
       | `End -> Failed ([] : 'msg list)
   end
 
 let set_context = new set_context
 
-class ['ctx,'str] check_context (name : string) (pred : 'ctx -> bool) (ctx : 'ctx) (str : 'str) =
+class ['ctx,'cursor] check_context (name : string) (pred : 'ctx -> bool) (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
     val mutable state = `Begin
 
 	  state <- `End;
 	  if pred ctx
 	  then
-	    Parsed (ctx, ctx, str)
+	    Parsed (ctx, ctx, cursor)
 	  else
-	    let coord = str#coord in
+	    let coord = cursor#coord in
 	    let msg = Msg.make name [||] (Msg.Locator.Point coord) in
 	    Failed [msg]
       | `End -> Failed []
 
 let check_context = new check_context
 
-class ['ctx,'str] enum_context (name : string) (f : 'ctx -> 'ctx list) (ctx : 'ctx) (str : 'str) =
+class ['ctx,'cursor] enum_context (name : string) (f : 'ctx -> 'ctx list) (ctx : 'ctx) (cursor : 'cursor) =
   object (self)
     val mutable state : 'ctx list option = None
 
 	  state <- Some (f ctx);
 	  if state = Some []
 	  then
-	    let coord = str#coord in
+	    let coord = cursor#coord in
 	    let msg = Msg.make name [||] (Msg.Locator.Point coord) in
 	    Failed [msg]
 	  else self#next
       | Some (ctx1::l1) ->
 	  state <- Some l1;
-	  Parsed (ctx1, (), str)
+	  Parsed (ctx1, (), cursor)
       | Some [] -> Failed []
   end
   
     (* line, column, msg *)
 
 (* returns one parsing result *)
-let once parse ctx str =
-  let p = parse ctx str in
+let once parse ctx cursor =
+  let p = parse ctx cursor in
   match p # next with
   | Parsed (ctx, x, _) -> ctx, x
   | Failed [] ->
       raise (SyntaxError (line, col, Msg.toString best_msg))
 
 (* returns all parsing results *)
-let all parse ctx str =
-  let p = parse ctx str in
+let all parse ctx cursor =
+  let p = parse ctx cursor in
   let res = ref [] in
   begin try while true do
     match p # next with