OCaml syntax highlighting
OCaml is a powerful functional programming language with strong static typing, pattern matching, and algebraic data types.
Example:
(* Single variable binding *)
let x = 42
(* Multiple bindings *)
let y = 3.14
let name = "Alice"
let flag = true
(* Type annotations (optional) *)
let count : int = 10
let message : string = "Hello"
(* Immutable by default - rebind with let *)
let x = x + 1
(* Mutable references *)
let counter = ref 0
let () = counter := !counter + 1
Example:
(* Simple function *)
let square x = x * x
(* Multiple parameters *)
let add x y = x + y
(* Type annotations *)
let multiply (x : int) (y : int) : int = x * y
(* Anonymous functions (lambdas) *)
let increment = fun x -> x + 1
(* Alternative lambda syntax *)
let decrement = function x -> x - 1
(* Recursive functions *)
let rec factorial n =
if n <= 1 then 1
else n * factorial (n - 1)
(* Mutually recursive functions *)
let rec is_even n =
if n = 0 then true
else is_odd (n - 1)
and is_odd n =
if n = 0 then false
else is_even (n - 1)
(* Higher-order functions *)
let apply_twice f x = f (f x)
let result = apply_twice square 2 (* 16 *)
Example:
(* Basic pattern matching *)
let describe_number n =
match n with
| 0 -> "zero"
| 1 -> "one"
| 2 -> "two"
| _ -> "many"
(* Pattern matching with guards *)
let classify_number n =
match n with
| n when n < 0 -> "negative"
| 0 -> "zero"
| n when n > 0 && n < 10 -> "small positive"
| _ -> "large positive"
(* Matching tuples *)
let describe_point (x, y) =
match (x, y) with
| (0, 0) -> "origin"
| (x, 0) -> "on x-axis"
| (0, y) -> "on y-axis"
| (x, y) -> "general point"
(* Function syntax with pattern matching *)
let fib = function
| 0 -> 0
| 1 -> 1
| n -> fib (n - 1) + fib (n - 2)
Example:
(* List literals *)
let empty = []
let numbers = [1; 2; 3; 4; 5]
let names = ["Alice"; "Bob"; "Charlie"]
(* Cons operator :: *)
let extended = 0 :: numbers (* [0; 1; 2; 3; 4; 5] *)
(* List concatenation *)
let combined = [1; 2] @ [3; 4] (* [1; 2; 3; 4] *)
(* Pattern matching on lists *)
let rec sum_list lst =
match lst with
| [] -> 0
| hd :: tl -> hd + sum_list tl
(* Head and tail *)
let first_element = function
| [] -> None
| hd :: _ -> Some hd
(* List.map *)
let doubled = List.map (fun x -> x * 2) [1; 2; 3]
(* List.filter *)
let evens = List.filter (fun x -> x mod 2 = 0) [1; 2; 3; 4; 5; 6]
(* List.fold_left *)
let sum = List.fold_left (+) 0 [1; 2; 3; 4; 5]
(* List.fold_right *)
let product = List.fold_right ( * ) [1; 2; 3; 4; 5] 1
Example:
(* Tuples *)
let pair = (42, "answer")
let triple = (1, 2.0, "three")
(* Destructuring tuples *)
let (x, y) = pair
(* Tuple functions *)
let first (x, _) = x
let second (_, y) = y
(* Records *)
type person = {
name : string;
age : int;
email : string;
}
let alice = {
name = "Alice";
age = 30;
email = "alice@example.com";
}
(* Accessing record fields *)
let name = alice.name
let age = alice.age
(* Record update (creates new record) *)
let older_alice = { alice with age = 31 }
(* Pattern matching on records *)
let greet person =
match person with
| { name; age; _ } ->
Printf.sprintf "Hello, %s! You are %d years old." name age
Example:
(* Simple enumeration *)
type color = Red | Green | Blue
let color_to_string = function
| Red -> "red"
| Green -> "green"
| Blue -> "blue"
(* Variants with data *)
type shape =
| Circle of float
| Rectangle of float * float
| Triangle of float * float * float
let area = function
| Circle r -> 3.14159 *. r *. r
| Rectangle (w, h) -> w *. h
| Triangle (a, b, c) ->
let s = (a +. b +. c) /. 2.0 in
sqrt (s *. (s -. a) *. (s -. b) *. (s -. c))
(* Option type (built-in variant) *)
let safe_divide x y =
if y = 0 then None
else Some (x / y)
let result = match safe_divide 10 2 with
| Some v -> Printf.sprintf "Result: %d" v
| None -> "Division by zero"
(* Result type for error handling *)
type ('a, 'e) result =
| Ok of 'a
| Error of 'e
let parse_int s =
try Ok (int_of_string s)
with Failure _ -> Error "Invalid integer"
Example:
(* Module definition *)
module Stack = struct
type 'a t = 'a list
let empty = []
let push x s = x :: s
let pop = function
| [] -> None
| x :: xs -> Some (x, xs)
let peek = function
| [] -> None
| x :: _ -> Some x
let is_empty s = (s = [])
end
(* Using the module *)
let s = Stack.empty
let s = Stack.push 1 s
let s = Stack.push 2 s
let top = Stack.peek s (* Some 2 *)
(* Module type (signature) *)
module type QUEUE = sig
type 'a t
val empty : 'a t
val enqueue : 'a -> 'a t -> 'a t
val dequeue : 'a t -> ('a * 'a t) option
end
(* Module implementing a signature *)
module Queue : QUEUE = struct
type 'a t = 'a list
let empty = []
let enqueue x q = q @ [x]
let dequeue = function
| [] -> None
| x :: xs -> Some (x, xs)
end
(* Functor (parameterized module) *)
module type COMPARABLE = sig
type t
val compare : t -> t -> int
end
module Set (Elem : COMPARABLE) = struct
type t = Elem.t list
let empty = []
let rec mem x = function
| [] -> false
| y :: ys ->
match Elem.compare x y with
| 0 -> true
| _ -> mem x ys
let rec add x s =
if mem x s then s
else x :: s
end
Example:
(* Identity function *)
let id x = x
(* Type is inferred as: 'a -> 'a *)
let n = id 42
let s = id "hello"
(* Composition *)
let compose f g x = f (g x)
(* Type: ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c *)
(* Pipeline operator *)
let (|>) x f = f x
let result = 5
|> fun x -> x * 2
|> fun x -> x + 1
|> fun x -> x * x
(* result = 121 *)
(* Polymorphic list operations *)
let rec map f = function
| [] -> []
| x :: xs -> f x :: map f xs
let rec filter pred = function
| [] -> []
| x :: xs ->
if pred x then x :: filter pred xs
else filter pred xs
Example:
(* References (mutable cells) *)
let counter = ref 0
let increment () =
counter := !counter + 1
let get_count () = !counter
(* Arrays (mutable) *)
let arr = [| 1; 2; 3; 4; 5 |]
let first = arr.(0) (* Access *)
let () = arr.(0) <- 10 (* Update *)
(* For loops *)
for i = 0 to 9 do
Printf.printf "%d " i
done
(* Reverse for loop *)
for i = 9 downto 0 do
Printf.printf "%d " i
done
(* While loops *)
let i = ref 0
while !i < 10 do
Printf.printf "%d " !i;
i := !i + 1
done
(* Sequences with ; *)
let run () =
print_endline "First";
print_endline "Second";
print_endline "Third"
Example:
(* Define exception *)
exception Invalid_argument of string
exception Not_found
(* Raise exception *)
let divide x y =
if y = 0 then
raise (Invalid_argument "Division by zero")
else
x / y
(* Catch exception *)
let safe_divide x y =
try
Some (divide x y)
with Invalid_argument msg ->
print_endline msg;
None
(* Multiple exception handlers *)
let process input =
try
let result = complex_operation input in
Ok result
with
| Not_found -> Error "Not found"
| Invalid_argument msg -> Error msg
| Failure msg -> Error ("Failure: " ^ msg)
Example:
(* Class definition *)
class counter init = object (self)
val mutable count = init
method get = count
method increment =
count <- count + 1
method reset =
count <- init
end
(* Creating objects *)
let c = new counter 0
let () = c#increment
let value = c#get (* 1 *)
(* Inheritance *)
class ['a] stack = object (self)
val mutable items : 'a list = []
method push x =
items <- x :: items
method pop =
match items with
| [] -> None
| x :: xs ->
items <- xs;
Some x
method peek =
match items with
| [] -> None
| x :: _ -> Some x
end
(* Class with inheritance *)
class counted_stack = object
inherit [int] stack as super
val mutable push_count = 0
method push x =
super#push x;
push_count <- push_count + 1
method get_push_count = push_count
end
Example:
(* Parametric polymorphism *)
type 'a option =
| Some of 'a
| None
type ('a, 'b) result =
| Ok of 'a
| Error of 'b
(* Recursive types *)
type 'a tree =
| Leaf
| Node of 'a * 'a tree * 'a tree
let rec tree_sum = function
| Leaf -> 0
| Node (value, left, right) ->
value + tree_sum left + tree_sum right
(* Phantom types *)
type 'a validated =
| Validated of string
let validate (s : string) : bool validated =
Validated s
let use_validated (Validated s : bool validated) =
print_endline s
(* GADTs (Generalized Algebraic Data Types) *)
type _ expr =
| Int : int -> int expr
| Bool : bool -> bool expr
| Add : int expr * int expr -> int expr
| If : bool expr * 'a expr * 'a expr -> 'a expr
let rec eval : type a. a expr -> a = function
| Int n -> n
| Bool b -> b
| Add (e1, e2) -> eval e1 + eval e2
| If (cond, then_e, else_e) ->
if eval cond then eval then_e else eval else_e
Example:
(* Binary search tree *)
type 'a bst =
| Empty
| Node of 'a * 'a bst * 'a bst
let rec insert x = function
| Empty -> Node (x, Empty, Empty)
| Node (y, left, right) ->
if x < y then Node (y, insert x left, right)
else if x > y then Node (y, left, insert x right)
else Node (y, left, right)
let rec search x = function
| Empty -> false
| Node (y, left, right) ->
if x = y then true
else if x < y then search x left
else search x right
(* Quicksort *)
let rec quicksort = function
| [] -> []
| pivot :: rest ->
let less = List.filter (fun x -> x < pivot) rest in
let greater = List.filter (fun x -> x >= pivot) rest in
quicksort less @ [pivot] @ quicksort greater
(* Memoization *)
let memoize f =
let table = Hashtbl.create 100 in
fun x ->
try Hashtbl.find table x
with Not_found ->
let result = f x in
Hashtbl.add table x result;
result
let rec fib_slow n =
if n <= 1 then n
else fib_slow (n - 1) + fib_slow (n - 2)
let fib_fast = memoize fib_slow
(* Map implementation *)
module StringMap = Map.Make(String)
let empty_map = StringMap.empty
let map_with_data =
StringMap.empty
|> StringMap.add "one" 1
|> StringMap.add "two" 2
|> StringMap.add "three" 3
let value = StringMap.find "two" map_with_data (* 2 *)