diff --git a/src/combinatoryLogic.ml b/src/combinatoryLogic.ml index a84816b..be9a51e 100644 --- a/src/combinatoryLogic.ml +++ b/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 diff --git a/src/extlib.ml b/src/extlib.ml index 6124650..8668b86 100644 --- a/src/extlib.ml +++ b/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 diff --git a/test/cl.ml b/test/cl.ml new file mode 100644 index 0000000..55a9cbd --- /dev/null +++ b/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)" diff --git a/test/dune b/test/dune index a9d8beb..6668f44 100644 --- a/test/dune +++ b/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)) +)