comparison src/elaborate.sml @ 249:b6b75e6e0898

Corify transaction wrappers
author Adam Chlipala <adamc@hcoop.net>
date Sun, 31 Aug 2008 09:45:23 -0400
parents 2b9dfaffb008
children 69d337f186eb
comparison
equal deleted inserted replaced
248:d5b12daa9b47 249:b6b75e6e0898
3034 L'.SgiVal (x, n, t) => 3034 L'.SgiVal (x, n, t) =>
3035 (case hnormCon (env, denv) t of 3035 (case hnormCon (env, denv) t of
3036 ((L'.TFun (dom, ran), _), []) => 3036 ((L'.TFun (dom, ran), _), []) =>
3037 (case (hnormCon (env, denv) dom, hnormCon (env, denv) ran) of 3037 (case (hnormCon (env, denv) dom, hnormCon (env, denv) ran) of
3038 (((L'.TRecord domR, _), []), 3038 (((L'.TRecord domR, _), []),
3039 ((L'.CApp (tf, arg3), _), [])) => 3039 ((L'.CApp (tf, arg), _), [])) =>
3040 (case (hnormCon (env, denv) tf, hnormCon (env, denv) arg3) of 3040 (case (hnormCon (env, denv) tf, hnormCon (env, denv) arg) of
3041 (((L'.CApp (tf, arg2), _), []), 3041 (((L'.CModProj (basis, [], "transaction"), _), []),
3042 (((L'.CRecord (_, []), _), []))) => 3042 ((L'.CApp (tf, arg3), _), [])) =>
3043 (case (hnormCon (env, denv) tf) of 3043 (case (basis = !basis_r,
3044 ((L'.CApp (tf, arg1), _), []) => 3044 hnormCon (env, denv) tf, hnormCon (env, denv) arg3) of
3045 (case (hnormCon (env, denv) tf, 3045 (true,
3046 hnormCon (env, denv) domR, 3046 ((L'.CApp (tf, arg2), _), []),
3047 hnormCon (env, denv) arg1, 3047 (((L'.CRecord (_, []), _), []))) =>
3048 hnormCon (env, denv) arg2) of 3048 (case (hnormCon (env, denv) tf) of
3049 ((tf, []), (domR, []), (arg1, []), 3049 ((L'.CApp (tf, arg1), _), []) =>
3050 ((L'.CRecord (_, []), _), [])) => 3050 (case (hnormCon (env, denv) tf,
3051 let 3051 hnormCon (env, denv) domR,
3052 val t = (L'.CApp (tf, arg1), loc) 3052 hnormCon (env, denv) arg1,
3053 val t = (L'.CApp (t, arg2), loc) 3053 hnormCon (env, denv) arg2) of
3054 val t = (L'.CApp (t, arg3), loc) 3054 ((tf, []), (domR, []), (arg1, []),
3055 in 3055 ((L'.CRecord (_, []), _), [])) =>
3056 (L'.SgiVal (x, n, (L'.TFun ((L'.TRecord domR, loc), 3056 let
3057 t), 3057 val t = (L'.CApp (tf, arg1), loc)
3058 loc)), loc) 3058 val t = (L'.CApp (t, arg2), loc)
3059 end 3059 val t = (L'.CApp (t, arg3), loc)
3060 val t = (L'.CApp (
3061 (L'.CModProj (basis, [], "transaction"), loc),
3062 t), loc)
3063 in
3064 (L'.SgiVal (x, n, (L'.TFun ((L'.TRecord domR, loc),
3065 t),
3066 loc)), loc)
3067 end
3068 | _ => all)
3060 | _ => all) 3069 | _ => all)
3061 | _ => all) 3070 | _ => all)
3062 | _ => all) 3071 | _ => all)
3063 | _ => all) 3072 | _ => all)
3064 | _ => all) 3073 | _ => all)