part2.cd 2.17 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
let pretty (x : Int) : String = string_of x;;
let even (Int -> Bool; ('a\Int) -> ('a\Int))
| x & Int -> (x mod 2) = 0
| x -> x
;;
let mmap (f : 'a -> 'b) (l : [ ('a) *] ) : [ ('b) *] =
  match l with
    [] -> []
  | (e, ll) -> (f e, mmap f ll)
;;
let map_even = mmap even
;;
let g ( (Int -> Int) -> Int -> Int;
        (Bool -> Bool) -> Bool -> Bool) x -> x
;;
let id ('a -> 'a) x -> x;;

let gid = g id;;
let id2g = id (id g);;

let churchtrue (x : 'a) (y : 'b) : 'a = x in churchtrue 42;;

let max (x : 'a) (y : 'a) : 'a = if x >> y then x else y;;

max 42;;

27

28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
type RBtree = Btree | Rtree
type Btree  = <blk elem='a>[ RBtree RBtree ] | []
type Rtree  = <red elem='a>[ Btree  Btree ]
type Unbal  = <blk elem='a>( [ Wrong RBtree ]
                           | [ RBtree Wrong ])
type Wrong  = <red elem='a>(  [ Rtree Btree ]
                           | [ Btree Rtree ])

let balance ( Unbal ->Rtree ; ('b \ Unbal) ->('b \ Unbal) )
  | <blk (z)>[ <red (y)>[ <red (x)>[ a b ] c ] d ]
  | <blk (z)>[ <red (x)>[ a <red (y)>[ b c ] ] d ]
  | <blk (x)>[ a <red (z)>[ <red (y)>[ b c ] d ] ]
  | <blk (x)>[ a <red (y)>[ b <red (z)>[ c d ] ] ]
      -> <red (y)>[  <blk (x)>[ a b ]   <blk (z)>[ c d ]  ]
  | x -> x
;;
Giuseppe Castagna's avatar
Giuseppe Castagna committed
44 45 46 47 48 49 50
let r = balance <blk elem=1>[ <red elem=1>[ <red elem=1>[ 1 2] 3 ]4];;
let id ('a -> 'a)
    Int  -> "foo"
  | x -> x
;;

(* some tricky examples *)
51

52 53
let f (_ : ('a | 'b | 'c)) (_ : (Int&'d&'e \1--3 )) : Any = raise "123";;

Giuseppe Castagna's avatar
Giuseppe Castagna committed
54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
let x = id even (even mmap) even;; (* same type as map_even *)

let twisted = id even (even mmap) even (mmap max [1 2 3 4 5 6]);;

let apply_to_3 (f: Int -> 'a): 'a = f 3 in
    mmap apply_to_3 twisted 
;;

type A = <a>'a
type B = <b>[(A|B)];;

let f (_ : 'a -> 'a -> 'a)(z : 'a)(_ : A|B) : A = <a>z;;

let x = f sum;;


(* Some expressions that are ill typed *)

72 73 74 75 76 77 78 79 80 81 82 83
let balance (Unbal ->Rtree ;  'a -> 'a )
  | <blk (z)>[ <red (y)>[ <red (x)>[ a b ] c ] d ]
  | <blk (z)>[ <red (x)>[ a <red (y)>[ b c ] ] d ]
  | <blk (x)>[ a <red (z)>[ <red (y)>[ b c ] d ] ]
  | <blk (x)>[ a <red (y)>[ b <red (z)>[ c d ] ] ]
      -> <red (y)>[  <blk (x)>[ a b ]   <blk (z)>[ c d ]  ]
  | x -> x
;;
let id ('a -> 'a)
    Int  -> "foo"
  | x -> x
;;
84 85 86
let apply ( f : 'a -> 'b) (x : 'a ) : 'b =
  f (x,x)
;;