บทความฉบับสมบูรณ์ — ครอบคลุมตั้งแต่พื้นฐานจนถึงการสร้างระบบ production-grade
ด้วยแนวคิด "Safety by Design" ตั้งแต่บรรทัดแรก
OCaml เป็นภาษาที่อยู่ในจุดที่น่าสนใจมาก — มันไม่ใช่ systems language แบบ "bare metal" อย่าง C/C++ แต่ก็ไม่ใช่ภาษา high-level ที่ห่างไกลจาก hardware อย่าง Python
OCaml 5 ยิ่งน่าสนใจขึ้นไปอีกด้วยการเพิ่ม Multicore GC และ Algebraic Effects เข้ามา
เปรียบเทียบกับภาษาอื่นในมุม Systems:
| ด้าน | OCaml 5 | Rust | Go | C++ |
|---|---|---|---|---|
| Memory Safety | GC (automatic) | Ownership/Borrow | GC | Manual |
| Concurrency Model | Domains + Effects + Eio | async/await + threads | goroutines | threads |
| Type Safety | Strong, inferred | Strong, inferred | Moderate | Weak |
| GC Pause | ต่ำ (incremental) | ไม่มี | ปานกลาง | ไม่มี |
| Learning Curve | ปานกลาง | สูงมาก | ต่ำ | สูงมาก |
| Ecosystem | ปานกลาง | ใหญ่ | ใหญ่ | ใหญ่มาก |
จุดแข็งของ OCaml 5 สำหรับ Systems Work:
Use Cases จริงที่ใช้ OCaml:
ข้อจำกัดที่ควรรู้:
ติดตั้ง opam (OCaml Package Manager):
# Linux / macOS
bash -c "sh <(curl -fsSL https://opam.ocaml.org/install.sh)"
# Arch Linux / CachyOS
sudo pacman -S opam
# เริ่มต้น opam
opam init --auto-setup
eval $(opam env)
สร้าง Switch สำหรับ OCaml 5.x:
# ดู version ที่มี
opam switch list-available | grep "^ocaml-base"
# สร้าง switch ใหม่
opam switch create 5.2.0
eval $(opam env)
# ตรวจสอบ
ocaml --version
# OCaml version 5.2.0
ติดตั้งเครื่องมือหลัก:
# Build system + formatter + LSP
opam install dune ocaml-lsp-server ocamlformat
# REPL ที่ดีกว่า default
opam install utop
# Profiling tools
opam install landmarks memtrace
# Testing
opam install alcotest qcheck
# Concurrency
opam install eio eio_main domainslib
# Systems libraries
opam install cmdliner logs fmt cstruct angstrom
โครงสร้าง Project เริ่มต้น:
dune init proj my_system_project
cd my_system_project
my_system_project/
├── bin/
│ ├── main.ml
│ └── dune
├── lib/
│ ├── my_system_project.ml
│ └── dune
├── test/
│ ├── test_main.ml
│ └── dune
└── dune-project
dune-project:
(lang dune 3.16)
(package
(name my_system_project)
(synopsis "A systems project in OCaml 5")
(depends
(ocaml (>= 5.2.0))
eio_main
domainslib
cmdliner
logs
alcotest))
Editor Setup (VS Code / Zed):
สำหรับ VS Code ติดตั้ง extension ocamllabs.ocaml-platform
สำหรับ Zed ใส่ใน settings.json:
{
"lsp": {
"ocamllsp": {
"binary": {
"path": "ocamllsp"
}
}
}
}
.ocamlformat แนะนำ:
version = 0.26.2
profile = conventional
doc-comments = before
OCaml ใช้ tagged value representation — ทุก value มี 1 bit สำหรับบอกว่าเป็น integer หรือ pointer
Primitive Types และ Memory Representation:
(* int — 63-bit บน 64-bit system (1 bit ใช้เป็น tag) *)
let x : int = 42
(* float — boxed เมื่ออยู่ใน heap, unboxed ใน float array *)
let f : float = 3.14
(* bool — เป็น int จริงๆ (0 = false, 1 = true) *)
let b : bool = true
(* char — 8-bit, เก็บเป็น int *)
let c : char = 'A'
(* string — immutable byte array, null-terminated *)
let s : string = "hello"
(* bytes — mutable byte array *)
let buf : bytes = Bytes.create 64
Records และ Memory Layout:
(* Record fields เก็บเป็น contiguous block ใน heap *)
type point = {
x : float;
y : float;
z : float;
}
(* Float record — unboxed เมื่อทุก field เป็น float *)
(* Memory: [tag | x | y | z] — ไม่มี boxing overhead *)
let origin = { x = 0.0; y = 0.0; z = 0.0 }
Variants และ Memory Layout:
type connection_state =
| Disconnected (* เป็น integer constant *)
| Connecting of string (* pointer to [tag | string] *)
| Connected of { fd: int; addr: string } (* pointer to record *)
| Failed of exn (* pointer to exception *)
ทำไม Type System สำคัญต่อ Systems Safety:
(* ไม่มี null — ต้องใช้ option อย่างชัดเจน *)
type 'a option = None | Some of 'a
let find_port config port =
match List.find_opt (fun p -> p.port_num = port) config.ports with
| None -> Error (`Port_not_found port)
| Some port_cfg -> Ok port_cfg
(* Compiler บังคับให้จัดการทุก case *)
Tail-Call Optimization (TCO) — สำคัญมากสำหรับ Systems Code:
(* ไม่ดี — stack overflow เมื่อ n ใหญ่ *)
let rec sum_bad n =
if n = 0 then 0
else n + sum_bad (n - 1) (* ไม่ใช่ tail call *)
(* ดี — TCO ทำให้กลายเป็น loop *)
let sum n =
let rec loop acc i =
if i = 0 then acc
else loop (acc + i) (i - 1) (* tail call *)
in
loop 0 n
Labeled Arguments สำหรับ API ที่ชัดเจน:
(* การใช้ labeled args ป้องกัน argument order bugs *)
let create_socket ~host ~port ~backlog =
let addr = Unix.ADDR_INET (Unix.inet_addr_of_string host, port) in
let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
Unix.bind sock addr;
Unix.listen sock backlog;
sock
(* ใช้งาน — ชัดเจน ไม่สับสน order *)
let server = create_socket ~host:"0.0.0.0" ~port:8080 ~backlog:128
Modeling System States อย่าง Exhaustive:
type process_state =
| Running of { pid: int; cpu_usage: float }
| Sleeping of { pid: int; sleep_since: float }
| Zombie of int (* pid *)
| Stopped of { pid: int; signal: int }
let describe_process state =
match state with
| Running { pid; cpu_usage } ->
Printf.sprintf "PID %d: running (%.1f%% CPU)" pid cpu_usage
| Sleeping { pid; sleep_since } ->
Printf.sprintf "PID %d: sleeping since %.0fs" pid sleep_since
| Zombie pid ->
Printf.sprintf "PID %d: zombie (needs reaping)" pid
| Stopped { pid; signal } ->
Printf.sprintf "PID %d: stopped by signal %d" pid signal
(* Compiler จะ warn ถ้าขาด case ใด — ป้องกัน unhandled state *)
Recursive Types สำหรับ Data Structures:
(* Binary Tree *)
type 'a tree =
| Leaf
| Node of { value: 'a; left: 'a tree; right: 'a tree }
let rec insert cmp x = function
| Leaf -> Node { value = x; left = Leaf; right = Leaf }
| Node { value; left; right } ->
let c = cmp x value in
if c = 0 then Node { value; left; right }
else if c < 0 then Node { value; left = insert cmp x left; right }
else Node { value; left; right = insert cmp x right }
Result Type สำหรับ Systems Errors:
type system_error =
| Permission_denied of string
| Not_found of string
| Timeout of float
| Connection_refused of { host: string; port: int }
| Unknown of string
(* ทุก function คืน result — ไม่มี surprise exception *)
let read_config path =
match Sys.file_exists path with
| false -> Error (Not_found path)
| true ->
try
let ic = open_in path in
let content = In_channel.input_all ic in
close_in ic;
Ok content
with Sys_error msg -> Error (Unknown msg)
(* Chaining ด้วย Result.bind (let* syntax) *)
let ( let* ) = Result.bind
let load_and_parse path =
let* content = read_config path in
let* parsed = parse_config content in
let* validated = validate_config parsed in
Ok validated
เปรียบเทียบแนวทาง Error Handling:
(* 1. Exceptions — ใช้สำหรับ truly unexpected errors *)
exception Database_corruption of string
raise (Database_corruption "checksum mismatch")
(* 2. Result — ใช้สำหรับ expected, recoverable errors *)
let connect host port : (connection, system_error) result = ...
(* 3. Option — ใช้เมื่อ "ไม่มี" เป็นผลลัพธ์ปกติ *)
let find_process pid : process_state option = ...
OCaml ใช้ Generational GC แบ่งเป็น 2 ส่วน:
┌─────────────────────────────────────────────┐
│ Minor Heap (per Domain ใน OCaml 5) │
│ ขนาดเล็ก (~256KB default) │
│ GC บ่อย แต่เร็วมาก │
│ Objects ส่วนใหญ่ตายที่นี่ (generational) │
└──────────────────┬──────────────────────────┘
│ promote (lived long enough)
┌──────────────────▼──────────────────────────┐
│ Major Heap (shared across Domains) │
│ ขนาดใหญ่ │
│ Incremental, concurrent GC │
│ Long-lived objects อยู่ที่นี่ │
└─────────────────────────────────────────────┘
GC Tuning สำหรับ Systems:
(* อ่านสถานะ GC ปัจจุบัน *)
let () =
let stat = Gc.stat () in
Printf.printf "Minor collections: %d\n" (int_of_float stat.Gc.minor_collections);
Printf.printf "Major collections: %d\n" (int_of_float stat.Gc.major_collections);
Printf.printf "Live words: %d\n" stat.Gc.live_words
(* ปรับ GC parameters *)
let () =
let ctrl = Gc.get () in
(* เพิ่ม minor heap — ลด minor GC frequency *)
Gc.set { ctrl with Gc.minor_heap_size = 1024 * 1024 };
(* space_overhead = 80 หมายถึง GC เมื่อ overhead > 80% *)
Gc.set { ctrl with Gc.space_overhead = 80 }
หลีกเลี่ยง GC Pressure:
(* ไม่ดี — สร้าง string ใหม่ทุกครั้ง = GC pressure *)
let process_requests requests =
List.map (fun req ->
"Response: " ^ req.body (* allocates new string each time *)
) requests
(* ดี — ใช้ Buffer เพื่อลด allocation *)
let process_requests requests =
let buf = Buffer.create 256 in
List.map (fun req ->
Buffer.clear buf;
Buffer.add_string buf "Response: ";
Buffer.add_string buf req.body;
Buffer.contents buf
) requests
ทำไม Immutability ถึง Safe:
(* Immutable — share ได้อย่างปลอดภัยระหว่าง Domains *)
type config = {
host : string;
port : int;
workers : int;
timeout : float;
}
(* "แก้ไข" ด้วยการสร้าง record ใหม่ — ไม่กระทบ original *)
let update_timeout config new_timeout =
{ config with timeout = new_timeout }
(* Persistent Map — functional, thread-safe โดยธรรมชาติ *)
module StringMap = Map.Make(String)
let registry = StringMap.empty
let registry = StringMap.add "service_a" handler_a registry
let registry = StringMap.add "service_b" handler_b registry
(* registry เก่ายังอยู่ — structural sharing *)
ref และ Mutable Fields:
(* ref — mutable reference *)
let counter = ref 0
incr counter (* counter := !counter + 1 *)
Printf.printf "%d\n" !counter
(* Mutable record fields — เฉพาะ field ที่ระบุ *)
type connection_pool = {
mutable size : int;
mutable active : int;
connections : connection Queue.t;
}
let acquire_connection pool =
if pool.active < pool.size then begin
pool.active <- pool.active + 1;
Queue.pop pool.connections
end else
Error `Pool_exhausted
Encapsulate Mutability ด้วย Module:
(* ซ่อน mutable state ไว้ข้างใน module *)
module Counter : sig
type t
val create : unit -> t
val increment : t -> unit
val get : t -> int
val reset : t -> unit
end = struct
type t = { mutable value : int }
let create () = { value = 0 }
let increment c = c.value <- c.value + 1
let get c = c.value
let reset c = c.value <- 0
end
Ctypes สำหรับ Type-safe C Bindings:
open Ctypes
open Foreign
(* Bind ฟังก์ชัน C อย่าง type-safe *)
let getpagesize = foreign "getpagesize" (void @-> returning int)
let mmap = foreign "mmap"
(ptr void @-> size_t @-> int @-> int @-> int @-> off_t @-> returning (ptr void))
let page_size = getpagesize ()
Bigarray สำหรับ Off-heap Memory:
open Bigarray
(* Allocate memory นอก GC heap — share กับ C ได้ *)
let shared_buffer =
Array1.create int8_unsigned c_layout (1024 * 1024)
(* เขียน/อ่านโดยตรง — zero-copy *)
let () =
Array1.fill shared_buffer 0;
shared_buffer.{0} <- 42;
Printf.printf "First byte: %d\n" shared_buffer.{0}
ใช้ memtrace:
(* เพิ่มใน main.ml *)
let () =
match Sys.getenv_opt "MEMTRACE" with
| Some path -> Memtrace.trace_if_requested ~context:"my_service" ()
| None -> ()
# รัน พร้อม trace
MEMTRACE=trace.ctf ./my_service
# วิเคราะห์
opam install memtrace-viewer
memtrace-viewer trace.ctf
ใช้ landmarks สำหรับ Allocation Profiling:
let[@landmark] process_batch items =
List.map expensive_transform items
OCAML_LANDMARKS=on ./my_service
┌─────────────────────────────────────────────────────────────┐
│ OCaml 5 Concurrency │
├───────────────┬──────────────────┬──────────────────────────┤
│ Domains │ Effects │ Eio │
│ (Parallelism)│ (Control Flow) │ (Concurrency) │
├───────────────┼──────────────────┼──────────────────────────┤
│ True parallel │ Resumable │ Structured concurrency │
│ execution │ continuations │ Fibers + Switches │
│ Shared memory │ Cooperative │ Non-blocking I/O │
│ OS threads │ scheduling │ Built on Effects │
└───────────────┴──────────────────┴──────────────────────────┘
Decision Matrix — เมื่อไหรใช้อะไร:
| งาน | เครื่องมือ |
|---|---|
| CPU-bound parallel computation | Domain + Domainslib |
| Concurrent I/O (network, file) | Eio |
| Custom scheduler / generator | Effect handlers |
| Simple parallel loop | Domainslib.Task.parallel_for |
| Producer-consumer queue | Eio.Stream หรือ Mutex + Condition |
(* Domain พื้นฐาน *)
let () =
let d1 = Domain.spawn (fun () ->
Printf.printf "Domain 1: %d\n" (Domain.self () :> int);
42
) in
let d2 = Domain.spawn (fun () ->
Printf.printf "Domain 2: %d\n" (Domain.self () :> int);
100
) in
let r1 = Domain.join d1 in
let r2 = Domain.join d2 in
Printf.printf "Results: %d + %d = %d\n" r1 r2 (r1 + r2)
Safe Patterns สำหรับ Domain:
(* Pattern 1: Data Partitioning — แต่ละ Domain ทำงานกับ data ส่วนตัว *)
let parallel_map f arr =
let n = Array.length arr in
let num_domains = Domain.recommended_domain_count () in
let chunk_size = (n + num_domains - 1) / num_domains in
let domains = Array.init num_domains (fun i ->
Domain.spawn (fun () ->
let start = i * chunk_size in
let stop = min n (start + chunk_size) in
Array.sub arr start (stop - start)
|> Array.map f
)
) in
Array.concat (Array.to_list (Array.map Domain.join domains))
(* Pattern 2: Immutable Sharing — share ข้อมูลที่ไม่เปลี่ยนแปลง *)
let config = { host = "localhost"; port = 8080; workers = 4 }
(* config เป็น immutable — share ระหว่าง Domain ได้ปลอดภัย *)
let _domains = Array.init 4 (fun _ ->
Domain.spawn (fun () -> serve config)
)
ระวัง Data Races:
(* อันตราย — data race! *)
let shared_counter = ref 0
let _d1 = Domain.spawn (fun () -> incr shared_counter)
let _d2 = Domain.spawn (fun () -> incr shared_counter)
(* ผลลัพธ์ไม่ deterministic *)
(* ปลอดภัย — ใช้ Atomic *)
let safe_counter = Atomic.make 0
let _d1 = Domain.spawn (fun () -> ignore (Atomic.fetch_and_add safe_counter 1))
let _d2 = Domain.spawn (fun () -> ignore (Atomic.fetch_and_add safe_counter 1))
(* Atomic operations ใน OCaml 5 *)
let counter = Atomic.make 0
(* get / set *)
let v = Atomic.get counter
Atomic.set counter 42
(* fetch_and_add — atomic increment, คืนค่าเดิม *)
let old_val = Atomic.fetch_and_add counter 1
(* compare_and_set — CAS operation *)
let success = Atomic.compare_and_set counter expected new_val
(* exchange — set และคืนค่าเดิม *)
let prev = Atomic.exchange counter 0
Lock-free Stack:
(* Treiber Stack — lock-free stack ด้วย CAS *)
type 'a node = {
value : 'a;
next : 'a node option;
}
type 'a stack = 'a node option Atomic.t
let create () : 'a stack = Atomic.make None
let push stack value =
let rec loop () =
let head = Atomic.get stack in
let new_node = Some { value; next = head } in
if Atomic.compare_and_set stack head new_node then ()
else loop () (* retry ถ้า CAS fail *)
in
loop ()
let pop stack =
let rec loop () =
match Atomic.get stack with
| None -> None
| Some { value; next } as head ->
if Atomic.compare_and_set stack head next then Some value
else loop ()
in
loop ()
(* Mutex พื้นฐาน *)
let mutex = Mutex.create ()
let with_mutex m f =
Mutex.lock m;
Fun.protect ~finally:(fun () -> Mutex.unlock m) f
(* Producer-Consumer ด้วย Condition *)
module Bounded_queue = struct
type 'a t = {
queue : 'a Queue.t;
mutex : Mutex.t;
not_empty : Condition.t;
not_full : Condition.t;
capacity : int;
}
let create capacity = {
queue = Queue.create ();
mutex = Mutex.create ();
not_empty = Condition.create ();
not_full = Condition.create ();
capacity;
}
let push bq item =
Mutex.lock bq.mutex;
while Queue.length bq.queue >= bq.capacity do
Condition.wait bq.not_full bq.mutex
done;
Queue.push item bq.queue;
Condition.signal bq.not_empty;
Mutex.unlock bq.mutex
let pop bq =
Mutex.lock bq.mutex;
while Queue.is_empty bq.queue do
Condition.wait bq.not_empty bq.mutex
done;
let item = Queue.pop bq.queue in
Condition.signal bq.not_full;
Mutex.unlock bq.mutex;
item
end
Effect Handlers คือหนึ่งใน features ที่สำคัญที่สุดของ OCaml 5
มันเป็น resumable exceptions — สามารถ resume กลับมาหลัง handle ได้
(* ประกาศ Effect *)
effect Log : string -> unit
effect Read_file : string -> string
effect Get_time : unit -> float
(* ใช้ perform เพื่อ trigger effect *)
let process_data () =
perform (Log "Starting process");
let content = perform (Read_file "/etc/hosts") in
let t = perform (Get_time ()) in
Printf.printf "Read %d bytes at %.0f\n" (String.length content) t
(* Handle effects *)
let () =
match process_data () with
| () -> ()
| effect (Log msg) k ->
Printf.printf "[LOG] %s\n" msg;
continue k () (* resume ต่อ *)
| effect (Read_file path) k ->
let content = In_channel.with_open_text path In_channel.input_all in
continue k content
| effect (Get_time ()) k ->
continue k (Unix.gettimeofday ())
Effect สำหรับ Cooperative Scheduling (Green Threads):
(* Yield effect สำหรับ cooperative multitasking *)
effect Yield : unit
type task = unit -> unit
let scheduler tasks =
let queue = Queue.of_list tasks in
let run_next () =
if not (Queue.is_empty queue) then
Queue.pop queue ()
in
while not (Queue.is_empty queue) do
let task = Queue.pop queue in
match task () with
| () -> ()
| effect Yield k ->
Queue.push (fun () -> continue k ()) queue;
run_next ()
done
(* Task ที่ yield *)
let task1 () =
Printf.printf "Task 1: step 1\n";
perform Yield;
Printf.printf "Task 1: step 2\n";
perform Yield;
Printf.printf "Task 1: done\n"
let task2 () =
Printf.printf "Task 2: step 1\n";
perform Yield;
Printf.printf "Task 2: done\n"
let () = scheduler [task1; task2]
(* Output:
Task 1: step 1
Task 2: step 1
Task 1: step 2
Task 2: done
Task 1: done *)
(* dune dependencies: (libraries eio eio_main) *)
(* TCP Echo Server ด้วย Eio *)
let handle_client flow addr =
let buf = Cstruct.create 4096 in
let rec loop () =
match Eio.Flow.read flow buf with
| exception End_of_file -> ()
| n ->
let data = Cstruct.sub buf 0 n in
Eio.Flow.write flow [data];
loop ()
in
Printf.printf "Client connected: %s\n"
(Eio.Net.Sockaddr.pp Format.str_formatter addr; Format.flush_str_formatter ());
loop ()
let run_server ~net ~port =
Eio.Net.with_tcp_connect net ~host:"0.0.0.0" ~service:(string_of_int port)
(fun _addr ->
(* ใช้ listen แทน connect สำหรับ server *)
let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in
Eio.Net.with_listening_socket net addr ~reuse_addr:true ~backlog:128
(fun server ->
Printf.printf "Listening on port %d\n" port;
let rec accept_loop () =
Eio.Net.accept_fork ~sw:!current_sw server
~on_error:(fun e -> Printf.eprintf "Error: %s\n" (Printexc.to_string e))
handle_client;
accept_loop ()
in
accept_loop ()
)
)
(* Main entry point *)
let () =
Eio_main.run (fun env ->
Eio.Switch.run (fun sw ->
current_sw := sw;
run_server ~net:(Eio.Stdenv.net env) ~port:8080
)
)
Structured Concurrency ด้วย Switch:
let () =
Eio_main.run (fun env ->
(* Switch คือ "scope" — fibers ทั้งหมดต้องจบก่อน switch ปิด *)
Eio.Switch.run (fun sw ->
(* Fork หลาย fibers *)
Eio.Fiber.fork ~sw (fun () ->
Printf.printf "Fiber 1: fetching data\n";
(* ... async work ... *)
);
Eio.Fiber.fork ~sw (fun () ->
Printf.printf "Fiber 2: processing\n";
(* ... async work ... *)
);
(* Switch จะรอทุก fiber จบ หรือ cancel ถ้ามี error *)
)
)
(* dune dependencies: (libraries domainslib) *)
open Domainslib
(* Parallel Map *)
let parallel_map pool f arr =
let n = Array.length arr in
let result = Array.make n (f arr.(0)) in
Task.parallel_for pool ~start:0 ~finish:(n-1) ~body:(fun i ->
result.(i) <- f arr.(i)
);
result
(* Parallel Reduction *)
let parallel_sum pool arr =
let n = Array.length arr in
Task.parallel_for_reduce pool (+) 0
~start:0 ~finish:(n-1)
~body:(fun i -> arr.(i))
(* Pipeline Parallelism *)
let process_pipeline pool data =
let stage1_result = parallel_map pool parse_raw data in
let stage2_result = parallel_map pool transform stage1_result in
let final_result = parallel_map pool serialize stage2_result in
final_result
let () =
let pool = Task.setup_pool ~num_domains:3 () in
let data = Array.init 1_000_000 (fun i -> float_of_int i) in
let result = Task.run pool (fun () -> parallel_sum pool data) in
Printf.printf "Sum: %.0f\n" result;
Task.teardown_pool pool
(* Unix module — low-level OS interface *)
(* Process management *)
let run_subprocess cmd args =
let pid = Unix.create_process cmd args Unix.stdin Unix.stdout Unix.stderr in
match Unix.waitpid [] pid with
| _, Unix.WEXITED 0 -> Ok ()
| _, Unix.WEXITED n -> Error (`Exit_code n)
| _, Unix.WSIGNALED s -> Error (`Signaled s)
| _, Unix.WSTOPPED _ -> Error (`Stopped)
(* File descriptors และ pipes *)
let with_pipe f =
let (read_fd, write_fd) = Unix.pipe () in
Fun.protect
~finally:(fun () ->
Unix.close read_fd;
Unix.close write_fd)
(fun () -> f ~read_fd ~write_fd)
(* Non-blocking I/O ด้วย select *)
let wait_for_input fds timeout =
let readable, _, _ = Unix.select fds [] [] timeout in
readable
TCP Server แบบ Low-level:
let create_tcp_server ~port ~backlog =
let sock = Unix.(socket PF_INET SOCK_STREAM 0) in
Unix.setsockopt sock Unix.SO_REUSEADDR true;
Unix.bind sock Unix.(ADDR_INET (inet_addr_any, port));
Unix.listen sock backlog;
sock
let accept_loop server_sock handler =
while true do
let (client_sock, client_addr) = Unix.accept server_sock in
let _domain = Domain.spawn (fun () ->
Fun.protect
~finally:(fun () -> Unix.close client_sock)
(fun () -> handler client_sock client_addr)
) in
()
done
Binary Protocol Parsing ด้วย Angstrom:
(* dune dependencies: (libraries angstrom) *)
open Angstrom
(* Parse custom binary protocol header *)
type packet_header = {
magic : int;
version : int;
length : int32;
flags : int;
}
let packet_header_parser =
let* magic = BE.int16 in
let* version = any_uint8 in
let* length = BE.int32 in
let* flags = any_uint8 in
return { magic; version; length; flags }
let parse_packet data =
match parse_string ~consume:All packet_header_parser data with
| Ok header -> Ok header
| Error msg -> Error (`Parse_error msg)
Cstruct สำหรับ Type-safe Binary Buffers:
(* dune dependencies: (libraries cstruct) *)
open Cstruct
(* Define binary layout *)
[%%cstruct
type ethernet_header = {
dst_mac : uint8_t [@len 6];
src_mac : uint8_t [@len 6];
ethertype : uint16_t;
} [@@big_endian]]
let parse_ethernet buf =
if Cstruct.length buf < sizeof_ethernet_header then
Error `Too_short
else
Ok {
dst_mac = get_ethernet_header_dst_mac buf;
src_mac = get_ethernet_header_src_mac buf;
ethertype = get_ethernet_header_ethertype buf;
}
JSON ด้วย ppx_yojson_conv:
(* dune dependencies: (libraries yojson ppx_yojson_conv) *)
(* (preprocess (pps ppx_yojson_conv)) *)
type server_config = {
host : string;
port : int;
workers : int;
timeout_ms : int;
} [@@deriving yojson]
let load_config path =
let json = Yojson.Safe.from_file path in
server_config_of_yojson json
let save_config path config =
let json = yojson_of_server_config config in
Yojson.Safe.to_file path json
Caqti สำหรับ Async Database:
(* dune dependencies: (libraries caqti caqti-driver-postgresql caqti-eio) *)
open Caqti_request.Infix
open Caqti_type.Std
(* Define queries *)
let insert_log =
(t2 string string ->. unit)
"INSERT INTO logs (level, message) VALUES (?, ?)"
let select_recent_logs =
(int ->* t2 string string)
"SELECT level, message FROM logs ORDER BY id DESC LIMIT ?"
(* ใช้งานกับ Eio *)
let log_message ~db ~level ~message =
let open Lwt_result.Syntax in
let* () = Caqti_eio.Pool.use (fun c ->
let module C = (val c : Caqti_eio.CONNECTION) in
C.exec insert_log (level, message)
) db in
Ok ()
(* dune dependencies: (libraries cmdliner logs fmt) *)
open Cmdliner
(* CLI Definition *)
let port_arg =
let doc = "Port number to listen on." in
Arg.(value & opt int 8080 & info ["p"; "port"] ~docv:"PORT" ~doc)
let workers_arg =
let doc = "Number of worker domains." in
Arg.(value & opt int 4 & info ["w"; "workers"] ~docv:"N" ~doc)
let verbose_flag =
Arg.(value & flag & info ["v"; "verbose"] ~doc:"Enable verbose logging.")
let run_cmd =
let run port workers verbose =
Logs.set_level (if verbose then Some Logs.Debug else Some Logs.Info);
Printf.printf "Starting server on port %d with %d workers\n" port workers;
(* ... start server ... *)
`Ok ()
in
let term = Term.(const run $ port_arg $ workers_arg $ verbose_flag) in
let info = Cmd.info "myserver" ~version:"1.0.0"
~doc:"A high-performance server written in OCaml 5" in
Cmd.v info term
let () = exit (Cmd.eval run_cmd)
Structured Logging ด้วย Logs:
let src = Logs.Src.create "myserver.network" ~doc:"Network subsystem"
module Log = (val Logs.src_log src : Logs.LOG)
let handle_connection fd addr =
Log.info (fun m -> m "New connection from %s" (format_addr addr));
Log.debug (fun m -> m "FD: %d" (Obj.magic fd : int));
match process_request fd with
| Ok response ->
Log.info (fun m -> m "Request processed successfully");
send_response fd response
| Error e ->
Log.err (fun m -> m "Request failed: %s" (error_to_string e))
(* Supervision ด้วย Eio Switch *)
let supervised_worker ~sw ~name f =
Eio.Fiber.fork ~sw (fun () ->
let rec run_with_restart () =
match f () with
| () ->
Logs.info (fun m -> m "Worker %s finished normally" name)
| exception exn ->
Logs.warn (fun m -> m "Worker %s crashed: %s, restarting..."
name (Printexc.to_string exn));
Eio.Time.sleep (Eio.Stdenv.clock !env) 1.0;
run_with_restart ()
in
run_with_restart ()
)
let run_service () =
Eio_main.run (fun env ->
Eio.Switch.run (fun sw ->
supervised_worker ~sw ~name:"http_server" (fun () -> run_http_server env);
supervised_worker ~sw ~name:"metrics" (fun () -> run_metrics_server env);
supervised_worker ~sw ~name:"background_jobs" (fun () -> run_job_scheduler env)
)
)
(* Bracket Pattern — guarantee cleanup *)
let with_resource acquire release f =
let resource = acquire () in
Fun.protect
~finally:(fun () -> release resource)
(fun () -> f resource)
(* ตัวอย่างการใช้งาน *)
let with_db_connection pool f =
with_resource
(fun () -> Pool.acquire pool)
(fun conn -> Pool.release pool conn)
f
let with_temp_file f =
let path = Filename.temp_file "ocaml_" ".tmp" in
with_resource
(fun () -> open_out path)
(fun oc ->
close_out_noerr oc;
Sys.remove path)
f
(* Eio version — scoped lifetime *)
let () =
Eio.Switch.run (fun sw ->
let file = Eio.Path.open_out ~sw ~create:(`Or_truncate 0o644)
(Eio.Path.( / ) fs "output.txt") in
Eio.Flow.write file [Cstruct.of_string "Hello!\n"]
(* file ถูก close อัตโนมัติเมื่อ switch ปิด *)
)
(* Alcotest — unit testing *)
let test_counter_increment () =
let c = Counter.create () in
Counter.increment c;
Counter.increment c;
Alcotest.(check int) "counter value" 2 (Counter.get c)
(* QCheck — property-based testing *)
let () =
QCheck.Test.make
~name:"parallel counter is consistent"
QCheck.(list (int_range 1 100))
(fun increments ->
let c = Atomic.make 0 in
let domains = List.map (fun n ->
Domain.spawn (fun () ->
for _ = 1 to n do
ignore (Atomic.fetch_and_add c 1)
done)
) increments in
List.iter Domain.join domains;
Atomic.get c = List.fold_left (+) 0 increments
)
|> QCheck.Test.check_exn
Static Binary ด้วย musl:
# ติดตั้ง musl toolchain
opam install ocaml-static-musl
# Build static binary
dune build --toolchain=musl
# ตรวจสอบ
file _build/default/bin/main.exe
# main.exe: ELF 64-bit, statically linked
Dockerfile สำหรับ OCaml 5:
# Stage 1: Build
FROM ocaml/opam:ubuntu-22.04-ocaml-5.2 AS builder
WORKDIR /app
COPY . .
RUN opam install --deps-only .
RUN opam exec -- dune build --release
# Stage 2: Runtime (minimal)
FROM debian:bookworm-slim
RUN adduser --system --no-create-home appuser
COPY --from=builder /app/_build/default/bin/main.exe /usr/local/bin/myserver
USER appuser
EXPOSE 8080
ENTRYPOINT ["/usr/local/bin/myserver"]
สร้าง Michael-Scott Queue (lock-free FIFO) ด้วย Atomic
เป้าหมาย: เข้าใจ CAS, ABA problem, memory ordering
ทักษะที่ได้: Atomic.compare_and_set, Domain safety, lock-free patterns
สร้าง reverse proxy ที่รับ request แล้วกระจายไปยัง backend servers
เป้าหมาย: Eio networking, structured concurrency, connection pooling
Stack: Eio + Cohttp + Angstrom สำหรับ HTTP parsing
อ่านไฟล์ log ขนาดใหญ่ parse และ aggregate ด้วย parallel pipeline
เป้าหมาย: Domainslib pipeline, performance benchmarking
Stack: Domainslib + Angstrom + Bechamel
สร้าง KV store แบบ simple ด้วย B-tree + WAL (Write-Ahead Log)
เป้าหมาย: Mutable data structures, crash safety, Cstruct binary I/O
Stack: Cstruct + Bigarray + Unix
Concurrent port scanner ที่ใช้ Eio fibers สแกนหลาย host/port พร้อมกัน
เป้าหมาย: Eio concurrency limits, timeout handling, structured output
Stack: Eio + Cmdliner + Logs
| งาน | OCaml 5 | Rust | Go |
|---|---|---|---|
| Thread/Task | Domain.spawn |
thread::spawn |
go func() |
| Async I/O | Eio.Fiber.fork |
tokio::spawn |
goroutine |
| Channel | Eio.Stream |
mpsc::channel |
chan |
| Mutex | Mutex.create |
Mutex::new |
sync.Mutex |
| Atomic int | Atomic.make |
AtomicI64::new |
sync/atomic |
| CAS | Atomic.compare_and_set |
compare_exchange |
CompareAndSwap |
| Parallel for | Task.parallel_for |
rayon::par_iter |
manual goroutines |
| Structured scope | Eio.Switch.run |
N/A (manual) | errgroup |
| OCaml | Rust | Go | C++ | |
|---|---|---|---|---|
| Null safety | option type |
Option<T> |
nil (unsafe) | nullptr (unsafe) |
| Buffer overflow | ตรวจ runtime | ป้องกัน compile | ตรวจ runtime | ไม่ตรวจ |
| Use-after-free | GC ป้องกัน | Borrow checker | GC ป้องกัน | ไม่ป้องกัน |
| Data race | ไม่ตรวจ compile | ตรวจ compile | ไม่ตรวจ compile | ไม่ตรวจ |
| Integer overflow | ตรวจ debug mode | ตรวจ debug mode | ตรวจ runtime | ไม่ตรวจ |
Build & Dev
├── dune — build system
├── opam — package manager
├── ocaml-lsp — language server
└── ocamlformat — code formatter
Concurrency
├── eio — effect-based concurrent I/O
├── eio_main — platform backend for eio
└── domainslib — parallel task pools
Networking
├── cohttp — HTTP client/server
├── dream — web framework
├── angstrom — parser combinators
└── faraday — serialization
Data & Storage
├── yojson — JSON
├── cstruct — binary buffers
├── caqti — async DB interface
└── irmin — distributed store
Systems
├── cmdliner — CLI argument parsing
├── logs — structured logging
├── fmt — format helpers
└── ctypes — C FFI
Testing
├── alcotest — unit testing
├── qcheck — property-based testing
└── bechamel — benchmarking