Mercurial > urweb

comparison lib/ur/top.ur @ 910:8e540df3294d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
grid1 compiles but gets stuck in JS
author Adam Chlipala <adamc@hcoop.net>
date Tue, 25 Aug 2009 13:57:56 -0400
parents 7a4b026e45dd
children 37dd42935dad
comparison
equal deleted inserted replaced
909:1d3f60e74ec7 910:8e540df3294d
153 (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] 153 (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest]
154 (acc : _ -> _ -> tr rest) r1 r2 => 154 (acc : _ -> _ -> tr rest) r1 r2 =>
155 f [nm] [t] [rest] ! r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm))) 155 f [nm] [t] [rest] ! r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
156 (fn _ _ => i) 156 (fn _ _ => i)
157 157
158 fun foldR3 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [tr :: {K} -> Type]
159 (f : nm :: Name -> t :: K -> rest :: {K}
160 -> [[nm] ~ rest] =>
161 tf1 t -> tf2 t -> tf3 t -> tr rest -> tr ([nm = t] ++ rest))
162 (i : tr []) [r :: {K}] (fl : folder r) =
163 fl [fn r :: {K} => $(map tf1 r) -> $(map tf2 r) -> $(map tf3 r) -> tr r]
164 (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest]
165 (acc : _ -> _ -> _ -> tr rest) r1 r2 r3 =>
166 f [nm] [t] [rest] ! r1.nm r2.nm r3.nm (acc (r1 -- nm) (r2 -- nm) (r3 -- nm)))
167 (fn _ _ _ => i)
168
158 fun foldRX [K] [tf :: K -> Type] [ctx :: {Unit}] 169 fun foldRX [K] [tf :: K -> Type] [ctx :: {Unit}]
159 (f : nm :: Name -> t :: K -> rest :: {K} 170 (f : nm :: Name -> t :: K -> rest :: {K}
160 -> [[nm] ~ rest] => 171 -> [[nm] ~ rest] =>
161 tf t -> xml ctx [] []) = 172 tf t -> xml ctx [] []) =
162 foldR [tf] [fn _ => xml ctx [] []] 173 foldR [tf] [fn _ => xml ctx [] []]
172 (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest] 183 (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest]
173 r1 r2 acc => 184 r1 r2 acc =>
174 <xml>{f [nm] [t] [rest] ! r1 r2}{acc}</xml>) 185 <xml>{f [nm] [t] [rest] ! r1 r2}{acc}</xml>)
175 <xml/> 186 <xml/>
176 187
188 fun foldRX3 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [ctx :: {Unit}]
189 (f : nm :: Name -> t :: K -> rest :: {K}
190 -> [[nm] ~ rest] =>
191 tf1 t -> tf2 t -> tf3 t -> xml ctx [] []) =
192 foldR3 [tf1] [tf2] [tf3] [fn _ => xml ctx [] []]
193 (fn [nm :: Name] [t :: K] [rest :: {K}] [[nm] ~ rest]
194 r1 r2 r3 acc =>
195 <xml>{f [nm] [t] [rest] ! r1 r2 r3}{acc}</xml>)
196 <xml/>
197
177 fun queryI [tables ::: {{Type}}] [exps ::: {Type}] 198 fun queryI [tables ::: {{Type}}] [exps ::: {Type}]
178 [tables ~ exps] (q : sql_query tables exps) 199 [tables ~ exps] (q : sql_query tables exps)
179 (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) 200 (f : $(exps ++ map (fn fields :: {Type} => $fields) tables)
180 -> transaction unit) = 201 -> transaction unit) =
181 query q 202 query q