diff --git a/src/ligo/rope.ml b/src/ligo/rope.ml new file mode 100644 index 000000000..f6b592056 --- /dev/null +++ b/src/ligo/rope.ml @@ -0,0 +1,39 @@ +module RopeImplementation = Rope_implementation + +type impl = RopeImplementation.t + +type 'a t = + S : string -> (((impl -> 'a) -> 'b) -> (impl -> 'a) -> 'b) t +| Other : 'a -> 'a t + +let _S = + fun constant -> + fun f -> + fun new_cont -> + f (fun (acc : impl) -> new_cont RopeImplementation.(cat acc (of_string constant))) + +let z = Other _S +let _d = + fun f -> + fun new_cont -> + f (fun (acc : impl) (i : int) -> new_cont RopeImplementation.(cat acc (of_string (string_of_int i)))) +let d = Other _d + +let _s = + fun f -> + fun new_cont -> + f (fun (acc : impl) (s : string) -> new_cont RopeImplementation.(cat acc (of_string s))) +let s = Other _s + +let start cont = cont RopeImplementation.(of_string "") +let finish (acc : impl) = acc + +let (~%) : type a b . (((impl -> a) -> a) -> b) t -> b = + function + | S str -> _S str start + | Other f -> f start +let (%) : type a b . a -> (a -> b) t -> b = fun fmt1 fmt2 -> match fmt2 with + | S str -> _S str fmt1 + | Other f2 -> f2 fmt1 +let (#%) fmt arg = + (fmt finish) arg diff --git a/src/ligo/rope.mli b/src/ligo/rope.mli new file mode 100644 index 000000000..0fb2e14f3 --- /dev/null +++ b/src/ligo/rope.mli @@ -0,0 +1,18 @@ +module RopeImplementation = Rope_implementation +type impl = RopeImplementation.t +type 'a t = + S : string -> (((impl -> 'a) -> 'b) -> (impl -> 'a) -> 'b) t + | Other : 'a -> 'a t +val _S : string -> ((impl -> 'a) -> 'b) -> (RopeImplementation.t -> 'a) -> 'b +val z : + (string -> ((impl -> 'a) -> 'b) -> (RopeImplementation.t -> 'a) -> 'b) t +val _d : ((impl -> int -> 'a) -> 'b) -> (RopeImplementation.t -> 'a) -> 'b +val d : (((impl -> int -> 'a) -> 'b) -> (RopeImplementation.t -> 'a) -> 'b) t +val _s : ((impl -> string -> 'a) -> 'b) -> (RopeImplementation.t -> 'a) -> 'b +val s : + (((impl -> string -> 'a) -> 'b) -> (RopeImplementation.t -> 'a) -> 'b) t +val start : (RopeImplementation.t -> 'a) -> 'a +val finish : impl -> impl +val ( ~% ) : (((impl -> 'a) -> 'a) -> 'b) t -> 'b +val ( % ) : 'a -> ('a -> 'b) t -> 'b +val ( #% ) : ((impl -> impl) -> 'a -> 'b) -> 'a -> 'b diff --git a/src/ligo/rope_implementation.ml b/src/ligo/rope_implementation.ml new file mode 100644 index 000000000..b073218ad --- /dev/null +++ b/src/ligo/rope_implementation.ml @@ -0,0 +1,4 @@ +type t = string +let of_string s = s +let cat a b = a ^ b +let to_string r = r diff --git a/src/ligo/rope_implementation.mli b/src/ligo/rope_implementation.mli new file mode 100644 index 000000000..b478569a7 --- /dev/null +++ b/src/ligo/rope_implementation.mli @@ -0,0 +1,4 @@ +type t +val of_string : string -> t +val cat : t -> t -> t +val to_string : t -> string diff --git a/src/ligo/rope_test.ml b/src/ligo/rope_test.ml new file mode 100644 index 000000000..36df73c00 --- /dev/null +++ b/src/ligo/rope_test.ml @@ -0,0 +1,28 @@ +module A = struct + open Rope_top_level_open + open Rope + + let x = d + let x = ~%d + let x = (~%d) #% 42 + let x = (~%d%d) + let x = (~%d%d) #% 42 43 + let x = (~%d%s) #% 42 "foo" + let x = (~%(S"foo")%s) #% "" + let x = (~%d%S"tralala"%d%s) #% 42 43 "foo" +end + +module B = struct + open Rope_top_level_open + + type foo = S | NotCaptured + let d = NotCaptured + let s = NotCaptured + + let x = Rope.(~%d) #% 42 + let x = Rope.(~%d%d) + let x = Rope.(~%d%d) #% 42 43 + let x = Rope.(~%d%s) #% 42 "foo" + let x = Rope.(~%(S"foo")%s) #% "" + let x = Rope.(~%d%S"tralala"%d%s) #% 42 43 "foo" +end diff --git a/src/ligo/rope_top_level_open.ml b/src/ligo/rope_top_level_open.ml new file mode 100644 index 000000000..fc0411987 --- /dev/null +++ b/src/ligo/rope_top_level_open.ml @@ -0,0 +1,3 @@ +open Rope + +let (#%) = (#%) diff --git a/src/ligo/rope_top_level_open.mli b/src/ligo/rope_top_level_open.mli new file mode 100644 index 000000000..b0e50e2e8 --- /dev/null +++ b/src/ligo/rope_top_level_open.mli @@ -0,0 +1,3 @@ +open Rope + +val ( #% ) : ((impl -> impl) -> 'a -> 'b) -> 'a -> 'b