Ocaml 学习笔记

之前研究Mina项目，学习下Ocaml语法。

A Tour

Base 提供了基本的标准库，Core 对 Base 进行了扩展。

open Base;;

Type Inference:

let sum_if_true test first second =
  (if test first then first else 0)
  + (if test second then second else 0);;
val sum_if_true : (int -> bool) -> int -> int -> int = 

Inferring generic types

let first_if_true test x y =
  if test x then x else y;;
val first_if_true : ('a -> bool) -> 'a -> 'a -> 'a = 

Tuples:

let a_tuple = (3,"three");;
val a_tuple : int * string = (3, "three")
let another_tuple = (3,"four",5.);;
val another_tuple : int * string * float = (3, "four", 5.)

let (x,y) = a_tuple;;
val x : int = 3
val y : string = "three"

Lists:

let languages = ["OCaml";"Perl";"C"];;
val languages : string list = ["OCaml"; "Perl"; "C"]

List.length languages;;
- : int = 3

List.map languages ~f:String.length;;
- : int list = [5; 4; 1]

Constructing Lists with :::

"French" :: "Spanish" :: languages;;
- : string list = ["French"; "Spanish"; "OCaml"; "Perl"; "C"]

languages;;
- : string list = ["OCaml"; "Perl"; "C"]

Recursive List Functions

let rec sum l =
  match l with
  | [] -> 0                   (* base case *)
  | hd :: tl -> hd + sum tl   (* inductive case *);;
val sum : int list -> int = 
sum [1;2;3];;
- : int = 6

Options

let divide x y =
  if y = 0 then None else Some (x / y);;
val divide : int -> int -> int option = 

let downcase_extension filename =
  match String.rsplit2 filename ~on:'.' with
  | None -> filename
  | Some (base,ext) ->
    base ^ "." ^ String.lowercase ext;;
val downcase_extension : string -> string = 
List.map ~f:downcase_extension
  [ "Hello_World.TXT"; "Hello_World.txt"; "Hello_World" ];;
- : string list = ["Hello_World.txt"; "Hello_World.txt"; "Hello_World"]

^ 用于连接字符串。

Records and Variants

type point2d = { x : float; y : float }

let p = { x = 3.; y = -4. };;
val p : point2d = {x = 3.; y = -4.}

let magnitude { x = x_pos; y = y_pos } =
  Float.sqrt (x_pos **. 2. +. y_pos **. 2.);;
val magnitude : point2d -> float = 

field punning

let magnitude { x; y } = Float.sqrt (x **. 2. +. y **. 2.);;
val magnitude : point2d -> float = 

Variant types

type circle_desc  = { center: point2d; radius: float }
type rect_desc    = { lower_left: point2d; width: float; height: float }
type segment_desc = { endpoint1: point2d; endpoint2: point2d }

type scene_element =
  | Circle  of circle_desc
  | Rect    of rect_desc
  | Segment of segment_desc

Imperative Programming

Arrays:

let numbers = [| 1; 2; 3; 4 |];;
val numbers : int array = [|1; 2; 3; 4|]
numbers.(2) <- 4;;
- : unit = ()
numbers;;
- : int array = [|1; 2; 4; 4|]

Mutable Record Fields

type running_sum =
  { mutable sum: float;
    mutable sum_sq: float; (* sum of squares *)
    mutable samples: int;
  }

Refs

let x = { contents = 0 };;
val x : int ref = {contents = 0}
x.contents <- x.contents + 1;;
- : unit = ()
x;;
- : int ref = {contents = 1}

let x = ref 0  (* create a ref, i.e., { contents = 0 } *);;
val x : int ref = {Base.Ref.contents = 0}
!x             (* get the contents of a ref, i.e., x.contents *);;
- : int = 0
x := !x + 1    (* assignment, i.e., x.contents <- ... *);;
- : unit = ()
!x;;
- : int = 1

For and While Loops

let permute array =
  let length = Array.length array in
  for i = 0 to length - 2 do
    (* pick a j to swap with *)
    let j = i + Random.int (length - i) in
    (* Swap i and j *)
    let tmp = array.(i) in
    array.(i) <- array.(j);
    array.(j) <- tmp
  done;;
val permute : 'a array -> unit = 

let find_first_negative_entry array =
  let pos = ref 0 in
  while !pos < Array.length array && array.(!pos) >= 0 do
    pos := !pos + 1
  done;
  if !pos = Array.length array then None else Some !pos;;
val find_first_negative_entry : int array -> int option = 
find_first_negative_entry [|1;2;0;3|];;
- : int option = None
find_first_negative_entry [|1;-2;0;3|];;
- : int option = Some 1

Variables and Functions

Variables

let  = 

let  =  in 

Pattern Matching and Let

let (ints,strings) = List.unzip [(1,"one"); (2,"two"); (3,"three")];;
val ints : int list = [1; 2; 3]
val strings : string list = ["one"; "two"; "three"]

Anonymous Functions

(fun x -> x + 1) 7;;
- : int = 8

在Ocaml中，函数只是普通的值，可以执行各种操作。

let plusone = (fun x -> x + 1);;
val plusone : int -> int = 
plusone 3;;
- : int = 4

等价于：

let plusone x = x + 1;;
val plusone : int -> int = 

function

可以采用 function 声明函数：

let some_or_zero = function
  | Some x -> x
  | None -> 0;;
val some_or_zero : int option -> int = 
List.map ~f:some_or_zero [Some 3; None; Some 4];;
- : int list = [3; 0; 4]

与下述代码等价：

let some_or_zero num_opt =
  match num_opt with
  | Some x -> x
  | None -> 0;;
val some_or_zero : int option -> int = 

多变量函数

let abs_diff x y = abs (x - y);;
val abs_diff : int -> int -> int = 
abs_diff 3 4;;
- : int = 1

Curry function:

let abs_diff =
(fun x -> (fun y -> abs (x - y)));;
val abs_diff : int -> int -> int = 

val abs_diff : int -> (int -> int)

元组

let abs_diff (x,y) = abs (x - y);;
val abs_diff : int * int -> int = 
abs_diff (3,4);;
- : int = 1

Recursive Functions

let rec find_first_repeat list =
  match list with
  | [] | [_] ->
    (* only zero or one elements, so no repeats *)
    None
  | x :: y :: tl ->
    if x = y then Some x else find_first_repeat (y::tl);;
val find_first_repeat : int list -> int option = 

相互递归的函数：

let rec is_even x =
  if x = 0 then true else is_odd (x - 1)
and is_odd x =
  if x = 0 then false else is_even (x - 1);;
val is_even : int -> bool = 
val is_odd : int -> bool = 
List.map ~f:is_even [0;1;2;3;4;5];;
- : bool list = [true; false; true; false; true; false]
List.map ~f:is_odd [0;1;2;3;4;5];;
- : bool list = [false; true; false; true; false; true]

Prefix and Infix Operators

Int.max 3 4  (* prefix *);;
- : int = 4
3 + 4        (* infix  *);;
- : int = 7

(+) 3 4;;
- : int = 7

Reverse application operator

let (|>) x f = f x;;
val ( |> ) : 'a -> ('a -> 'b) -> 'b = 

应用操作符

|> 是反向操作符， 也有一个应用操作符。

(@@);;
- : ('a -> 'b) -> 'a -> 'b = 

带标签的参数

let ratio ~num ~denom = Float.of_int num /. Float.of_int denom;;
val ratio : num:int -> denom:int -> float = 

调用：

ratio ~num:3 ~denom:10;;
- : float = 0.3
ratio ~denom:10 ~num:3;;
- : float = 0.3

Lable prunning:

let num = 3 in
let denom = 4 in
ratio ~num ~denom;;
- : float = 0.75

可选参数

采用 ? 标记：

let concat ?sep x y =
  let sep = match sep with None -> "" | Some s -> s in
  x ^ sep ^ y;;
val concat : ?sep:string -> string -> string -> string = 
concat "foo" "bar"             (* without the optional argument *);;
- : string = "foobar"
concat ~sep:":" "foo" "bar"    (* with the optional argument    *);;
- : string = "foo:bar"

Lists and Patterns

基础

open Base;;
[1;2;3];;
- : int list = [1; 2; 3]

采用 :: 符号：

1 :: (2 :: (3 :: []));;
- : int list = [1; 2; 3]
1 :: 2 :: 3 :: [];;
- : int list = [1; 2; 3]

空列表[] 是多态的：

let empty = [];;
val empty : 'a list = []
3 :: empty;;
- : int list = [3]
"three" :: empty;;
- : string list = ["three"]

List 模式匹配

let rec sum l =
  match l with
  | [] -> 0
  | hd :: tl -> hd + sum tl;;
val sum : int list -> int = 
sum [1;2;3];;
- : int = 6
sum [];;
- : int = 0

benchmark

模式匹配比其它实现方式速度要快。

let rec sum_if l =
  if List.is_empty l then 0
  else List.hd_exn l + sum_if (List.tl_exn l);;
val sum_if : int list -> int = 

速度测试：

let numbers = List.range 0 1000 in
[ Bench.Test.create ~name:"sum_if" (fun () -> sum_if numbers)
; Bench.Test.create ~name:"sum"    (fun () -> sum numbers) ]
|> Bench.bench;;
Estimated testing time 20s (2 benchmarks x 10s). Change using -quota SECS.
┌────────┬──────────┐
│ Name   │ Time/Run │
├────────┼──────────┤
│ sum_if │  62.00us │
│ sum    │  17.99us │
└────────┴──────────┘
- : unit = ()

List 模块

List.map ~f:String.length ["Hello"; "World!"];;
- : int list = [5; 6]

List.map2_exn ~f:Int.max [1;2;3] [3;2;1];;
- : int list = [3; 2; 3]

List.fold ~init:0 ~f:(+) [1;2;3;4];;
- : int = 10

String.concat 和 ^ 的性能比较

let s = "." ^ "."  ^ "."  ^ "."  ^ "."  ^ "."  ^ ".";;
val s : string = "......."

let s = String.concat [".";".";".";".";".";".";"."];;
val s : string = "......."

String.concat 函数更高效，^ 需要每次分配一个新的字符串。

List.reduce

List.reduce;;
- : 'a list -> f:('a -> 'a -> 'a) -> 'a option = 

List.filter

List.filter ~f:(fun x -> x % 2 = 0) [1;2;3;4;5];;
- : int list = [2; 4]

List.filter_map

let extensions filenames =
  List.filter_map filenames ~f:(fun fname ->
      match String.rsplit2 ~on:'.' fname with
      | None  | Some ("",_) -> None
      | Some (_,ext) ->
        Some ext)
  |> List.dedup_and_sort ~compare:String.compare;;
val extensions : string list -> string list = 
extensions ["foo.c"; "foo.ml"; "bar.ml"; "bar.mli"];;
- : string list = ["c"; "ml"; "mli"]

List.partition_tf:

let is_ocaml_source s =
  match String.rsplit2 s ~on:'.' with
  | Some (_,("ml"|"mli")) -> true
  | _ -> false;;
val is_ocaml_source : string -> bool = 
let (ml_files,other_files) =
List.partition_tf ["foo.c"; "foo.ml"; "bar.ml"; "bar.mli"]  ~f:is_ocaml_source;;
val ml_files : string list = ["foo.ml"; "bar.ml"; "bar.mli"]
val other_files : string list = ["foo.c"]

List.append

List.append [1;2;3] [4;5;6];;
- : int list = [1; 2; 3; 4; 5; 6]

@ 和 List.append 等价。

[1;2;3] @ [4;5;6];;
- : int list = [1; 2; 3; 4; 5; 6]

List.concat:

List.concat [[1;2];[3;4;5];[6];[]];;
- : int list = [1; 2; 3; 4; 5; 6]

Tail recursion

Non-tail recursion

let rec length = function
  | [] -> 0
  | _ :: tl -> 1 + length tl;;
val length : 'a list -> int = 
length [1;2;3];;
- : int = 3

Tail recursion

let rec length_plus_n l n =
  match l with
  | [] -> n
  | _ :: tl -> length_plus_n tl (n + 1);;
val length_plus_n : 'a list -> int -> int = 
let length l = length_plus_n l 0;;
val length : 'a list -> int = 
length [1;2;3;4];;
- : int = 4

只有最终的结果返回给调用者。

Terser and Faster patterns

优化前：

let rec remove_sequential_duplicates list =
  match list with
  | [] -> []
  | [x] -> [x]
  | first :: second :: tl ->
    if first = second then
      remove_sequential_duplicates (second :: tl)
    else
      first :: remove_sequential_duplicates (second :: tl);;
val remove_sequential_duplicates : int list -> int list = 

优化后：

let rec remove_sequential_duplicates list =
  match list with
  | [] as l -> l
  | [_] as l -> l
  | first :: (second :: _ as tl) ->
    if first = second then
      remove_sequential_duplicates tl
    else
      first :: remove_sequential_duplicates tl;;
val remove_sequential_duplicates : int list -> int list = 

进一步优化；

let rec remove_sequential_duplicates list =
  match list with
  | [] | [_] as l -> l
  | first :: (second :: _ as tl) ->
    if first = second then
      remove_sequential_duplicates tl
    else
      first :: remove_sequential_duplicates tl;;
val remove_sequential_duplicates : int list -> int list = 

采用when

let rec remove_sequential_duplicates list =
  match list with
  | [] | [_] as l -> l
  | first :: (second :: _ as tl) when first = second ->
    remove_sequential_duplicates tl
  | first :: tl -> first :: remove_sequential_duplicates tl;;
val remove_sequential_duplicates : int list -> int list = 

Polymorphic compare

Base.Poly

open Base.Poly;;
"foo" = "bar";;
- : bool = false
3 = 4;;
- : bool = false
[1;2;3] = [1;2;3];;
- : bool = true

let rec remove_sequential_duplicates list =
  match list with
  | [] | [_] as l -> l
  | first :: (second :: _ as tl) when first = second ->
    remove_sequential_duplicates tl
  | first :: tl -> first :: remove_sequential_duplicates tl;;
val remove_sequential_duplicates : 'a list -> 'a list = 
remove_sequential_duplicates [1;2;2;3;4;3;3];;
- : int list = [1; 2; 3; 4; 3]
remove_sequential_duplicates ["one";"two";"two";"two";"three"];;
- : string list = ["one"; "two"; "three"]

List.count

let count_some l = List.count ~f:Option.is_some l;;
val count_some : 'a option list -> int = 

Files, Modules and Programs

freq.ml

open Base
open Stdio

let build_counts () =
  In_channel.fold_lines In_channel.stdin ~init:[] ~f:(fun counts line ->
      let count =
        match List.Assoc.find ~equal:String.equal counts line with
        | None -> 0
        | Some x -> x
      in
      List.Assoc.add ~equal:String.equal counts line (count + 1))

let () =
  build_counts ()
  |> List.sort ~compare:(fun (_, x) (_, y) -> Int.descending x y)
  |> (fun l -> List.take l 10)
  |> List.iter ~f:(fun (line, count) -> printf "%3d: %s\n" count line)

main 函数

let () = 

运行：

ocamlopt freq.ml -o freq
ocamlfind ocamlopt -linkpkg -package base -package stdio freq.ml -o freq 

dune-project: 一个项目一个构建文件；

dune: 一个文件夹一个

dune build freq.exe
./_build/default/freq.exe

dune exec ./freq.exe

ocmalc: bytecode compiler .bc

ocamlopt: nativecode compiler .exe

模块首字母大写。

模块接口和实现

具体类型和抽象类型

嵌入式模块

module  :  = 

Include: 包含其它模块的内容

open Base

(* The new function we're going to add *)
let apply f_opt x =
  match f_opt with
  | None -> None
  | Some f -> Some (f x)

(* The remainder of the option module *)
include Option

module type of :

open Base

(* Include the interface of the option module from Base *)
include module type of Option

(* Signature of function we're adding *)
val apply : ('a -> 'b) t -> 'a -> 'b t

Records

basic syntax:

type  =
    {  : ;
       : ;
      ...
    }

Polymorphic type:

type 'a with_line_num = { item: 'a; line_num: int }

Patterns and Exhaustiveness

let service_info_to_string
  { service_name = name; port = port; protocol = prot  }
  =
  sprintf "%s %i/%s" name port prot
;;
val service_info_to_string : service_info -> string = 
service_info_to_string ssh;;
- : string = "ssh 22/udp"

Records patterns are irrefutable.

#warnings "+9";;
let service_info_to_string
  { service_name = name; port = port; protocol = prot  }
  =
  sprintf "%s %i/%s" name port prot
;;
Line 2, characters 5-59:
Warning 9 [missing-record-field-pattern]: the following labels are not bound in this record pattern:
comment
Either bind these labels explicitly or add '; _' to the pattern.
val service_info_to_string : service_info -> string = 

Field Punning

let service_info_to_string { service_name; port; protocol; comment } =
  let base = sprintf "%s %i/%s" service_name port protocol in
  match comment with
  | None -> base
  | Some text -> base ^ " #" ^ text;;
val service_info_to_string : service_info -> string = 

Reusing Field Names

添加type annotations

let get_heartbeat_session_id (t:heartbeat) = t.session_id;;
val get_heartbeat_session_id : heartbeat -> string = 

let message_to_string { Log_entry.important; message; _ } =
  if important then String.uppercase message else message;;
val message_to_string : Log_entry.t -> string = 

let is_important t = t.Log_entry.important;;
val is_important : Log_entry.t -> bool = 

Functional Updates

仅需更新一个字段：

let register_heartbeat t hb =
  { t with last_heartbeat_time = hb.Heartbeat.time };;
val register_heartbeat : client_info -> Heartbeat.t -> client_info = 

Mutable Fields:

type client_info =
  { addr: Unix.Inet_addr.t;
    port: int;
    user: string;
    credentials: string;
    mutable last_heartbeat_time: Time_ns.t;
    mutable last_heartbeat_status: string;
  }

let register_heartbeat t (hb:Heartbeat.t) =
  t.last_heartbeat_time   <- hb.time;
  t.last_heartbeat_status <- hb.status_message;;
val register_heartbeat : client_info -> Heartbeat.t -> unit = 

First-Class Fields

[@@deriving fields] annotation

#require "ppx_jane";;

module Logon = struct
  type t =
    { session_id: string;
      time: Time_ns.t;
      user: string;
      credentials: string;
    }
  [@@deriving fields]
end;;
module Logon :
  sig
    type t = {
      session_id : string;
      time : Time_ns.t;
      user : string;
      credentials : string;
    }
    val credentials : t -> string
    val user : t -> string
    val time : t -> Time_ns.t
    val session_id : t -> string
    module Fields :
      sig
        val names : string list
        val credentials :
          ([< `Read | `Set_and_create ], t, string) Field.t_with_perm
        val user :
          ([< `Read | `Set_and_create ], t, string) Field.t_with_perm
        val time :
          ([< `Read | `Set_and_create ], t, Time_ns.t) Field.t_with_perm
...
      end
  end

Variants

variant type

type  =
  |  [ of  [* ]... ]
  |  [ of  [* ]... ]
  | ...

open Base
open Stdio
type basic_color =
  | Black | Red | Green | Yellow | Blue | Magenta | Cyan | White

let basic_color_to_int = function
  | Black -> 0 | Red     -> 1 | Green -> 2 | Yellow -> 3
  | Blue  -> 4 | Magenta -> 5 | Cyan  -> 6 | White  -> 7;;
val basic_color_to_int : basic_color -> int = 
List.map ~f:basic_color_to_int [Blue;Red];;
- : int list = [4; 1]

type weight = Regular | Bold
type color =
  | Basic of basic_color * weight (* basic colors, regular and bold *)
  | RGB   of int * int * int      (* 6x6x6 color cube *)
  | Gray  of int     

Variants, Tuples, Parens

Testing

Inline Tests

(library
 (name foo)
 (libraries base stdio)
 (inline_tests)
 (preprocess (pps ppx_inline_test)))

open Base

let%test "rev" =
  List.equal Int.equal (List.rev [ 3; 2; 1 ]) [ 1; 2; 3 ]

dune runtest

使用let%test_unit 和 [%test_eq]

(library
 (name foo)
 (libraries base stdio)
 (preprocess
  (pps ppx_inline_test ppx_assert))
 (inline_tests))

open Base

let%test_unit "rev" =
  [%test_eq: int list] (List.rev [ 3; 2; 1 ]) [ 3; 2; 1 ]

Expect tests:

open! Base
open Stdio

let%expect_test "trivial" = print_endline "Hello World!"

open!： 压缩warning

open Base
open Stdio

let%expect_test _ =
  print_s [%sexp (List.rev [ 3; 2; 1 ] : int list)];
  [%expect {| (1 2 3) |}]

open Base

let%test "rev" =
  List.equal Int.equal (List.rev [ 3; 2; 1 ]) [ 1; 2; 3 ]

Quoted string:

{|This is a quoted string|};;
- : string = "This is a quoted string"

Property Testing with Quickcheck

open Core

let%test_unit "List.rev_append is List.append of List.rev" =
  Quickcheck.test
    ~sexp_of:[%sexp_of: int list * int list]
    [%quickcheck.generator: int list * int list]
    ~f:(fun (l1, l2) ->
      [%test_eq: int list]
        (List.rev_append l1 l2)
        (List.append (List.rev l1) l2

参考

https://dev.realworldocaml.org/

https://v3.ocaml.org/packages