Initial import of Rope library

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

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

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

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

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

src/ligo/rope_top_level_open.ml

@@ -0,0 +1,3 @@
+open Rope
+
+let (#%) = (#%)

src/ligo/rope_top_level_open.mli

@@ -0,0 +1,3 @@
+open Rope
+
+val ( #% ) : ((impl -> impl) -> 'a -> 'b) -> 'a -> 'b