summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-10-24 16:13:53 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-10-24 16:13:53 -0400
commitd27809108ef5ce4ed389cd39562e0dabb4a38c75 (patch)
tree61c2777481cb40e1b7abd0b564ba8172eb21200b /src
parent9569ae99c75cb74aeeb6fa02e6eec9eff2c7669f (diff)
Stop including functors in paths
Diffstat (limited to 'src')
-rw-r--r--src/corify.sml37
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