Mercurial > urweb
diff src/corify.sml @ 423:82067ea6e723
Stop including functors in paths
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Fri, 24 Oct 2008 16:13:53 -0400 |
parents | ab3177746c78 |
children | dfc8c991abd0 |
line wrap: on
line diff
--- a/src/corify.sml Thu Oct 23 18:45:10 2008 -0400 +++ b/src/corify.sml Fri Oct 24 16:13:53 2008 -0400 @@ -109,9 +109,9 @@ val lookupStrByName : string * t -> t val lookupStrByNameOpt : string * t -> t option - val bindFunctor : t -> string list -> string -> int -> string -> int -> L.str -> t - val lookupFunctorById : t -> int -> string list * string * int * L.str - val lookupFunctorByName : string * t -> string list * string * int * L.str + val bindFunctor : t -> string -> int -> string -> int -> L.str -> t + val lookupFunctorById : t -> int -> string * int * L.str + val lookupFunctorByName : string * t -> string * int * L.str end = struct datatype flattening = @@ -120,7 +120,7 @@ constructors : L'.patCon SM.map, vals : int SM.map, strs : flattening SM.map, - funs : (string list * string * int * L.str) SM.map} + funs : (string * int * L.str) SM.map} | FFfi of {mod : string, vals : L'.con SM.map, constructors : (string * string list * L'.con option * L'.datatype_kind) SM.map} @@ -131,7 +131,7 @@ constructors : L'.patCon IM.map, vals : int IM.map, strs : flattening IM.map, - funs : (string list * string * int * L.str) IM.map, + funs : (string * int * L.str) IM.map, current : flattening, nested : flattening list } @@ -405,21 +405,21 @@ fun bindFunctor ({basis, cons, constructors, vals, strs, funs, current = FNormal {name, cons = mcons, constructors = mconstructors, vals = mvals, strs = mstrs, funs = mfuns}, nested} : t) - mods x n xa na str = + x n xa na str = {basis = basis, cons = cons, constructors = constructors, vals = vals, strs = strs, - funs = IM.insert (funs, n, (mods, xa, na, str)), + funs = IM.insert (funs, n, (xa, na, str)), current = FNormal {name = name, cons = mcons, constructors = mconstructors, vals = mvals, strs = mstrs, - funs = SM.insert (mfuns, x, (mods, xa, na, str))}, + funs = SM.insert (mfuns, x, (xa, na, str))}, nested = nested} - | bindFunctor _ _ _ _ _ _ _ = raise Fail "Corify.St.bindFunctor" + | bindFunctor _ _ _ _ _ _ = raise Fail "Corify.St.bindFunctor" fun lookupFunctorById ({funs, ...} : t) n = case IM.find (funs, n) of @@ -696,7 +696,7 @@ | L.DSgn _ => ([], st) | L.DStr (x, n, _, (L.StrFun (xa, na, _, _, str), _)) => - ([], St.bindFunctor st (x :: mods) x n xa na str) + ([], St.bindFunctor st x n xa na str) | L.DStr (x, n, _, (L.StrProj (str, x'), _)) => let @@ -706,9 +706,9 @@ SOME st' => St.bindStr st x n st' | NONE => let - val (mods', x', n', str') = St.lookupFunctorByName (x', inner) + val (x', n', str') = St.lookupFunctorByName (x', inner) in - St.bindFunctor st mods' x n x' n' str' + St.bindFunctor st x n x' n' str' end in ([], st) @@ -957,20 +957,11 @@ | L.StrProj (str, x) => St.lookupFunctorByName (x, unwind' str) | _ => raise Fail "Corify of fancy functor application [2]" - val (fmods, xa, na, body) = unwind str1 + val (xa, na, body) = unwind str1 val (ds1, {inner = inner', outer}) = corifyStr mods (str2, st) - val mods' = case #1 str2 of - L.StrConst _ => fmods @ mods - | _ => - let - val ast = unwind' str2 - in - fmods @ St.name ast - end - - val (ds2, {inner, outer}) = corifyStr mods' (body, St.bindStr outer xa na inner') + val (ds2, {inner, outer}) = corifyStr mods (body, St.bindStr outer xa na inner') in (ds1 @ ds2, {inner = St.bindStr inner xa na inner', outer = outer}) end