Mercurial > urweb
comparison src/mono_util.sml @ 193:8a70e2919e86
Specialization of single-parameter datatypes
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Fri, 08 Aug 2008 17:55:51 -0400 |
parents | 8e9f97508f0d |
children | 890a61991263 |
comparison
equal
deleted
inserted
replaced
192:9bbf4d383381 | 193:8a70e2919e86 |
---|---|
37 | 37 |
38 structure S = Search | 38 structure S = Search |
39 | 39 |
40 structure Typ = struct | 40 structure Typ = struct |
41 | 41 |
42 fun join (o1, o2) = | 42 open Order |
43 case o1 of | |
44 EQUAL => o2 () | |
45 | v => v | |
46 | |
47 fun joinL f (os1, os2) = | |
48 case (os1, os2) of | |
49 (nil, nil) => EQUAL | |
50 | (nil, _) => LESS | |
51 | (h1 :: t1, h2 :: t2) => | |
52 join (f (h1, h2), fn () => joinL f (t1, t2)) | |
53 | (_ :: _, nil) => GREATER | |
54 | 43 |
55 fun compare ((t1, _), (t2, _)) = | 44 fun compare ((t1, _), (t2, _)) = |
56 case (t1, t2) of | 45 case (t1, t2) of |
57 (TFun (d1, r1), TFun (d2, r2)) => | 46 (TFun (d1, r1), TFun (d2, r2)) => |
58 join (compare (d1, d2), fn () => compare (r1, r2)) | 47 join (compare (d1, d2), fn () => compare (r1, r2)) |