热门问题
时间线
聊天
视角
ML语言
来自维基百科，自由的百科全书
Remove ads
提示：此条目的主题不是英文缩写为ML的机器学习。ML（Meta Language：元语言），是一个函数式、指令式的通用的编程语言，它著称于使用了多态的Hindley–Milner类型推论[8]。ML能自动的指定多数表达式的类型，不要求显式的类型标注，而且能够确保类型安全，已经正式证明了有良好类型的ML程序不会导致运行时间类型错误[8]。
ML提供了对函数实际参数的模式匹配、垃圾回收、指令式编程、传值调用和柯里化。它被大量的用于编程语言研究之中，并且是全面规定了的和使用形式语义验证了的少数语言之一。它的类型和模式匹配使得它非常适合并且经常用于在其他形式语言上进行操作，比如在编译器构造、自动化定理证明和形式验证中。
Remove ads
历史
在1970年代早期，ML由爱丁堡大学的罗宾·米尔纳及他人研制出来[1]，用于在LCF定理证明器中开发证明策略[9]。LCF的语言是“PPλ”，它是一阶逻辑演算与有类型的多态λ演算的结合，以ML作为元语言。ML的语法从ISWIM及其扩展实现PAL得到了启发[2]，LCF ML运行在DEC-10/TOPS-10主机的Stanford LISP 1.6下[10]。
在1980年，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加入了开发，在又进行一系列重写改进之后，新的编译器被称为“Edinburgh ML”[14]。
在1981年，INRIA的Gérard Huet，将最初的LCF ML适配到Multics系统的Maclisp下，并且增加了编译器[15]。这个实现被描述于INRIA内部文档“ML手册”之中[16]，它被开发者自称为“Le_ML”[17]。剑桥大学的Lawrence Paulson在1985年用它开发了基于Franz Lisp的Cambridge LCF[18]，进而剑桥大学的Michael J. C. Gordon又用它开发了基于Common Lisp的HOL88[19]。[a]
在1983年，Robin Milner由两个动机驱使开始重新设计ML[20]。其一是爱丁堡大学的Rod Burstall及其小组在规定上的工作，具体化为规定语言CLEAR[21]，和表达可执行规定的函数式语言HOPE[22]。这项工作与ML有关的是两方面成果：首先，HOPE拥有优雅的编程特征，特别是模式匹配[23]，和子句式函数定义[24]；其次，是使用在接口中的签名，进行规定的模块化构造的想法。其二是Luca Cardelli在VAX ML上的工作，通过增加命名记录和可变类型，扩展了ML中数据类型的品目[25]。
在1984年，贝尔实验室的David MacQueen提出了对Standard ML的模块系统的设计[26]。在Standard ML的持续设计期间[27]，Edinburgh ML被渐进的修改，充当了Standard ML的近似原型实现[28]。在1986年，普林斯顿大学的Andrew Appel和贝尔实验室的David MacQueen，以Edinburgh Standard ML作为起步开发环境[29]，开始了专注于生成高质量机器代码的Standard ML of New Jersey的活跃开发[30]。
在1990年，Robin Milner、Mads Tofte和Robert Harper制定的Standard ML的正式规定《The Definition of Standard ML》最终完成[31]；在1997年，这个标准规定增补了David MacQueen为作者并进行了修订[32]。在1989年，Mads Tofte、Nick Rothwell和David N. Turner于爱丁堡大学开始开发ML Kit编译器，为了强调清晰性而非高效，将标准定义直接转译成一组Standard ML模块；在1992年和1993年期间，主要通过爱丁堡大学的Nick Rothwell和哥本哈根大学计算机科学系（DIKU）的Lars Birkedal的工作[33]，ML Kit第一版完成并开源发行[34]。
在1987年，INRIA的Ascánder Suárez，基于巴黎第七大学的Guy Cousineau的“范畴抽象机器”（CAM）[35]，利用Le Lisp的运行时间系统重新实现了Le_ML，并正式命名为Caml[15]。在1990年和1991年，INRIA的Xavier Leroy基于用C实现的字节码解释器[36]，利用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 ML和OCaml。ML的实力大多被用于语言设计和操作，比如建构编译器、分析器、定理证明器，但是它作为通用语言也被用于生物信息和财务系统等领域。ML确立了静态类型函数式编程范型，从而在编程语言历史上占有显要地位，它的思想在影响了众多的语言，例如Haskell、Nemerle[6]、ATS和Elm[3]。
Remove ads
解释与编译
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!
Remove ads
核心语言
不同于纯函数式编程语言，ML是兼具一些指令式特征的函数式编程语言。ML的特征包括：传值调用的求值策略，头等函数，带有垃圾收集的自动内存管理，参数多态，静态类型，类型推论，代数数据类型，模式匹配和例外处理。不同于Haskell，ML与大多数编程语言一样使用及早求值。
用ML书写的程序构成自要被求值的表达式，而非语句或命令，尽管一些表达式返回一个平凡的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表达式的值是在in和end之间表达式的值。这个递归函数的实现不保证能够终止，因为负数实际参数会导致递归调用的无穷降链条件。更健壮的实现会在递归前检查实际参数为非负数，并在有问题的情况，即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
Remove ads
有一些基本类型可以当作是“内建”的，因为它们是在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中的函数只接受一个值作为参数，而不是参数的一个列表，可以使用上述元组模式匹配来实际上传递多个参数。函数还可以返回一个元组。例如：
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。
下列函数是多态类型的一个例子：
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的任何运算符优先级。标准基本库提供了如下内建中缀规定：
infix 7 * / div mod
infix 6 + - ^
infixr 5 :: @
infix 4 = <> > >= < <=
infix 3 := o
infix 0 before
Remove ads
算符=和<>分别被定义为多态的等式和不等式。=它确定两个值是否相等，有着类型''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}不是。函数类型永远不是等式类型，因为一般情况下不可能确定两个函数是否等价。
Remove ads
类型声明或同义词（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
Remove ads
Standard ML提供了对代数数据类型（ADT）的强力支持。一个ML数据类型可以被当作是元组的不交并（积之和）。数据类型使用datatype关键字来定义，比如：
datatype int_or_string
= INT of int
| STRING of string
| NEITHER
这个数据类型声明建立一个全新的数据类型int_or_string，还有一起的新构造子（一种特殊函数或值）INT、STRING和NEITHER；每个这种类型的值都是要么INT具有一个整数，要么STRING具有一个字符串，要么NEITHER。写为如下这样：
val i = INT 3
val s = STRING "qq"
val n = NEITHER
val INT j = i
这里最后的一个声明通过模式匹配，将变量j绑定到变量i所绑定的整数3。val 模式 = 表达式是绑定的一般形式，它是良好定义的，当且仅当模式和表达式有相同的类型。
数据类型可以是多态的：
datatype 'a pair
= PAIR of 'a * 'a
这个数据类型声明建立一个新的类型'a pair家族，比如int pair，string pair等等。
数据类型可以是递归的：
datatype int_list
= EMPTY
| INT_LIST of int * int_list
这个数据类型声明建立一个新类型int_list，这个类型的每个值是要么EMPTY（空列表），要么是一个整数和另一个int_list的接合。
通过datatype创建的类型是等式类型，如果它的所有变体，要么是没有参数的空构造子，要么是有等式类型参数的构造子，并且在多态类型情况下所有类型参数也都是等式类型。递归类型在有可能情况下是等式类型，否则就不是。
Remove ads
基础库提供的复杂数据类型之一是列表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绑定了四个变量m、n、r和s；第二个val绑定了一个变量url；第三个val绑定了三个变量port、addr和name，第四个叫分层模式，绑定了三个变量x、fst和snd。
模式匹配可以在语法上嵌入到函数定义中，比如：
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]
Remove ads
函数可以接受函数作为实际参数，比如：
fun applyToBoth f x y = (f x, f y)
函数可以产生函数作为返回值，比如：
fun constantFn k = (fn anything => k)
函数可以同时接受和产生函数，比如复合函数：
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
例外可以使用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
Zero在0情况下发起，控制从函数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。
函子接受指定签名的一个结构作为参数，并返回一个结构作为结果，下面示例的函子能在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.sig和rational.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
基本库find和exists函数在不存在符合条件元素的时候会遍历整个列表，[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，并接着归并序列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结构的SOME和NONE构造子的协定，可以将所映射函数认为不符合条件的元素或者结果排除掉，它会遍历整个列表。[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]的高阶函数foldr和map的实现，和达成一个整数列表的合计函数的简单用例：
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)，除非必需的情况避免使用遍历整个列表的rev和length函数。[k]
通过比较于这些排序算法的周知过程式编程语言比如C语言的实现，可以体察到ML在控制流程和列表数据结构上的相关限制，和与之相适应的采用尾递归的特色函数式编程风格。
插入排序算法是稳定的自适应排序，它在输入列表趋于正序的时候性能最佳，在输入列表趋于反序的时候性能最差，因此在算法实现中，需要insert函数所插入列表保持为反序，在插入都完成后经rev函数再反转回正序。在预期输入数据趋于随机化或者预知它经过了反转的情况下，可以采用保持要插入列表为正序的变体插入排序算法实现，它在输入列表趋于反序的时候性能最佳，在输入列表趋于正序的时候性能最差，它比自适应实现少作一次全列表反转。[l]
采用foldr函数可以相应的保持要插入列表为正序，由于fun foldr f b l = foldl f b (rev l)，它等同于对反转过的列表应用变体插入排序。
希尔排序算法是对插入排序的改进，保持了自适应性，放弃了稳定性。[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 + 1而h'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]，这里在xi和xj之间的10个a，具有相同的值并且需要保持其下标表示的次序，这里的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函数融合了插入和筛选功能，它首先在暂时位于堆顶的要插入的元素，和从堆顶节点左右子堆的两个堆顶元素中筛选出的那个元素，二者中选择出哪个适合作堆顶元素；如果要插入元素适合，则以它为新堆顶元素而结束整个过程，否则以筛选出元素为新堆顶元素，并自顶向下逐级处理提供了新堆顶元素的子堆，将要插入元素暂时作为其堆顶元素并对它继续进行siftdown；siftdown只要到达了某个堆底，就插入要插入的元素而结束整个过程。
在提取堆顶元素生成结果列表时，先提取走堆顶元素的内容，再摘掉最后的堆底元素将它的内容暂时放置在堆顶，这时堆的大小也相应的减一，随后的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函数只筛选不插入，它将堆的大小减一。
这里的insert和extract函数也可以直接转写为等价的尾递归形式，与列表情况不同，只要树结构能保持良好的平衡，采用尾递归形式就没有太大的必要性。[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
这里采用的基数是2的3次幂8，代码所使用的列表元组大小与基数大小成正比，运算量与列表中元素的总数与最大数的位数的乘积成正比。
编写排序算法进行测试除了使用简单的数列，[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
注释和附录代码
参见
延伸阅读
引用
外部链接
Wikiwand - on
Seamless Wikipedia browsing. On steroids.
Remove ads