[MLton-devel] cvs commit: MLton_touch primitive

[Stephen Weeks]

sweeks      03/05/19 19:18:29

  Modified:    basis-library/misc primitive.sml
               basis-library/mlton finalizable.sml
               mlton/atoms prim.fun prim.sig
               mlton/backend backend.fun
  Log:
  Added MLton_touch primitive and used it in implementing
  MLton.Finalizable.

Revision  Changes    Path
1.51      +1 -0      mlton/basis-library/misc/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -r1.50 -r1.51
--- primitive.sml	12 May 2003 08:36:18 -0000	1.50
+++ primitive.sml	20 May 2003 02:18:25 -0000	1.51
@@ -58,6 +58,7 @@
       val handlesSignals = _prim "MLton_handlesSignals": bool;
       val installSignalHandler = _prim "MLton_installSignalHandler": unit -> unit;
       val safe = _build_const "MLton_safe": bool;
+      val touch = fn z => _prim "MLton_touch": 'a -> unit; z
       val usesCallcc: bool ref = ref false;
 
       structure Array =



1.6       +1 -6      mlton/basis-library/mlton/finalizable.sml

Index: finalizable.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/finalizable.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- finalizable.sml	19 May 2003 22:05:53 -0000	1.5
+++ finalizable.sml	20 May 2003 02:18:25 -0000	1.6
@@ -14,14 +14,9 @@
 		      finalizers: ('a -> unit) list ref,
 		      value: 'a ref}
 
-fun touch (r: 'a ref) =
-   if r = ref (!r)
-      then raise Fail "Finalize.touch bug\n"
-   else ()
-	    
 fun withValue (T {value, ...}, f) =
    DynamicWind.wind (fn () => f (!value),
-		     fn () => touch value)
+		     fn () => Primitive.touch value)
 
 fun addFinalizer (T {finalizers, ...}, f) =
    List.push (finalizers, f)



1.49      +3 -0      mlton/mlton/atoms/prim.fun

Index: prim.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.fun,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -r1.48 -r1.49
--- prim.fun	19 May 2003 18:36:45 -0000	1.48
+++ prim.fun	20 May 2003 02:18:26 -0000	1.49
@@ -106,6 +106,7 @@
        | MLton_installSignalHandler
        | MLton_serialize
        | MLton_size
+       | MLton_touch
        | Real_Math_acos
        | Real_Math_asin
        | Real_Math_atan
@@ -330,6 +331,7 @@
 	   "MLton_installSignalHandler"),
 	  (MLton_serialize, DependsOnState, "MLton_serialize"),
 	  (MLton_size, DependsOnState, "MLton_size"),
+	  (MLton_touch, SideEffect, "MLton_touch"),
 	  (Real_Math_acos, Functional, "Real_Math_acos"),
 	  (Real_Math_asin, Functional, "Real_Math_asin"),
 	  (Real_Math_atan, Functional, "Real_Math_atan"),
@@ -700,6 +702,7 @@
        | MLton_equal => one (arg 0)
        | MLton_serialize => one (arg 0)
        | MLton_size => one (deref (arg 0))
+       | MLton_touch => one (arg 0)
        | Ref_assign => one (arg 1)
        | Ref_deref => one result
        | Ref_ref => one (arg 0)



1.38      +1 -0      mlton/mlton/atoms/prim.sig

Index: prim.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.sig,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -r1.37 -r1.38
--- prim.sig	14 May 2003 01:14:46 -0000	1.37
+++ prim.sig	20 May 2003 02:18:26 -0000	1.38
@@ -111,6 +111,7 @@
 	     | MLton_installSignalHandler (* backend *)
 	     | MLton_serialize (* unused *)
 	     | MLton_size (* ssa to rssa *)
+	     | MLton_touch (* backend *)
 	     | Real_Math_acos (* codegen *)
 	     | Real_Math_asin (* codegen *)
 	     | Real_Math_atan (* codegen *)



1.54      +1 -0      mlton/mlton/backend/backend.fun

Index: backend.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/backend.fun,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -r1.53 -r1.54
--- backend.fun	15 May 2003 14:50:55 -0000	1.53
+++ backend.fun	20 May 2003 02:18:26 -0000	1.54
@@ -500,6 +500,7 @@
 		  in
 		     case Prim.name prim of
 			MLton_installSignalHandler => Vector.new0 ()
+		      | MLton_touch => Vector.new0 ()
 		      | _ => 
 			   Vector.new1
 			   (M.Statement.PrimApp





-------------------------------------------------------
This SF.net email is sponsored by: ObjectStore.
If flattening out C++ or Java code to make your application fit in a
relational database is painful, don't do it! Check out ObjectStore.
Now part of Progress Software. http://www.objectstore.net/sourceforge
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel