part2.cd 1.18 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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
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;;

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
;;