Mercurial > urweb

comparison demo/more/dlist.ur @ 953:301530da2062

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Bad sort functions tested
author Adam Chlipala <adamc@hcoop.net>
date Thu, 17 Sep 2009 14:57:38 -0400
parents 07569af40069
children 2a50da66ffd8
comparison
equal deleted inserted replaced
952:07569af40069 953:301530da2062
77 </xml> 77 </xml>
78 78
79 fun renderFlat [ctx] [ctx ~ body] [t] (f : t -> position -> xml (ctx ++ body) [] []) filter ls = 79 fun renderFlat [ctx] [ctx ~ body] [t] (f : t -> position -> xml (ctx ++ body) [] []) filter ls =
80 List.mapX (fn p => f p.1 p.2) ls 80 List.mapX (fn p => f p.1 p.2) ls
81 81
82 fun render [ctx] [ctx ~ body] [t] f r dl = <xml> 82 val split [t] =
83 <dyn signal={sort <- r.Sort; 83 let
84 case sort of 84 fun split' acc (ls : list t) =
85 case ls of
86 [] => acc
87 | x1 :: [] => (x1 :: acc.1, acc.2)
88 | x1 :: x2 :: ls => split' (x1 :: acc.1, x2 :: acc.2) ls
89 in
90 split' ([], [])
91 end
92
93 fun merge [t] (cmp : t -> t -> signal bool) =
94 let
95 fun merge' acc (ls1 : list t) (ls2 : list t) =
96 case (ls1, ls2) of
97 ([], _) => return (List.revAppend acc ls2)
98 | (_, []) => return (List.revAppend acc ls1)
99 | (x1 :: ls1', x2 :: ls2') =>
100 b <- cmp x1 x2;
101 if b then
102 merge' (x1 :: acc) ls1' ls2
103 else
104 merge' (x2 :: acc) ls1 ls2'
105 in
106 merge' []
107 end
108
109 fun sort [t] (cmp : t -> t -> signal bool) =
110 let
111 fun sort' (ls : list t) =
112 case ls of
113 [] => return ls
114 | _ :: [] => return ls
115 | _ =>
116 let
117 val (ls1, ls2) = split ls
118 in
119 ls1' <- sort' ls1;
120 ls2' <- sort' ls2;
121 merge cmp ls1' ls2'
122 end
123 in
124 sort'
125 end
126
127 fun render [ctx] [ctx ~ body] [t] f (r : {Filter : t -> signal bool,
128 Sort : signal (option (t -> t -> signal bool))}) dl = <xml>
129 <dyn signal={cmp <- r.Sort;
130 case cmp of
85 None => return (renderDyn f r.Filter dl) 131 None => return (renderDyn f r.Filter dl)
86 | Some sort => 132 | Some cmp =>
87 dl' <- signal dl; 133 dl' <- signal dl;
88 elems <- (case dl' of 134 elems <- (case dl' of
89 Empty => return [] 135 Empty => return []
90 | Nonempty {Head = hd, Tail = tlTop} => 136 | Nonempty {Head = hd, Tail = tlTop} =>
91 let 137 let
102 listOut (Some tl) tl' ((v, pos) :: acc) 148 listOut (Some tl) tl' ((v, pos) :: acc)
103 end 149 end
104 in 150 in
105 listOut None hd [] 151 listOut None hd []
106 end); 152 end);
153 elems <- sort (fn v1 v2 => cmp v1.1 v2.1) elems;
107 return (renderFlat f r.Filter elems)}/> 154 return (renderFlat f r.Filter elems)}/>
108 </xml> 155 </xml>
109 156
110 157
111 158