[pure-lang-svn] SF.net SVN: pure-lang: [429] pure/trunk/lib
Status: Beta
Brought to you by:
agraef
Menu
▾
▴
[pure-lang-svn] SF.net SVN: pure-lang: [429] pure/trunk/lib
|
From: <js...@us...> - 2008-07-09 19:56:09
|
Revision: 429
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=429&view=rev
Author: jspitz
Date: 2008-07-09 12:56:14 -0700 (Wed, 09 Jul 2008)
Log Message:
-----------
Update 'set.pure' and 'dict.pure' with versions that compile faster.
Modified Paths:
--------------
pure/trunk/lib/dict.pure
pure/trunk/lib/set.pure
Modified: pure/trunk/lib/dict.pure
===================================================================
--- pure/trunk/lib/dict.pure 2008-07-09 13:44:01 UTC (rev 428)
+++ pure/trunk/lib/dict.pure 2008-07-09 19:56:14 UTC (rev 429)
@@ -86,26 +86,18 @@
hdict xys = foldl insert emptyhdict xys if listp xys;
// insert a new member into the dict or hdict
-insert (t@Dict d) (x::int => y) |
-insert (t@Dict d) (x::string => y) |
insert (t@Dict d) (x => y) |
insert (t@Hdict d) (x => y)
= if t === Dict
then t ((insertd d x y)!0)
else t ((inserth d (hash x) x y)!0)
with
- insertd nil key::int val |
- insertd nil key::string val |
insertd nil key val
= [(bin key val ( 0) nil nil), 1];
- insertd (bin k::int _ b l r) key::int val |
- insertd (bin k::string _ b l r) key::string val |
insertd (bin k _ b l r) key val
= [(bin key val b l r), 0] if key == k;
- insertd (bin k::int v b l r) key::int val |
- insertd (bin k::string v b l r) key::string val |
insertd (bin k v b l r) key val
= adjust leftHasChanged (bin k v b newl r) (-1)
when
@@ -113,8 +105,6 @@
end
if key < k;
- insertd (bin k::int v b l r) key::int val |
- insertd (bin k::string v b l r) key::string val |
insertd (bin k v b l r) key val
= adjust rightHasChanged (bin k v b l newr) ( 1)
when
@@ -149,21 +139,18 @@
adjust 0 oldTree _ = [oldTree, 0];
- adjust 1 (bin key::int val b0 l r) LoR |
- adjust 1 (bin key::string val b0 l r) LoR |
adjust 1 (bin key val b0 l r) LoR
= [rebal toBeRebalanced (bin key val b0 l r) b1, whatHasChanged]
when
[b1, whatHasChanged, toBeRebalanced] = table b0 LoR
end;
- rebal 0 (bin k::int v _ l r) b |
- rebal 0 (bin k::string v _ l r) b |
rebal 0 (bin k v _ l r) b
= bin k v b l r;
rebal 1 oldTree _ = (Dict_avl_geq oldTree)!0;
+/*
// Balance rules for insertions
// balance where balance whole tree to be
// before inserted after increased rebalanced
@@ -173,11 +160,18 @@
table ( 1) ( 1) = [( 0), 0, 0];
table (-1) (-1) = [( 0), 0, 0];
table (-1) ( 1) = [( 0), 0, 1]
+*/
+
+// table w/o pattern matching
+ table bb::int wi::int = [ba, wti, tbr]
+ when
+ ba = if bb == 0 then -wi else 0;
+ wti = bb == 0;
+ tbr = (bb + wi) == 0;
+ end
end;
// delete a member by key from the dict or hdict
-delete (t@Dict d) x::int |
-delete (t@Dict d) x::string |
delete (t@Dict d) x |
delete (t@Hdict d) x
= if t === Dict
@@ -186,18 +180,12 @@
with
deleted nil _ = [nil, 0];
- deleted (bin k::int _ _ nil r ) key::int |
- deleted (bin k::string _ _ nil r ) key::string |
deleted (bin k _ _ nil r ) key
= [r, 1] if key == k;
- deleted (bin k::int _ _ l nil) key::int |
- deleted (bin k::string _ _ l nil) key::string |
deleted (bin k _ _ l nil) key
= [l, 1] if key == k;
- deleted (bin k::int _ b (bin kl::int vl bl rl ll) r ) key::int |
- deleted (bin k::string _ b (bin kl::string vl bl rl ll) r ) key::string |
deleted (bin k _ b (bin kl vl bl rl ll) r ) key
= Dict_adjustd leftHasChanged (bin lastk lastv b newl r) (-1)
when
@@ -207,8 +195,6 @@
end
if key == k;
- deleted (bin k::int v b l r) key::int |
- deleted (bin k::string v b l r) key::string |
deleted (bin k v b l r) key
= Dict_adjustd leftHasChanged (bin k v b newl r) (-1)
when
@@ -216,8 +202,6 @@
end
if key < k;
- deleted (bin k::int v b l r) key::int |
- deleted (bin k::string v b l r) key::string |
deleted (bin k v b l r) key
= Dict_adjustd rightHasChanged (bin k v b l newr) ( 1)
when
@@ -311,14 +295,10 @@
end;
// check whether a key in dict or hdict
-member (Dict d) k::int |
-member (Dict d) k::string |
member (Dict d) k = member d k
with
member nil _ = 0;
- member (bin x _ _ d1 d2) y::int |
- member (bin x _ _ d1 d2) y::string |
member (bin x _ _ d1 d2) y
= member d1 y if x > y;
= member d2 y if x < y;
@@ -343,8 +323,6 @@
with
members nil = [];
- members (bin x::int y _ d1 d2) |
- members (bin x::string y _ d1 d2) |
members (bin x y _ d1 d2)
= members d1 + ((x => y) : (members d2))
end;
@@ -401,8 +379,6 @@
with
keys nil = [];
- keys (bin x::int _ _ d1 d2) |
- keys (bin x::string _ _ d1 d2) |
keys (bin x _ _ d1 d2)
= keys d1 + (x : (keys d2))
end;
@@ -429,14 +405,10 @@
end;
// get a value by key from dict or hdict
-(Dict d)!k::int |
-(Dict d)!k::string |
(Dict d)!k = d!k
with
nil!_ = throw out_of_bounds;
- (bin x::int y _ d1 d2)!x1::int |
- (bin x::string y _ d1 d2)!x1::string |
(bin x y _ d1 d2)!x1
= d1!x1 if x1 < x;
= d2!x1 if x1 > x;
@@ -469,8 +441,6 @@
slice d ys [] = reverse ys;
nil!_ = nil;
- (bin x::int y _ d1 d2)!x1::int |
- (bin x::string y _ d1 d2)!x1::string |
(bin x y _ d1 d2)!x1
= d1!x1 if x1 < x;
= d2!x1 if x1 > x;
@@ -499,8 +469,6 @@
end;
// curried version of insert for dict and hdict
-update d@(Dict _) x::int y |
-update d@(Dict _) x::string y |
update d@(Dict _) x y |
update d@(Hdict _) x y
= insert d (x => y);
@@ -528,35 +496,41 @@
with
adjust 0 oldTree _ = [oldTree, 0];
- adjust 1 (bin key::int val b0 l r) LoR |
- adjust 1 (bin key::string val b0 l r) LoR |
adjust 1 (bin key val b0 l r) LoR
= rebal toBeRebalanced (bin key val b0 l r) b1 whatHasChanged
when
- [b1, whatHasChanged, toBeRebalanced] = tabled b0 LoR
+ [b1, whatHasChanged, toBeRebalanced] = table b0 LoR
end;
- rebal 0 (bin k::int v _ l r) b whatHasChanged |
- rebal 0 (bin k::string v _ l r) b whatHasChanged |
rebal 0 (bin k v _ l r) b whatHasChanged
= [bin k v b l r, whatHasChanged];
rebal 1 oldTree _ _ = Dict_avl_geq oldTree;
+/*
// Balance rules for deletions
// balance where balance whole tree to be
// before deleted after decreased rebalanced
-tabled ( 0) ( 1) = [( 1), 0, 0];
-tabled ( 0) (-1) = [(-1), 0, 0];
-tabled ( 1) ( 1) = [( 0), 1, 1];
+table ( 0) ( 1) = [( 1), 0, 0];
+table ( 0) (-1) = [(-1), 0, 0];
+table ( 1) ( 1) = [( 0), 1, 1];
// ^^^^
// It depends on the tree pattern in avl_geq whether it really decreases
-tabled ( 1) (-1) = [( 0), 1, 0];
-tabled (-1) ( 1) = [( 0), 1, 0];
-tabled (-1) (-1) = [( 0), 1, 1];
+table ( 1) (-1) = [( 0), 1, 0];
+table (-1) ( 1) = [( 0), 1, 0];
+table (-1) (-1) = [( 0), 1, 1];
// ^^^^
// It depends on the tree pattern in avl_geq whether it really decreases
+*/
+
+// table w/o pattern matching
+ table bb wd = [ba, wtd, tbr]
+ when
+ ba = if bb == 0 then wd else 0;
+ wtd = abs bb;
+ tbr = bb == wd;
+ end
end;
// Single and double tree rotations - these are common for insert and delete
@@ -571,23 +545,13 @@
*/
Dict_avl_geq d = avl_geq d
with
- avl_geq (bin a::int va (-1) alpha (bin b::int vb (-1) beta gamma)) |
- avl_geq (bin a::string va (-1) alpha (bin b::string vb (-1) beta gamma)) |
avl_geq (bin a va (-1) alpha (bin b vb (-1) beta gamma))
= [bin b vb ( 0) (bin a va ( 0) alpha beta) gamma, 1];
- avl_geq (bin a::int va (-1) alpha (bin b::int vb ( 0) beta gamma)) |
- avl_geq (bin a::string va (-1) alpha (bin b::string vb ( 0) beta gamma)) |
avl_geq (bin a va (-1) alpha (bin b vb ( 0) beta gamma))
= [bin b vb ( 1) (bin a va (-1) alpha beta) gamma, 0];
// the tree doesn't decrease with this pattern
- avl_geq (bin a::int va (-1) alpha
- (bin b::int vb ( 1)
- (bin x::int vx b1 beta gamma) delta)) |
- avl_geq (bin a::string va (-1) alpha
- (bin b::string vb ( 1)
- (bin x::string vx b1 beta gamma) delta)) |
avl_geq (bin a va (-1) alpha
(bin b vb ( 1) (bin x vx b1 beta gamma) delta))
= [bin x vx ( 0) (bin a va b2 alpha beta) (bin b vb b3 gamma delta), 1]
@@ -595,23 +559,13 @@
[b2, b3] = table b1
end;
- avl_geq (bin b::int vb ( 1) (bin a::int va ( 1) alpha beta) gamma) |
- avl_geq (bin b::string vb ( 1) (bin a::string va ( 1) alpha beta) gamma) |
avl_geq (bin b vb ( 1) (bin a va ( 1) alpha beta) gamma)
= [bin a va ( 0) alpha (bin b vb ( 0) beta gamma), 1];
- avl_geq (bin b::int vb ( 1) (bin a::int va ( 0) alpha beta) gamma) |
- avl_geq (bin b::string vb ( 1) (bin a::string va ( 0) alpha beta) gamma) |
avl_geq (bin b vb ( 1) (bin a va ( 0) alpha beta) gamma)
= [bin a va (-1) alpha (bin b vb ( 1) beta gamma), 0];
// the tree doesn't decrease with this pattern
- avl_geq (bin b::int vb ( 1)
- (bin a::int va (-1) alpha
- (bin x::int vx b1 beta gamma)) delta) |
- avl_geq (bin b::string vb ( 1)
- (bin a::string va (-1) alpha
- (bin x::string vx b1 beta gamma)) delta) |
avl_geq (bin b vb ( 1)
(bin a va (-1) alpha (bin x vx b1 beta gamma)) delta)
= [bin x vx ( 0) (bin a va b2 alpha beta) (bin b vb b3 gamma delta), 1]
@@ -619,7 +573,16 @@
[b2, b3] = table b1
end;
+/*
table ( 1) = [( 0), (-1)];
table (-1) = [( 1), ( 0)];
table ( 0) = [( 0), ( 0)]
+*/
+
+// table w/o pattern matching
+ table bal = [b1, b2]
+ when
+ b1 = bal == (-1);
+ b2 = -(bal == 1);
+ end
end;
Modified: pure/trunk/lib/set.pure
===================================================================
--- pure/trunk/lib/set.pure 2008-07-09 13:44:01 UTC (rev 428)
+++ pure/trunk/lib/set.pure 2008-07-09 19:56:14 UTC (rev 429)
@@ -78,31 +78,19 @@
bag xs = foldl insert emptybag xs if listp xs;
// insert a new member into a set or bag
-insert (t@Set m) y::int |
-insert (t@Set m) y::string |
insert (t@Set m) y |
-insert (t@Bag m) y::int |
-insert (t@Bag m) y::string |
insert (t@Bag m) y = t ((insert m y)!0)
with
- insert nil key::int |
- insert nil key::string |
insert nil key
= [(bin key ( 0) nil nil), 1];
- insert (bin k::int b::int l r) key::int |
- insert (bin k::string b::int l r) key::string |
insert (bin k b::int l r) key
= [(bin key b l r), 0] if (key == k) && (t === Set);
- insert (bin k::int b::int l r) key::int |
- insert (bin k::string b::int l r) key::string |
insert (bin k b::int l r) key
= adjust leftHasChanged (bin k b newL r) (-1)
when [newL, leftHasChanged] = insert l key end if key < k;
- insert (bin k::int b::int l r) key::int |
- insert (bin k::string b::int l r) key::string |
insert (bin k b::int l r) key
= adjust rightHasChanged (bin k b l newR) ( 1)
when [newR, rightHasChanged] = insert r key end
@@ -111,22 +99,18 @@
adjust 0 oldTree _
= [oldTree, 0];
- adjust 1 (bin key::int b0::int l r) LoR::int |
- adjust 1 (bin key::string b0::int l r) LoR::int |
adjust 1 (bin key b0::int l r) LoR::int
= [rebal toBeRebalanced (bin key b0 l r) b1, whatHasChanged]
when
[b1, whatHasChanged, toBeRebalanced] = table b0 LoR
end;
- rebal 0 (bin k::int _ l r) b |
- rebal 0 (bin k::string _ l r) b |
rebal 0 (bin k _ l r) b
= bin k b l r;
rebal 1 oldTree _
= (Set_avl_geq oldTree)!0;
-
+/*
// Balance rules for insertions
// balance where balance whole tree to be
// before inserted after increased rebalanced
@@ -136,31 +120,30 @@
table ( 1) ( 1) = [( 0), 0, 0];
table (-1) (-1) = [( 0), 0, 0];
table (-1) ( 1) = [( 0), 0, 1];
+*/
+
+// table w/o pattern matching
+ table bb::int wi::int = [ba, wti, tbr]
+ when
+ ba = if bb == 0 then -wi else 0;
+ wti = bb == 0;
+ tbr = (bb + wi) == 0;
+ end
end;
// delete a member by key from the data structure
-delete (t@Set m) y::int |
-delete (t@Set m) y::string |
delete (t@Set m) y |
-delete (t@Bag m) y::int |
-delete (t@Bag m) y::string |
delete (t@Bag m) y
= t ((delete m y)!0)
with
delete nil _ = [nil, 0];
- delete (bin k::int _ nil r) key::int |
- delete (bin k::string _ nil r) key::string |
delete (bin k _ nil r) key
= [r, 1] if key == k;
- delete (bin k::int _ l nil) key::int |
- delete (bin k::string _ l nil) key::string |
delete (bin k _ l nil) key
= [l, 1] if key == k;
- delete (bin k::int b::int x@(bin kl::int bl::int rl ll) r) key::int |
- delete (bin k::string b::int x@(bin kl::string bl::int rl ll) r) key::string |
delete (bin k b::int x@(bin kl bl::int rl ll) r) key
= Set_adjustd leftHasChanged (bin lk b newL r) (-1)
when
@@ -169,8 +152,6 @@
end
if key == k;
- delete (bin k::int b::int l r) key::int |
- delete (bin k::string b::int l r) key::string |
delete (bin k b::int l r) key
= Set_adjustd leftHasChanged (bin k b newL r) (-1)
when
@@ -178,8 +159,6 @@
end
if key < k;
- delete (bin k::int b::int l r) key::int |
- delete (bin k::string b::int l r) key::string |
delete (bin k b::int l r) key
= Set_adjustd rightHasChanged (bin k b l newR) ( 1)
when
@@ -213,18 +192,12 @@
end;
// check whether a key exists in set or bag
-member (Set m) k::int |
-member (Set m) k::string |
member (Set m) k |
-member (Bag m) k::int |
-member (Bag m) k::string |
member (Bag m) k
= member m k
with
member nil _ = 0;
- member (bin x _ m1 m2) y::int |
- member (bin x _ m1 m2) y::string |
member (bin x _ m1 m2) y
= member m1 y if x > y;
= member m2 y if x < y;
@@ -238,8 +211,6 @@
with
members nil = [];
- members (bin x::int _ m1 m2) |
- members (bin x::string _ m1 m2) |
members (bin x _ m1 m2)
= (members m1) + (x : (members m2))
end;
@@ -336,8 +307,6 @@
with
adjust 0 oldTree _ = [oldTree, 0];
- adjust 1 (bin key::int b0::int l r) LoR::int |
- adjust 1 (bin key::string b0::int l r) LoR::int |
adjust 1 (bin key b0::int l r) LoR::int
= rebal toBeRebalanced (bin key b0 l r) b1 whatHasChanged
when
@@ -349,14 +318,13 @@
decide whether the whole tree increases. With deletions it is sometimes not
sufficient and we need to know which kind of tree rotation took place.
*/
- rebal 0 (bin k::int _ l r) b::int whatHasChanged |
- rebal 0 (bin k::string _ l r) b::int whatHasChanged |
rebal 0 (bin k _ l r) b::int whatHasChanged
= [bin k b l r, whatHasChanged];
rebal 1 oldTree _ _ = Set_avl_geq oldTree;
// Balance rules for deletions
+/*
// balance where balance whole tree to be
// before deleted after decreased rebalanced
table ( 0) ( 1) = [( 1), 0, 0];
@@ -370,9 +338,17 @@
table (-1) (-1) = [( 0), 1, 1]
// ^^^^
// It depends on the tree pattern in avl_geq whether it really decreases
+*/
+
+// table w/o pattern matching
+ table bb wd = [ba, wtd, tbr]
+ when
+ ba = if bb == 0 then wd else 0;
+ wtd = abs bb;
+ tbr = bb == wd;
+ end
end;
-
// Single and double tree rotations - these are common for insert and delete
/*
The patterns (-1)-(-1), (-1)-( 1), ( 1)-( 1) and ( 1)-(-1) on the LHS always
@@ -386,21 +362,13 @@
Set_avl_geq x = avl_geq x
with
- avl_geq (bin a::int (-1) alpha (bin b::int (-1) beta gamma)) |
- avl_geq (bin a::string (-1) alpha (bin b::string (-1) beta gamma)) |
avl_geq (bin a (-1) alpha (bin b (-1) beta gamma))
= [bin b ( 0) (bin a ( 0) alpha beta) gamma, 1];
- avl_geq (bin a::int (-1) alpha (bin b::int ( 0) beta gamma)) |
- avl_geq (bin a::string (-1) alpha (bin b::string ( 0) beta gamma)) |
avl_geq (bin a (-1) alpha (bin b ( 0) beta gamma))
= [bin b ( 1) (bin a (-1) alpha beta) gamma, 0];
// the tree doesn't decrease with this pattern
- avl_geq (bin a::int (-1) alpha
- (bin b::int ( 1) (bin x::int b1 beta gamma) delta)) |
- avl_geq (bin a::string (-1) alpha
- (bin b::string ( 1) (bin x::string b1 beta gamma) delta)) |
avl_geq (bin a (-1) alpha
(bin b ( 1) (bin x b1 beta gamma) delta))
= [bin x ( 0) (bin a b2 alpha beta)
@@ -409,21 +377,13 @@
[b2, b3] = table b1
end;
- avl_geq (bin b::int ( 1) (bin a::int ( 1) alpha beta) gamma) |
- avl_geq (bin b::string ( 1) (bin a::string ( 1) alpha beta) gamma) |
avl_geq (bin b ( 1) (bin a ( 1) alpha beta) gamma)
= [bin a ( 0) alpha (bin b ( 0) beta gamma), 1];
- avl_geq (bin b::int ( 1) (bin a::int ( 0) alpha beta) gamma) |
- avl_geq (bin b::string ( 1) (bin a::string ( 0) alpha beta) gamma) |
avl_geq (bin b ( 1) (bin a ( 0) alpha beta) gamma)
= [bin a (-1) alpha (bin b ( 1) beta gamma), 0];
// the tree doesn't decrease with this pattern
- avl_geq (bin b::int ( 1)
- (bin a::int (-1) alpha (bin x::int b1 beta gamma)) delta) |
- avl_geq (bin b::string ( 1)
- (bin a::string (-1) alpha (bin x::string b1 beta gamma)) delta) |
avl_geq (bin b ( 1)
(bin a (-1) alpha (bin x b1 beta gamma)) delta)
= [bin x ( 0) (bin a b2 alpha beta)
@@ -431,8 +391,16 @@
when
[b2, b3] = table b1
end;
-
+/*
table ( 1) = [( 0), (-1)];
table (-1) = [( 1), ( 0)];
table ( 0) = [( 0), ( 0)]
+*/
+
+// table w/o pattern matching
+ table bal = [b1, b2]
+ when
+ b1 = bal == (-1);
+ b2 = -(bal == 1);
+ end
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
