Mercurial > urweb

comparison src/corify.sml @ 163:80192edca30d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Datatypes through corify
author Adam Chlipala <adamc@hcoop.net>
date Tue, 29 Jul 2008 13:16:21 -0400
parents 06a98129b23f
children 33d4a8eea484
comparison
equal deleted inserted replaced
162:06a98129b23f 163:80192edca30d
73 73
74 datatype core_val = 74 datatype core_val =
75 ENormal of int 75 ENormal of int
76 | EFfi of string * L'.con 76 | EFfi of string * L'.con
77 val bindVal : t -> string -> int -> t * int 77 val bindVal : t -> string -> int -> t * int
78 val bindConstructor : t -> string -> int -> t
78 val lookupValById : t -> int -> int option 79 val lookupValById : t -> int -> int option
79 val lookupValByName : t -> string -> core_val 80 val lookupValByName : t -> string -> core_val
80 81
81 val bindStr : t -> string -> int -> t -> t 82 val bindStr : t -> string -> int -> t -> t
82 val lookupStrById : t -> int -> t 83 val lookupStrById : t -> int -> t
180 current = current, 181 current = current,
181 nested = nested}, 182 nested = nested},
182 n') 183 n')
183 end 184 end
184 185
186 fun bindConstructor {cons, vals, strs, funs, current, nested} s n =
187 let
188 val current =
189 case current of
190 FFfi _ => raise Fail "Binding inside FFfi"
191 | FNormal {cons, vals, strs, funs} =>
192 FNormal {cons = cons,
193 vals = SM.insert (vals, s, n),
194 strs = strs,
195 funs = funs}
196 in
197 {cons = cons,
198 vals = IM.insert (vals, n, n),
199 strs = strs,
200 funs = funs,
201 current = current,
202 nested = nested}
203 end
204
185 fun lookupValById ({vals, ...} : t) n = IM.find (vals, n) 205 fun lookupValById ({vals, ...} : t) n = IM.find (vals, n)
186 206
187 fun lookupValByName ({current, ...} : t) x = 207 fun lookupValByName ({current, ...} : t) x =
188 case current of 208 case current of
189 FFfi {mod = m, vals, ...} => 209 FFfi {mod = m, vals, ...} =>
382 let 402 let
383 val (st, n) = St.bindCon st x n 403 val (st, n) = St.bindCon st x n
384 in 404 in
385 ([(L'.DCon (x, n, corifyKind k, corifyCon st c), loc)], st) 405 ([(L'.DCon (x, n, corifyKind k, corifyCon st c), loc)], st)
386 end 406 end
387 | L.DDatatype _ => raise Fail "Corify DDatatype" 407 | L.DDatatype (x, n, xncs) =>
388 | L.DDatatypeImp _ => raise Fail "Corify DDatatypeImp" 408 let
409 val (st, n) = St.bindCon st x n
410 val (xncs, st) = ListUtil.foldlMap (fn ((x, n, co), st) =>
411 let
412 val st = St.bindConstructor st x n
413 val co = Option.map (corifyCon st) co
414 in
415 ((x, n, co), st)
416 end) st xncs
417 in
418 ([(L'.DDatatype (x, n, xncs), loc)], st)
419 end
420 | L.DDatatypeImp (x, n, m1, ms, s, xncs) =>
421 let
422 val (st, n) = St.bindCon st x n
423 val c = corifyCon st (L.CModProj (m1, ms, s), loc)
424
425 val (xncs, st) = ListUtil.foldlMap (fn ((x, n, co), st) =>
426 let
427 val (st, n) = St.bindVal st x n
428 val co = Option.map (corifyCon st) co
429 in
430 ((x, n, co), st)
431 end) st xncs
432
433 val cds = map (fn (x, n, co) =>
434 let
435 val t = case co of
436 NONE => c
437 | SOME t' => (L'.TFun (t', c), loc)
438 val e = corifyExp st (L.EModProj (m1, ms, x), loc)
439 in
440 (L'.DVal (x, n, t, e, x), loc)
441 end) xncs
442 in
443 ((L'.DCon (x, n, (L'.KType, loc), c), loc) :: cds, st)
444 end
389 | L.DVal (x, n, t, e) => 445 | L.DVal (x, n, t, e) =>
390 let 446 let
391 val (st, n) = St.bindVal st x n 447 val (st, n) = St.bindVal st x n
392 val s = 448 val s =
393 if String.isPrefix "wrap_" x then 449 if String.isPrefix "wrap_" x then