[MLton-commit] r4599

[Wesley Terpstra]

Carry type information from _symbol all the way to the c-codegen when importing. This prevents type conflicts with objects which already imported by MLton's own header files.
----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.sig
U   mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun
U   mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun

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

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun	2006-05-25 06:50:42 UTC (rev 4598)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun	2006-05-25 10:52:45 UTC (rev 4599)
@@ -46,7 +46,7 @@
  | Exn_setExtendExtra (* implement exceptions *)
  | Exn_setInitExtra (* implement exceptions *)
  | FFI of 'a CFunction.t (* ssa to rssa *)
- | FFI_Symbol of {name: string} (* codegen *)
+ | FFI_Symbol of {name: string, cty: CType.t option} (* codegen *)
  | GC_collect (* ssa to rssa *)
  | IntInf_add (* ssa to rssa *)
  | IntInf_andb (* ssa to rssa *)
@@ -486,7 +486,7 @@
     | Exn_setExtendExtra => Exn_setExtendExtra
     | Exn_setInitExtra => Exn_setInitExtra
     | FFI func => FFI (CFunction.map (func, f))
-    | FFI_Symbol {name} => FFI_Symbol {name = name}
+    | FFI_Symbol {name, cty} => FFI_Symbol {name = name, cty = cty}
     | GC_collect => GC_collect
     | IntInf_add => IntInf_add
     | IntInf_andb => IntInf_andb

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.sig	2006-05-25 06:50:42 UTC (rev 4598)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.sig	2006-05-25 10:52:45 UTC (rev 4599)
@@ -36,7 +36,7 @@
              | Exn_setExtendExtra (* implement exceptions *)
              | Exn_setInitExtra (* implement exceptions *)
              | FFI of 'a CFunction.t (* ssa to rssa *)
-             | FFI_Symbol of {name: string} (* codegen *)
+             | FFI_Symbol of {name: string, cty: CType.t option} (* codegen *)
              | GC_collect (* ssa to rssa *)
              | IntInf_add (* ssa to rssa *)
              | IntInf_andb (* ssa to rssa *)
@@ -216,7 +216,7 @@
                                 deWeak: 'b -> 'b,
                                 result: 'b} -> 'b vector
       val ffi: 'a CFunction.t -> 'a t
-      val ffiSymbol: {name: string} -> 'a t
+      val ffiSymbol: {name: string, cty: CType.t option} -> 'a t
       val fromString: string -> 'a t option
       val gcCollect: 'a t
       val intInfEqual: 'a t

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun	2006-05-25 06:50:42 UTC (rev 4598)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun	2006-05-25 10:52:45 UTC (rev 4599)
@@ -476,10 +476,16 @@
               case s of
                  Statement.PrimApp {prim, ...} =>
                     (case Prim.name prim of
-                        Prim.Name.FFI_Symbol {name} =>
+                        Prim.Name.FFI_Symbol {name, cty} =>
                            doit
                            (name, fn () =>
-                            concat ["extern ", name, ";\n"])
+                            concat ["extern ", 
+                                    case cty of
+                                       SOME x => CType.toString x
+                                     | NONE => "", 
+                                    " ",
+                                    name, 
+                                    ";\n"])
                       | _ => ())
                | _ => ())
           val _ =

Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun	2006-05-25 06:50:42 UTC (rev 4598)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-core.fun	2006-05-25 10:52:45 UTC (rev 4599)
@@ -940,9 +940,10 @@
                            Type.defaultWord)
 
    fun mkAddress {expandedPtrTy: Type.t,
-                  name: string}: Cexp.t =
+                  name: string,
+                  cty: CType.t option }: Cexp.t =
       primApp {args = Vector.new0 (),
-               prim = Prim.ffiSymbol {name = name},
+               prim = Prim.ffiSymbol {name = name, cty = cty},
                result = expandedPtrTy}
 
    fun mkFetch {ctypeCbTy, isBool,
@@ -1038,7 +1039,8 @@
              | _ => (error (); ())
          val addrExp =
             mkAddress {expandedPtrTy = expandedPtrTy,
-                       name = name}
+                       name = name,
+                       cty = NONE}
          fun wrap (e, t) = Cexp.make (Cexp.node e, t)
       in
          wrap (addrExp, elabedTy)
@@ -1099,7 +1101,8 @@
              | NONE => (error (); CType.word (WordSize.default, {signed = false}))
          val addrExp =
             mkAddress {expandedPtrTy = Type.word (WordSize.pointer ()),
-                       name = name}
+                       name = name,
+                       cty = SOME ctypeCbTy}
          val () =
             if List.exists (attributes, fn attr =>
                             attr = SymbolAttribute.Alloc)
@@ -1220,7 +1223,8 @@
          val isBool = Type.isBool expandedCbTy
          val addrExp =
             mkAddress {expandedPtrTy = Type.word (WordSize.pointer ()),
-                       name = name}
+                       name = name,
+                       cty = SOME ctypeCbTy}
          fun wrap (e, t) = Cexp.make (Cexp.node e, t)
       in
          wrap (mkFetch {ctypeCbTy = ctypeCbTy,