pure-lang-svn

[pure-lang-svn] SF.net SVN: pure-lang: [381] pure/trunk/examples/dict.pure

[<js...@us...>]

Revision: 381
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=381&view=rev
Author:   jspitz
Date:     2008-07-03 22:42:48 -0700 (Thu, 03 Jul 2008)

Log Message:
-----------
Add dict data container to examples.

Added Paths:
-----------
    pure/trunk/examples/dict.pure

Added: pure/trunk/examples/dict.pure
===================================================================
--- pure/trunk/examples/dict.pure	                        (rev 0)
+++ pure/trunk/examples/dict.pure	2008-07-04 05:42:48 UTC (rev 381)
@@ -0,0 +1,578 @@
+/* Pure's dict and hdict data types based on AVL trees. */
+
+/* Copyright (c) 2008 by Albert Graef <Dr....@t-...>.
+   Copyright (c) 2008 by Jiri Spitz <jir...@bl...>.
+
+   This file is part of the Pure programming language and system.
+
+   Pure is free software: you can redistribute it and/or modify it under the
+   terms of the GNU General Public License as published by the Free Software
+   Foundation, either version 3 of the License, or (at your option) any later
+   version.
+
+   Pure is distributed in the hope that it will be useful, but WITHOUT ANY
+   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+   FOR a PARTICULAR PURPOSE.  See the GNU General Public License for more
+   details.
+
+   You should have received a copy of the GNU General Public License along
+   with this program.  If not, see <http://www.gnu.org/licenses/>. */
+
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   The used algorithm of AVL trees has its origin in the SWI-Prolog
+   implementation of association lists. The original file was created by
+   R. A. O'Keefe and updated for the SWI-Prolog by Jan Wielemaker. For the
+   original file see http://www.swi-prolog.org.
+
+   The port from SWI-Prolog and the deletion stuff (rmfirst, rmlast, delete)
+   missing in the original file was provided by Jiri Spitz
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+/* Empty tree constant, consider this private. */
+nullary nil;
+
+/*****
+Tree for dict and hdict is either:
+-  nil  (empty tree) or
+-  bin Key value Balance Left Right  (Left, Right: trees)
+
+Balance: ( 1), ( 0), or (-1) denoting |L|-|R| = 1, 0, or -1, respectively
+*****/
+
+
+/* Public operations: ******************************************************
+
+emptydict, emptyhdict:		return the empty dict or bag
+dict xs, hdict xs;		create a dict or hdict from list xs
+dictp x, hdictp x;		check whether x is a dict or hdict
+mkdict y xs, mkhdixt y xs:	create dict or hdict from a list of keys and
+				a constant value
+
+#d				size of dict or hdict d
+d!x:				get value from d by key x
+
+null d				tests whether d is the empty dict or hdict
+member d x			tests whether d contains member with key x
+members d, list d		list members of d (in ascending order fo dict)
+keys d:				lists keys of d (in ascending order fo dict)
+values d:			list values of d
+
+first m, last m			return first and last member of dict
+rmfirst m, rmlast m		remove first and last member from dict
+insert m x			insert x into d (replace existing element)
+delete m x			remove x from d
+
+   *************************************************************************/
+
+
+// Dict and hdict type checks
+dictp (Dict _)			= 1;
+dictp _				= 0;
+
+hdictp (Hdict _)		= 1;
+hdictp _			= 0;
+
+// create an empty dict or hdict
+emptydict			= Dict  nil;
+emptyhdict			= Hdict nil;
+
+// create dict or hdict from a list
+dict  xys			= foldl insert emptydict  xys if listp xys;
+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
+		[newl, leftHasChanged] = insertd l key val
+	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
+		[newr, rightHasChanged] = insertd r key val
+	end
+	if key > k;
+
+  inserth nil k::int x y	= [(bin k [[x, y]] ( 0) nil nil), 1];
+
+  inserth (bin k::int v b l r) key::int x y
+		= [(bin k (inserth2 v x y) b l r), 0] if k == key;
+
+  inserth (bin k::int v b l r) key::int x y
+	= adjust leftHasChanged (bin k v b newl r) (-1)
+	when
+		[newl, leftHasChanged] = inserth l key x y
+	end
+	if key < k;
+
+  inserth (bin k::int v b l r) key::int x y
+	= adjust rightHasChanged (bin k v b l newr) ( 1)
+	when
+		[newr, rightHasChanged] = inserth r key x y
+	end
+	if key > k;
+
+  inserth2 [] x  y		= [x, y]:[];
+  inserth2 ([x1, y] :xys) x2 y1	= ([x1, y1]:xys) if x1 === x2;
+  inserth2 ([x,  y] :xys) x1 y1	= ([x,  y]:(inserth2 xys x1 y1));
+
+  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
+table	( 0)	(-1)		= [( 1), 	1,		0];
+table	( 0)	( 1)		= [(-1),  	1,		0];
+table	( 1)	(-1)		= [( 0),  	0,		1];
+table	( 1)	( 1)		= [( 0),  	0,		0];
+table	(-1)	(-1)		= [( 0),  	0,		0];
+table	(-1)	( 1)		= [( 0),  	0,		1]
+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
+		then t ((deleted d x)!0)
+		else t ((deleteh d (hash x) x)!0)
+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
+		[lastk, lastv]	= last (bin kl vl bl rl ll);
+		[newl, leftHasChanged]
+				= rmlast (bin kl vl bl rl ll)
+	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
+		[newl, leftHasChanged] = deleted l key
+	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
+		[newr, rightHasChanged] = deleted r key
+	end
+	if key > k;
+
+  deleteh nil _ _		= [nil, 0];
+
+  deleteh (bin k::int xys b nil r  ) key::int x
+	= (if (newxys == [])
+	then [r, 1]
+	else [bin k newxys b nil r, 0])
+		when
+			newxys = deleteh2 xys x
+		end
+	if k == key;
+  
+  deleteh (bin k::int xys b l   nil) key::int x
+	= (if (newxys == [])
+	then [l, 1]
+	else [bin k newxys b l nil, 0])
+		when
+			newxys = deleteh2 xys x
+		end
+	if k == key;
+
+  deleteh (bin k::int xys b (bin kl vl bl rl ll) r) key::int x
+	= Dict_adjustd leftHasChanged (bin lastk lastv b newl r) (-1)
+	when
+		[lastk, lastv]	= last (bin kl vl bl rl ll);
+		[newl, leftHasChanged]	= rmlast (bin kl vl bl rl ll)
+	end
+	if (k == key) && ((deleteh2 xys x) == []);
+
+  deleteh (bin k::int xys b l r) key::int x
+	= [bin key (deleteh2 xys x) b l r, 0]
+	if k == key;
+
+  deleteh (bin k::int v b l r) key::int x
+	= Dict_adjustd leftHasChanged (bin k v b newl r) (-1)
+	when
+		[newl, leftHasChanged] = deleteh l key x
+	end
+	if key < k;
+
+  deleteh (bin k::int v b l r) key::int x
+	= Dict_adjustd rightHasChanged (bin k v b l newr) ( 1)
+	when
+		[newr, rightHasChanged] = deleteh r key x
+	end
+	if key > k;
+
+  deleteh2 [] _			= [];
+  deleteh2 ([x1 ,_] : xys) x2	= xys if x1 === x2;
+  deleteh2 ([x,  y] : xys) x1	= [x, y] : (deleteh2 xys x1);
+
+  rmlast nil			= [nil, 0];
+  rmlast (bin _ _ _      l nil)	= [l,   1];
+  rmlast (bin k v b::int l r  )
+	= Dict_adjustd rightHasChanged (bin k v b l newr) ( 1)
+	when [newr, rightHasChanged] = rmlast r end;
+
+  last (bin x y _ _ nil)	= [x, y];
+  last (bin _ _ _ _ d2 )	= last d2
+end;
+
+
+// create dict or hdict from a list of keys and a constant value
+mkdict  y xs			= dict  (zip xs (repeat (#xs) y)) if listp xs;
+mkhdict y xs			= hdict (zip xs (repeat (#xs) y)) if listp xs;
+
+// check for the empty dict or hdict
+null (Dict nil)			= 1;
+null (Dict   _)			= 0;
+
+null (Hdict nil)		= 1;
+null (Hdict   _)		= 0;
+
+// get a number of members in dict or hdict
+#(Dict  d)			= #d
+with
+  #nil				= 0;
+  #(bin _ _ _ d1 d2)		= #d1 + #d2 + 1
+end;
+
+#(Hdict d)			= size d
+with
+  size nil			= 0;
+  size (bin _ xys _ d1 d2)	= size d1 + size d2 + #xys
+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;
+				= 1 if x == y
+end;
+
+member (Hdict d) k		= member d (hash k) k
+with
+  member nil _ _		= 0;
+  member (bin k::int xys _ d1 d2) k1::int x1
+				= member d1 k1 x1 if k > k1;
+				= member d2 k1 x1 if k < k1;
+				= memberk xys x1;
+
+  memberk [] _	 		= 0;
+  memberk ([x1, y]:_  ) x2	= 1 if x1 === x2;
+  memberk (      _:xys) x2	= memberk xys x2
+end;;
+
+// get all members of dict or hdict
+members (Dict  d)		= members d
+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;
+
+members (Hdict d)		= members d
+with
+  members nil			= [];
+  members (bin _ xys _ d1 d2)	= members d1 + xys + members d2
+end;
+
+list d@(Dict  _) |
+list d@(Hdict _)		= members d;
+
+// get the first member of a dict
+first (Dict d)			= first d
+with
+  first (bin x y _ nil _)	= [x, y];
+  first (bin _ _ _ d1  _)	= first d1
+end;
+
+// get the last member of a dict
+last (Dict d)			= last d
+with
+  last (bin x y _ _ nil)	= [x, y];
+  last (bin _ _ _ _ d2 )	= last d2
+end;
+
+// remove the first member from a dict
+rmfirst (Dict d)		= Dict ((rmfirst d)!0)
+with
+  rmfirst nil			= [nil, 0];
+  rmfirst (bin _ _ _ nil r)	= [r, 1];
+  rmfirst (bin k v b l   r)
+	= Dict_adjustd leftHasChanged (bin k v b newl r) (-1)
+	when
+		[newl, leftHasChanged] = rmfirst l
+	end
+end;
+
+// remove the last member from a dict
+rmlast (Dict d)			= Dict ((rmlast d)!0)
+with
+  rmlast nil			= [nil 0];
+  rmlast (bin _ _ _ l nil)	= [l, 1];
+  rmlast (bin k v b l   r)
+	= Dict_adjustd rightHasChanged (bin k v b l newr) ( 1)
+	when
+		[newr, rightHasChanged] = rmlast r
+	end
+end;
+
+// get a list of all keys from dict or hdict
+keys (Dict  d)	= keys  d
+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;
+
+keys (Hdict d)	= keys d
+with
+  keys nil			= [];
+  keys (bin _ xys _ d1 d2)	= keys d1 + map (\d -> d!0) xys + keys d2
+end;
+
+// get a list of all values from dict or hdict
+vals (Dict  d)	= vals d
+with
+  vals nil			= [];
+  vals (bin _ y _ d1 d2)	= vals d1 + (y : (vals d2))
+end;
+
+vals (Hdict d)	= vals d
+with
+  vals nil			= [];
+  vals (bin _ xys _ d1 d2)	= vals d1 + map (\d -> d!1) xys + vals d2
+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;
+				= y
+end;
+
+(Hdict d)!k			= lookup d (hash k) k
+with
+  lookup nil _ _		= throw out_of_bounds;
+
+  lookup (bin k::int xys _ d1 d2) k1::int x1
+				= lookup d1 k1 x1 if k > k1;
+				= lookup d2 k1 x1 if k < k1;
+				= lookupk xys x1;
+
+  lookupk []	       _	= throw out_of_bounds;
+  lookupk ([xa,y]:  _) xb	= y if xa === xb;
+  lookupk (    _ :xys) x	= lookupk xys x
+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];
+
+// equality checks for dict and hdict
+(Dict  d1) == (Dict  d2)	= (members d1) == (members d2);
+
+(Hdict d1) == (Hdict d2)
+	= if (all (member d1) (keys d2))
+  		then
+			if (all (member d2) (keys d1))
+			then (vals d1) == (map ((!)d2) (keys d1))
+			else 0
+  		else 0;
+
+
+// inequality checks for dict and hdict
+(Dict  d1) != (Dict  d2)	= (members d1) != (members d2);
+(Hdict d1) != (Hdict d2)	= not (d1 == d2);
+
+
+/* Private functions, don't invoke these directly. */
+
+Dict_adjustd ToF::int tree LoR::int
+				= adjust ToF tree LoR
+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
+	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];
+//					  ^^^^
+// 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];
+//					  ^^^^
+// It depends on the tree pattern in avl_geq whether it really decreases
+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
+  change the tree height and these are the only patterns which can happen
+  after an insertion. That's the reason why we can use tablei only to decide
+  the needed changes.
+  The patterns (-1)-( 0) and ( 1)-( 0) do not change the tree height. After a
+  deletion any pattern can occur and so we return 1 or 0 as a flag of
+  a height change.
+*/
+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]
+		when
+			[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]
+		when
+			[b2, b3] = table b1
+		end;
+
+  table ( 1)			= [( 0), (-1)];
+  table (-1)			= [( 1), ( 0)];
+  table ( 0)			= [( 0), ( 0)]
+end;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[pure-lang-svn] SF.net SVN: pure-lang: [397] pure/trunk/examples/dict.pure

[<js...@us...>]

Revision: 397
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=397&view=rev
Author:   jspitz
Date:     2008-07-06 00:44:56 -0700 (Sun, 06 Jul 2008)

Log Message:
-----------
Change dict to use '=>' operator; bugfixes in equality/inequality tests.

Modified Paths:
--------------
    pure/trunk/examples/dict.pure

Modified: pure/trunk/examples/dict.pure
===================================================================
--- pure/trunk/examples/dict.pure	2008-07-06 01:36:57 UTC (rev 396)
+++ pure/trunk/examples/dict.pure	2008-07-06 07:44:56 UTC (rev 397)
@@ -33,6 +33,10 @@
 /* Empty tree constant, consider this private. */
 nullary nil;
 
+/* Definition of the mapsto operator used for key=>value pairs */
+infix 2 => ;
+
+
 /*****
 Tree for dict and hdict is either:
 -  nil  (empty tree) or
@@ -46,7 +50,7 @@
 
 emptydict, emptyhdict:		return the empty dict or bag
 dict xs, hdict xs;		create a dict or hdict from list xs
-dictp x, hdictp x;		check whether x is a dict or hdict
+dictp d, hdictp d;		check whether x is a dict or hdict
 mkdict y xs, mkhdixt y xs:	create dict or hdict from a list of keys and
 				a constant value
 
@@ -59,10 +63,11 @@
 keys d:				lists keys of d (in ascending order fo dict)
 values d:			list values of d
 
-first m, last m			return first and last member of dict
-rmfirst m, rmlast m		remove first and last member from dict
-insert m x			insert x into d (replace existing element)
-delete m x			remove x from d
+first d, last d			return first and last member of dict
+rmfirst d, rmlast d		remove first and last member from dict
+insert d xy			insert x into d (replace existing element)
+update d x y			fully curried version of insert
+delete d x			remove x from d
 
    *************************************************************************/
 
@@ -83,10 +88,10 @@
 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]
+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)
@@ -119,7 +124,7 @@
 	end
 	if key > k;
 
-  inserth nil k::int x y	= [(bin k [[x, y]] ( 0) nil nil), 1];
+  inserth nil k::int x y	= [(bin k [x => y] ( 0) nil nil), 1];
 
   inserth (bin k::int v b l r) key::int x y
 		= [(bin k (inserth2 v x y) b l r), 0] if k == key;
@@ -138,9 +143,11 @@
 	end
 	if key > k;
 
-  inserth2 [] x  y		= [x, y]:[];
-  inserth2 ([x1, y] :xys) x2 y1	= ([x1, y1]:xys) if x1 === x2;
-  inserth2 ([x,  y] :xys) x1 y1	= ([x,  y]:(inserth2 xys x1 y1));
+  inserth2 [] x  y		= [x => y];
+  inserth2 ((x1 => y):xys) x2 y1
+				= ((x1 => y1):xys) if x1 === x2;
+  inserth2 ((x  => y):xys) x1 y1
+				= ((x  => y ):(inserth2 xys x1 y1));
 
   adjust 0 oldTree _		= [oldTree, 0];
 
@@ -267,8 +274,8 @@
 	if key > k;
 
   deleteh2 [] _			= [];
-  deleteh2 ([x1 ,_] : xys) x2	= xys if x1 === x2;
-  deleteh2 ([x,  y] : xys) x1	= [x, y] : (deleteh2 xys x1);
+  deleteh2 ((x1 => _) : xys) x2	= xys if x1 === x2;
+  deleteh2 ((x  => y) : xys) x1	= (x => y) : (deleteh2 xys x1);
 
   rmlast nil			= [nil, 0];
   rmlast (bin _ _ _      l nil)	= [l,   1];
@@ -329,8 +336,8 @@
 				= memberk xys x1;
 
   memberk [] _	 		= 0;
-  memberk ([x1, y]:_  ) x2	= 1 if x1 === x2;
-  memberk (      _:xys) x2	= memberk xys x2
+  memberk ((x1 => y):_  ) x2	= 1 if x1 === x2;
+  memberk (        _:xys) x2	= memberk xys x2
 end;;
 
 // get all members of dict or hdict
@@ -341,7 +348,7 @@
   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))
+				= members d1 + ((x => y) : (members d2))
 end;
 
 members (Hdict d)		= members d
@@ -356,14 +363,14 @@
 // get the first member of a dict
 first (Dict d)			= first d
 with
-  first (bin x y _ nil _)	= [x, y];
+  first (bin x y _ nil _)	= (x => y);
   first (bin _ _ _ d1  _)	= first d1
 end;
 
 // get the last member of a dict
 last (Dict d)			= last d
 with
-  last (bin x y _ _ nil)	= [x, y];
+  last (bin x y _ _ nil)	= (x => y);
   last (bin _ _ _ _ d2 )	= last d2
 end;
 
@@ -405,7 +412,7 @@
 keys (Hdict d)	= keys d
 with
   keys nil			= [];
-  keys (bin _ xys _ d1 d2)	= keys d1 + map (\d -> d!0) xys + keys d2
+  keys (bin _ xys _ d1 d2)	= keys d1 + map (\(key => _) -> key) xys + keys d2
 end;
 
 // get a list of all values from dict or hdict
@@ -418,7 +425,7 @@
 vals (Hdict d)	= vals d
 with
   vals nil			= [];
-  vals (bin _ xys _ d1 d2)	= vals d1 + map (\d -> d!1) xys + vals d2
+  vals (bin _ xys _ d1 d2)	= vals d1 + map (\(_ => val) -> val) xys + vals d2
 end;
 
 // get a value by key from dict or hdict
@@ -446,8 +453,8 @@
 				= lookupk xys x1;
 
   lookupk []	       _	= throw out_of_bounds;
-  lookupk ([xa,y]:  _) xb	= y if xa === xb;
-  lookupk (    _ :xys) x	= lookupk xys x
+  lookupk ((xa => y):_  ) xb	= y if xa === xb;
+  lookupk (       _ :xys) x	= lookupk xys x
 end;
 
 // curried version of insert for dict and hdict
@@ -458,9 +465,20 @@
 				= insert d [x, y];
 
 // equality checks for dict and hdict
-(Dict  d1) == (Dict  d2)	= (members d1) == (members d2);
+d1@(Dict  _) == d2@(Dict  _)	= eq (members d1) (members d2)
+with
+  eq [] []			= 1;
+  eq (x:xs) []			= 0;
+  eq [] (x:xs)			= 0;
+  eq (x:xs) (y:ys)		= if eq x y then eq xs ys else 0;
 
-(Hdict d1) == (Hdict d2)
+  eq (x1::int    => y1)  (x2::int    => y2) |
+  eq (x1::string => y1)  (x2::string => y2) |
+  eq (x1         => y1)  (x2         => y2)
+				= x1 == x2 && y1 == y2
+end;
+
+d1@(Hdict _) == d2@(Hdict _)
 	= if (all (member d1) (keys d2))
   		then
 			if (all (member d2) (keys d1))
@@ -470,10 +488,21 @@
 
 
 // inequality checks for dict and hdict
-(Dict  d1) != (Dict  d2)	= (members d1) != (members d2);
-(Hdict d1) != (Hdict d2)	= not (d1 == d2);
+d1@(Dict  _) != d2@(Dict  _)	= neq (members d1) (members d2)
+with
+  neq [] []			= 0;
+  neq (x:xs) []			= 1;
+  neq [] (x:xs)			= 1;
+  neq (x:xs) (y:ys)		= if neq x y then 1 else neq xs ys;
 
+  neq (x1::int    => y1) (x2::int    => y2) |
+  neq (x1::string => y1) (x2::string => y2) |
+  neq (x1         => y1) (x2         => y2)
+				= x1 != x2 || y1 != y2
+end;
 
+d1@(Hdict _) != d2@(Hdict _)	= not (d1 == d2);
+
 /* Private functions, don't invoke these directly. */
 
 Dict_adjustd ToF::int tree LoR::int


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[pure-lang-svn] SF.net SVN: pure-lang: [401] pure/trunk/examples/dict.pure

[<js...@us...>]

Revision: 401
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=401&view=rev
Author:   jspitz
Date:     2008-07-06 10:37:53 -0700 (Sun, 06 Jul 2008)

Log Message:
-----------
Revert changes to equality/inequality tests after moving '=>' to prelude, fix typo.

Modified Paths:
--------------
    pure/trunk/examples/dict.pure

Modified: pure/trunk/examples/dict.pure
===================================================================
--- pure/trunk/examples/dict.pure	2008-07-06 10:50:05 UTC (rev 400)
+++ pure/trunk/examples/dict.pure	2008-07-06 17:37:53 UTC (rev 401)
@@ -47,7 +47,7 @@
 emptydict, emptyhdict:		return the empty dict or bag
 dict xs, hdict xs;		create a dict or hdict from list xs
 dictp d, hdictp d;		check whether x is a dict or hdict
-mkdict y xs, mkhdixt y xs:	create dict or hdict from a list of keys and
+mkdict y xs, mkhdict y xs:	create dict or hdict from a list of keys and
 				a constant value
 
 #d				size of dict or hdict d
@@ -461,19 +461,8 @@
 				= insert d [x, y];
 
 // equality checks for dict and hdict
-d1@(Dict  _) == d2@(Dict  _)	= eq (members d1) (members d2)
-with
-  eq [] []			= 1;
-  eq (x:xs) []			= 0;
-  eq [] (x:xs)			= 0;
-  eq (x:xs) (y:ys)		= if eq x y then eq xs ys else 0;
+d1@(Dict  _) == d2@(Dict  _)	= (members d1) == (members d2);
 
-  eq (x1::int    => y1)  (x2::int    => y2) |
-  eq (x1::string => y1)  (x2::string => y2) |
-  eq (x1         => y1)  (x2         => y2)
-				= x1 == x2 && y1 == y2
-end;
-
 d1@(Hdict _) == d2@(Hdict _)
 	= if (all (member d1) (keys d2))
   		then
@@ -484,19 +473,7 @@
 
 
 // inequality checks for dict and hdict
-d1@(Dict  _) != d2@(Dict  _)	= neq (members d1) (members d2)
-with
-  neq [] []			= 0;
-  neq (x:xs) []			= 1;
-  neq [] (x:xs)			= 1;
-  neq (x:xs) (y:ys)		= if neq x y then 1 else neq xs ys;
-
-  neq (x1::int    => y1) (x2::int    => y2) |
-  neq (x1::string => y1) (x2::string => y2) |
-  neq (x1         => y1) (x2         => y2)
-				= x1 != x2 || y1 != y2
-end;
-
+d1@(Dict  _) != d2@(Dict  _)	= (members d1) != (members d2);
 d1@(Hdict _) != d2@(Hdict _)	= not (d1 == d2);
 
 /* Private functions, don't invoke these directly. */


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[pure-lang-svn] SF.net SVN: pure-lang: [402] pure/trunk/examples/dict.pure

[<js...@us...>]

Revision: 402
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=402&view=rev
Author:   jspitz
Date:     2008-07-06 14:20:06 -0700 (Sun, 06 Jul 2008)

Log Message:
-----------
Bugfix of 'mkdict', 'mkhdict' and 'update' to use '=>' operator.

Modified Paths:
--------------
    pure/trunk/examples/dict.pure

Modified: pure/trunk/examples/dict.pure
===================================================================
--- pure/trunk/examples/dict.pure	2008-07-06 17:37:53 UTC (rev 401)
+++ pure/trunk/examples/dict.pure	2008-07-06 21:20:06 UTC (rev 402)
@@ -285,8 +285,8 @@
 
 
 // create dict or hdict from a list of keys and a constant value
-mkdict  y xs			= dict  (zip xs (repeat (#xs) y)) if listp xs;
-mkhdict y xs			= hdict (zip xs (repeat (#xs) y)) if listp xs;
+mkdict  y xs			= dict  (zipwith (=>) xs (repeat (#xs) y)) if listp xs;
+mkhdict y xs			= hdict (zipwith (=>) xs (repeat (#xs) y)) if listp xs;
 
 // check for the empty dict or hdict
 null (Dict nil)			= 1;
@@ -458,7 +458,7 @@
 update d@(Dict  _) x::string y |
 update d@(Dict  _) x         y |
 update d@(Hdict _) x         y
-				= insert d [x, y];
+				= insert d (x => y);
 
 // equality checks for dict and hdict
 d1@(Dict  _) == d2@(Dict  _)	= (members d1) == (members d2);


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.