Машина Тьюринга на OCaml

2025-06-03 19:47
vak: (Знайка)
В качестве иллюстрации к языку OCaml вот вам реализация машины Тьюринга. В студенчестве я на Рефале такое писал. Жаль не сохранилось.
(* Types for Turing machine *)
type symbol = One | Blank
type direction = Left | Right
type state = string
type transition = (state * symbol) * (state * symbol * direction)
type tape = { left: symbol list; head: symbol; right: symbol list }

(* Convert symbol to string for printing *)
let string_of_symbol = function
    | One -> "1"
    | Blank -> "_"

(* Print the current tape and head position *)
let print_tape tape state =
    let left_str = List.map string_of_symbol tape.left |> String.concat "" in
    let right_str = List.map string_of_symbol tape.right |> String.concat "" in
    Printf.printf "[%s] %s (%s) %s\n" left_str (string_of_symbol tape.head) state right_str

(* Move the tape head *)
let move_head tape dir =
    match dir with
    | Right ->
      let new_right, new_head = match tape.right with
          | [] -> ([], Blank)
          | h :: t -> (t, h)
      in
      { left = tape.head :: tape.left; head = new_head; right = new_right }
    | Left ->
      let new_left, new_head = match tape.left with
          | [] -> ([], Blank)
          | h :: t -> (t, h)
      in
      { left = new_left; head = new_head; right = tape.head :: tape.right }

(* Step the Turing machine *)
let step tape state transitions =
    let current = (state, tape.head) in
    match List.assoc_opt current transitions with
    | None -> None (* No transition: halt *)
    | Some (new_state, new_symbol, dir) ->
      let new_tape = { tape with head = new_symbol } in
      let moved_tape = move_head new_tape dir in
      Some (moved_tape, new_state)

(* Run the Turing machine *)
let run_turing_machine tape start_state transitions accept_state reject_state =
    let rec run tape state =
        print_tape tape state;
        if state = accept_state then Printf.printf "Accepted\n"
        else if state = reject_state then Printf.printf "Rejected\n"
        else match step tape state transitions with
            | None -> Printf.printf "Halted (no transition)\n"
            | Some (new_tape, new_state) -> run new_tape new_state
    in
    run tape start_state

(* Turing machine to add two unary numbers *)
let example_add () =
    let transitions = [
        (* q0: Move right to find blank *)
        (("q0", One), ("q0", One, Right));
        (("q0", Blank), ("q1", One, Left));
        (* q1: Move left to start *)
        (("q1", One), ("q1", One, Left));
        (("q1", Blank), ("qaccept", Blank, Right));
    ] in
    (* Tape represents 2 + 3: 11_111 *)
    let tape = { left = []; head = One; right = [One; Blank; One; One; One] } in
    run_turing_machine tape "q0" transitions "qaccept" "qreject"

(* Run the example *)
let () = example_add ()
Вышеприведённая программа на машине Тьюринга складывает два числа 2+3, записанные как последовательность единиц: 11 111. В результате получается 5, то есть 11111. Запускаем:
$ ocaml turing_add.ml 
[] 1 (q0) 1_111
[1] 1 (q0) _111
[11] _ (q0) 111
[1] 1 (q1) 1111
[] 1 (q1) 11111
[] _ (q1) 111111
[_] 1 (qaccept) 11111
Accepted
Tags:

OCaml

2025-06-02 13:18
vak: (Знайка)
Новая книжка на моей полке.



Свет не сошёлся клином на одном Rust. За последние годы появился ещё один значимый язык. В 2023 году OCaml получил престижную премию SIGPLAN Award. Когда-то в юности я фигел от Снобола-4, позже от Scheme. А здесь всё совсем удобно сделано.



Сижу разбираюсь, как устроен NQCC, компилятор Си из книжки, написанный на OCaml. И прихожу к выводу, что сделан он весьма неплохо, причём во многом благодаря OCaml. Если бы я сейчас начинал какую нибудь серьёзную разработку типа компилятора, возможно я бы делал его на OCaml вместо Rust или Golang.

Для примера, перепрём /bin/echo на OCaml.
let process_escapes str =
    let len = String.length str in
    let buf = Buffer.create len in
    let rec loop i =
        if i >= len then Buffer.contents buf
        else if str.[i] <> '\\' then (
            Buffer.add_char buf str.[i];
            loop (i + 1)
        ) else if i + 1 < len then (
            match str.[i + 1] with
            | 'n' -> Buffer.add_char buf '\n'; loop (i + 2)
            | 't' -> Buffer.add_char buf '\t'; loop (i + 2)
            | '\\' -> Buffer.add_char buf '\\'; loop (i + 2)
            | _ -> Buffer.add_char buf str.[i]; loop (i + 1)
        ) else (
            Buffer.add_char buf str.[i];
            loop (i + 1)
        )
    in
    loop 0

let echo no_newline enable_escapes args =
    let process = if enable_escapes then process_escapes else fun x -> x in
    let output = String.concat " " (List.map process args) in
    if no_newline then print_string output
    else print_endline output

let main () =
    let no_newline = ref false in
    let enable_escapes = ref false in
    let args = ref [] in
    let speclist = [
        ("-n", Arg.Set no_newline, "do not output the trailing newline");
        ("-e", Arg.Set enable_escapes, "enable interpretation of backslash escapes");
    ] in
    Arg.parse speclist (fun arg -> args := arg :: !args) "Usage: echo [-n] [-e] [string ...]";
    echo !no_newline !enable_escapes (List.rev !args)

let () = main ()
Компилируем, запускаем:
$ ocamlopt -O2 -o echo echo.ml

$ ./echo --help
Usage: echo [-n] [-e] [string ...]
  -n do not output the trailing newline
  -e enable interpretation of backslash escapes
  -help  Display this list of options
  --help  Display this list of options

$ ./echo -e "Hello\nWorld"
Hello
World
Tags: