diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-10-24 16:13:53 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-10-24 16:13:53 -0400 |
commit | d27809108ef5ce4ed389cd39562e0dabb4a38c75 (patch) | |
tree | 61c2777481cb40e1b7abd0b564ba8172eb21200b /src | |
parent | 9569ae99c75cb74aeeb6fa02e6eec9eff2c7669f (diff) |
Stop including functors in paths
Diffstat (limited to 'src')
-rw-r--r-- | src/corify.sml | 37 |
1 files changed, 14 insertions, 23 deletions
diff --git a/src/corify.sml b/src/corify.sml index 09af27d0..89d1e63f 100644 --- a/src/corify.sml +++ b/src/corify.sml @@ -109,9 +109,9 @@ structure St : sig 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 @@ datatype flattening = 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 @@ type t = { 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 lookupStrByNameOpt (m, {basis, current = FNormal {strs, ...}, ...} : t) = 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 @@ fun corifyDecl mods ((d, loc : EM.span), st) = | 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 @@ fun corifyDecl mods ((d, loc : EM.span), st) = 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 @@ and corifyStr mods ((str, _), st) = | 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 |