fixed unsafe contracts: there is now a ContractSafe module...

Author: melsman

Contract.sig

@@ -1,3 +1,3 @@
 signature Contract =
 CONTRACTSIG where type 'a exp = ContractBase.exp0
-            and type contr = ContractBase.contr 
+            and type contr = ContractBase.contr

ContractMonad.sml

@@ -1,4 +1,6 @@
 
+structure Contract = ContractSafe
+
 signature CONTRACT_MONAD = sig
   type 'a m
   val ret       : 'a -> 'a m
@@ -10,7 +12,7 @@ signature CONTRACT_MONAD = sig
   val wait      : int -> unit m
   val terminate : unit -> 'a m
   val skip      : unit m
-  val toContr   : unit m -> Contract.contr
+  val toContr   : unit m -> ContractSafe.contr
 end
 
 structure ContractMonad :> CONTRACT_MONAD =

ContractSafe.sml

@@ -0,0 +1 @@
+structure ContractSafe = Contract :> CONTRACTSIG

Instruments.sml

@@ -2,7 +2,7 @@ structure Instruments = struct
 
 exception Error of string
 
-local open Currency Contract in
+local open Currency ContractSafe in
 
 infix !+! !-! !*! !<! !=! !|! 
 

Makefile

@@ -6,7 +6,7 @@ MOSML=mosml
 
 # All infrastructure modules (not tests). Order matters here:
 
-COREFILES=DateUtil.sml ListSort.sig ListSort.sml CURRENCY.sig Currency.sml ContractBase.sml CONTRACTSIG.sig Contract.sig Contract.sml ContractTransform.sml Instruments.sml
+COREFILES=DateUtil.sml ListSort.sig ListSort.sml CURRENCY.sig Currency.sml ContractBase.sml CONTRACTSIG.sig Contract.sig Contract.sml ContractSafe.sml ContractTransform.sml Instruments.sml
 MOSMLFILES=LargeInt.sml $(COREFILES)
 
 SMLFILES=$(COREFILES) ContractMonad.sml

contract.mlb

@@ -10,6 +10,7 @@ in
    ContractBase.sml
    Contract.sig
    Contract.sml
+   ContractSafe.sml
    Instruments.sml
    ContractTransform.sml
    ContractMonad.sml

loadscript

@@ -3,10 +3,10 @@
 app load ["Math", "Date", "Bool", "ListPair", "IntInf", "CharVector"];
 structure LargeInt = Int;
 
-app use ["DateUtil.sml", "ListSort.sig", "ListSort.sml", "CURRENCY.sig", "Currency.sml", "ContractBase.sml", "CONTRACTSIG.sig", "Contract.sig", "Contract.sml", "Instruments.sml", "ContractTransform.sml", "ContractMonad.sml"];
+app use ["DateUtil.sml", "ListSort.sig", "ListSort.sml", "CURRENCY.sig", "Currency.sml", "ContractBase.sml", "CONTRACTSIG.sig", "Contract.sig", "Contract.sml", "ContractSafe.sml", "Instruments.sml", "ContractTransform.sml", "ContractMonad.sml"];
 
 (* bring contract "constructors" in direct scope *)
-open Currency Contract Instruments;
+open Currency ContractSafe Instruments;
 
 print "vanillaFx Put \"F\" \"us\" (USD,SEK) 30E6 6.3 365:\n";
 

pftest.sml

@@ -1,5 +1,5 @@
 local
-  open portfolio ContractTransform Contract
+  open portfolio ContractSafe
 in 
 
 (* compact function for computing and printing all cashflows

portfolio.sml

@@ -41,8 +41,8 @@ val forwards =
     ]
 
 (* everything together (using "all" constructor) is the portfolio *)
-val fxPortfolio = Contract.all (singleBarriers @ doubleBarriers @
-                                touchOptions @ vanillas @ forwards)
+val fxPortfolio = ContractSafe.all (singleBarriers @ doubleBarriers @
+                                    touchOptions @ vanillas @ forwards)
 
 end
 

test/basiccontracts.sml

@@ -1,6 +1,6 @@
 structure test = struct
 
-open Currency Contract
+open Currency ContractSafe
 infix !+! !-! !*! !<! !=! !|! 
 
 fun println s = print (s ^ "\n")

test/contract.sml

@@ -3,7 +3,7 @@ infix  6  !+! !-!
 infix  5  !|!
 infix  4  !=! !<!
 
-open Contract
+open ContractSafe
 
 val today = DateUtil.? "2014-01-01"
 fun ctestE s c f E =
@@ -19,27 +19,32 @@ val () = ctest "zero scale" zero (fn () => scale(R 3.0,zero))
 val () = ctest "zero both" zero (fn () => both(zero,scale(R 3.0,zero)))
 
 fun iter n f a = if n < 0 then a else iter (n-1) f (f(n,a))
+val pay1EUR = transfOne(EUR,"me","you")
+val equity = "Carlsberg"
+infix ++
+fun d ++ i = DateUtil.addDays i d
 
-local
-  val y1 = 360
-  val x = new "x"
-  val equity = "Carlsberg"
-  val hit = transl(y1,transfOne(EUR,"me","you"))
-  val f = (x, V x !|! (R 50.0 !<! obs(equity,0)))
-  fun barrier() =
-      iff(acc(f, y1, B false),
-          hit,
-          zero)
-  infix ++
-  fun d ++ i = DateUtil.addDays i d
-  val E_no = iter 1000 (fn (i,e) => addFixing((equity,today++i,20.0),e)) E0
-  val E_hit = iter 1000 (fn (i,e) => addFixing((equity,today++i,real (i div 7)),e)) E0
-in 
-  val () = ctestE "barrier - no hit" zero barrier E_no
-  val () = ctestE "barrier - hit" hit barrier E_hit
-end
+val () =
+    let val y1 = 360
+        val x = new "x"
+        val hit = transl(y1,pay1EUR)
+        val f = (x, V x !|! (R 50.0 !<! obs(equity,0)))
+        fun barrier() =
+            iff(acc(f, y1, B false),
+                hit,
+                zero)
+        val E_no = iter 1000 (fn (i,e) => addFixing((equity,today++i,20.0),e)) E0
+        val E_hit = iter 1000 (fn (i,e) => addFixing((equity,today++i,real (i div 7)),e)) E0
+    in ctestE "barrier - no hit" zero barrier E_no
+     ; ctestE "barrier - hit" hit barrier E_hit
+    end
 
-(*
-fun translE(e,c) = 
-val () = ctest "zero scale" zero (fn () => scale(R 3.0,zero))
+(* Requires let-binding...
+val () =
+    let val maxInt = 100000
+        fun translE(e: intE,c) =
+            checkWithin(obs("Time",0) !=! e, maxInt, c, zero)
+        val E = iter 1000 (fn (i,e) => addFixing((equity,today++i,real i),e)) E0
+    in ctestE "translE" pay1EUR (fn () => translE(obs(equity,5), pay1EUR)) E
+    end
 *)

test/expr.sml

@@ -4,7 +4,7 @@ infix  6  !+! !-!
 infix  5  !|!
 infix  4  !=! !<!
 
-open Contract
+open ContractSafe
 
 fun etestE s e f E =
     Utest.testPP ppExp s e (fn () =>
@@ -65,7 +65,7 @@ val f = (v,V v !+! I 1)
 val () = etest "test acc - i0" (I 44) (fn () => acc(f,0,I 44))
 val () = etest "test acc - i3" (I 4) (fn () => acc(f,3,I 1))
 
-val x : (int num * real num) var = new "v"
+val x : (real num * int num) var = new "v"
 val f = (x, pair(fst(V x) !+! obs("C",0),
                  snd(V x) !+! I 1))