[MLton-commit] r6397

[Vesa Karvonen]

Added a tiny combinator library for contracts (as in Design by Contract).

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

A   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/debug/
A   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/debug/contract.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm
U   mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
U   mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use
A   mltonlib/trunk/com/ssh/extended-basis/unstable/public/debug/
A   mltonlib/trunk/com/ssh/extended-basis/unstable/public/debug/contract.sig

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

Added: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/debug/contract.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/debug/contract.sml	2008-02-14 00:38:53 UTC (rev 6396)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/debug/contract.sml	2008-02-14 01:12:08 UTC (rev 6397)
@@ -0,0 +1,27 @@
+(* Copyright (C) 2008 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+structure Contract :> CONTRACT = struct
+   type 'a t = 'a UnOp.t
+   exception Contract
+   exception Caller of Exn.t
+   exception Callee of Exn.t
+   val assert = Fn.id
+   val T = Fn.id
+   fun F _ = raise Contract
+   val ef = Effect.obs
+   fun pr pr x = if pr x then x else raise Contract
+   fun op --> (d, c) f x =
+       Exn.try (fn () => d x,
+                fn x => c x (f x)
+                   handle Caller e => raise Callee e
+                        | Callee e => raise Caller e
+                        | e        => raise Callee e,
+                fn e as Caller _ => raise e
+                 | e as Callee _ => raise e
+                 | e             => raise Caller e)
+   val op andAlso = op o
+end


Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/debug/contract.sml
___________________________________________________________________
Name: svn:eol-style
   + native

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm	2008-02-14 00:38:53 UTC (rev 6396)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm	2008-02-14 01:12:08 UTC (rev 6397)
@@ -43,6 +43,7 @@
    ../../../public/data/unit.sig
    ../../../public/data/univ.sig
    ../../../public/data/void.sig
+   ../../../public/debug/contract.sig
    ../../../public/fn/bin-fn.sig
    ../../../public/fn/bin-op.sig
    ../../../public/fn/bin-pr.sig

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm	2008-02-14 00:38:53 UTC (rev 6396)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm	2008-02-14 01:12:08 UTC (rev 6397)
@@ -29,6 +29,7 @@
    ../../../detail/data/sq.sml
    ../../../detail/data/sum.sml
    ../../../detail/data/univ-exn.sml
+   ../../../detail/debug/contract.sml
    ../../../detail/fn/bin-fn.sml
    ../../../detail/fn/bin-op.sml
    ../../../detail/fn/bin-pr.sml

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb	2008-02-14 00:38:53 UTC (rev 6396)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb	2008-02-14 01:12:08 UTC (rev 6397)
@@ -195,6 +195,10 @@
          public/control/exn.sig
          detail/control/exn.sml
 
+         (* Contract *)
+         public/debug/contract.sig
+         detail/debug/contract.sml
+
          (* Emb *)
          public/generic/emb.sig
          detail/generic/emb.sml

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use	2008-02-14 00:38:53 UTC (rev 6396)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use	2008-02-14 01:12:08 UTC (rev 6397)
@@ -88,6 +88,8 @@
      "detail/data/sum.sml",
      "public/control/exn.sig",
      "detail/control/exn.sml",
+     "public/debug/contract.sig",
+     "detail/debug/contract.sml",
      "public/generic/emb.sig",
      "detail/generic/emb.sml",
      "public/generic/iso.sig",

Added: mltonlib/trunk/com/ssh/extended-basis/unstable/public/debug/contract.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/debug/contract.sig	2008-02-14 00:38:53 UTC (rev 6396)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/debug/contract.sig	2008-02-14 01:12:08 UTC (rev 6397)
@@ -0,0 +1,36 @@
+(* Copyright (C) 2008 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+(**
+ * The {Contract} module provides a combinator library for specifying
+ * contrants.  Inspiration comes mainly from the article:
+ *
+ *   Contracts for Higher-Order Functions
+ *   Robert Bruce Findler and Matthias Felleisen
+ *   ICFP 2002
+ *   [http://citeseer.ist.psu.edu/findler02contracts.html]
+ *
+ * Another combinator library with the same source of inspiration, but a
+ * different implementation, is described in the article:
+ *
+ *   Typed Contracts for Functional Programming
+ *   Ralf Hinze, Johan Jeuring, and Andres Löh
+ *   FLOPS 2006
+ *   [http://people.cs.uu.nl/andres/Contracts.html]
+ *)
+signature CONTRACT = sig
+   type 'a t
+   exception Contract
+   exception Caller of Exn.t
+   exception Callee of Exn.t
+   val assert : 'a t -> 'a UnOp.t
+   val T : 'a t
+   val F : 'a t
+   val ef : 'a Effect.t -> 'a t
+   val pr : 'a UnPr.t -> 'a t
+   val andAlso : 'a t BinOp.t
+   val --> : 'a t * ('a -> 'b t) -> ('a -> 'b) t
+end


Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/public/debug/contract.sig
___________________________________________________________________
Name: svn:eol-style
   + native