Mercurial > urweb

comparison src/cjr_env.sml @ 188:8e9f97508f0d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Datatype representation optimization
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 19:49:21 -0400
parents d11754ffe252
children 890a61991263
comparison
equal deleted inserted replaced
187:fb6ed259f5bd 188:8e9f97508f0d
127 fun lookupStruct (env : env) n = 127 fun lookupStruct (env : env) n =
128 case IM.find (#structs env, n) of 128 case IM.find (#structs env, n) of
129 NONE => raise UnboundStruct n 129 NONE => raise UnboundStruct n
130 | SOME x => x 130 | SOME x => x
131 131
132 fun classifyDatatype xncs =
133 if List.all (fn (_, _, NONE) => true | _ => false) xncs then
134 Enum
135 else
136 Default
137
132 fun declBinds env (d, loc) = 138 fun declBinds env (d, loc) =
133 case d of 139 case d of
134 DDatatype (x, n, xncs) => 140 DDatatype (_, x, n, xncs) =>
135 let 141 let
136 val env = pushDatatype env x n xncs 142 val env = pushDatatype env x n xncs
143 val dt = (TDatatype (classifyDatatype xncs, n, xncs), loc)
137 in 144 in
138 foldl (fn ((x', n', NONE), env) => pushENamed env x' n' (TDatatype (n, xncs), loc) 145 foldl (fn ((x', n', NONE), env) => pushENamed env x' n' dt
139 | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, (TDatatype (n, xncs), loc)), loc)) 146 | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, dt), loc))
140 env xncs 147 env xncs
141 end 148 end
142 | DStruct (n, xts) => pushStruct env n xts 149 | DStruct (n, xts) => pushStruct env n xts
143 | DVal (x, n, t, _) => pushENamed env x n t 150 | DVal (x, n, t, _) => pushENamed env x n t
144 | DFun (fx, n, args, ran, _) => 151 | DFun (fx, n, args, ran, _) =>