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/src/MLRISC/library/catlist.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/library/catlist.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 411 (*
2 :     * Constant time concatenable list.
3 :     *
4 :     * -- Allen
5 :     *)
6 :    
7 : monnier 245 signature CATNETABLE_LIST =
8 :     sig
9 :     type 'a catlist
10 :     val empty : 'a catlist
11 :     val null : 'a catlist -> bool
12 :     val length : 'a catlist -> int
13 :     val cons : 'a * 'a catlist -> 'a catlist
14 :     val unit : 'a -> 'a catlist
15 :     val append : 'a catlist * 'a catlist -> 'a catlist
16 :     val hd : 'a catlist -> 'a
17 :     val tl : 'a catlist -> 'a catlist
18 :    
19 :     val fromList : 'a list -> 'a catlist
20 :     val toList : 'a catlist -> 'a list
21 :    
22 :     val map : ('a -> 'b) -> 'a catlist -> 'b catlist
23 :     val app : ('a -> unit) -> 'a catlist -> unit
24 :     end
25 :    
26 :     structure CatnetableList :> CATNETABLE_LIST =
27 :     struct
28 :     datatype 'a catlist = empty | unit of 'a | @ of 'a catlist * 'a catlist
29 :    
30 :     fun null empty = true
31 :     | null _ = false
32 :    
33 :     fun length empty = 0
34 :     | length (unit _) = 1
35 :     | length (a @ b) = length a + length b
36 :    
37 :     fun hd empty = raise Empty
38 :     | hd (unit a) = a
39 :     | hd (a @ b) = hd a
40 :    
41 :     fun tl empty = raise Empty
42 :     | tl (unit a) = empty
43 :     | tl ((unit _) @ a) = a
44 :     | tl ((a @ b) @ c) = tl(a @ (b @ c))
45 :     | tl (empty @ c) = tl c
46 :    
47 :     fun cons(a,empty) = unit a
48 :     | cons(a,b) = unit a @ b
49 :    
50 :     fun append(empty,a) = a
51 :     | append(a,empty) = a
52 :     | append(a,b) = a @ b
53 :    
54 :     fun map f l =
55 :     let fun g empty = empty
56 :     | g (unit a) = unit(f a)
57 :     | g (a @ b) = (g a) @ (g b)
58 :     in g l end
59 :    
60 :     fun app f l =
61 :     let fun g empty = ()
62 :     | g (unit a) = f a
63 :     | g (a @ b) = (g a; g b)
64 :     in g l end
65 :    
66 :     fun fromList [] = empty
67 :     | fromList (a::b) = cons(a,fromList b)
68 :    
69 :     fun toList l =
70 :     let fun g(empty,l) = l
71 :     | g(unit a,l) = a::l
72 :     | g(a @ b, l) = g(a,g(b,l))
73 :     in g(l,[]) end
74 :    
75 :     end
76 :    

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