Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/system/Basis/Implementation/list.sml
ViewVC logotype

Annotation of /sml/trunk/system/Basis/Implementation/list.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3417 - (view) (download)

1 : monnier 416 (* list.sml
2 :     *
3 : jhr 3417 * COPYRIGHT (c) 2009 The Fellowship of SML/NJ (http://www.smlnj.org)
4 :     * All rights reserved.
5 : monnier 416 *
6 :     * Available (unqualified) at top level:
7 :     * type list
8 :     * val nil, ::, hd, tl, null, length, @, app, map, foldr, foldl, rev
9 : jhr 3417 * exception Empty
10 : monnier 416 *
11 :     * Consequently the following are not visible at top level:
12 :     * val last, nth, take, drop, concat, revAppend, mapPartial, find, filter,
13 :     * partition, exists, all, tabulate
14 :     *
15 :     * The following infix declarations will hold at top level:
16 :     * infixr 5 :: @
17 :     *
18 :     *)
19 :    
20 :     structure List : LIST =
21 :     struct
22 :    
23 :     val op + = InlineT.DfltInt.+
24 :     val op - = InlineT.DfltInt.-
25 :     val op < = InlineT.DfltInt.<
26 :     val op <= = InlineT.DfltInt.<=
27 :     val op > = InlineT.DfltInt.>
28 :     val op >= = InlineT.DfltInt.>=
29 : monnier 498 (* val op = = InlineT.= *)
30 : monnier 416
31 :     datatype list = datatype list
32 :    
33 : george 825 exception Empty = Empty
34 : monnier 416
35 : jhr 3417 (* these functions are implemented in base/system/smlnj/init/pervasive.sml *)
36 : monnier 416 val null = null
37 :     val hd = hd
38 :     val tl = tl
39 : jhr 3417 val length = length
40 :     val rev = rev
41 :     val op @ = op @
42 :     val foldr = foldr
43 :     val foldl = foldl
44 :     val app = app
45 :     val map = map
46 : monnier 416
47 :     fun last [] = raise Empty
48 :     | last [x] = x
49 :     | last (_::r) = last r
50 :    
51 :     fun getItem [] = NONE
52 :     | getItem (x::r) = SOME(x, r)
53 :    
54 :     fun nth (l,n) = let
55 :     fun loop ((e::_),0) = e
56 :     | loop ([],_) = raise Subscript
57 :     | loop ((_::t),n) = loop(t,n-1)
58 :     in
59 :     if n >= 0 then loop (l,n) else raise Subscript
60 :     end
61 :    
62 :     fun take (l, n) = let
63 :     fun loop (l, 0) = []
64 :     | loop ([], _) = raise Subscript
65 :     | loop ((x::t), n) = x :: loop (t, n-1)
66 :     in
67 :     if n >= 0 then loop (l, n) else raise Subscript
68 :     end
69 :    
70 :     fun drop (l, n) = let
71 :     fun loop (l,0) = l
72 :     | loop ([],_) = raise Subscript
73 :     | loop ((_::t),n) = loop(t,n-1)
74 :     in
75 :     if n >= 0 then loop (l,n) else raise Subscript
76 :     end
77 :    
78 :    
79 :     fun concat [] = []
80 :     | concat (l::r) = l @ concat r
81 :    
82 :     fun revAppend ([],l) = l
83 :     | revAppend (h::t,l) = revAppend(t,h::l)
84 :    
85 :     fun mapPartial pred l = let
86 :     fun mapp ([], l) = rev l
87 :     | mapp (x::r, l) = (case (pred x)
88 :     of SOME y => mapp(r, y::l)
89 :     | NONE => mapp(r, l)
90 :     (* end case *))
91 :     in
92 :     mapp (l, [])
93 :     end
94 :    
95 :     fun find pred [] = NONE
96 :     | find pred (a::rest) = if pred a then SOME a else (find pred rest)
97 :    
98 :     fun filter pred [] = []
99 :     | filter pred (a::rest) = if pred a then a::(filter pred rest)
100 :     else (filter pred rest)
101 :    
102 :     fun partition pred l = let
103 :     fun loop ([],trueList,falseList) = (rev trueList, rev falseList)
104 :     | loop (h::t,trueList,falseList) =
105 :     if pred h then loop(t, h::trueList, falseList)
106 :     else loop(t, trueList, h::falseList)
107 :     in loop (l,[],[]) end
108 :    
109 :    
110 :     fun exists pred = let
111 :     fun f [] = false
112 :     | f (h::t) = pred h orelse f t
113 :     in f end
114 :     fun all pred = let
115 :     fun f [] = true
116 :     | f (h::t) = pred h andalso f t
117 :     in f end
118 :    
119 :     fun tabulate (len, genfn) =
120 :     if len < 0 then raise Size
121 :     else let
122 :     fun loop n = if n = len then []
123 :     else (genfn n)::(loop(n+1))
124 :     in loop 0 end
125 :    
126 : blume 1062 fun collate compare = let
127 :     fun loop ([], []) = EQUAL
128 :     | loop ([], _) = LESS
129 :     | loop (_, []) = GREATER
130 :     | loop (x :: xs, y :: ys) =
131 :     (case compare (x, y) of
132 :     EQUAL => loop (xs, ys)
133 :     | unequal => unequal)
134 :     in
135 :     loop
136 :     end
137 :    
138 : monnier 416 end (* structure List *)
139 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0