Mercurial > urweb

comparison src/tag.sml @ 119:7fdc146b2bc2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Proper handling of non-function-call links
author Adam Chlipala <adamc@hcoop.net>
date Sun, 13 Jul 2008 16:11:25 -0400
parents 94856a3b4752
children fd98dd10dce7
comparison
equal deleted inserted replaced
118:7207f794b916 119:7fdc146b2bc2
169 | _ => ([], all) 169 | _ => ([], all)
170 170
171 val (fnam, t, _, tag) = E.lookupENamed env f 171 val (fnam, t, _, tag) = E.lookupENamed env f
172 val (args, result) = unravel t 172 val (args, result) = unravel t
173 173
174 val (app, _) = foldl (fn (t, (app, n)) =>
175 ((EApp (app, (ERel n, loc)), loc),
176 n - 1))
177 ((ENamed f, loc), length args - 1) args
178 val body = (EWrite app, loc)
179 val unit = (TRecord (CRecord ((KType, loc), []), loc), loc) 174 val unit = (TRecord (CRecord ((KType, loc), []), loc), loc)
180 val (abs, _, t) = foldr (fn (t, (abs, n, rest)) => 175
181 ((EAbs ("x" ^ Int.toString n, 176 val (abs, t) =
182 t, 177 case args of
183 rest, 178 [] =>
184 abs), loc), 179 let
185 n + 1, 180 val body = (EWrite (ENamed f, loc), loc)
186 (TFun (t, rest), loc))) 181 in
187 (body, 0, unit) args 182 ((EAbs ("x", unit, unit, body), loc),
183 (TFun (unit, unit), loc))
184 end
185 | _ =>
186 let
187 val (app, _) = foldl (fn (t, (app, n)) =>
188 ((EApp (app, (ERel n, loc)), loc),
189 n - 1))
190 ((ENamed f, loc), length args - 1) args
191 val body = (EWrite app, loc)
192 val (abs, _, t) = foldr (fn (t, (abs, n, rest)) =>
193 ((EAbs ("x" ^ Int.toString n,
194 t,
195 rest,
196 abs), loc),
197 n + 1,
198 (TFun (t, rest), loc)))
199 (body, 0, unit) args
200 in
201 (abs, t)
202 end
188 in 203 in
189 [(DVal ("wrap_" ^ fnam, cn, t, abs, tag), loc), 204 [(DVal ("wrap_" ^ fnam, cn, t, abs, tag), loc),
190 (DExport cn, loc)] 205 (DExport cn, loc)]
191 end) newTags 206 end) newTags
192 in 207 in