Mercurial > urweb

comparison src/mono_env.sml @ 183:c0ea24dcb86f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Optimizing 'case' in Mono_reduce
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 13:30:27 -0400
parents d11754ffe252
children 8e9f97508f0d
comparison
equal deleted inserted replaced
182:d11754ffe252 183:c0ea24dcb86f
37 37
38 type env = { 38 type env = {
39 datatypes : (string * (string * int * typ option) list) IM.map, 39 datatypes : (string * (string * int * typ option) list) IM.map,
40 constructors : (string * typ option * int) IM.map, 40 constructors : (string * typ option * int) IM.map,
41 41
42 relE : (string * typ) list, 42 relE : (string * typ * exp option) list,
43 namedE : (string * typ * exp option * string) IM.map 43 namedE : (string * typ * exp option * string) IM.map
44 } 44 }
45 45
46 val empty = { 46 val empty = {
47 datatypes = IM.empty, 47 datatypes = IM.empty,
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 fun pushERel (env : env) x t = 73 fun pushERel (env : env) x t eo =
74 {datatypes = #datatypes env, 74 {datatypes = #datatypes env,
75 constructors = #constructors env, 75 constructors = #constructors env,
76 76
77 relE = (x, t) :: #relE env, 77 relE = (x, t, eo) :: #relE env,
78 namedE = #namedE env} 78 namedE = #namedE env}
79 79
80 fun lookupERel (env : env) n = 80 fun lookupERel (env : env) n =
81 (List.nth (#relE env, n)) 81 (List.nth (#relE env, n))
82 handle Subscript => raise UnboundRel n 82 handle Subscript => raise UnboundRel n
108 | DExport _ => env 108 | DExport _ => env
109 109
110 fun patBinds env (p, loc) = 110 fun patBinds env (p, loc) =
111 case p of 111 case p of
112 PWild => env 112 PWild => env
113 | PVar (x, t) => pushERel env x t 113 | PVar (x, t) => pushERel env x t NONE
114 | PPrim _ => env 114 | PPrim _ => env
115 | PCon (_, NONE) => env 115 | PCon (_, NONE) => env
116 | PCon (_, SOME p) => patBinds env p 116 | PCon (_, SOME p) => patBinds env p
117 | PRecord xps => foldl (fn ((_, p, _), env) => patBinds env p) env xps 117 | PRecord xps => foldl (fn ((_, p, _), env) => patBinds env p) env xps
118 118