Mercurial > urweb

comparison src/tag.sml @ 492:4a241d108a2c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Handle nullary transaction pages; avoid marking up headers array when reading cookies
author Adam Chlipala <adamc@hcoop.net>
date Tue, 11 Nov 2008 18:39:38 -0500
parents 9117a7bf229c
children 9864b64b1700
comparison
equal deleted inserted replaced
491:0fd65c50e0e2 492:4a241d108a2c
182 val env = env' 182 val env = env'
183 183
184 val newDs = map 184 val newDs = map
185 (fn (ek, f, cn) => 185 (fn (ek, f, cn) =>
186 let 186 let
187 val unit = (TRecord (CRecord ((KType, loc), []), loc), loc)
188
187 fun unravel (all as (t, _)) = 189 fun unravel (all as (t, _)) =
188 case t of 190 case t of
189 TFun (dom, ran) => 191 TFun (dom, ran) =>
190 let 192 let
191 val (args, result) = unravel ran 193 val (args, result) = unravel ran
195 | _ => ([], all) 197 | _ => ([], all)
196 198
197 val (fnam, t, _, tag) = E.lookupENamed env f 199 val (fnam, t, _, tag) = E.lookupENamed env f
198 val (args, result) = unravel t 200 val (args, result) = unravel t
199 201
200 val unit = (TRecord (CRecord ((KType, loc), []), loc), loc)
201
202 val (abs, t) = 202 val (abs, t) =
203 case args of 203 case args of
204 [] => 204 [] =>
205 let 205 let
206 val body = (EWrite (ENamed f, loc), loc) 206 val app = (EApp ((ENamed f, loc), (ERecord [], loc)), loc)
207 val body = (EWrite app, loc)
207 in 208 in
208 ((EAbs ("x", unit, unit, body), loc), 209 (body,
209 (TFun (unit, unit), loc)) 210 (TFun (unit, unit), loc))
210 end 211 end
211 | _ => 212 | _ =>
212 let 213 let
213 val (app, _) = foldl (fn (t, (app, n)) => 214 val (app, _) = foldl (fn (t, (app, n)) =>