summaryrefslogtreecommitdiff
path: root/ide/document.ml
diff options
context:
space:
mode:
Diffstat (limited to 'ide/document.ml')
-rw-r--r--ide/document.ml35
1 files changed, 18 insertions, 17 deletions
diff --git a/ide/document.ml b/ide/document.ml
index 9823e757..62457fe5 100644
--- a/ide/document.ml
+++ b/ide/document.ml
@@ -16,8 +16,8 @@ type id = Stateid.t
class type ['a] signals =
object
- method popped : callback:('a -> unit) -> unit
- method pushed : callback:('a -> unit) -> unit
+ method popped : callback:('a -> ('a list * 'a list) option -> unit) -> unit
+ method pushed : callback:('a -> ('a list * 'a list) option -> unit) -> unit
end
class ['a] signal () =
@@ -32,14 +32,14 @@ end
type 'a document = {
mutable stack : 'a sentence list;
mutable context : ('a sentence list * 'a sentence list) option;
- pushed_sig : 'a signal;
- popped_sig : 'a signal;
+ pushed_sig : ('a * ('a list * 'a list) option) signal;
+ popped_sig : ('a * ('a list * 'a list) option) signal;
}
-let connect d =
+let connect d : 'a signals =
object
- method pushed ~callback = d.pushed_sig#connect callback
- method popped ~callback = d.popped_sig#connect callback
+ method pushed ~callback = d.pushed_sig#connect (fun (x, ctx) -> callback x ctx)
+ method popped ~callback = d.popped_sig#connect (fun (x, ctx) -> callback x ctx)
end
let create () = {
@@ -49,6 +49,12 @@ let create () = {
popped_sig = new signal ();
}
+let repr_context s = match s.context with
+| None -> None
+| Some (cl, cr) ->
+ let map s = s.data in
+ Some (List.map map cl, List.map map cr)
+
(* Invariant, only the tip is a allowed to have state_id = None *)
let invariant l = l = [] || (List.hd l).state_id <> None
@@ -64,12 +70,13 @@ let tip_data = function
let push d x =
assert(invariant d.stack);
d.stack <- { data = x; state_id = None } :: d.stack;
- d.pushed_sig#call x
+ d.pushed_sig#call (x, repr_context d)
let pop = function
| { stack = [] } -> raise Empty
- | { stack = { data }::xs } as s -> s.stack <- xs; s.popped_sig#call data; data
-
+ | { stack = { data }::xs } as s ->
+ s.stack <- xs; s.popped_sig#call (data, repr_context s); data
+
let focus d ~cond_top:c_start ~cond_bot:c_stop =
assert(invariant d.stack);
if d.context <> None then invalid_arg "focus";
@@ -124,12 +131,6 @@ let context d =
let pair _ x y = try Option.get x, y with Option.IsNone -> assert false in
List.map (flat pair true) top, List.map (flat pair true) bot
-let iter d f =
- let a, s, b = to_lists d in
- List.iter (flat f false) a;
- List.iter (flat f true) s;
- List.iter (flat f false) b
-
let stateid_opt_equal = Option.equal Stateid.equal
let is_in_focus d id =
@@ -154,7 +155,7 @@ let cut_at d id =
if stateid_opt_equal state_id (Some id) then CSig.Stop (n, zone)
else CSig.Cont (n + 1, data :: zone) in
let n, zone = CList.fold_left_until aux (0, []) d.stack in
- for i = 1 to n do ignore(pop d) done;
+ for _i = 1 to n do ignore(pop d) done;
List.rev zone
let find_id d f =