Mercurial > urweb
comparison src/cjr_env.sml @ 188:8e9f97508f0d
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, _) => |