Mercurial > urweb
comparison src/cjr_env.sml @ 809:81fce435e255
Mutual datatypes through Cjrize
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 16 May 2009 16:02:17 -0400 |
parents | 8688e01ae469 |
children | b2311dfb3158 |
comparison
equal
deleted
inserted
replaced
808:d8f58d488cfb | 809:81fce435e255 |
---|---|
135 else | 135 else |
136 Default | 136 Default |
137 | 137 |
138 fun declBinds env (d, loc) = | 138 fun declBinds env (d, loc) = |
139 case d of | 139 case d of |
140 DDatatype (_, x, n, xncs) => | 140 DDatatype dts => |
141 let | 141 foldl (fn ((_, x, n, xncs), env) => |
142 val env = pushDatatype env x n xncs | 142 let |
143 val dt = (TDatatype (classifyDatatype xncs, n, ref xncs), loc) | 143 val env = pushDatatype env x n xncs |
144 in | 144 val dt = (TDatatype (classifyDatatype xncs, n, ref xncs), loc) |
145 foldl (fn ((x', n', NONE), env) => pushENamed env x' n' dt | 145 in |
146 | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, dt), loc)) | 146 foldl (fn ((x', n', NONE), env) => pushENamed env x' n' dt |
147 env xncs | 147 | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, dt), loc)) |
148 end | 148 env xncs |
149 end) env dts | |
149 | DDatatypeForward (_, x, n) => pushDatatype env x n [] | 150 | DDatatypeForward (_, x, n) => pushDatatype env x n [] |
150 | DStruct (n, xts) => pushStruct env n xts | 151 | DStruct (n, xts) => pushStruct env n xts |
151 | DVal (x, n, t, _) => pushENamed env x n t | 152 | DVal (x, n, t, _) => pushENamed env x n t |
152 | DFun (fx, n, args, ran, _) => | 153 | DFun (fx, n, args, ran, _) => |
153 let | 154 let |