Mercurial > urweb

comparison src/mono_env.sml @ 800:e92cfac1608f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Proper lifting of MonoEnv stored expressions; avoidance of onchange clobbering
author Adam Chlipala <adamc@hcoop.net>
date Thu, 14 May 2009 13:18:31 -0400
parents 8688e01ae469
children d8f58d488cfb
comparison
equal deleted inserted replaced
799:9330ba3a2799 800:e92cfac1608f
68 fun lookupConstructor (env : env) n = 68 fun lookupConstructor (env : env) n =
69 case IM.find (#constructors env, n) of 69 case IM.find (#constructors env, n) of
70 NONE => raise UnboundNamed n 70 NONE => raise UnboundNamed n
71 | SOME x => x 71 | SOME x => x
72 72
73 structure U = MonoUtil
74
75 val liftExpInExp =
76 U.Exp.mapB {typ = fn t => t,
77 exp = fn bound => fn e =>
78 case e of
79 ERel xn =>
80 if xn < bound then
81 e
82 else
83 ERel (xn + 1)
84 | _ => e,
85 bind = fn (bound, U.Exp.RelE _) => bound + 1
86 | (bound, _) => bound}
87
73 fun pushERel (env : env) x t eo = 88 fun pushERel (env : env) x t eo =
74 {datatypes = #datatypes env, 89 {datatypes = #datatypes env,
75 constructors = #constructors env, 90 constructors = #constructors env,
76 91 relE = (x, t, eo) :: map (fn (x, t, eo) => (x, t, Option.map (liftExpInExp 0) eo)) (#relE env),
77 relE = (x, t, eo) :: #relE env,
78 namedE = #namedE env} 92 namedE = #namedE env}
79 93
80 fun lookupERel (env : env) n = 94 fun lookupERel (env : env) n =
81 (List.nth (#relE env, n)) 95 (List.nth (#relE env, n))
82 handle Subscript => raise UnboundRel n 96 handle Subscript => raise UnboundRel n