1(*
2    Title:      Standard Basis Library: List Structure
3    Author:     David Matthews
4    Copyright   David Matthews 1999, 2005, 2016
5
6    This library is free software; you can redistribute it and/or
7    modify it under the terms of the GNU Lesser General Public
8    License as published by the Free Software Foundation; either
9    version 2.1 of the License, or (at your option) any later version.
10    
11    This library is distributed in the hope that it will be useful,
12    but WITHOUT ANY WARRANTY; without even the implied warranty of
13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14    Lesser General Public License for more details.
15    
16    You should have received a copy of the GNU Lesser General Public
17    License along with this library; if not, write to the Free Software
18    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
19*)
20
21structure List: LIST =
22    struct
23    datatype list = datatype list
24    exception Empty
25    
26    fun null [] = true | null (_::_) = false
27    
28    val length = length (* Declared in prelude. *)
29    
30    (* ...
31    fun   nil @ M = M   (* append *)
32     | (x::L) @ M = x :: (L @ M);
33    ... *)
34    
35    (* Dave's improved(?) version SPF 10/2/94 *)
36    (* Taken from the prelude.  The idea is to avoid rebuilding the
37       list if the second list is empty. *)
38    fun x @ nil = x  (* append *)
39      | x @ y =
40        let
41        fun app nil = y
42         | app (a :: b) = a :: app b
43        in
44        app x
45        end;
46
47    fun hd (a::_) = a | hd _ = raise Empty
48    and tl (_::a) = a | tl _ = raise Empty
49    
50    (* TODO: We could avoid the test for nil in the recursive cases. *)
51    fun last [] = raise Empty
52      | last [a] = a
53      | last (_::b) = last b
54      
55    fun getItem [] = NONE
56      | getItem (a::b) = SOME(a, b)
57    
58    (* We could raise subscript immediately if i < 0 and we probably
59       would have to if we were using fixed precision arithmetic. *)
60    fun nth([], _) = raise General.Subscript
61     |  nth(a::_, 0) = a
62     |  nth(_::l, i) = nth(l, i-1)
63    
64    (* TODO: Many of these functions involve recursing down the list and
65       so require stack space proportional to the length of the list.
66       Would it be more efficient to build the lists in reverse and then
67       reverse the result?  That would save on stack space at the expense
68       of constructing the list twice. *)
69    
70    fun take(_, 0) = []
71     |  take([], _) = raise General.Subscript
72     |  take(a::b, i) = a :: take(b, i-1)
73     
74    fun drop(l, 0) = l
75     |  drop([], _) = raise General.Subscript
76     |  drop(_::l, i) = drop(l, i-1)
77     
78    fun revAppend([], a) = a
79     |  revAppend(x::y, a) = revAppend(y, x::a)
80     
81    fun rev l = revAppend(l, [])
82
83    fun concat [] = []
84     |  concat (a::b) = a @ concat b
85     
86    fun app _ [] = ()
87     |  app f (h::t) = (f h; app f t)
88
89    fun map _ [] = []
90      | map f (a::b) = f a :: map f b;
91
92    fun mapPartial _ [] = []
93      | mapPartial f (a::b) = 
94          case f a of
95              SOME r => r :: mapPartial f b
96            | NONE => mapPartial f b
97
98    fun find _ [] = NONE
99      | find f (a::b) = if f a then SOME a else find f b
100      
101    fun filter _ [] = []
102      | filter f (a::b) = if f a then a :: filter f b else filter f b
103    
104    (* This is defined to evaluate f from left to right.  *)
105    (* TODO: This involves returning a pair and creating new pairs
106       which allocates storage in Poly/ML.  Is there a more efficient
107       implementation?  e.g. recurse down the list and then reverse it. *)
108    fun partition _ [] = ([], [])
109      | partition f (a::b) =
110            let
111            val test = f a
112            and (x, y) = partition f b
113            in
114            if test then (a::x, y) else (x, a::y)
115            end
116            
117    fun foldl _ b [] = b
118      | foldl f b (x::y) = foldl f (f(x, b)) y
119
120    fun foldr _ b [] = b
121      | foldr f b (x::y) = f(x, foldr f b y)
122
123    fun exists _ [] = false
124      | exists f (a::b) = if f a then true else exists f b
125      
126    fun all _ [] = true
127      | all f (a::b) = if f a then all f b else false
128
129    (* tabulate a function. *)
130    local
131        fun tabF max n f =
132            if n = max then []
133            else f n :: tabF max (n+1) f
134    in
135        fun tabulate(n, f) =
136            if n < 0 then raise Size
137            else tabF n 0 f
138    end
139
140    (* Lexicographic comparison.  *)
141    fun collate _   ([], []) = General.EQUAL
142     |  collate _   ([], _) = General.LESS
143     |  collate _   (_, []) = General.GREATER
144     |  collate cmp (a::b, c::d) =
145            (case cmp (a, c) of General.EQUAL => collate cmp (b, d) | notEqual => notEqual)
146    end;
147
148(* Values available at the top level. *)
149exception Empty = List.Empty
150val null : 'a list -> bool = List.null 
151val hd : 'a list -> 'a = List.hd 
152val tl : 'a list -> 'a list = List.tl 
153val length : 'a list -> int = List.length 
154val rev : 'a list -> 'a list = List.rev 
155val op @ : ('a list * 'a list) -> 'a list = List.@ 
156val app : ('a -> unit) -> 'a list -> unit = List.app 
157val map : ('a -> 'b) -> 'a list -> 'b list = List.map 
158val foldr: ('a*'b->'b)-> 'b -> 'a list -> 'b = List.foldr 
159val foldl: ('a*'b->'b)-> 'b -> 'a list -> 'b = List.foldl;
160