Mercurial > urweb

comparison src/corify.sml @ 1990:7bd2ecf96bb0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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