Commits

Sébastien Ferré committed 2b9f0b8

Add of context.

Comments (0)

Files changed (1)

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