Mercurial > urweb
diff src/corify.sml @ 1989:210fb3dfc483
Some more nested functor bug-fixing, including generating fresh internal names at applications; still need to debug issues with datatype constructors
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 20 Feb 2014 10:27:15 -0500 |
parents | 6745eafff617 |
children | 7bd2ecf96bb0 |
line wrap: on
line diff
--- a/src/corify.sml Tue Feb 18 07:07:01 2014 -0500 +++ b/src/corify.sml Thu Feb 20 10:27:15 2014 -0500 @@ -64,7 +64,10 @@ in count := r + 1; r -end + end + +fun getCounter () = !count +fun setCounter n = count := n end @@ -107,11 +110,13 @@ val bindStr : t -> string -> int -> t -> t val lookupStrById : t -> int -> t + val lookupStrByIdOpt : t -> int -> t option val lookupStrByName : string * t -> t val lookupStrByNameOpt : string * t -> t option val bindFunctor : t -> string -> int -> string -> int -> L.str -> t val lookupFunctorById : t -> int -> string * int * L.str + val lookupFunctorByIdOpt : t -> int -> (string * int * L.str) option val lookupFunctorByName : string * t -> string * int * L.str end = struct @@ -399,6 +404,11 @@ NONE => raise Fail ("Corify.St.lookupStrById(" ^ Int.toString n ^ ")") | SOME f => dummy (basis, f) +fun lookupStrByIdOpt ({basis, strs, ...} : t) n = + case IM.find (strs, n) of + NONE => NONE + | SOME f => SOME (dummy (basis, f)) + fun lookupStrByName (m, {basis, current = FNormal {strs, ...}, ...} : t) = (case SM.find (strs, m) of NONE => raise Fail "Corify.St.lookupStrByName [1]" @@ -435,6 +445,9 @@ NONE => raise Fail "Corify.St.lookupFunctorById" | SOME v => v +fun lookupFunctorByIdOpt ({funs, ...} : t) n = + IM.find (funs, n) + fun lookupFunctorByName (m, {current = FNormal {funs, ...}, ...} : t) = (case SM.find (funs, m) of NONE => raise Fail ("Corify.St.lookupFunctorByName " ^ m ^ "[1]") @@ -781,6 +794,11 @@ ([], st) end + | L.DStr (x, n, _, (L.StrVar n', _)) => + (case St.lookupFunctorByIdOpt st n' of + SOME (arg, dom, body) => ([], St.bindFunctor st x n arg dom body) + | NONE => ([], St.bindStr st x n (St.lookupStrById st n'))) + | L.DStr (x, n, _, str) => let val mods' = @@ -1130,7 +1148,7 @@ ([], st)) end -and corifyStr mods ((str, _), st) = +and corifyStr mods ((str, loc), st) = case str of L.StrConst ds => let @@ -1163,6 +1181,20 @@ val (xa, na, body) = unwind str1 + (* An important step to make sure that nested functors + * "close under their environments": *) + val (next, body') = ExplRename.rename {NextId = getCounter (), + FormalName = xa, + FormalId = na, + Body = body} + + (*val () = Print.prefaces ("RENAME " ^ ErrorMsg.spanToString loc) + [("FROM", ExplPrint.p_str ExplEnv.empty body), + ("TO", ExplPrint.p_str ExplEnv.empty body')]*) + val body = body' + + val () = setCounter next + val (ds1, {inner = inner', outer}) = corifyStr mods (str2, st) val (ds2, {inner, outer}) = corifyStr mods (body, St.bindStr outer xa na inner')