Mercurial > urweb

comparison src/defunc.sml @ 626:230654093b51

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
demo/hello compiles with kind polymorphism
author Adam Chlipala <adamc@hcoop.net>
date Sun, 22 Feb 2009 17:17:01 -0500
parents 3ce20b0b6914
children
comparison
equal deleted inserted replaced
625:47947d6e9750 626:230654093b51
37 val functionInside = U.Con.exists {kind = fn _ => false, 37 val functionInside = U.Con.exists {kind = fn _ => false,
38 con = fn TFun _ => true 38 con = fn TFun _ => true
39 | CFfi ("Basis", "transaction") => true 39 | CFfi ("Basis", "transaction") => true
40 | _ => false} 40 | _ => false}
41 41
42 val freeVars = U.Exp.foldB {kind = fn (_, xs) => xs, 42 val freeVars = U.Exp.foldB {kind = fn (_, _, xs) => xs,
43 con = fn (_, _, xs) => xs, 43 con = fn (_, _, xs) => xs,
44 exp = fn (bound, e, xs) => 44 exp = fn (bound, e, xs) =>
45 case e of 45 case e of
46 ERel x => 46 ERel x =>
47 if x >= bound then 47 if x >= bound then
68 in 68 in
69 pof (0, ls) 69 pof (0, ls)
70 end 70 end
71 71
72 fun squish fvs = 72 fun squish fvs =
73 U.Exp.mapB {kind = fn k => k, 73 U.Exp.mapB {kind = fn _ => fn k => k,
74 con = fn _ => fn c => c, 74 con = fn _ => fn c => c,
75 exp = fn bound => fn e => 75 exp = fn bound => fn e =>
76 case e of 76 case e of
77 ERel x => 77 ERel x =>
78 if x >= bound then 78 if x >= bound then
209 end 209 end
210 | _ => (e, st) 210 | _ => (e, st)
211 211
212 fun bind (env, b) = 212 fun bind (env, b) =
213 case b of 213 case b of
214 U.Decl.RelC (x, k) => E.pushCRel env x k 214 U.Decl.RelK x => E.pushKRel env x
215 | U.Decl.RelC (x, k) => E.pushCRel env x k
215 | U.Decl.NamedC (x, n, k, co) => E.pushCNamed env x n k co 216 | U.Decl.NamedC (x, n, k, co) => E.pushCNamed env x n k co
216 | U.Decl.RelE (x, t) => E.pushERel env x t 217 | U.Decl.RelE (x, t) => E.pushERel env x t
217 | U.Decl.NamedE (x, n, t, eo, s) => E.pushENamed env x n t eo s 218 | U.Decl.NamedE (x, n, t, eo, s) => E.pushENamed env x n t eo s
218 219
219 fun doDecl env = U.Decl.foldMapB {kind = fn x => x, 220 fun doDecl env = U.Decl.foldMapB {kind = default,
220 con = default, 221 con = default,
221 exp = exp, 222 exp = exp,
222 decl = default, 223 decl = default,
223 bind = bind} 224 bind = bind}
224 env 225 env