[MLton-commit] r6875

[Wesley Terpstra]

Check that symbol scopes are used consistently. Give a warning if not.

This a common example that generates the warning:
  val _ = _export "foo" ...  (* defaults to public *)
  val a = _address "foo" ... (* defaults to external *)


----------------------------------------------------------------------

U   mlton/trunk/mlton/atoms/ffi.fun
U   mlton/trunk/mlton/atoms/ffi.sig
U   mlton/trunk/mlton/elaborate/elaborate-core.fun

----------------------------------------------------------------------

Modified: mlton/trunk/mlton/atoms/ffi.fun
===================================================================
--- mlton/trunk/mlton/atoms/ffi.fun	2008-09-21 12:53:12 UTC (rev 6874)
+++ mlton/trunk/mlton/atoms/ffi.fun	2008-09-22 09:43:21 UTC (rev 6875)
@@ -13,6 +13,23 @@
 structure Convention = CFunction.Convention
 structure SymbolScope = CFunction.SymbolScope
 
+local
+   val scopes: (word * String.t * SymbolScope.t) HashSet.t = 
+      HashSet.new {hash = #1}
+in
+   fun checkScope {name, symbolScope} =
+      let
+         val hash = String.hash name
+      in
+         (#3 o HashSet.lookupOrInsert)
+         (scopes, hash,
+          fn (hash', name', _) =>
+          hash = hash' andalso name = name',
+          fn () =>
+          (hash, name, symbolScope))
+      end
+end
+
 val exports: {args: CType.t vector,
               convention: Convention.t,
               id: int,

Modified: mlton/trunk/mlton/atoms/ffi.sig
===================================================================
--- mlton/trunk/mlton/atoms/ffi.sig	2008-09-21 12:53:12 UTC (rev 6874)
+++ mlton/trunk/mlton/atoms/ffi.sig	2008-09-22 09:43:21 UTC (rev 6875)
@@ -25,6 +25,9 @@
       val addSymbol: {ty: CType.t,
                       name: string,
                       symbolScope: CFunction.SymbolScope.t} -> unit
+      val checkScope: {name: string,
+                       symbolScope: CFunction.SymbolScope.t} ->
+                      CFunction.SymbolScope.t
       val declareExports: {print: string -> unit} -> unit
       val declareHeaders: {print: string -> unit} -> unit
       val numExports: unit -> int

Modified: mlton/trunk/mlton/elaborate/elaborate-core.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-core.fun	2008-09-21 12:53:12 UTC (rev 6874)
+++ mlton/trunk/mlton/elaborate/elaborate-core.fun	2008-09-22 09:43:21 UTC (rev 6875)
@@ -908,6 +908,21 @@
                | _ => NONE)
     | _ => NONE
 
+fun scopeCheck {name, symbolScope, region} =
+   let
+      fun warn l = 
+         Control.warning (region, seq (List.map (l, str)), Layout.empty)
+      val oldScope = 
+         Ffi.checkScope {name = name, symbolScope = symbolScope}
+   in
+      if symbolScope = oldScope then () else
+      warn [ "symbol '", name, "' redeclared as ", 
+             SymbolScope.toString symbolScope, 
+             " (previously ", 
+             SymbolScope.toString oldScope,
+             "). This may cause linker errors"]
+   end
+
 fun import {attributes: ImportExportAttribute.t list,
             elabedTy: Type.t,
             expandedTy: Type.t,
@@ -949,6 +964,12 @@
                      NONE => (invalidAttributes ()
                               ; SymbolScope.External)
                    | SOME s => s
+               val () = 
+                  case name of
+                     NONE => ()
+                   | SOME x => scopeCheck {name = x, 
+                                           symbolScope = symbolScope, 
+                                           region = region}
                val addrTy = Type.cpointer
                val func =
                   CFunction.T {args = let
@@ -1163,6 +1184,9 @@
                NONE => (invalidAttributes ()
                         ; SymbolScope.External)
              | SOME s => s
+         val () = scopeCheck {name = name, 
+                              symbolScope = symbolScope, 
+                              region = region}
          val addrExp =
             mkAddress {expandedPtrTy = expandedPtrTy,
                        name = name,
@@ -1251,6 +1275,9 @@
          val () =
             if alloc andalso symbolScope = SymbolScope.External
             then invalidAttributes () else ()
+         val () = scopeCheck {name = name, 
+                              symbolScope = symbolScope, 
+                              region = region}
          val () =
             if not alloc then () else
             Ffi.addSymbol {name = name, 
@@ -1378,6 +1405,9 @@
                (invalidAttributes ()
                 ; SymbolScope.Public)
           | SOME s => s
+      val () = scopeCheck {name = name, 
+                           symbolScope = symbolScope, 
+                           region = region}
       val (exportId, args, res) =
          case Type.toCFunType expandedTy of
             NONE =>