ML語言

ML（Meta Language：元語言），是一個函數式、指令式的通用的程式語言，它著稱於使用了多態的Hindley–Milner類型推論。ML能自動的指定多數表達式 (電腦科學)的類型，不要求顯式的類型標註，而且能夠確保類型安全，已經正式證明了有良好類型的ML程序不會導致運行時間類型錯誤。

ML提供了對函數實際參數的模式匹配、垃圾回收、指令式編程、傳值調用和柯里化。它被大量的用於程式語言研究之中，並且是全面規定了的和使用形式語義驗證了的少數語言之一。它的類型和模式匹配使得它非常適合併且經常用於在其他形式語言上進行操作，比如在編譯器構造、自動化定理證明和形式驗證中。

## 歷史

在1970年代早期，ML由愛丁堡大學的羅賓·米爾納及他人研製出來，用於在可計算函數邏輯定理證明器中開發證明策略。LCF的語言是「PPλ」，它是一階邏輯演算與有類型的多態λ演算的結合，以ML作為元語言。ML的語法從ISWIM及其擴展實現PAL得到了啟發，可計算函數邏輯 ML運行在DEC-10/TOPS-10主機的Stanford LISP 1.6下。

在1980年，Luca Cardelli於愛丁堡大學的VAX/VMS系統上開發了ML編譯器，它被稱為「VAX ML」，以區別於LCF版本的「DEC-10 ML」。VAX ML的編譯器和運行時間系統二者，都是用Pascal書寫而建立在「函數抽象機器」（FAM）之上。在1982年，愛丁堡大學的Kevin Mitchell，用VAX ML重寫了VAX ML編譯器，隨即John Scott和Alan Mycroft加入了開發，在又進行一系列重寫改進之後，新的編譯器被稱為「Edinburgh ML」。

在1981年，INRIA的Gérard Huet，將最初的LCF ML適配到Multics系統的Maclisp下，並且增加了編譯器。這個實現被描述於INRIA內部文檔「ML手冊」之中，它被開發者自稱為「Le_ML」。劍橋大學的Lawrence Paulson在1985年用它開發了基於Franz Lisp的Cambridge LCF，進而劍橋大學的Michael J. C. Gordon又用它開發了基於Common Lisp的HOL。基於GNU Common Lisp的Cambridge LCF ML示例： console $ hol88 =============================================================================== HOL88 Version 2.02 (GCL), built on 3/2/26 =============================================================================== #letrec fact n = if n=0 then 1 else n*fact(n-1);; fact = - : (int -> int) #fact 3;; 6 : int #

在1983年，Robin Milner由兩個動機驅使開始重新設計ML。其一是愛丁堡大學的Rod Burstall及其小組在規定上的工作，具體化為規定語言CLEAR，和表達可執行規定的函數式語言HOPE。這項工作與ML有關的是兩方面成果：首先，HOPE擁有優雅的編程特徵，特別是模式匹配，和子句式函數定義；其次，是使用在接口中的簽名，進行規定的模塊化構造的想法。其二是Luca Cardelli在VAX ML上的工作，通過增加命名記錄和可變類型，擴展了ML中數據類型的品目。

在1984年，貝爾實驗室的David MacQueen提出了對Standard ML的模塊系統的設計。在Standard ML的持續設計期間，Edinburgh ML被漸進的修改，充當了Standard ML的近似原型實現。在1986年，普林斯頓大學的Andrew Appel和貝爾實驗室的David MacQueen，以Edinburgh Standard ML作為起步開發環境，開始了專注於生成高質量機器代碼的Standard ML of New Jersey的活躍開發。

在1990年，Robin Milner、Mads Tofte和Robert Harper制定的Standard ML的正式規定《The Definition of Standard ML》最終完成；在1997年，這個標準規定增補了David MacQueen為作者並進行了修訂。在1989年，Mads Tofte、Nick Rothwell和David N. Turner於愛丁堡大學開始開發ML Kit編譯器，為了強調清晰性而非高效，將標準定義直接轉譯成一組Standard ML模塊；在1992年和1993年期間，主要通過愛丁堡大學的Nick Rothwell和哥本哈根大學UCPH電腦科學系（DIKU）的Lars Birkedal的工作，ML Kit第一版完成並開源發行。

在1987年，INRIA的Ascánder Suárez，基於巴黎第七大學的Guy Cousineau的「範疇抽象機器」（CAM），利用Le Lisp的運行時間系統重新實現了Le_ML，並正式命名為Caml。在1990年和1991年，INRIA的Xavier Leroy基於用C實現的字節碼解釋器，利用Damien Doligez提供的記憶體管理系統重新實現了Caml，並稱其為Caml Light。在1995年，Xavier Leroy又增加了機器代碼編譯器和高層模塊系統，這個版本也稱為「Caml Special Light」。在1996年，INRIA的Didier Rémy和Jérôme Vouillon，向Caml Special Light增加了面向對象特徵，從而形成了OCaml。

今天ML家族的兩個主要的方言是Standard ML和OCaml。ML的實力大多被用於語言設計和操作，比如建構編譯器、分析器、定理證明器，但是它作為通用語言也被用於生物資訊和財務系統等領域。ML確立了靜態類型函數式編程范型，從而在程式語言歷史上占有顯要地位，它的思想在影響了眾多的語言，例如Haskell、Nemerle、ATS (程式語言)和Elm。

## 解釋與編譯

ML代碼片段很容易通過將其錄入到「頂層」來研習，它也叫作讀取-求值-輸出循環或REPL。這是列印結果或定義的表達式的推論類型的交互式會話。很多SML實現提供交互式REPL，比如SML/NJ：

```console
$ sml
Standard ML of New Jersey v110.79 [built: Mon Apr 22 10:14:55 2024]
```

可以在提示符`-`後鍵入代碼。例如計算`1 + 2 * 3`:

```sml
- 1 + 2 * 3;
val it = 7 : int
- it;
val it = 7 : int
```

頂層推論這個表達式的類型為`int`並給出結果`7`。如果輸入不完全，解釋器會列印第二提示符`=`，這時通常可以用`;`終結輸入。`it`是給未指定變量的表達式的標準變量。輸入control-C可返回解釋器頂層，輸入control-D可退出解釋器。可以使用第三方工具`rlwrap`運行SML/NJ解釋器，它處理使用者輸入並提供`readline`的行編輯、持久歷史和補全功能。

下面是輸出hello, world!的例子代碼，在SML/NJ解釋器下執行它：

```sml
- print "Hello, world!\n";
Hello, world!
val it = () : unit
- val _ = print "Hello, world!\n";
Hello, world!
```

使用MLton編譯器進行編譯執行它：

```console
$ echo 'print "Hello, world!\n";' > hello-world.sml
$ mlton hello-world.sml
$ ./hello-world
Hello, world!
```

使用LunarML源到源編譯器，將前面的例子編譯成Javascript代碼並使用Node.js執行它:

```console
$ echo 'print "Hello, world!\n";' > hello-world.sml
$ lunarml compile --nodejs hello-world.sml
$ nodejs hello-world.mjs
Hello, world!
```

## 核心語言

不同於純函數式程式語言，ML是兼具一些指令式特徵的函數式程式語言。ML的特徵包括：傳值調用的求值策略，頭等函數，帶有垃圾收集的自動記憶體管理，參數多態，靜態類型，類型推論，代數數據類型，模式匹配和例外處理。不同於Haskell，ML與大多數程式語言一樣使用及早求值。

用ML書寫的程序構成自要被求值的表達式 (電腦科學)，而非語句或命令，儘管一些表達式返回一個平凡的`unit`值並且只為其副作用而求值。以下章節介紹採用Standard ML的語法和語義。

### 函數

就像所有的函數式語言一樣，ML的關鍵特徵是函數，它被用於進行抽象。例如階乘函數用純ML可表達為：

```sml
fun fac 0 = 1
  | fac n = n * fac (n - 1)
```

這裡將階乘描述為遞歸函數，具有一個單一的終止基礎情況。它類似於在數學教科書見到的階乘描述。多數ML代碼在設施和語法上類似於數學。

憑藉類型推論編譯器能推導出，`fac`接受整數`0`作為實際參數，則形式參數`n`也是整數類型`int`，而`fac 0`的結果是整數`1`，則函數`fac`的結果也是整數類型。函數`fac`接受一個整數的形式參數並返回一個整數結果，它作為一個整體從而有著「從整數到整數的函數」類型`int -> int`。函數及其形式參數的"類型"還可以用類型標註（annotation）來描述，使用`E : t`表示法，它可以被讀作表達式`E`有類型`t`，它是可選也可忽略的。使用類型標註，這個例子可重寫為如下：

```sml
fun fac 0 = 1
  | fac (n : int) : int = n * fac (n - 1)
```

這個函數還依賴於模式匹配，這是ML語言的重要部份。注意函數形式參數不必須在圓括號內但要用空格分隔。當一個函數的實際參數是`0`，它將返回整數`1`。對於所有其他情況，嘗試第二行。這是一個遞歸，並且再次執行這個函數直到達到基礎情況。它可以使用`case`表達式重寫為：

```sml
fun fac n = case n 
     of 0 => 1
      | n => n * fac (n - 1)
```

這裡`case`介入了模式和對應表達式的序列。它還可以重寫為將標識符綁定到lambda函數：

```sml
val rec fac =
     fn 0 => 1
      | n => n * fac (n - 1)
```

這裡的關鍵字`val`介入了標識符到值的綁定，`fn`介入了匿名函數的定義，它可以用在`fun`的位置上，但使用`=>`算符而非`=`。綁定到遞歸的匿名函數需要使用`rec`關鍵字來指示。

通過將主要工作寫入尾遞歸風格的內部迭代函數，藉助於語言編譯或解釋系統進行的尾調用優化，這個函數可以得以增進性能，它的調用棧不需要隨函數調用數目而成比例的增長。對這個函數可以採用向內部函數增加額外的「累加器」形式參數`acc`來實現：

```sml
fun fac n = let
    fun loop (0, acc) = acc
      | loop (n, acc) = loop (n - 1, n * acc)
    in
        loop (n, 1)
    end
```

`let`表達式的值是在`in`和`end`之間表達式的值。這個遞歸函數的實現不保證能夠終止，因為負數實際參數會導致遞歸調用的無窮降鏈條件。更健壯的實現會在遞歸前檢查實際參數為非負數，並在有問題的情況，即`n`是負數的時候，啟用例外處理：

```sml
fun fac n = let
    fun loop (0, acc) = acc
      | loop (n, acc) = loop (n - 1, n * acc)
    in
        if (n < 0) 
        then raise Fail "negative argument"
        else loop (n, 1)
    end
```

### 類型

有一些基本類型可以當作是「內建」的，因為它們是在Standard ML標準基本庫中預先定義的，並且語言為它們提供文字 (電腦編程)表示法，比如`34`是整數，而`"34"`是字串。一些最常用的基本類型是：

- `int` 整數，比如`3`或`~12`。注意波浪號~表示負號。
- `real`浮點數，比如`4.2`或`~6.4`。Standard ML不隱含的提升整數為浮點數，因此表達式`2 + 5.67` 是無效的。
- `string`字串，比如`"this is a string"`或`""`（空串）。
- `char`字符，比如`#"y"`或`#"\n"`（換行符）。
- `bool`布爾值，它是要麼`true`要麼`false`。產生`bool`值的有比較算符`=`、`<>`、`>`、`>=`、`<`、`<=`，邏輯函數`not`和短路求值的中綴算符`andalso`、`orelse`。

包括上述基本類型的各種類型可以用多種方式組合。一種方式是元組，它是值的有序集合，比如表達式`(1, 2)`的類型是`int * int`，而`("foo", false)`的類型是`string * bool`。可以使用`#1 ("foo", false)`這樣的語法來提取元組的指定次序的成員。

有0元組`()`，它的類型指示為`unit`。但是沒有1元組，或者說在例子`(1)`和`1`之間沒有區別，都有類型`int`。元組可以嵌套，`(1, 2, 3)`不同於`((1, 2), 3)`和`(1, (2, 3))`二者。前者的類型是`int * int * int`，其他兩個的類型分別是`(int * int) * int`和`int * (int * int)`。

組合值的另一種方式是記錄。記錄很像元組，除了它的成員是有名字的而非有次序的，例如`{a = 5.0, b = "five"}`有類型`{a : real, b : string}`，這同於類型`{b : string, a : real}`。可以使用`#a {a = 5.0, b = "five"}`這樣的語法來選取記錄的指定名字的欄位。

Standard ML中的函數隻接受一個值作為參數，而不是參數的一個列表，可以使用上述元組模式匹配來實際上傳遞多個參數。函數還可以返回一個元組。例如：

```sml
fun sum (a, b) = a + b
fun average pair = sum pair div 2

infix averaged_with
fun a averaged_with b = average (a, b)
val c = 3 averaged_with 7

fun int_pair (n : int) = (n, n)
```

這裡第一段創建了兩個類型是`int * int -> int`的函數`sum`和`average`。第二段創建中綴算子`averaged_with`，接著定義它為類型`int * int -> int`的函數。最後的`int_pair`函數的類型是`int -> int * int`。

下列函數是多態類型的一個例子：

```sml
fun pair x = (x, x)
```

編譯器無法推論出的`pair`的特殊化了的類型，它可以是`int -> int * int`、`real -> real * real`甚至是`(int * real -> string) -> (int * real -> string) * (int * real -> string)`。在Standard ML中，它可以簡單指定為多態類型`'a -> 'a * 'a`，這裡的`'a`（讀作「alpha」）是一個類型變量，指示任何可能的類型。在上述定義下，`pair 3`和`pair "x"`都是有良好定義的，分別產生`(3, 3)`和`("x", "x")`。

SML標準基本庫包括了重載標識符：`+`、`-`、`*`、`div`、`mod`、`/`、`~`、`abs`、`<`、`>`、`<=`、`>=`。標準基本庫提供了多態函數：`!`、`:=`、`o`、`before`、`ignore`。中綴運算符可以有從預設最低`0`到最高`9`的任何運算符優先級。標準基本庫提供了如下內建中綴規定：

```sml
infix  7  * / div mod
infix  6  + - ^
infixr 5  :: @
infix  4  = <> > >= < <=
infix  3  := o
infix  0  before
```

### 等式類型

算符`=`和`<>`分別被定義為多態的等式和不等式。`=`它確定兩個值是否相等，有著類型`''a * ''a -> bool`。這意味著它的兩個運算數必須有相同的類型，這個類型必須是等式類型（`eqtype`）。上述基本類型中除了`real`之外，`int`、`real`、`string`、`char`和`bool`都是等式類型。

例如：`3 = 3`、`"3" = "3"`、`#"3" = #"3"`和`true = true`，都是有效的表達式並求值為`true`；而`3 = 4`是有效表達式並求值為`false`，`3.0 = 3.0`是無效表達式而被編譯器拒絕。這是因為IEEE浮點數等式打破了ML中對等式的一些要求。特別是`nan`不等於自身，所以關係不是自反的。

元組和記錄類型是等式類型，當時且僅當它的每個成員類型是等式類型；例如`int * string`、`{b : bool, c : char}`和`unit`是等式類型，而`int * real`和`{x : real}`不是。函數類型永遠不是等式類型，因為一般情況下不可能確定兩個函數是否等價。

### 類型聲明

類型聲明或同義詞（synonym）使用`type`關鍵字來定義。下面是給在平面中的點的類型聲明，計算兩點間距離，和通過海倫公式計算給定角點的三角形的面積的函數。

```sml
type loc = real * real

fun heron (a: loc, b: loc, c: loc) = let
    fun dist ((x0, y0), (x1, y1)) = let
        val dx = x1 - x0
        val dy = y1 - y0
        in
            Math.sqrt (dx * dx + dy * dy)
        end
    val ab = dist (a, b)
    val bc = dist (b, c)
    val ac = dist (a, c)
    val s = (ab + bc + ac) / 2.0
    in
        Math.sqrt (s * (s - ab) * (s - bc) * (s - ac))
    end
```

### 數據類型

Standard ML提供了對代數數據類型（ADT）的強力支持。一個ML數據類型可以被當作是元組的不交並（積類型之和）。數據類型使用`datatype`關鍵字來定義，比如：

```sml
datatype int_or_string
  = INT of int
  | STRING of string
  | NEITHER
```

這個數據類型聲明建立一個全新的數據類型`int_or_string`，還有一起的新構造子（一種特殊函數或值）`INT`、`STRING`和`NEITHER`；每個這種類型的值都是要麼`INT`具有一個整數，要麼`STRING`具有一個字串，要麼`NEITHER`。寫為如下這樣：

```sml
val i = INT 3
val s = STRING "qq"
val n = NEITHER
val INT j = i
```

這裡最後的一個聲明通過模式匹配，將變量`j`綁定到變量`i`所綁定的整數`3`。`val 模式 = 表达式`是綁定的一般形式，它是良好定義的，若且唯若模式和表達式有相同的類型。

數據類型可以是多態的：

```sml
datatype 'a pair
  = PAIR of 'a * 'a
```

這個數據類型聲明建立一個新的類型`'a pair`家族，比如`int pair`，`string pair`等等。

數據類型可以是遞歸的：

```sml
datatype int_list
  = EMPTY
  | INT_LIST of int * int_list
```

這個數據類型聲明建立一個新類型`int_list`，這個類型的每個值是要麼`EMPTY`（空列表），要麼是一個整數和另一個`int_list`的接合。

通過`datatype`創建的類型是等式類型，如果它的所有變體，要麼是沒有參數的空構造子，要麼是有等式類型參數的構造子，並且在多態類型情況下所有類型參數也都是等式類型。遞歸類型在有可能情況下是等式類型，否則就不是。

### 列表

基礎庫提供的複雜數據類型之一是列表`list`。它是一個遞歸的、多態的數據類型，可以等價的定義為：

```sml
datatype 'a list
  = nil 
  | :: of 'a * 'a list
```

這裡的`::`是中綴算符，例如`3 :: 4 :: 5 :: nil`是三個整數的列表。列表是ML程序中最常用的數據類型之一，語言還為生成列表提供了特殊表示法`[3, 4, 5]`。

`real list`當然不是等式類型。但是沒有`int list`不能是等式類型的理由，所以它就是等式類型。注意類型變量不同就是不同的列表類型，比如`(nil : int list) = (nil : char list)`是無效的，因為兩個表達式有不同的類型，即使它們有相同的值。但是`nil = nil`和`(nil : int list) = nil`都是有效的。

基本庫`rev`函數「反轉」一個列表中的元素。它的類型是`'a list -> 'a list`，就是說它可以接受其元素有任何類型的列表，並返回相同類型的列表。更準確的說，它返回其元素相較於給定列表是反轉次序的一個新列表，比如將`[ "a", "b", "c" ]`映射成`[ "c", "b", "a" ]`。中綴算符`@`表示兩個列表的串接。

`rev`和`@`一般被實現為基本庫函數`revAppend`的簡單應用：

```sml
fun revAppend ([], l) = l
  | revAppend (x :: r, l) = revAppend(r, x :: l)

fun rev l = revAppend(l, [])

fun l1 @ l2 = revAppend(rev l1, l2)
```

### 模式匹配

Standard ML的數據類型可以輕易的定義和用於編程，在很大程度上是由它的模式匹配，還有多數Standard ML實現的模式窮盡性檢查和模式冗餘檢查。

模式匹配可以在語法上嵌入到變量綁定之中，比如：

```sml
val ((m: int, n: int), (r: real, s: real)) = ((2, 3), (2.0, 3.0))

type hyperlink = {protocol: string, address: string, title: string}

val url : hyperlink =
    {title="The Standard ML Basis Library", protocol="https",
     address="//smlfamily.github.io/Basis/overview.html"}
val {protocol=port, address=addr, title=name} = url

val x as (fst, snd) = (2, true)
```

第一個`val`綁定了四個變量`m`、`n`、`r`和`s`；第二個`val`綁定了一個變量`url`；第三個`val`綁定了三個變量`port`、`addr`和`name`，第四個叫分層模式，綁定了三個變量`x`、`fst`和`snd`。

模式匹配可以在語法上嵌入到函數定義中，比如：

```sml
datatype shape
  = Circle of loc * real    (* 中心和弧度 *)
  | Square of loc * real    (* 左上角和边长，坐标轴对齐 *)
  | Triangle of loc * loc * loc     (* 角点 *)

fun area (Circle (_, r)) = 3.14 * r * r
  | area (Square (_, s)) = s * s
  | area (Triangle (a, b, c)) = heron (a, b, c) 
```

次序在模式匹配中是緊要的：模式按文本次序來依次進行匹配。在特定計算中，使用下劃線`_`，來省略不需要它的值的子成員，這也叫做通配符（wildcard）模式。所謂的「子句形式」風格的函數定義，這裡的模式緊隨在函數名字之後出現，只是如下形式的一種語法糖：

```sml
fun area shape = case shape
      of Circle (_, r) => 3.14 * r * r
       | Square (_, s) => s * s
       | Triangle (a, b, c) => heron (a, b, c)
```

模式窮盡性檢查將確保數據類型的每個情況都已經顧及到。子句集合是窮盡和不冗餘的函數示例：

```sml
fun hasCorners (Circle _) = false
  | hasCorners _ = true
```

如果控制通過了第一個模式`Circle`，則這個值必定是要麼`Square`要麼`Triangle`。在任何這些情況下，這個形狀都有角點，所以返回`true`而不用區分具體是那種情況。

如果有遺漏，則產生警告。不詳盡的模式示例：

```sml
fun center (Circle (c, _)) = c
  | center (Square ((x, y), s)) = (x + s / 2.0, y + s / 2.0)
```

這裡在`center`函數中沒有給`Triangle`的模式。

編譯器發起模式不詳盡的一個警告，並且如果在運行時間，`Triangle`被傳遞給這個函數，則發起例外`Match`。

如果模式存在冗餘，也會導致一個編譯時間警告。存在模式冗餘的（無意義）函數示例：

```sml
fun f (Circle ((x, y), r)) = x+y
  | f (Circle _) = 1.0
  | f _ = 0.0
```

匹配第二個子句的模式的任何值都也匹配第一個子句的模式，所以第二個子句是不可到達的。因此這個定義整體上是冗餘的。

### 高階函數

函數可以接受函數作為實際參數，比如：

```sml
fun applyToBoth f x y = (f x, f y)
```

函數可以產生函數作為返回值，比如：

```sml
fun constantFn k = (fn anything => k)
```

函數可以同時接受和產生函數，比如函數複合 (電腦科學)：

```sml
fun compose (f, g) = (fn x => f (g x))
```

基本庫的函數`List.map`，是在Standard ML中最常用的Curry化高階函數，它在概念上可定義為：

```sml
fun map' _ [] = []
  | map' f (x :: xs) = f x :: map f xs
```

在基本庫中將函數複合定義為多態中綴算符`(f o g)`，`map`和`fold`高階函數有較高效率的實現。映射函數的實際實現：

```sml
fun map f = let
    fun m [] = []
	  | m [a] = [f a]
	  | m [a, b] = [f a, f b]
	  | m [a, b, c] = [f a, f b, f c]
	  | m (a :: b :: c :: d :: r) = f a :: f b :: f c :: f d :: m r
    in
	    m
    end
```

摺疊函數的實際實現：

```sml
fun foldl f b l = let
    fun f2 ([], b) = b
	  | f2 (a :: r, b) = f2 (r, f (a, b))
    in
	    f2 (l, b)
    end

fun foldr f b l = foldl f b (rev l)
```

過濾器函數的實際實現：

```sml
fun filter pred [] = []
  | filter pred (a :: rest) =
      if pred a
	  then a :: (filter pred rest)
	  else (filter pred rest)
```

### 例外

例外可以使用`raise`關鍵字發起，並通過模式匹配`handle`構造來處理：

```sml
exception Undefined;

fun max [x] = x
  | max (x :: xs) = let
    val m = max xs
    in
        if x > m then x else m 
    end
  | max [] =
      raise Undefined

fun main xs = let
    val msg = (Int.toString (max xs))
              handle Undefined => "empty list...there is no max!"
    in
        print (msg ^ "\n")
    end
```

這裡的`^`是字串串接算符。可以利用例外系統來實現非局部退出，例如這個函數所採用技術：

```sml
exception Zero;

fun listProd ns = let
    fun p [] = 1
      | p (0 :: _) = raise Zero
      | p (h :: t) = h * p t
    in
        (p ns)
        handle Zero => 0
    end
```

`Zero`在`0`情況下發起，控制從函數`p`中一起出離。

### 引用

初始化基礎庫還以引用的形式提供了可變的存儲。引用`ref`可以在某種意義上被認為是如下這樣定義的：

```sml
datatype 'a ref = ref of 'a
```

還定義了內建的`:=`函數來修改引用的內容，和`!`函數來檢索引用的內容。階乘函數可以使用引用定義為指令式風格：

```sml
fun factImperative n = let
    val i = ref n and acc = ref 1
    in
        while !i > 0 do
            (acc := !acc * !i;
             i := !i - 1);
        !acc
    end
```

這裡使用圓括號對以`;`分隔的表達式進行了順序複合。

可變類型`'a ref`是等式類型，即使它的成員類型不是。兩個引用被稱為是相等的，如果它們標識相同的「`ref`單元」，就是說相同的對`ref`構造子調用生成的同一個指針。因此`(ref 1) = (ref 1)`和`(ref 1.0) = (ref 1.0)`都是有效的，並且都求值為`false`，因為即使兩個引用碰巧指向了相同的值，引用自身是分立的，每個都可以獨立於其他而改變。

## 模塊語言

模塊是ML用於構造大型項目和庫的系統。

### 模塊

一個模塊構成自一個簽名（signature）文件和一個或多個結構文件。簽名文件指定要實現的API（就像C語言頭文件或Java接口文件）。結構實現這個簽名（就像C語言源文件或Java類文件）。頂層解釋器通過`use`命令導入它們。ML的標準庫被實現為這種方式的模塊。

例如，下列定義一個算術簽名：

```sml
signature ARITH =
sig
    eqtype t
    val zero : t
    val one : t
    val fromInt: int -> t  
    val fromIntPair : int * int -> t
    val fromReal : real -> t
    val succ : t -> t
    val pred : t -> t
    val ~ : t -> t
    val + : t * t -> t
    val - : t * t -> t
    val * : t * t -> t
    val / : t * t -> t
    val == : t * t -> bool
    val <> : t * t -> bool
    val > : t * t -> bool
    val >= : t * t -> bool
    val < : t * t -> bool
    val <= : t * t -> bool
end
```

將上述內容存入`arith.sig`文件中。下面是這個簽名使用有理數的實現：

```sml
structure Rational : ARITH =
struct
    datatype t = Rat of int * int
    val zero = Rat (0, 1)
    val one = Rat (1, 1)
    fun fromInt n = Rat (n, 1)
    fun ineg (a, b) = (~a, b)
    fun fromIntPair (num, den) = let
        fun reduced_fraction (numerator, denominator) = let
            fun gcd (n, 0) = n
              | gcd (n, d) = gcd (d, n mod d)
            val d = gcd (numerator, denominator)
            in 
                if d > 1 then (numerator div d, denominator div d) 
                else (numerator, denominator)
            end
        in  
            if num < 0 andalso den < 0
            then Rat (reduced_fraction (~num, ~den))
            else if num < 0 
            then Rat (ineg (reduced_fraction (~num, den)))
            else if den < 0
            then Rat (ineg (reduced_fraction (num, ~den)))
            else Rat (reduced_fraction (num, den))
        end
    val SOME maxInt = Int.maxInt
    val minPos = 1.0 / (real maxInt)
    fun fromReal r = let
        fun convergent (i, f, h_1, k_1, h_2, k_2) = 
              if i <> 0 andalso ((h_1 > (maxInt - h_2) div i)
                  orelse (k_1 > (maxInt - k_2) div i))
              then (h_1, k_1)
              else if f < minPos 
              then (i * h_1 + h_2, i * k_1 + k_2)
              else convergent (trunc (1.0 / f), Real.realMod (1.0 / f),
                               i * h_1 + h_2, i * k_1 + k_2, h_1, k_1)
        in 
            if r < 0.0
            then Rat (ineg (convergent (trunc (~ r), 
                      Real.realMod (~ r), 1, 0, 0, 1))) 
            else Rat (convergent (trunc r, Real.realMod r, 1, 0, 0, 1))
        end
    fun succ (Rat (a, b)) = fromIntPair (a + b, b)
    fun pred (Rat (a, b)) = fromIntPair (a - b, b)
    fun add (Rat (a, b), Rat (c, d)) = 
          if b = d then fromIntPair(a + c, b) 
          else fromIntPair (a * d + c * b, b * d)
    fun sub (Rat (a, b), Rat (c, d)) = 
          if b = d then fromIntPair(a - c, b) 
          else fromIntPair (a * d - c * b, b * d)
    fun mul (Rat (a, b), Rat (c, d)) = fromIntPair (a * c, b * d)
    fun div_ (Rat (a, b), Rat (c, d)) = fromIntPair (a * d, b * c)
    fun gt (Rat (a, b), Rat (c, d)) =
          if b = d then (a > c) else (a * d) > (b * c)
    fun lt (Rat (a, b), Rat (c, d)) =
          if b = d then (a < c) else (a * d) < (b * c)
    fun neg (Rat (a, b)) = Rat (~a, b)
    fun eq (Rat (a, b), Rat (c, d)) = ((b = d) andalso (a = c))
    fun ~ a = neg a
    fun a + b = add (a, b)
    fun a - b = sub (a, b)
    fun a * b = mul (a, b)
    fun a / b = div_ (a, b)
    fun op == (a, b) = eq (a, b)
    fun a <> b = not (eq (a, b))
    fun a > b = gt (a, b)
    fun a >= b = (gt (a, b) orelse eq (a, b))
    fun a < b = lt (a, b)
    fun a <= b = (lt (a, b) orelse eq (a, b))
end
```

將上述內容村存入`rational.sml`文件中。下面是在SML/NJ中這個結構的簡單用例：

```sml
- use "./arith.sig";
[opening ./arith.sig]
signature ARITH =
  sig
    eqtype t
    val zero : t
    val one : t
    val fromInt : int -> t
    val fromIntPair : int * int -> t
    val fromReal : real -> t
    val succ : t -> t
    val pred : t -> t
    val ~ : t -> t
    val + : t * t -> t
    val - : t * t -> t
    val * : t * t -> t
    val / : t * t -> t
    val == : t * t -> bool
    val <> : t * t -> bool
    val > : t * t -> bool
    val >= : t * t -> bool
    val < : t * t -> bool
    val <= : t * t -> bool
  end
val it = () : unit
- use "./rational.sml";
[opening ./rational.sml]
[autoloading]
[library $SMLNJ-BASIS/basis.cm is stable]
[library $SMLNJ-BASIS/(basis.cm):basis-common.cm is stable]
[autoloading done]
structure Rational : ARITH
val it = () : unit
- infix ==;
infix ==
- local open Rational
= in
= val c = let 
=     val a = fromIntPair(2, 3)
=     val b = fromIntPair(4, 6)
=     in
=         a + b
=     end
= end;
val c = Rat (4,3) : Rational.t
- structure R = Rational;
structure R : ARITH
- R.fromReal(3.245);
val it = Rat (649,200) : Rational.t
```

Standard ML只允許通過簽名函數同實現進行交互，例如不可以直接通過這個代碼中的`Rat`來建立數據對象。結構塊對外部隱藏所有實現細節。這裡的`:`叫做透明歸屬（ascription），可以通過所綁定的變量見到此結構的數據內容，與之相對的是`:>`，它叫做不透明歸屬，此結構的數據內容對外完全不可見。比如上面用例有結果：`val c = Rat (4,3) : Rational.t`，如果改為不透明歸屬則有結果：`val c = - : Rational.t`。

要用有理數進行實際上的數值計算，需要處理分數形式中分母快速增大導致溢出整數類型大小範圍等問題。對分數採取修約的有理數實現：

```sml
signature ARITH =
sig
    eqtype t
    val zero : t
    val one : t
    val fromInt: int -> t  
    val fromIntPair : int * int -> t
    val repr : t -> unit
    val succ : t -> t
    val pred : t -> t
    val ~ : t -> t
    val + : t * t -> t
    val - : t * t -> t
    val * : t * t -> t
    val / : t * t -> t
end
```

```sml
structure Rational : ARITH =
struct
    type t = int * int
    val zero = (0, 1)
    val one = (1, 1)
    val maxInt = (let val SOME a = Int.maxInt in Int.toLarge a end)
    fun fromInt n = (n, 1)
    fun neg (a, b) = (~a, b)
    fun fromLargePair (a, b) = (Int.fromLarge a, Int.fromLarge b)
    fun fromIntPair (num, den) = let
        fun reduced_fraction (numerator, denominator) = let
            fun gcd (n, 0) = n
              | gcd (n, d) = gcd (d, n mod d)
            val d = gcd (numerator, denominator)
            in 
                if d > 1 then (numerator div d, denominator div d) 
                else (numerator, denominator)
            end
        in
            if num < 0 andalso den < 0
            then reduced_fraction (~num, ~den)
            else if num < 0 
            then neg (reduced_fraction (~num, den))
            else if den < 0
            then neg (reduced_fraction (num, ~den))
            else reduced_fraction (num, den)
        end
    fun repr (a, b) = let
        val m = if (b = 0) then 0 else if (a >= 0) then a div b else ~a div b
        val n = if (b = 0) then 1 else if (a >= 0) then a mod b else ~a mod b
        val ms = Int.toString m and ns = Int.toString n and bs = Int.toString b
        in 
            if n <> 0 andalso m <> 0 andalso a < 0
            then print ("~" ^ ms ^ " - " ^ ns ^ "/" ^ bs ^ "\n")
            else if n <> 0 andalso m <> 0  
            then print (ms ^ " + " ^ ns ^ "/" ^ bs ^ "\n")
            else if n <> 0 andalso m = 0 andalso a < 0
            then print ("~" ^ ns ^ "/" ^ bs ^ "\n")
            else if n <> 0 andalso m = 0 
            then print (ns ^ "/" ^ bs ^ "\n")
            else if a < 0 
            then print ("~" ^ ms ^ "\n")
            else print (ms ^ "\n")
        end
    fun convergent (i, n, d, h_1, k_1, h_2, k_2) = 
          if i <> 0 andalso ((h_1 > (maxInt - h_2) div i)
              orelse (k_1 > (maxInt - k_2) div i))
          then (h_1, k_1)  
          else if n = 0
          then (i * h_1 + h_2, i * k_1 + k_2) 
          else convergent (d div n, d mod n, n,
                           i * h_1 + h_2, i * k_1 + k_2, h_1, k_1) 
    fun add ((a, b), (c, d)) = let
        val la = Int.toLarge a and lb = Int.toLarge b
        val lc = Int.toLarge c and ld = Int.toLarge d 
        val m = la * ld + lb * lc and n = lb * ld 
        in 
            if b = d 
            then fromIntPair (a + c, b)
            else fromLargePair (convergent (m div n, m mod n, n, 1, 0, 0, 1))
        end 
    fun sub ((a, b), (c, d)) = let
        val la = Int.toLarge a and lb = Int.toLarge b
        val lc = Int.toLarge c and ld = Int.toLarge d  
        val m = la * ld - lb * lc and n = lb * ld
        in  
            if b = d
            then fromIntPair (a - c, b)
            else if m < 0 
            then neg (fromLargePair (convergent (~m div n, ~m mod n, n, 1, 0, 0, 1)))
            else if m > 0
            then fromLargePair (convergent (m div n, m mod n, n, 1, 0, 0, 1))
            else (0, 1)
        end
    fun mul ((a, b), (c, d)) = let
        val la = Int.toLarge a and lb = Int.toLarge b
        val lc = Int.toLarge c and ld = Int.toLarge d 
        val m = la * lc and n = lb * ld 
        in  
            fromLargePair (convergent (m div n, m mod n, n, 1, 0, 0, 1))
        end
    fun op + ((a, b), (c, d)) = 
          if a < 0 andalso c < 0 
          then neg (add ((~a, b), (~c, d)))
          else if a < 0
          then sub ((c, d), (~a, b))
          else if c < 0
          then sub ((a, b), (~c, d))
          else add ((a, b), (c, d))
    fun op - ((a, b), (c, d)) = 
          if a < 0 andalso c < 0 
          then sub ((~c, d), (~a, b))
          else if a < 0
          then neg (add ((~a, b), (c, d)))
          else if c < 0
          then add ((a, b), (~c, d))
          else sub ((a, b), (c, d))
    fun op * ((a, b), (c, d)) = 
          if a < 0 andalso c < 0  
          then mul ((~a, b), (~c, d))
          else if a < 0
          then neg (mul ((~a, b), (c, d)))
          else if c < 0
          then neg (mul ((a, b), (~c, d)))
          else mul ((a, b), (c, d))
    fun op / ((a, b), (c, d)) =
          if a < 0 andalso c < 0  
          then mul ((~a, b), (d, ~c))
          else if a < 0
          then neg (mul ((~a, b), (d, c)))
          else if c < 0
          then neg (mul ((a, b), (d, ~c)))
          else mul ((a, b), (d, c))
    fun succ a = add (a, one)
    fun pred a = sub (a, one)
    fun ~ a = neg a
end
```

### 函子

函子接受指定簽名的一個結構作為參數，並返回一個結構作為結果，下面示例的函子能在`ARITH`簽名的結構上計算移動平均：

```sml
signature MOVINGLIST = 
sig
    type t
    structure Arith : sig
        type t end
    val size : t -> int
    val average : t -> Arith.t
    val fromList : Arith.t list -> t
    val move : t * Arith.t -> t
    val expand : t * Arith.t -> t
    val shrink : t -> t
    val trunc : t -> t
end
```

將上述內容存入`movinglist.sig`文件。

```sml
functor MovingList (S: ARITH) : MOVINGLIST = 
struct
    type t = S.t list * int * S.t
    structure Arith = S
    fun size (ml : t) = #2 ml
    fun average (ml : t) = #3 ml
    fun fromList (l : S.t list) = let
        val n = length l
        val sum = foldl S.+ S.zero l
        local open S in
        val m = sum / (fromInt n) end 
        in
            if (null l) then raise Empty
            else (l, n, m) 
        end
    fun move ((l, n, m) : t, new : S.t) = let
        val old = List.nth (l, n - 1) 
        local open S in
        val m' = m + (new - old) / (fromInt n) end    
        in
            (new :: l, n, m')
        end     
    fun expand ((l, n, m) : t, new : S.t) = let
        val n' = n + 1; 
        local open S in
        val m' = m + (new - m) / (fromInt n') end
        in
            (new :: l, n', m')
        end
    fun shrink ((l, n, m) : t) = let
        val old = List.nth (l, n - 1) 
        val n' = if (n > 2) then n - 1 else 1 
        local open S in 
        val m' = m + (m - old) / (fromInt n') end
        in
            (l, n', m')
        end
    fun trunc ((l, n, m) : t) =
          (List.take (l, n), n, m)
end
```

將上述內容存入`movinglist.sml`文件中。下面是在SML/NJ中這個函子的簡單用例，承接前面章節的例子已經加載`arith.sig`和`rational.sml`：

```sml
- use "./movinglist.sig";
[opening movinglist.sig]
signature MOVINGLIST =
  sig
    type t
    structure Arith : sig type t end
    val size : t -> int
    val average : t -> Arith.t
    val fromList : Arith.t list -> t
    val move : t * Arith.t -> t
    val expand : t * Arith.t -> t
    val shrink : t -> t
    val trunc : t -> t
  end
val it = () : unit
- use "./movinglist.sml";
[opening movinglist.sml]
[autoloading]
[autoloading done]
functor MovingList(S: sig
                        eqtype t
                        val zero : t
                        val one : t
                        val fromInt : int -> t
                        val fromIntPair : int * int -> t
                        val fromReal : real -> t
                        val succ : t -> t
                        val pred : t -> t
                        val ~ : t -> t
                        val + : t * t -> t
                        val - : t * t -> t
                        val * : t * t -> t
                        val / : t * t -> t
                        val == : t * t -> bool
                        val <> : t * t -> bool
                        val > : t * t -> bool
                        val >= : t * t -> bool
                        val < : t * t -> bool
                        val <= : t * t -> bool
                      end) :
                  sig
                    type t
                    structure Arith : <sig>
                    val size : t -> int
                    val average : t -> Arith.t
                    val fromList : Arith.t list -> t
                    val move : t * Arith.t -> t
                    val expand : t * Arith.t -> t
                    val shrink : t -> t
                    val trunc : t -> t
                  end
val it = () : unit
- structure R = Rational;
structure R : ARITH
- structure MLR = MovingList (Rational);
structure MLR : MOVINGLIST
- val d = MLR.fromList [R.fromIntPair (4, 5), R.fromIntPair (2, 3)];
val d = ([Rat (4,5),Rat (2,3)],2,Rat (11,15)) : MLR.t
- val d = MLR.expand (d, R.fromIntPair (5, 6));
val d = ([Rat (5,6),Rat (4,5),Rat (2,3)],3,Rat (23,30)) : MLR.t
- val d = MLR.move (d, R.fromIntPair (7, 8));
val d = ([Rat (7,8),Rat (5,6),Rat (4,5),Rat (2,3)],3,Rat (301,360)) : MLR.t
- val d = MLR.shrink d;
val d = ([Rat (7,8),Rat (5,6),Rat (4,5),Rat (2,3)],2,Rat (41,48)) : MLR.t
- val d = MLR.trunc d;
val d = ([Rat (7,8),Rat (5,6)],2,Rat (41,48)) : MLR.t
```

這個用例承上節示例，`Rational`結構採用了透明歸屬，有結果如：`val d = ([Rat (4,5),Rat (2,3)],2,Rat (11,15)) : MLR.t`。如果它改為不透明歸屬，則對應結果為：`val d = ([-,-],2,-) : MLR.t`。

## 示例代碼

下列例子使用了Standard ML的語法和語義。

### 素數

下面是求素數的試除法實現：

```sml
fun prime n = let
    fun isPrime (l, i) = let
        fun existsDivisor [] = false 
          | existsDivisor (x :: xs) = 
              if (i mod x) = 0 then true
              else if (x * x) > i then false 
              else existsDivisor xs
        in  
            not (existsDivisor l)
        end
    fun iterate (acc, i) =
          if i > n then acc
          else if isPrime (acc, i)
          then iterate (acc @ [i], i + 2)
          else iterate (acc, i + 2)
    in 
        if n < 2 then []
        else iterate ([2], 3)
    end
```

基本庫`find`和`exists`函數在不存在符合條件元素的時候會遍歷整個列表，找出函數的實際實現：

```sml
fun find pred [] = NONE
  | find pred (a :: rest) =
      if pred a 
      then SOME a 
      else (find pred rest)
```

存在謂詞函數的實際實現：

```sml
    
fun exists pred = let
    fun f [] = false
      | f (h :: t) = 
          pred h orelse f t
    in
        f
    end
```

這裡採用了特殊化了的`existsDivisor`，用以在後續元素都不滿足條件時立即結束運算。

下面是埃拉托斯特尼篩法實現：

```sml
fun prime n = let
    fun dropComposite (acc, [], _, _) = rev acc
      | dropComposite (acc, l as x :: xs, j, i) = 
          if j > n then List.revAppend (acc, l) 
          else if x < j  
          then dropComposite (x :: acc, xs, j, i)
          else if x > j 
          then dropComposite (acc, l, j + i, i)
          else dropComposite (acc, xs, j + i, i)
    fun init i = let
        fun loop (l, i) = 
              if i <= 2 then l
              else loop (i :: l, i - 2)
        in
            loop ([], i - (i + 1) mod 2)
        end
    fun iterate (acc, []) = rev acc     
      | iterate (acc, l as x :: xs) = 
          if x * x > n
          then 2 :: List.revAppend (acc, l)
          else iterate (x :: acc,
                 dropComposite ([], xs, x * x, x * 2))
    in 
        if n < 2 then [] 
        else iterate ([], init n)
    end
```

這裡基於列表的篩法實現符合埃拉托斯特尼的原初演算法。篩法還有基於陣列的直觀實現。篩法基於陣列的實現：

```sml
fun prime n = let
    val sieve = Array.array (n + 1, true);
    fun markComposite (j, i) =
          if j > n then () 
          else (Array.update (sieve, j, false); 
                markComposite (j + i, i))
    fun iterate i =
          if i * i > n then ()
          else if Array.sub (sieve, i)
          then (markComposite (i * i, i);
                iterate (i + 1))
          else iterate (i + 1)
    fun generate (acc, i) = 
          if i < 2 then acc
          else if Array.sub (sieve, i) 
          then generate (i :: acc, i - 1)
          else generate (acc, i - 1) 
    in 
        if n < 2 then [] 
        else (iterate 2;
              generate ([], n))
    end
```

下面是其解釋器下命令行運行實例：

```sml
- fun printIntList (l: int list) =
=     print ((String.concatWith " " (map Int.toString l)) ^ "\n");
val printIntList = fn : int list -> unit
- val _ = printIntList (prime 100);
2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97
```

### 漢明數

正規數是形如$\ 2^i\cdot 3^j\cdot 5^k\ $的整數，對於非負整數$\ i\ $、$\ j\ $和$\ k$，它是可以整除$\ 60^{\max(\lceil i\,/2\rceil,j,k)}\ $的數。計算升序的正規數的算法經由戴克斯特拉得以流行，理察·漢明最初提出了這個問題，故而這個問題被稱為「漢明問題」，這個數列也因而被稱為漢明數。Dijkstra計算這些數的想法如下：

- 漢明數的序列開始於數`1`。
- 要加入序列中的數有下述形式：`2h, 3h, 5h`，這裡的`h`是序列已有的任意的漢明數。
- 因此，可以生成最初只有一個`1`的序列`H`，並接著歸併演算法序列`2H, 3H, 5H`，並以此類推。

示例漢明數程序代碼，一般用來展示，確使計算只在需要時進行的純函數式編程方式。

```sml
fun Hamming_number n = let
    fun merge (p, q) = let
        fun revMerge (acc, p, q) =
              if not (null p) andalso not (null q) then
                  if hd p < hd q
                  then revMerge ((hd p) :: acc, tl p, q)
                  else if hd p > hd q
                  then revMerge ((hd q) :: acc, p, tl q)
                  else revMerge ((hd p) :: acc, tl p, tl q)
              else if null p 
              then List.revAppend (q, acc)
              else List.revAppend (p, acc)
        in
            if (null p) then q
            else if (null q) then p
            else rev (revMerge ([], p, q))
        end
    fun mul m x =
          if x <= (n div m) then SOME (x * m) else NONE
    fun mapPrefix pred l = let
        fun mapp ([], acc) = rev acc
          | mapp (x :: xs, acc) = 
             (case (pred x)
                of SOME a => mapp (xs, a :: acc)
                 | NONE => rev acc)
        in
            mapp (l, [])
        end
    fun mergeWith f (m, i) = merge (f m, i)
    fun generate l = let
        fun listMul m = mapPrefix (mul m) l
        in
            foldl (mergeWith listMul) [] [2, 3, 5]
        end
    fun iterate (acc, l) =
          if (hd l) > (n div 2) then merge (l, acc)
          else iterate (merge (l, acc), generate l)
    in
        if n > 0 then iterate ([], [1]) else []
    end
```

產生指定範圍內的漢明數需要多輪運算，後面每輪中的三個列表元素乘積運算中都可能產生超出這個範圍的結果，它們不需要出現在後續的運算之中。漢明數進一步性質演示代碼：

```sml
fun printIntList (l: int list) =
    print ((String.concatWith " " (map Int.toString l)) ^ "\n");
fun diff (p, q) = let
    fun revDiff (acc, p, q) =
          if not (null p) andalso not (null q) then
              if hd p < hd q
              then revDiff ((hd p) :: acc, tl p, q)
              else if hd p > hd q
              then revDiff (acc, p, tl q)
              else revDiff (acc, tl p, tl q)
          else if null q 
          then List.revAppend (p, acc)
          else acc
    in
        if (null p) then []
        else if (null q) then p
        else rev (revDiff ([], p, q))
    end;
fun Hamming_number n = let
    fun merge (p, q) = let
        fun revMerge (acc, p, q) =
              if not (null p) andalso not (null q) then
                  if hd p < hd q
                  then revMerge ((hd p) :: acc, tl p, q)
                  else if hd p > hd q
                  then revMerge ((hd q) :: acc, p, tl q)
                  else revMerge ((hd p) :: acc, tl p, tl q)
              else if null p 
              then List.revAppend (q, acc)
              else List.revAppend (p, acc)
        in
            if (null p) then q
            else if (null q) then p
            else rev (revMerge ([], p, q))
        end
    fun mergeWith f (m, i) = merge (f m, i)
    fun mul m x = (x * m)             
    fun generate l = let
        fun listMul m = map (mul m) l
        in
            printIntList (listMul 2);
            printIntList (diff (listMul 3, listMul 2));
            printIntList (diff (listMul 5, merge (listMul 2, listMul 3)));  
            foldl (mergeWith listMul) [] [2, 3, 5]
        end
    val count = ref 1;
    fun iterate (acc, l) =
          if (hd l) > (n div 2) then merge (l, acc)
          else (print ("round " ^ (Int.toString (!count)) ^ " for " ^
                       (Int.toString(length l)) ^ " number(s)\n");
                count := !count + 1;
                iterate (merge (l, acc), generate l))
    in
        if n > 0 then iterate ([], [1]) else []
    end;
```

```sml
val l = Hamming_number 400;
val h = List.filter (fn x => (x <= 400)) l;
val _ = print ((Int.toString (length h)) ^ " numbers from " ^ 
               (Int.toString (length l)) ^ " numbers\n");
```

基本庫`mapPartial`函數與它所映射的函數，通過基於`Option`結構的`SOME`和`NONE`構造子的協定，可以將所映射函數認為不符合條件的元素或者結果排除掉，它會遍歷整個列表。部份映射函數的實際實現：

```sml
fun mapPartial pred l = let
    fun mapp ([], l) = rev l
      | mapp (x :: r, l) =
         (case (pred x)
            of SOME y => mapp (r, y :: l)
             | NONE => mapp (r, l)
             (* end case *))
    in
        mapp (l, [])
    end
```

由於這個演算法採用升序列表，故而這裡將它改寫為`mapPrefix`函數，用來在特定條件不滿足條件就立即結束。下面是漢明數程序在解釋器下命令行運行實例：

```sml
- fun printIntList (l: int list) =
=     print ((String.concatWith " " (map Int.toString l)) ^ "\n");
val printIntList = fn : int list -> unit
- val _ = printIntList (Hamming_number 400);
1 2 3 4 5 6 8 9 10 12 15 16 18 20 24 25 27 30 32 36 40 45 48 50 54 60 64 72 75 80 81 90 96 100 108 120 125 128 135 144 150 160 162 180 192 200 216 225 240 243 250 256 270 288 300 320 324 360 375 384 400
```

### 續體傳遞風格實例

下面是續體傳遞風格（CPS）的高階函數foldr和map的實現，和達成一個整數列表的合計函數的簡單用例：

```sml
fun foldr' f b l = let
    fun g ([], k) = k b
      | g (a :: r, k) = g (r, fn x => k (f (a, x)))
    in
        g (l, fn x => x)
    end

fun map' f l = foldr' (fn (x, y) => (f x) :: y) [] l 

fun sum l = foldr' (fn (x, y) => (x + y)) 0 l
```

對於輸入`[e<sub>1</sub>, e<sub>2</sub>, …, e<sub>n</sub>]`，`sum`函數等價於將函數複合`(fn x => x)∘(fn x => e<sub>1</sub> + x)∘(fn x => e<sub>2</sub> + x)∘…∘(fn x => e<sub>n</sub> + x)`，應用於`0`之上，它得到`(e<sub>1</sub> + (e<sub>2</sub> + (… + (e<sub>n</sub> + 0)…)))`。

SML/NJ支持頭等對象的續體。頭等續體對一門語言而言是能完全控制指令執行次序的能力。它們可以用來跳轉到產生對當前函數調用的那個函數，或者跳轉到此前已經退出了的函數。頭等續體保存了程序執行狀態，它不保存程序數據，只保存執行上下文。

### 排序算法

排序算法關注計算複雜度，特別是時間複雜度，基本庫函數的實現細節也要考慮在內，比如串接函數`@`，它被實現為`fun l1 @ l2 = revAppend(rev l1, l2)`，除非必需的情況避免使用遍歷整個列表的`rev`和`length`函數。列表長度函數的實際實現：

```sml
fun length l = let
    (* fast add that avoids the overflow test *)
    val op + = Int.fast_add
    fun loop (n, []) = n
	  | loop (n, [_]) = n + 1
	  | loop (n, _ :: _ :: l) = loop (n + 2, l)
    in
	    loop (0, l)
    end
```

通過比較於這些排序算法的周知過程式程式語言比如C語言的實現，可以體察到ML在控制流程和列表數據結構上的相關限制，和與之相適應的採用尾遞歸的特色函數式編程風格。

#### 插入排序

下面是簡單的插入排序算法的尾遞歸和等價的普通遞歸實現：

尾遞歸｜普通遞歸

```sml
fun insertSort l = let
    fun insert pred (ins, l) = let
        fun loop (acc, []) =
              List.revAppend (acc, [ins])
          | loop (acc, l as x :: xs) =
              if pred (ins, x)
              then List.revAppend (acc, ins :: l)
              else loop (x :: acc, xs)
        in  loop ([], l) end
    val rec ge = fn (x, y) => (x >= y)     
    in
        rev (foldl (insert ge) [] l)
    end
```

```sml
fun insertSort l = let
    fun insert pred (ins, []) =
          [ins]

      | insert pred (ins, l as x :: xs) =
          if pred (ins, x)
	      then ins :: l
	      else x :: (insert pred (ins, xs))

    val rec ge = fn (x, y) => (x >= y)     
    in
        rev (foldl (insert ge) [] l)
    end
```

`x`保存在形式參數`acc`對應的分配堆中｜`x`保存在調用棧棧幀中

插入排序算法是穩定的自適應排序，它在輸入列表趨於正序的時候性能最佳，在輸入列表趨於反序的時候性能最差，因此在演算法實現中，需要`insert`函數所插入列表保持為反序，在插入都完成後經`rev`函數再反轉回正序。在預期輸入數據趨於隨機化或者預知它經過了反轉的情況下，可以採用保持要插入列表為正序的變體插入排序算法實現，它在輸入列表趨於反序的時候性能最佳，在輸入列表趨於正序的時候性能最差，它比自適應實現少作一次全列表反轉。變體的插入排序算法實現：

```sml
fun insertSort l = let
    fun insert pred (ins, l) = let
        fun loop (acc, []) =
              List.revAppend (acc, [ins])
          | loop (acc, l as x :: xs) =
              if pred (ins, x)
              then List.revAppend (acc, ins :: l)
              else loop (x :: acc, xs)
         in 
            loop ([], l)
        end
    val rec lt = fn (x, y) => (x < y)     
    in
        foldl (insert lt) [] l
    end
```

採用`foldr`函數可以相應的保持要插入列表為正序，由於`fun foldr f b l = foldl f b (rev l)`，它等同於對反轉過的列表應用變體插入排序。

#### 希爾排序

希爾排序算法是對插入排序的改進，保持了自適應排序，放棄了穩定性。下面是希爾排序算法的原型實現，當輸入列表趨於正序的時候，`scatter`函數將其分解為一組趨於反序的子列表，經過在輸入趨於反序情況下性能最佳的變體插入排序後，`gather`函數再將它們合成為一個列表：

```sml
fun shellSort l = let
    fun insert pred (ins, l) = let
        fun loop (acc, []) =
              List.revAppend (acc, [ins])
          | loop (acc, l as x :: xs) =
              if pred (ins, x)
              then List.revAppend (acc, ins :: l)
              else loop (x :: acc, xs)
        in 
            loop ([], l)
        end
    val rec lt = fn (x, y) => (x < y)
    fun insertSort l = foldl (insert lt) [] l 
    fun scatter (l, n) = let
        fun dup n = let
            fun loop (acc, i) =
                  if i <= 0 then acc
                  else loop ([] :: acc, i - 1)
            in
                loop ([], n)
            end
        fun loop ([], acc, lol) =
              List.revAppend (acc, lol)
          | loop (l, acc, []) =
              loop (l, [], rev acc)
          | loop (x :: xs, acc, l :: ls) =
              loop (xs, (x :: l) :: acc, ls)
        in
            loop (l, [], dup n)
        end
    fun gather lol = let
        fun loop ([], [], l) = rev l
          | loop (acc, [], l) =
              loop ([], rev acc, l)
          | loop (acc, [] :: ls, l) =
              loop (acc, ls, l)  
          | loop (acc, (x :: xs) :: ls, l) =    
              loop (xs :: acc, ls, x :: l)
        in
            loop ([], lol, [])
        end 
    val gap = let
        fun loop (acc, i) = let
        val h = (i * 5 - 1) div 11
            in
                if i < 5 then rev (1 :: acc) 
                else loop (h :: acc, h)
            end
        in 
            loop ([], length l)
        end
    fun sort (h, l) = gather (map insertSort (scatter (l, h)))
    in
        foldl sort l gap 
    end
```

下面是希爾排序的實現：

```sml
fun shellSort l = let
    fun insert pred (ins, l) = let
        fun loop (acc, []) =
              List.revAppend (acc, [ins])
          | loop (acc, l as x :: xs) =
              if pred (ins, x)
              then List.revAppend (acc, ins :: l)
              else loop (x :: acc, xs)
        in 
            loop ([], l)
        end
    val rec lt = fn (x, y) => (x < y)
    fun insertSort [] = []
      | insertSort [x] = [x]
      | insertSort [x, y] =
          if (y < x) then [y, x] else [x, y] 
      | insertSort (x :: y :: z :: xs) = let
        val (x, y, z) = 
              if (y < x) then
                  if z < y then (z, y, x) 
                  else if z < x then (y, z, x)
                  else (y, x, z)
              else
                  if z < x then (z, x, y)
                  else if z < y then (x, z, y) 
                  else (x, y, z)
        in
           foldl (insert lt) [x, y, z] xs
        end 
    fun group (lol, n) = let
        fun dup n = let
            fun loop (acc, i) =
                  if i <= 0 then acc
                  else loop ([] :: acc, i - 1)
            in
                loop ([], n)
            end    
        fun loop ([], [], accj, lol') = 
              List.revAppend (accj, lol')
          | loop (acci, [], accj, []) =
              loop ([], rev acci, [], rev accj)              
          | loop (acci, [], accj, lol') =
              loop ([], rev acci, accj, lol')
          | loop (acci, lol, accj, []) =
              loop (acci, lol, [], rev accj)    
          | loop (acci, [] :: ls, accj, lol') =
              loop (acci, ls, accj, lol')  
          | loop (acci, (x :: xs) :: ls, accj, l' :: ls') =                
              loop (xs :: acci, ls, (x :: l') :: accj, ls')
        in
            loop ([], lol, [], dup n)
        end 
    val (lol, len) = foldl
          (fn (x, (l, n)) => ([x] :: l, n + 1)) ([], 0) (rev l)
    val incs = [1, 4, 9, 20, 46, 103, 233, 525, 1182, 2660, 
                5985, 13467, 30301, 68178, 153401, 345152,
                776591, 1747331, 3931496, 8845866, 19903198,
                44782196, 100759940, 226709866, 510097200]
    val gap = let
        val v = len * 3 div 4
        val thold = if (v = 0) then 1 else v
        fun loop (acc, h) = 
              if (hd h) > thold then acc
              else loop ((hd h) :: acc, tl h)
        in 
            loop ([], incs)
        end
    fun sort (h, lol) = map insertSort (group (lol, h))
    in
        hd (foldl sort lol gap) 
    end
```

這裡採用的間隔序列是OEIS A108870，即$\ \begin{smallmatrix} \left\lceil \frac{1}{5} \left(9\cdot \left(\frac{9}{4}\right)^{k-1} - 4 \right) \right\rceil \end{smallmatrix} \ $，它是徳田尚之在1992年提出的。這個序列用遞推公式表示為：`h<sub>k</sub> = ⌈h'<sub>k</sub>⌉`，這裡的`h'<sub>k</sub> = 2.25·h'<sub>k-1</sub> + 1`而`h'<sub>1</sub> = 1`。假定一個列表的長度`s`位於序列兩個元素之間，即`h<sub>k-1</sub> < h<sub>k</sub> ≤ s < h<sub>k+1</sub>`，如果`h<sub>k</sub> ≤ <math>\tfrac {n}{m}</math>·s`，這裡的`n ≤ m`，則選擇初始間隔為`h<sub>k</sub>`，否則為`h<sub>k-1</sub>`。在這個閾值下，對於不同長度`s`的列表和對應的初始間隔`h`，每個列表的這些初始子列表的平均長度`<math>\tfrac{s}{h}</math>`，約在`<math>\tfrac{m}{n}</math> ≤ <math>\tfrac{s}{h}</math> < <math>\tfrac{9}{4}</math>·<math>\tfrac{m}{n}</math>`範圍之內。間隔序列還可以採用OEIS A102549，它是Marcin Ciura在2001年通過實驗得到的。希爾排序還可以採用Ciura提出的間隔序列：

```sml
    val incs = [1750, 701, 301, 132, 57, 23, 10, 4, 1]
    val gap = let
        fun loop (acc, i) = let
            val h = (i * 4 - 1) div 9
            fun iter incs =
                  if i >= (hd incs) * 4 div 3 then incs
                  else iter (tl incs)
            in
                if i <= ((hd incs) * 3)
                then List.revAppend (acc, iter incs) 
                else loop (h :: acc, h)
            end
        in  
            if len = 0 then [1]
            else loop ([], len)
        end
```

#### 快速排序

下面是快速排序算法的自頂向下實現：

```sml
fun quickSort [] = []
  | quickSort [x] = [x]
  | quickSort [x, y] =
      if x <= y then [x, y] else [y, x]
  | quickSort [x, y, z] = let
    val (x, y) = if x <= y then (x, y) else (y, x)
    val (y, z) = if y <= z then (y, z) else (z, y)
    val (x, y) = if x <= y then (x, y) else (y, x)
    in
        [x, y, z]
    end
  | quickSort (pivot :: xs) = let
    fun partition pred l = let
        fun loop ([], p, q) = (p, q)
          | loop (h :: t, p, q) =
              if (pred h) 
              then loop (t, h :: p, q)
              else loop (t, p, h :: q)
        in
            loop (l, [], [])
        end
    val (le, gt) = partition (fn x => (x <= pivot)) xs
    in  
        (quickSort le) @ (pivot :: (quickSort gt))
    end
```

基本庫`partition`函數實現對快速排序而言有不必要的反轉，劃分函數的實際實現：

```sml
fun partition pred l = let
    fun loop ([], trueList, falseList) =
          (rev trueList, rev falseList)
      | loop (h :: t, trueList, falseList) =
          if pred h then loop (t, h :: trueList, falseList)
          else loop (t, trueList, h :: falseList)
    in
	    loop (l, [], [])
    end
```

這裡採用了它的簡化改寫。在ML中快速排序應採用自底向上實現：

```sml
fun quickSort l = let 
    fun partition pred l = let
        fun loop ([], p, q) = (p, q)
          | loop (h :: t, p, q) =
              if (pred h) 
              then loop (t, h :: p, q)
              else loop (t, p, h :: q)
        in
            loop (l, [], [])
        end
    fun iterate (acc, []) = acc
      | iterate (acc, [] :: xs) = iterate (acc, xs)
      | iterate (acc, [x] :: xs) = iterate (x :: acc, xs)
      | iterate (acc, [x, y] :: xs) = let
        val (x, y) = if x <= y then (x, y) else (y, x) 
        in
            iterate (x :: y :: acc, xs)
        end
      | iterate (acc, [x, y, z] :: xs) = let
        val (x, y) = if x <= y then (x, y) else (y, x)
        val (x, y, z) =
              if y <= z then (x, y, z)
              else if x <= z then (x, z, y)
              else (z, x, y)
        in
            iterate (x :: y :: z :: acc, xs)
        end
      | iterate (acc, (pivot :: d) :: xs) = let
        val (le, gt) = partition (fn x => (x <= pivot)) d
        in
            iterate (acc, gt :: [pivot] :: le :: xs) 
        end       
    in
        iterate ([], [l])
    end
```

#### 歸併排序

下面是歸併排序算法的自底向上法實現：

```sml
fun mergeSort l = let
    fun init (acc, []) = acc
      | init (acc, [x]) = [x] :: acc
      | init (acc, [x, y]) =
          if x <= y then [x, y] :: acc else [y, x] :: acc
      | init (acc, x :: y :: z :: xs) = let
        val (x, y, z) =
              if x <= y then
                  if y <= z then (x, y, z)
                  else if x <= z then (x, z, y)
                  else (z, x, y)
              else 
                  if x <= z then (y, x, z)
                  else if y <= z then (y, z, x)
                  else (z, y, x)
        in
            init ([x, y, z] :: acc, xs)
        end
    fun mergeWith _ (acc, [], []) = acc
      | mergeWith _ (acc, p, []) = List.revAppend (p, acc)  
      | mergeWith _ (acc, [], q) = List.revAppend (q, acc)
      | mergeWith cmp (acc, p :: ps, q :: qs) =
          if cmp (p, q)
          then mergeWith cmp (p :: acc, ps, q :: qs)
          else mergeWith cmp (q :: acc, p :: ps, qs)
    val mergeRev = mergeWith (fn (x, y) => (x > y))
    val revMerge = mergeWith (fn (x, y) => (x < y))
    fun iterate ([], _) = []
      | iterate ([x], isRev) =
          if isRev then rev x else x
      | iterate (acc, isRev) = let      
        val merge = if isRev then mergeRev else revMerge
        fun loop (acci, []) = acci
          | loop (acci, [x]) = (rev x) :: acci 
          | loop (acci, x :: y :: xs) = 
              loop (merge ([], x, y) :: acci, xs)
        in
            iterate (loop ([], acc), not isRev)
        end
    in
        iterate (init ([], l), false)
    end
```

考慮輸入列表`[x<sub>1</sub>, ..., x<sub>i</sub>, a<sub>0</sub>, ..., a<sub>9</sub>, x<sub>j</sub>, ..., x<sub>n</sub>]`，這裡在`x<sub>i</sub>`和`x<sub>j</sub>`之間的`10`個`a`，具有相同的值並且需要保持其下標表示的次序，這裡的`x<sub>i</sub> > a`並且`x<sub>j</sub> < a`，並且在這個區段前後的元素總數都能被`3`整除，則它被分解成子列表的列表`[X<sub>m</sub>, ..., [x<sub>j</sub>, a<sub>8</sub>, a<sub>9</sub>], [a<sub>5</sub>, a<sub>6</sub>, a<sub>7</sub>], [a<sub>2</sub>, a<sub>3</sub>, a<sub>4</sub>], [a<sub>0</sub>, a<sub>1</sub>, x<sub>i</sub>], ..., X<sub>1</sub>]`，這裡有`m = n div 3`；假定這`4`個含有`a`的子列表兩兩歸併，在歸併正序子列表的歸併條件`x < y`下，能得到`[X<sub>1</sub>, ..., [x<sub>i</sub>, a<sub>4</sub>, ..., a<sub>0</sub>], [a<sub>9</sub>, ..., a<sub>5</sub>, x<sub>j</sub>], ..., X<sub>k</sub>]`；繼續推演下去，在歸併反序子列表的歸併條件`x > y`下，能得到`[X<sub>h</sub>, ..., [x<sub>j</sub>, a<sub>0</sub>, ..., a<sub>9</sub>, x<sub>i</sub>], ..., X<sub>1</sub>]`。可以看出這種歸併操作能夠保證排序算法的穩定性，即具有相同值的元素之間的相對次序保持不變。

分解初始的子列表採用了插入排序，還可進一步增加其大小。歸併排序也有自頂向下實現。歸併排序算法的自頂向下實現：

```sml
fun mergeSort l = let
    fun sort ([], _) = []
      | sort ([x], _) = [x]
      | sort ([x, y], _) =
          if x <= y then [x, y] else [y, x]
      | sort ([x, y, z], _) =
          if x <= y then
              if y <= z then [x, y, z]
              else if x <= z then [x, z, y] 
              else [z, x, y]
          else 
              if x <= z then [y, x, z]
              else if y <= z then [y, z, x]
              else [z, y, x] 
      | sort (l, n) = let
        val m = n div 2
        fun split (l, acc, i) = 
              if i = 0 then (rev acc, l)
              else split (tl l, (hd l) :: acc, i - 1)
        fun merge (p, q) = let
            fun revMerge (acc, p, q) =
                  if not (null p) andalso not (null q) then
                      if (hd p) <= (hd q)
                      then revMerge ((hd p) :: acc, tl p, q)
                      else revMerge ((hd q) :: acc, p, tl q)
                  else if null p 
                  then List.revAppend (q, acc)
                  else List.revAppend (p, acc)
            in
                rev (revMerge ([], p, q))
            end
        val (ls, rs) = split (l, [], m)
        in
            merge (sort (ls, m), sort (rs, n - m))
        end
    in
        sort (l, length l)
    end
```

#### 堆排序

下面是堆排序的基於陣列的實現：

```sml
fun heapSort l = let
    val h = Array.fromList l
    val len = Array.length h
    fun get i = Array.sub (h, i)
    fun set i v = Array.update (h, i, v)
    fun siftdown (i, ins, n) = let
        fun sift k = let
            val l = k * 2 + 1
            val r = l + 1
            in 
                if (r < n) andalso
                   (get r) > (get l) then r
                else if (l < n) then l
                else k
            end
        fun loop i = let
            val j = sift i
            in
                if j = i orelse (get j) <= ins
                then set i ins
                else (set i (get j); loop j)
            end
        in
            loop i    
        end
    fun heapify () = let
        fun loop i =
              if i < 0 then ()
              else (siftdown (i, get i, len);
                    loop (i - 1))
        in
            loop (len div 2 - 1)
        end
    fun generate () = let
        fun loop (acc, i) = let
            val t = get 0
            in
               if i <= 0 then t :: acc
               else (siftdown (0, get i, i);
                     loop (t :: acc, i - 1))
            end
        in  
            if len = 0 then []
            else loop ([], len - 1)
        end
    in
        heapify (); 
        generate ()
    end
```

在陣列實現中，`siftdown`函數融合了插入和篩選功能，它首先在暫時位於堆頂的要插入的元素，和從堆頂節點左右子堆的兩個堆頂元素中篩選出的那個元素，二者中選擇出哪個適合作堆頂元素；如果要插入元素適合，則以它為新堆頂元素而結束整個過程，否則以篩選出元素為新堆頂元素，並自頂向下逐級處理提供了新堆頂元素的子堆，將要插入元素暫時作為其堆頂元素並對它繼續進行`siftdown`；`siftdown`只要到達了某個堆底，就插入要插入的元素而結束整個過程。

在提取堆頂元素生成結果列表時，先提取走堆頂元素的內容，再摘掉最後的堆底元素將它的內容暫時放置在堆頂，這時堆的大小也相應的減一，隨後的`siftdown`函數，篩選出新的堆頂元素，並把原最後堆底元素插入回堆中。

在`heapify`函數建造堆的時候，首先自列表中間將元素分為前後兩組，後組中的元素被視為只有一個元素的堆，然後從後往前處理前組中的元素，這時它的左右子節點已經是已有的堆或者為空，在其上進行`siftdown`，從而合成一個新堆。建造堆也可以採用`siftup`函數來實現，它自第二個元素開始從前往後逐個處理列表元素，其前面是已有的堆，將這個新元素自堆底向上插入到這個堆中。堆排序算法的陣列實現中，堆建造函數`heapify`也可以使用`siftup`函數的陣列來完成，它將新節點自堆底向上插入到合適的位置，而不對途徑節點左右子樹頂點進行比較：

```sml
    fun siftup i = let
        val ins = get i
        fun loop i = let
            val j = (i - 1) div 2 
            in
                if i <= 0 orelse (get j) >= ins
                then set i ins
                else (set i (get j); loop j)
            end
        in
            loop i    
        end  
    fun heapify () = let
        fun loop i =
              if i > (len - 1) then ()
              else (siftup i; loop (i + 1))
        in
            loop 1
        end
```

堆排序算法也可以使用二叉樹數據結構來實現二叉堆：

```sml
fun heapSort l = let
    datatype 'a heap
      = Nil 
      | Leaf of 'a
      | Node of 'a * int * 'a heap * 'a heap
    fun key Nil = 
          let val SOME a = Int.minInt in a end
      | key (Leaf k) = k
      | key (Node (k, _, _, _)) = k
    fun count Nil = 0
      | count (Leaf _) = 1
      | count (Node (_, c, _, _)) = c
    fun left Nil = Nil
      | left (Leaf _) = Nil
      | left (Node (_, _, l, _)) = l 
    fun insert (Nil, x) = Leaf x
      | insert (Leaf k, l) = 
          if l >= k
          then Node (l, 2, Leaf k, Nil)
          else Node (k, 2, Leaf l, Nil)
      | insert (Node (k, _, Leaf l, Nil), r) = 
          if r >= k 
          then Node (r, 3, Leaf k, Leaf l)
          else if r >= l
          then Node (k, 3, Leaf r, Leaf l)
          else Node (k, 3, Leaf l, Leaf r)
      | insert (Node (k, c, l, r), x) = let
        val (k, x) = 
              if k >= x then (k, x) else (x, k) 
        in      
            if (count l) <= (count r)
            then Node (k, c + 1, insert (l, x), r) 
            else if x >= (key l)
            then Node (k, c + 1, insert (r, x), l)
            else Node (k, c + 1, l, insert (r, x))
        end
    fun extract Nil = Nil
      | extract (Leaf _) = Nil
      | extract (Node (_, _, l, Nil)) = l
      | extract (Node (_, c, l, r)) = let
        val k = key l
        val n = left l 
        in
            if n = Nil
            then Node (k, c - 1, r, Nil)
            else if (key n) >= (key r)
            then Node (k, c - 1, extract l, r)
            else Node (k, c - 1, r, extract l)
        end
    fun heapify () = let
        fun loop (acc, []) = acc
          | loop (acc, x :: xs) =
              loop (insert (acc, x), xs)  
        in
            loop (Nil, l)
        end
    fun generate h = let
        fun loop (acc, Nil) = acc
          | loop (acc, h) =
              loop ((key h) :: acc, extract h)
        in
            loop ([], h)
        end           
    in
        generate (heapify ())
    end
```

二叉樹實現不能直接訪問堆底元素，從而不適宜通過摘掉它使堆的大小減一。這裡的`insert`函數，在原堆頂元素和要插入元素中選擇適合者作為新的堆頂元素，將落選的另一個元素作為新的要插入元素，插入到利於保持這個堆平衡的那個子樹之中。這裡的`extract`函數隻篩選不插入，它將堆的大小減一。

這裡的`insert`和`extract`函數也可以直接轉寫為等價的尾遞歸形式，與列表情況不同，只要樹結構能保持良好的平衡，採用尾遞歸形式就沒有太大的必要性。在堆排序算法的二叉樹實現中，樹插入和提取函數也可以寫為等價的尾遞歸形式代碼：

```sml
    exception Err;   
    fun revLink ([], t) = t
      | revLink (Nil :: xs, t) = revLink (xs, t)   
      | revLink ((Leaf k) :: xs, t) = 
          revLink (xs, Node (k, (count t) + 1, t, Nil))
      | revLink (Node (k, c, Nil, r) :: xs, t) = 
          revLink (xs, Node (k, c, t, r)) 
      | revLink (Node (k, c, l, Nil) :: xs, t) = 
          revLink (xs, Node (k, c, l, t))
      | revLink (_ :: xs, t) = raise Err        
    fun insert (t, x) = let    
        fun loop (acc, Nil, x) = revLink (acc, Leaf x)
          | loop (acc, Leaf k, l) = 
              if l >= k
              then revLink (acc, Node (l, 2, Leaf k, Nil))
              else revLink (acc, Node (k, 2, Leaf l, Nil))
          | loop (acc, Node (k, _, Leaf l, Nil), r) = 
              if r >= k 
              then revLink (acc, Node (r, 3, Leaf k, Leaf l))
              else if r >= l
              then revLink (acc, Node (k, 3, Leaf r, Leaf l))
              else revLink (acc, Node (k, 3, Leaf l, Leaf r))
          | loop (acc, Node (k, c, l, r), x) = let
            val (k, x) = 
                  if k >= x then (k, x) else (x, k) 
            in      
                if (count l) <= (count r)
                then loop (Node (k, c + 1, Nil, r) :: acc, l, x) 
                else if x >= (key l)
                then loop (Node (k, c + 1, Nil, l) :: acc, r, x)
                else loop (Node (k, c + 1, l, Nil) :: acc, r, x)
            end
        in 
            loop ([], t, x)
        end
    fun extract t = let
        fun loop (acc, Nil) = revLink (acc, Nil)
          | loop (acc, Leaf _) = revLink (acc, Nil)
          | loop (acc, Node (_, _, l, Nil)) = revLink (acc, l)
          | loop (acc, Node (_, c, l, r)) = let
            val k = key l
            val n = left l 
            in
                if n = Nil
                then revLink (acc, Node (k, c - 1, r, Nil))
                else if (key n) >= (key r)
                then loop (Node (k, c - 1, Nil, r) :: acc, l)
                else loop (Node (k, c - 1, r, Nil) :: acc, l)
            end
        in 
            loop ([], t)    
        end
```

在二叉樹實現下，也可以採用`siftdown`函數來初始建造堆，而不需要在節點中保存關於樹狀態的統計資訊。堆排序算法的二叉樹實現中，堆建造函數也可以主要採用`siftdown`函數來完成，這裡不需要在節點中保存關於樹狀態的統計資訊：

```sml
fun heapSort l = let
    datatype 'a heap
      = Nil 
      | Node of 'a * 'a heap * 'a heap
    fun key Nil = 
          let val SOME a = Int.minInt in a end
      | key (Node (k, _, _)) = k
    fun left Nil = Nil
      | left (Node (_, l, _)) = l
    fun right Nil = Nil
      | right (Node (_, _, r)) = r
    fun leaf k = Node (k, Nil, Nil)     
    fun sift (l, r) =
          if l <> Nil andalso r <> Nil then
              if (key l) >= (key r) then l else r
          else if l <> Nil then l
          else if r <> Nil then r
          else Nil
    fun siftdown (x, l, r) = let
        val superior = sift (l, r)
        in
            if superior = Nil then Node (x, Nil, Nil)
            else if x >= (key superior) then Node (x, l, r) 
            else if superior = l
            then Node (key l, siftdown (x, left l, right l), r)
            else Node (key r, l, siftdown (x, left r, right r))
        end
    fun insert (Nil, x) = Node (x, Nil, Nil)
      | insert (Node (k, l, r), x) = let
        val superior = sift (l, r)
        in
           if x >= k andalso superior = l
           then Node (x, l, insert (r, k))
           else if x >= k
           then Node (x, insert (l, k), r)
           else if superior = l
           then Node (k, l, insert (r, x))
           else Node (k, insert (l, x), r)
        end
    fun extract Nil = Nil
      | extract (Node (_, l, r)) = let
        val superior = sift (l, r)
        in
            if superior = Nil then Nil
            else if superior = l
            then Node (key l, extract l, r)
            else Node (key r, l, extract r)
        end
    fun join (l, r) = extract (Node (key Nil, l, r))
    fun heapify () = let
        fun init (hs, ls, [], _) = (hs, ls)
          | init (hs, ls, x :: xs, flag) =
              if flag 
              then init ((leaf x) :: hs, ls, xs, false)
              else init (hs, x :: ls, xs, true)
        val (hs, ls) = init ([], [], l, true)
        fun loop ([], [], []) = Nil
          | loop ([], [h], []) = h
          | loop ([], [], x :: xs) = 
              loop ([], [leaf x], xs)
          | loop ([], [h], x :: xs) = 
              loop ([], [insert (h, x)], xs)    
          | loop (acc, [], l) =
              loop ([], acc, l)
          | loop (acc, [h], l) = 
              loop ([], h :: acc, l)
          | loop (acc, l :: r :: hs, []) =
              loop (join (l, r) :: acc, hs, [])
          | loop (acc, l :: r :: hs, x :: xs) =
              loop (siftdown (x, l, r) :: acc, hs, xs)  
        in  
            loop ([], hs, ls)
        end
    fun generate h = let
        fun loop (acc, Nil) = acc
          | loop (acc, h) =
              loop ((key h) :: acc, extract h)
        in
            loop ([], h)
        end           
    in
        generate (heapify ())
    end
```

稍加處理，堆建造函數也可以只用`siftdown`函數來完成：

```sml
    fun heapify () = let
        exception Err;
        fun split () = let
            val (rs, ts) = let
                  fun loop (acci, accj, [], i, n) =
                        if i = n 
                        then (List.revAppend (accj, acci), [])
                        else (acci, accj)
                    | loop (acci, accj, x :: xs, i, n) =  
                        if i = n
                        then loop (List.revAppend (accj, acci),
                                   [x], xs, i + 1, n * 2 + 1)
                        else loop (acci, x :: accj, xs, i + 1, n)
                  in
                      loop ([], [], l, 0, 1)
                  end
            fun loop (hs, ls, [], _) = (hs, ls, ts)
              | loop (hs, ls, x :: xs, flag) =
                  if flag 
                  then loop (x :: hs, ls, xs, false)
                  else loop (hs, x :: ls, xs, true)
            in
                loop ([], [], rs, true)
            end
        fun init () = let 
            val (hs, ls, ts) = split ()
            fun loop (acc, [], []) = (acc, ls)
              | loop (acc, [], ts) =
                  (acc, List.revAppend (ts, ls))
              | loop (acc, k :: hs, []) =
                  loop ((leaf k) :: acc, hs, []) 
              | loop (acc, k :: hs, [x]) = let
                val (k, x) = 
                      if k >= x then (k, x) else (x, k)  
                in
                   loop (Node (k, leaf x, Nil) :: acc, hs, [])
                end
              | loop (acc, k :: hs, l :: r :: rs) = let
                val (k, l, r) = 
                      if k >= l then
                          if l >= r then (k, l, r)
                          else if k >= r then (k, r, l)
                          else (r, k, l)
                      else
                          if k >= r then (l, k, r)
                          else if l >= r then (l, r, k)
                          else (r, l, k)
                in 
                    loop (Node (k, leaf l, leaf r) :: acc, hs, rs)
                end                   
            in  
                loop ([], hs, ts)                
            end
        val (hs, ls) = init ()
        fun loop ([], [], []) = Nil
          | loop ([], [h], []) = h
          | loop ([], [], _) = raise Err
          | loop ([], [h], _) = raise Err
          | loop (acc, [], l) = 
              loop ([], acc, l)
          | loop (acc, [h], l) =
              loop ([], h :: acc, l)
          | loop (acc, l :: r :: hs, []) = raise Err
          | loop (acc, l :: r :: hs, x :: xs) =
              loop (siftdown (x, l, r) :: acc, hs, xs)   
        in  
            loop ([], hs, ls)
        end
```

#### 基數排序

下面是針對非負整數的基數排序算法的實現：

```sml
fun radixSort l = let
    fun distribute (l, d) = let
        val t0 = ([], [], [], [], [], [], [], [])
        fun loop (t, []) = let
            fun join (acc, i) = let
                val f = case i 
                      of 1 => (#1 t) | 2 => (#2 t) | 3 => (#3 t)
                       | 4 => (#4 t) | 5 => (#5 t) | 6 => (#6 t) 
                       | 7 => (#7 t) | 8 => (#8 t) | _ => []
                in
                    if i <= 0 then acc      
                    else join (List.revAppend (f, acc), i - 1)         
                end
            in
                join ([], 8)
            end      
          | loop (t, x :: xs) = let
            val (f0, f1, f2, f3, f4, f5, f6, f7) = t
            val t = case ((x div d) mod 8)
                  of 0 => (x :: f0, f1, f2, f3, f4, f5, f6, f7)
                   | 1 => (f0, x :: f1, f2, f3, f4, f5, f6, f7)
                   | 2 => (f0, f1, x :: f2, f3, f4, f5, f6, f7)
                   | 3 => (f0, f1, f2, x :: f3, f4, f5, f6, f7)
                   | 4 => (f0, f1, f2, f3, x :: f4, f5, f6, f7)
                   | 5 => (f0, f1, f2, f3, f4, x :: f5, f6, f7)
                   | 6 => (f0, f1, f2, f3, f4, f5, x :: f6, f7)
                   | 7 => (f0, f1, f2, f3, f4, f5, f6, x :: f7)
                   | _ => t0
            in
                loop (t, xs)
            end       
        in
            loop (t0, l)
        end
    val SOME maxInt = Int.maxInt
    val max = foldl (fn (x, y) => if x > y then x else y) 0 l
    fun iterate (l, d) = let
        val l' = distribute (l, d)
        in
            if d >= (maxInt div 8 + 1) orelse
               ((max div d) div 8) = 0 then l'  
            else iterate (l', d * 8)
        end
    in
        iterate (l, 1) 
    end
```

這裡採用的基數是`2`的`3`次冪`8`，代碼所使用的列表元組大小與基數大小成正比，運算量與列表中元素的總數與最大數的位數的乘積成正比。

### 隨機數生成

編寫排序算法進行測試除了使用簡單的數列，排序算法的簡單測試代碼：

```sml
fun printIntList (l: int list) =
      print ((String.concatWith " " (map Int.toString l)) ^ "\n")
fun shuffle (l, n) = let
    fun split (l, acc, i) = 
          if i = 0 then (acc, l)
          else split (tl l, (hd l) :: acc, i - 1)
    fun zip (acc, p, q, flag) =
          if null p then List.revAppend (q, acc)
          else if null q then List.revAppend (p, acc)
          else if flag then zip ((hd p) :: acc, tl p, q, false)
          else zip ((hd q) :: acc, p, tl q, true)
    val (p, q) = split (l, [], n div 2)
    in
        if (null l) then tl [0]
        else zip ([], p, q, true)
    end
fun testsort f n = let
    fun loop (acc, i) =
          if (i <= 0) then acc
          else loop (i :: acc, i - 1)
    val sl = shuffle (loop ([], n), n)
    val ssl = shuffle (sl, n) 
    in
        print ("source list is: ");
        printIntList ssl; 
        print ("result list is: ");
        printIntList (f ssl)
    end
```

測試用列表還可以使用線性同餘偽隨機數函數來生成：

```sml
fun randList (n, seed) = let
    val randx = ref seed
    fun lcg () = (randx := (!randx * 421 + 1663) mod 7875; !randx) 
    (* fun lcg () = (randx := (!randx * 1366 + 150889) mod 714025; !randx) *)
    fun iterate (acc, i) =
          if i <= 0 then acc
          else iterate (lcg () :: acc, i - 1)
    in
        iterate ([], n)
    end
```

### 語言解釋器

定義和處理一個小型表達式語言是相對容易的：

```sml
exception Err;
 
datatype ty
  = IntTy
  | BoolTy
 
datatype exp
  = True
  | False
  | Int of int
  | Not of exp
  | Add of exp * exp
  | If of exp * exp * exp
 
fun typeOf (True) = BoolTy
  | typeOf (False) = BoolTy
  | typeOf (Int _) = IntTy
  | typeOf (Not e) = 
      if typeOf e = BoolTy
      then BoolTy
      else raise Err
  | typeOf (Add (e1, e2)) = 
      if (typeOf e1 = IntTy) andalso (typeOf e2 = IntTy)
      then IntTy
      else raise Err
  | typeOf (If (e1, e2, e3)) = 
      if typeOf e1 <> BoolTy
      then raise Err
      else if typeOf e2 <> typeOf e3 then raise Err
      else typeOf e2

fun eval (True) = True
  | eval (False) = False
  | eval (Int n) = Int n
  | eval (Not e) = (case eval e
      of True => False
       | False => True
       | _ => raise Fail "type-checking is broken")
  | eval (Add (e1, e2)) = let
    val (Int n1) = eval e1
    val (Int n2) = eval e2
    in
        Int (n1 + n2)
    end
  | eval (If (e1, e2, e3)) = 
      if eval e1 = True
      then eval e2
      else eval e3
 
fun exp_repr e = let
    val msg = case e
         of True  => "True"
          | False => "False"
          | Int n => Int.toString n
          | _ => ""     
    in
        msg ^ "\n"
    end
    
(* 忽略TypeOf的返回值，它在类型错误时发起Err *) 
fun evalPrint e = (ignore (typeOf e); print (exp_repr (eval e)));
```

將這段代碼錄入文件比如`expr-lang.sml`，並在命令行下執行`sml expr-lang.sml`，可以用如下在正確類型的和不正確類型上運行的例子，測試這個新語言：

```sml
- val e1 = Add (Int 1, Int 2);  (* 正确的类型 *)
val e1 = Add (Int 1,Int 2) : exp
- val _ = evalPrint e1;
3
- val e2 = Add (Int 1, True);   (* 不正确的类型 *)
val e2 = Add (Int 1,True) : exp
- val _ = evalPrint e2;

uncaught exception Err
  raised at: expr-lang.sml:25.20-25.23
```

## 參見

- SML/NJ，由普林斯頓大學和貝爾實驗室聯合開發的實現，它具有工具ML-Lex、ML-Yacc和並發編程擴展Concurrent ML。
- MLton，嚴格遵循標準定義的強力的過程間優化編譯器，它具有工具MLLex、MLYacc和MLNLFFIGen。
- HaMLet，是一個SML解釋器，由Andreas Rossberg在馬克斯·普朗克軟體系統研究所（MPI-SWS）編寫，意圖成為精確且無障礙的標準定義參考實現。
- LunarML，產生Lua/JavaScript代碼的Standard ML編譯器。
- OCaml，由法國國家資訊與自動化研究所（INRIA）維護，是一個「工業強度」的ML方言，演化自最初用來實現Coq定理證明器的Caml。
- Alice (programming language)，由薩爾蘭大學設計的Alice ML，是基於Standard ML的函數式程式語言，擴展了對並發、分布式和約束式編程的豐富支持。
- ATS (程式語言)，由波士頓大學的Hongwei Xi和卡內基·梅隆大學的Frank Pfenning提出的Dependent ML發展而來，它向ML擴展了依賴類型。
- F#，由微軟研究院（MSR）開發，是一個基於OCaml的一個以.NET為目標的程式語言。
- F*，由MSR和INRIA主導開發，是一個基於ML的依賴類型函數式程式語言。
- Futhark，由哥本哈根大學UCPH電腦科學系（DIKU）開發，是屬於ML家族的一個函數式、數據並行、陣列程式語言。
- Ur，由麻省理工學院的Adam Chlipala開發，是語法基於Standard ML的專門用於web開發的一個函數式程式語言。
- CM-Lex和CM-Yacc，由卡內基·梅隆大學的Karl Crary開發，是用於Standard ML、OCaml和Haskell的詞法分析器和語法解析器。

## 基本資料

- 日語原文：ML
- 編程范型：多范型：函數式，指令式
- 發行時間：1973年
- 設計者：羅賓·米爾納及愛丁堡大學其他人
- 軟體版本週期： Standard ML '97
- 軟體版本週期：1997年
- 類型系統：類型推論，靜態類型，強類型
- dialects：Standard ML, OCaml
- 受影響於：ISWIM，PAL，POP-2，GEDANKEN
- 施影響於：Clojure、Coq、Cyclone (程式語言)、C++、Elm、Futhark、F#、F*、Haskell、Idris、Lazy ML、Miranda、Nemerle、OCaml、Opa (程式語言)、Rust、Scala、Standard ML、Ur
- wikibooks：Standard ML Programming