Mercurial > urweb
comparison 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 |
comparison
equal
deleted
inserted
replaced
192:9bbf4d383381 | 193:8a70e2919e86 |
---|---|
49 bind = fn (bound, U.Con.Rel _) => bound + 1 | 49 bind = fn (bound, U.Con.Rel _) => bound + 1 |
50 | (bound, _) => bound} | 50 | (bound, _) => bound} |
51 | 51 |
52 val lift = liftConInCon 0 | 52 val lift = liftConInCon 0 |
53 | 53 |
54 val subConInCon = | |
55 U.Con.mapB {kind = fn k => k, | |
56 con = fn (xn, rep) => fn c => | |
57 case c of | |
58 CRel xn' => | |
59 (case Int.compare (xn', xn) of | |
60 EQUAL => #1 rep | |
61 | GREATER => CRel (xn' - 1) | |
62 | LESS => c) | |
63 | _ => c, | |
64 bind = fn ((xn, rep), U.Con.Rel _) => (xn+1, liftConInCon 0 rep) | |
65 | (ctx, _) => ctx} | |
66 | |
54 | 67 |
55 (* Back to environments *) | 68 (* Back to environments *) |
56 | 69 |
57 exception UnboundRel of int | 70 exception UnboundRel of int |
58 exception UnboundNamed of int | 71 exception UnboundNamed of int |
173 end | 186 end |
174 | DVal (x, n, t, e, s) => pushENamed env x n t (SOME e) s | 187 | DVal (x, n, t, e, s) => pushENamed env x n t (SOME e) s |
175 | DValRec vis => foldl (fn ((x, n, t, e, s), env) => pushENamed env x n t NONE s) env vis | 188 | DValRec vis => foldl (fn ((x, n, t, e, s), env) => pushENamed env x n t NONE s) env vis |
176 | DExport _ => env | 189 | DExport _ => env |
177 | 190 |
191 fun patBinds env (p, loc) = | |
192 case p of | |
193 PWild => env | |
194 | PVar (x, t) => pushERel env x t | |
195 | PPrim _ => env | |
196 | PCon (_, _, _, NONE) => env | |
197 | PCon (_, _, _, SOME p) => patBinds env p | |
198 | PRecord xps => foldl (fn ((_, p, _), env) => patBinds env p) env xps | |
199 | |
178 end | 200 end |