ML語言

来自维基百科,自由的百科全书

MLMeta Language:元語言),是一個函數式指令式通用程式語言,它著稱於使用了多態Hindley–Milner類型推論[8]。ML能自動的指定多數表達式英語Expression (computer science)類型,不要求顯式的類型標註,而且能夠確保類型安全,已經正式證明了有良好類型的ML程序不會導致運行時間類型錯誤[8]

快速預覽 編程範型, 設計者 ...
ML
編程範型多范型函數式指令式
設計者羅賓·米爾納愛丁堡大學其他人
面市時間1973年,​52年前​(1973
型態系統類型推論靜態類型強類型
衍生副語言
Standard ML, OCaml
受影響於
ISWIM[1]PAL[2]POP-2[1],GEDANKEN[1]
影響語言
ClojureCoqCyclone英語Cyclone (programming language)C++Elm[3]Futhark[4]F#F*HaskellIdris、Lazy ML[5]MirandaNemerle[6]OCamlOpa英語Opa (programming language)RustScalaStandard MLUr[7]
關閉

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

歷史

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

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

在1981年,INRIAGérard Huet英語Gérard Huet,將最初的LCF ML適配到Multics系統的Maclisp下,並且增加了編譯器[15]。這個實現被描述於INRIA內部文檔「ML手冊」之中[16],它被開發者自稱為「Le_ML」[17]劍橋大學Lawrence Paulson英語Lawrence Paulson在1985年用它開發了基於Franz Lisp的Cambridge LCF[18],進而劍橋大學Michael J. C. Gordon英語Michael J. C. Gordon又用它開發了基於Common LispHOL88英語HOL (proof assistant)[19][a]

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

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

在1990年,Robin MilnerMads Tofte英語Mads TofteRobert Harper英語Robert Harper (computer scientist)制定的Standard ML的正式規定《The Definition of Standard ML》最終完成[31];在1997年,這個標準規定增補了David MacQueen為作者並進行了修訂[32]。在1989年,Mads Tofte英語Mads Tofte、Nick Rothwell和David N. Turner於愛丁堡大學開始開發ML Kit編譯器,為了強調清晰性而非高效,將標準定義直接轉譯成一組Standard ML模塊;在1992年和1993年期間,主要通過愛丁堡大學的Nick Rothwell和哥本哈根大學計算機科學系英語UCPH Department of Computer Science(DIKU)的Lars Birkedal的工作[33],ML Kit第一版完成並開源發行[34]

在1987年,INRIA的Ascánder Suárez,基於巴黎第七大學Guy Cousineau法語Guy Cousineau的「範疇抽象機器英語Categorical abstract machine」(CAM)[35],利用Le Lisp的運行時間系統重新實現了Le_ML,並正式命名為Caml[15]。在1990年和1991年,INRIAXavier Leroy英語Xavier Leroy基於用C實現的字節碼解釋器[36],利用Damien Doligez英語Damien Doligez提供的內存管理系統重新實現了Caml,並稱其為Caml Light[37]。在1995年,Xavier Leroy又增加了機器代碼編譯器和高層模塊系統[38],這個版本也稱為「Caml Special Light」。在1996年,INRIA的Didier Rémy和Jérôme Vouillon,向Caml Special Light增加了物件導向特徵[39],從而形成了OCaml[40]

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

解釋與編譯

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

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

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

- 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解釋器下執行它:

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

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

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

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

$ 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書寫的程序構成自要被求值的表達式英語Expression (computer science),而非語句或命令,儘管一些表達式返回一個平凡的unit值並且只為其副作用而求值。以下章節介紹採用Standard ML的語法和語義。

函數

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

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,它是可選也可忽略的。使用類型標註,這個例子可重寫為如下:

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

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

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

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

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

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

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

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

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

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標準基本庫中預先定義的,並且語言為它們提供文字英語Literal (computer programming)表示法,比如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短路求值的中綴算符andalsoorelse

包括上述基本類型的各種類型可以用多種方式組合。一種方式是元組,它是值的有序集合,比如表達式(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) * intint * (int * int)

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

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

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的函數sumaverage。第二段創建中綴算子averaged_with,接著定義它為類型int * int -> int的函數。最後的int_pair函數的類型是int -> int * int

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

fun pair x = (x, x)

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

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

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

等式類型

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

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

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

類型聲明

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

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數據類型可以被當作是元組不交並英語Product type)。數據類型使用datatype關鍵字來定義,比如:

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

這個數據類型聲明建立一個全新的數據類型int_or_string,還有一起的新構造子(一種特殊函數或值)INTSTRINGNEITHER;每個這種類型的值都是要麼INT具有一個整數,要麼STRING具有一個字符串,要麼NEITHER。寫為如下這樣:

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

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

數據類型可以是多態的:

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

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

數據類型可以是遞歸的:

datatype int_list
  = EMPTY
  | INT_LIST of int * int_list

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

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

列表

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

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的簡單應用:

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實現的模式窮盡性檢查和模式冗餘檢查。

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

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綁定了四個變量mnrs;第二個val綁定了一個變量url;第三個val綁定了三個變量portaddrname,第四個叫分層模式,綁定了三個變量xfstsnd

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

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)模式。所謂的「子句形式」風格的函數定義,這裡的模式緊隨在函數名字之後出現,只是如下形式的一種語法糖

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

模式窮盡性檢查將確保數據類型的每個情況都已經顧及到。[b] 如果有遺漏,則產生警告。[c] 如果模式存在冗餘,也會導致一個編譯時間警告。[d]

高階函數

函數可以接受函數作為實際參數,比如:

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

函數可以產生函數作為返回值,比如:

fun constantFn k = (fn anything => k)

函數可以同時接受和產生函數,比如複合函數英語Function composition (computer science)

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

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

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

在基本庫中將函數複合定義為多態中綴算符(f o g)mapfold高階函數有較高效率的實現。[e]

例外

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

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

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

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

Zero0情況下發起,控制從函數p中一起出離。

引用

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

datatype 'a ref = ref of 'a

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

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的標準庫被實現為這種方式的模塊。

例如,下列定義一個算術簽名:

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文件中。下面是這個簽名使用有理數的實現:

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中這個結構的簡單用例:

- 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

要用有理數進行實際上的數值計算,需要處理分數形式中分母快速增大導致溢出整數類型大小範圍等問題。[f]

函子

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

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文件。

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.sigrational.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的語法和語義。

素數

下面是求素數試除法實現:

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

基本庫findexists函數在不存在符合條件元素的時候會遍歷整個列表,[g] 這裡採用了特殊化了的existsDivisor,用以在後續元素都不滿足條件時立即結束運算。

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

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

這裡基於列表的篩法實現符合埃拉托斯特尼的原初算法[42]篩法還有基於數組的直觀實現。[h] 下面是其解釋器下命令行運行實例:

- 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

漢明數

正規數是形如整數,對於非負整數,它是可以整除的數。計算升序的正規數的算法經由戴克斯特拉得以流行[43]理察·漢明最初提出了這個問題,故而這個問題被稱為「漢明問題」,這個數列也因而被稱為漢明數。Dijkstra計算這些數的想法如下:

  • 漢明數的序列開始於數1
  • 要加入序列中的數有下述形式:2h, 3h, 5h,這裡的h是序列已有的任意的漢明數。
  • 因此,可以生成最初只有一個1的序列H,並接著歸併英語Merge algorithm序列2H, 3H, 5H,並以此類推。

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

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

產生指定範圍內的漢明數需要多輪運算,後面每輪中的三個列表元素乘積運算中都可能產生超出這個範圍的結果,它們不需要出現在後續的運算之中。[i] 基本庫mapPartial函數與它所映射的函數,通過基於Option結構的SOMENONE構造子的協定,可以將所映射函數認為不符合條件的元素或者結果排除掉,它會遍歷整個列表。[j] 由於這個算法採用升序列表,故而這裡將它改寫為mapPrefix函數,用來在特定條件不滿足條件就立即結束。下面是漢明數程序在解釋器下命令行運行實例:

- 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)[45]高階函數foldrmap的實現,和達成一個整數列表的合計函數的簡單用例:

fun foldr' f b l = let
    fun f2 ([], k) = k b
      | f2 (a :: r, k) =
          f2 (r, fn x => k (f (a, x)))
    in
        f2 (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

對於輸入[e1, e2, ..., en]sum函數等價於函數複合(fn x => x) o (fn x => e1 + x) o (fn x => e2 + x) o ... o (fn x => en + x),它應用於0上得到(e1 + (e2 + (... + (en + 0)...)))[46]

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

排序算法

排序算法關注計算複雜度,特別是時間複雜度,基本庫函數的實現細節也要考慮在內,比如串接函數@,它被實現為fun l1 @ l2 = revAppend(rev l1, l2),除非必需的情況避免使用遍歷整個列表的revlength函數。[k] 通過比較於這些排序算法的周知過程式編程語言比如C語言的實現,可以體察到ML在控制流程和列表資料結構上的相關限制,和與之相適應的採用尾遞歸的特色函數式編程風格。

插入排序

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

更多資訊 尾遞歸, 普通遞歸 ...
尾遞歸 普通遞歸
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
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保存在調用棧棧幀中
關閉

插入排序算法是穩定自適應排序英語Adaptive sort,它在輸入列表趨於正序的時候性能最佳,在輸入列表趨於反序的時候性能最差,因此在算法實現中,需要insert函數所插入列表保持為反序,在插入都完成後經rev函數再反轉回正序。在預期輸入數據趨於隨機化或者預知它經過了反轉的情況下,可以採用保持要插入列表為正序的變體插入排序算法實現,它在輸入列表趨於反序的時候性能最佳,在輸入列表趨於正序的時候性能最差,它比自適應實現少作一次全列表反轉。[l] 採用foldr函數可以相應的保持要插入列表為正序,由於fun foldr f b l = foldl f b (rev l),它等同於對反轉過的列表應用變體插入排序。

希爾排序

希爾排序算法是對插入排序的改進,保持了自適應性英語Adaptive sort,放棄了穩定性[m] 下面是希爾排序的實現:

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,即,它是徳田尚之在1992年提出的[48]。這個序列用遞推公式表示為:hk = ⌈h'k,這裡的h'k = 2.25·h'k-1 + 1h'1 = 1。假定一個列表的長度s位於序列兩個元素之間,即hk-1 < hk ≤ s < hk+1,如果hk·s,這裡的n ≤ m,則選擇初始間隔為hk,否則為hk-1。在這個閾值下,對於不同長度s的列表和對應的初始間隔h,每個列表的這些初始子列表的平均長度,約在 < ·範圍之內。間隔序列還可以採用OEIS A102549,它是Marcin Ciura在2001年通過實驗得到的[49][n]

快速排序

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

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函數實現對快速排序而言有不必要的反轉,[o] 這裡採用了它的簡化改寫。在ML中快速排序應採用自底向上實現:

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

歸併排序

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

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

考慮輸入列表[x1, ..., xi, a0, ..., a9, xj, ..., xn],這裡在xixj之間的10a,具有相同的值並且需要保持其下標表示的次序,這裡的xi > a並且xj < a,並且在這個區段前後的元素總數都能被3整除,則它被分解成子列表的列表[Xm, ..., [xj, a8, a9], [a5, a6, a7], [a2, a3, a4], [a0, a1, xi], ..., X1],這裡有m = n div 3;假定這4個含有a的子列表兩兩歸併,在歸併正序子列表的歸併條件x < y下,能得到[X1, ..., [xi, a4, ..., a0], [a9, ..., a5, xj], ..., Xk];繼續推演下去,在歸併反序子列表的歸併條件x > y下,能得到[Xh, ..., [xj, a0, ..., a9, xi], ..., X1]。可以看出這種歸併操作能夠保證排序算法的穩定性,即具有相同值的元素之間的相對次序保持不變。

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

堆排序

下面是堆排序的基於數組的實現:

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

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

heapify函數建造堆的時候,首先自列表中間將元素分為前後兩組,後組中的元素被視為只有一個元素的堆,然後從後往前處理前組中的元素,這時它的左右子節點已經是已有的堆或者為空,在其上進行siftdown,從而合成一個新堆。建造堆也可以採用siftup函數來實現,它自第二個元素開始從前往後逐個處理列表元素,其前面是已有的堆,將這個新元素自堆底向上插入到這個堆中。[q]

排序算法也可以使用二元樹資料結構來實現二叉堆

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函數隻篩選不插入,它將堆的大小減一。

這裡的insertextract函數也可以直接轉寫為等價的尾遞歸形式,與列表情況不同,只要樹結構能保持良好的平衡,採用尾遞歸形式就沒有太大的必要性。[r] 在二元樹實現下,也可以採用siftdown函數來初始建造堆,而不需要在節點中保存關於樹狀態的統計信息。[s]

基數排序

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

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

這裡採用的基數238,代碼所使用的列表元組大小與基數大小成正比,運算量與列表中元素的總數與最大數的位數的乘積成正比。

隨機數生成

編寫排序算法進行測試除了使用簡單的數列,[t] 測試用列表還可以使用線性同餘偽隨機數函數來生成[50]

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

語言解釋器

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

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,可以用如下在正確類型的和不正確類型上運行的例子,測試這個新語言:

- 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

注釋和附錄代碼

參見

延伸閱讀

引用

外部連結

Loading related searches...

Wikiwand - on

Seamless Wikipedia browsing. On steroids.