Working combinatory logic.

src/combinatoryLogic.ml

@@ -1,8 +1,11 @@
 (** Combinatory logic. *)
 
+open Extlib
+
 (** A combinator. *)
 type t = I | K | S | App of t * t
 
+(** String representation. *)
 let rec to_string = function
   | I -> "I"
   | K -> "K"
@@ -12,6 +15,26 @@ let rec to_string = function
     let pa s = if pa then "("^s^")" else s in
     to_string t ^ " " ^ pa (to_string u)
 
+(** Parser. *)
+let rec of_string s =
+  let s = String.trim s in
+  let l = String.length s in
+  match s with
+  | "I" -> I
+  | "K" -> K
+  | "S" -> S
+  | _ when s.[l-1] = ')' ->
+    let i = String.matching_parenthesis s (l-1) in
+    if i = 0 then of_string (String.sub s 1 (l-2))
+    else
+      let t = String.sub s 0 i |> of_string in
+      let u = String.sub s i (l-i) |> of_string in
+      App (t, u)
+  | _ ->
+    let t = String.sub s 0 (l-1) |> of_string in
+    let u = String.sub s (l-1) 1 |> of_string in 
+    App (t, u)
+
 (** Normalize combinator. *)
 let rec normalize t =
   match t with

src/extlib.ml

@@ -127,13 +127,34 @@ module String = struct
 
   (** Find the matching closing parenthesis of an opening parenthesis. *)
   let matching_parenthesis s i =
-    assert (s.[i] = '(');
-    let n = ref 0 in
-    find_index_from
-      (fun c ->
-         if c = '(' then incr n
-         else if c = ')' then decr n;
-         assert (!n >= 0);
-         !n = 0
-      ) s i
+    let find_closing a b =
+      let n = ref 0 in
+      find_index_from
+        (fun c ->
+           if c = a then incr n
+           else if c = b then decr n;
+           assert (!n >= 0);
+           !n = 0
+        ) s i
+    in
+    let find_opening a b =
+      let n = ref 0 in
+      let ans = ref (-1) in
+      try
+        for i = i downto 0 do
+          if s.[i] = b then incr n
+          else if s.[i] = a then decr n;
+          assert (!n >= 0);
+          if !n = 0 then (
+            ans := i;
+            raise Exit
+          )
+        done;
+        raise Not_found
+      with Exit -> !ans
+    in
+    match s.[i] with
+    | '(' -> find_closing '(' ')'
+    | ')' -> find_opening '(' ')'
+    | _ -> assert false
 end

test/cl.ml

@@ -0,0 +1,12 @@
+(** Test combinatory logic. *)
+
+open Alg
+open CombinatoryLogic
+
+let () =
+  print_endline (to_string (App (App (S, K), I)));
+  print_endline (to_string (App (S, App (K, I))));
+  let test s = print_endline (to_string (of_string s)) in
+  test "S K I";
+  test "(S K) I";
+  test "S (K I)"

test/dune

@@ -224,3 +224,14 @@
  (alias runtest)
  (action (run ./gen.exe))
 )
+
+(executable
+ (name cl)
+ (modules cl)
+ (libraries alg)
+)
+
+(rule
+ (alias runtest)
+ (action (run ./cl.exe))
+)