# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1224879233 14400
# Node ID 82067ea6e72324a292393c61a7fe54d63d24a134
# Parent  0ce90d4d9ae7fd00ca2217d718c51fe05674b24c
Stop including functors in paths

diff -r 0ce90d4d9ae7 -r 82067ea6e723 src/corify.sml
--- 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