Mercurial > urweb
comparison src/mono_env.sml @ 188:8e9f97508f0d
Datatype representation optimization
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 03 Aug 2008 19:49:21 -0400 |
parents | c0ea24dcb86f |
children | 890a61991263 |
comparison
equal
deleted
inserted
replaced
187:fb6ed259f5bd | 188:8e9f97508f0d |
---|---|
96 fun declBinds env (d, loc) = | 96 fun declBinds env (d, loc) = |
97 case d of | 97 case d of |
98 DDatatype (x, n, xncs) => | 98 DDatatype (x, n, xncs) => |
99 let | 99 let |
100 val env = pushDatatype env x n xncs | 100 val env = pushDatatype env x n xncs |
101 val dt = (TDatatype (MonoUtil.classifyDatatype xncs, n, xncs), loc) | |
101 in | 102 in |
102 foldl (fn ((x', n', NONE), env) => pushENamed env x' n' (TDatatype (n, xncs), loc) NONE "" | 103 foldl (fn ((x', n', NONE), env) => pushENamed env x' n' dt NONE "" |
103 | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, (TDatatype (n, xncs), loc)), loc) NONE "") | 104 | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, dt), loc) NONE "") |
104 env xncs | 105 env xncs |
105 end | 106 end |
106 | DVal (x, n, t, e, s) => pushENamed env x n t (SOME e) s | 107 | DVal (x, n, t, e, s) => pushENamed env x n t (SOME e) s |
107 | DValRec vis => foldl (fn ((x, n, t, e, s), env) => pushENamed env x n t NONE s) env vis | 108 | DValRec vis => foldl (fn ((x, n, t, e, s), env) => pushENamed env x n t NONE s) env vis |
108 | DExport _ => env | 109 | DExport _ => env |
110 fun patBinds env (p, loc) = | 111 fun patBinds env (p, loc) = |
111 case p of | 112 case p of |
112 PWild => env | 113 PWild => env |
113 | PVar (x, t) => pushERel env x t NONE | 114 | PVar (x, t) => pushERel env x t NONE |
114 | PPrim _ => env | 115 | PPrim _ => env |
115 | PCon (_, NONE) => env | 116 | PCon (_, _, NONE) => env |
116 | PCon (_, SOME p) => patBinds env p | 117 | PCon (_, _, SOME p) => patBinds env p |
117 | PRecord xps => foldl (fn ((_, p, _), env) => patBinds env p) env xps | 118 | PRecord xps => foldl (fn ((_, p, _), env) => patBinds env p) env xps |
118 | 119 |
119 end | 120 end |