Mercurial > urweb
comparison src/corify.sml @ 1990:7bd2ecf96bb0
Fixed issue with datatype constructors inside functors; now on to some problem with modules inside functors
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 20 Feb 2014 10:48:17 -0500 |
parents | 210fb3dfc483 |
children | 403f0cc65b9c |
comparison
equal
deleted
inserted
replaced
1989:210fb3dfc483 | 1990:7bd2ecf96bb0 |
---|---|
97 val bindConstructor : t -> string -> int -> t * int | 97 val bindConstructor : t -> string -> int -> t * int |
98 val bindConstructorAs : t -> string -> int -> L'.patCon -> t | 98 val bindConstructorAs : t -> string -> int -> L'.patCon -> t |
99 val lookupConstructorByNameOpt : t -> string -> L'.patCon option | 99 val lookupConstructorByNameOpt : t -> string -> L'.patCon option |
100 val lookupConstructorByName : t -> string -> L'.patCon | 100 val lookupConstructorByName : t -> string -> L'.patCon |
101 val lookupConstructorById : t -> int -> L'.patCon | 101 val lookupConstructorById : t -> int -> L'.patCon |
102 val lookupConstructorByIdOpt : t -> int -> L'.patCon option | |
102 | 103 |
103 datatype core_val = | 104 datatype core_val = |
104 ENormal of int | 105 ENormal of int |
105 | EFfi of string * L'.con | 106 | EFfi of string * L'.con |
106 val bindVal : t -> string -> int -> t * int | 107 val bindVal : t -> string -> int -> t * int |
317 | 318 |
318 fun lookupConstructorById ({constructors, ...} : t) n = | 319 fun lookupConstructorById ({constructors, ...} : t) n = |
319 case IM.find (constructors, n) of | 320 case IM.find (constructors, n) of |
320 NONE => raise Fail "Corify.St.lookupConstructorById" | 321 NONE => raise Fail "Corify.St.lookupConstructorById" |
321 | SOME x => x | 322 | SOME x => x |
323 | |
324 fun lookupConstructorByIdOpt ({constructors, ...} : t) n = | |
325 IM.find (constructors, n) | |
322 | 326 |
323 fun lookupConstructorByNameOpt ({current, ...} : t) x = | 327 fun lookupConstructorByNameOpt ({current, ...} : t) x = |
324 case current of | 328 case current of |
325 FFfi {mod = m, constructors, ...} => | 329 FFfi {mod = m, constructors, ...} => |
326 (case SM.find (constructors, x) of | 330 (case SM.find (constructors, x) of |
742 (L'.DVal (x, n, t, e, x), loc) | 746 (L'.DVal (x, n, t, e, x), loc) |
743 end) xncs | 747 end) xncs |
744 in | 748 in |
745 ((L'.DCon (x, n, k', cBase), loc) :: cds, st) | 749 ((L'.DCon (x, n, k', cBase), loc) :: cds, st) |
746 end | 750 end |
751 | L.DVal (x, n, t, e as (L.ENamed n', _)) => | |
752 let | |
753 val st = | |
754 case St.lookupConstructorByIdOpt st n' of | |
755 SOME pc => St.bindConstructorAs st x n pc | |
756 | _ => st | |
757 | |
758 val (st, n) = St.bindVal st x n | |
759 val s = doRestify Settings.Url (mods, x) | |
760 in | |
761 ([(L'.DVal (x, n, corifyCon st t, corifyExp st e, s), loc)], st) | |
762 end | |
747 | L.DVal (x, n, t, e) => | 763 | L.DVal (x, n, t, e) => |
748 let | 764 let |
749 val (st, n) = St.bindVal st x n | 765 val (st, n) = St.bindVal st x n |
750 val s = doRestify Settings.Url (mods, x) | 766 val s = doRestify Settings.Url (mods, x) |
751 in | 767 in |