Mercurial > urweb
diff src/core_env.sml @ 193:8a70e2919e86
Specialization of single-parameter datatypes
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Fri, 08 Aug 2008 17:55:51 -0400 |
parents | 9bbf4d383381 |
children | 5c50b17f5e4a |
line wrap: on
line diff
--- a/src/core_env.sml Fri Aug 08 10:59:06 2008 -0400 +++ b/src/core_env.sml Fri Aug 08 17:55:51 2008 -0400 @@ -51,6 +51,19 @@ val lift = liftConInCon 0 +val subConInCon = + U.Con.mapB {kind = fn k => k, + con = fn (xn, rep) => fn c => + case c of + CRel xn' => + (case Int.compare (xn', xn) of + EQUAL => #1 rep + | GREATER => CRel (xn' - 1) + | LESS => c) + | _ => c, + bind = fn ((xn, rep), U.Con.Rel _) => (xn+1, liftConInCon 0 rep) + | (ctx, _) => ctx} + (* Back to environments *) @@ -175,4 +188,13 @@ | DValRec vis => foldl (fn ((x, n, t, e, s), env) => pushENamed env x n t NONE s) env vis | DExport _ => env +fun patBinds env (p, loc) = + case p of + PWild => env + | PVar (x, t) => pushERel env x t + | PPrim _ => env + | PCon (_, _, _, NONE) => env + | PCon (_, _, _, SOME p) => patBinds env p + | PRecord xps => foldl (fn ((_, p, _), env) => patBinds env p) env xps + end