Commit 25b12781 authored by Kim Nguyễn's avatar Kim Nguyễn

Merge branch 'master' of https://git.cduce.org/cduce

* 'master' of https://git.cduce.org/cduce:
  added code for patricia trees
  Added few twisted examples
parents e2d51998 f753cdb0
......@@ -41,9 +41,34 @@ let balance ( Unbal ->Rtree ; ('b \ Unbal) ->('b \ Unbal) )
-> <red (y)>[ <blk (x)>[ a b ] <blk (z)>[ c d ] ]
| x -> x
;;
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 *)
let f (_ : ('a | 'b | 'c)) (_ : (Int&'d&'e \1--3 )) : Any = raise "123";;
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 *)
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 ]
......@@ -52,12 +77,10 @@ let balance (Unbal ->Rtree ; 'a -> 'a )
-> <red (y)>[ <blk (x)>[ a b ] <blk (z)>[ c d ] ]
| x -> x
;;
let r = balance <blk elem=1>[ <red elem=1>[ <red elem=1>[ 1 2] 3 ]4];;
let id ('a -> 'a)
Int -> "foo"
| x -> x
;;
id 42;;
let apply ( f : 'a -> 'b) (x : 'a ) : 'b =
f (x,x)
;;
......@@ -3,6 +3,8 @@
http://ittc.ku.edu/~andygill/papers/IntMap98.pdf
*)
type Leaf = <leaf key=Caml_int> 'a
type Branch = <brch pre=Caml_int bit=Caml_int>[ (Leaf|Branch) (Leaf|Branch) ]
......@@ -18,7 +20,7 @@ let branching_bit (p0: Caml_int)(p1: Caml_int): Caml_int = lowest_bit (Pervasive
let mask (p: Caml_int) (m: Caml_int): Caml_int =
Pervasives.land p (Pervasives.pred m)
let matchPrefix (k: Caml_int)(p: Caml_int)(m: Caml_int): Bool =
let match_prefix (k: Caml_int)(p: Caml_int)(m: Caml_int): Bool =
mask p m = k
let zero_bit (k: Caml_int)(m: Caml_int): Bool = Pervasives.land k m = 0
......@@ -27,13 +29,13 @@ let lookup (k: Caml_int)(d: Dict) : ['a?] =
match d with
| [] -> []
| <brch pre=p bit=m>[ t0 t1 ] ->
if not (matchPrefix k p m) then []
if not (match_prefix k p m) then []
else if zero_bit k m then lookup k t0
else lookup k t1
| <leaf key=j> x -> if j=k then [ x ] else []
let join (p0: Caml_int, t0: Dict\[],p1: Caml_int,t1: Dict\[]): Leaf | Branch =
let join (p0: Caml_int)(t0: Dict\[])(p1: Caml_int)(t1: Dict\[]): Branch =
let m = branching_bit p0 p1 in
if zero_bit p0 m then
<brch pre=(mask p0 m) bit=m>[t0 t1]
......@@ -42,17 +44,36 @@ let join (p0: Caml_int, t0: Dict\[],p1: Caml_int,t1: Dict\[]): Leaf | Branch =
let insert (c: 'a -> 'a -> 'a) (k: Caml_int) (x: 'a) (t: Dict): Leaf|Branch =
let insert (c: 'a -> 'a -> 'a) (k: Caml_int) (x: 'a) (t: Dict): Leaf|Branch =
let ins (Leaf|Branch -> Leaf|Branch ; [] -> Leaf )
| [] -> <leaf key=k> x
| (<leaf key=j>y)&t ->
if j=k then <leaf key=k>(c x y)
else join (k,<leaf key=k>x,j,t)
else join k (<leaf key=k>x) j t
| (<brch pre=p bit=m>[ t0 t1 ])&t ->
if matchPrefix k p m then
if match_prefix k p m then
if zero_bit k m then <brch pre=p bit=m>[ (ins t0) t1 ]
else <brch pre=p bit=m>[ t0 (ins t1) ]
else join (k,<leaf key=k>x,p,t)
else join k (<leaf key=k>x) p t
in ins t
let max (x: 'a)(y: 'a): 'a = if (x >> y) then x else y;;
let swap (f : 'a -> 'a -> 'a) (x: 'a)(y: 'a): 'a = f y x;;
let merge (c: 'a -> 'a -> 'a): (Dict,Dict) -> Dict =
fun aux( ([],[]) -> []
; (Dict,Dict)\([],[]) -> Dict\[]
; (Branch,Branch) -> Branch )
| ([],t) | (t,[]) -> t
| (<leaf key=k>x , t) -> insert c k x t
| (t , <leaf key=k>x) -> insert (swap c) k x t
| (<brch pre=p bit=m>[ s0 s1 ] , <brch pre=q bit=n>[ t0 t1 ])&(s,t) ->
if (m=n) && (p=q) then <brch pre=p bit=m>[ (aux(s0,t0)) (aux(s1,t1)) ]
else if (m << n) && (match_prefix q p m) then
if zero_bit q m then <brch pre=p bit=m>[ (aux(s0,t)) s1 ]
else <brch pre=p bit=m>[ s0 (aux(s1,t)) ]
else if (m >> n) && (match_prefix p q n) then
if zero_bit p n then <brch pre=q bit=n>[ (aux(s,t0)) t1 ]
else <brch pre=q bit=n>[ t0 (aux(s,t1)) ]
else join p s q t
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment