q-lang-cvs — cvs commit log

[q-lang-cvs] q/stdlib bag.q, 1.5, 1.6 dict.q, 1.5, 1.6 hdict.q, 1.6, 1.7 set.q, 1.6, 1.7

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q/stdlib
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv18298

Modified Files:
	bag.q dict.q hdict.q set.q 
Log Message:
faster AVL tree implementation by Jiri Spitz

Index: bag.q
===================================================================
RCS file: /cvsroot/q-lang/q/stdlib/bag.q,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** bag.q	2 Oct 2007 00:56:23 -0000	1.5
--- bag.q	21 Feb 2008 07:58:13 -0000	1.6
***************
*** 19,23 ****
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  
! public type Bag = virtual bag Xs | private const nil, bin H X M1 M2;
  
  /* Construction and type checking: */
--- 19,38 ----
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  
! /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!    Updated: 18 February 2008 by Jiri Spitz
! 
!    Purpose: More efficient algorithm for association lists implemented
!    as AVL trees.
! 
!    The used algorithm 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 deletion stuff (rmfirst, rmlast, delete) is new, it was missing
!    in the original assoc.pl file.
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
! 
! public type Bag = virtual bag Xs | private const nil, bin X B M1 M2;
  
  /* Construction and type checking: */
***************
*** 56,102 ****
  @0
  
  /* Private Functions: ******************************************************/
  
! private height M;		// return height of tree
! private slope M;		// return slope (height diff between left and
! 				// right subtree)
! private mkbin X M1 M2;		// construct node, recomputing height
  
! private rebal M;		// rebalance tree after insertions and 
! 				// deletions
! private rol M, ror M;		// single rotation left/right
! private shl M, shr M;		// shift to left/right (single or double
! 				// rotation)
  
! private join M1 M2;		// join two balanced subtrees
  
! height nil			= 0;
! height (bin H _ _ _)		= H;
  
! slope nil			= 0;
! slope (bin _ _ M1 M2)		= height M1 - height M2;
  
! mkbin X M1 M2			= bin (max (height M1) (height M2) + 1)
! 				  X M1 M2;
  
! rebal M				= shl M if slope M = -2;
! 				= shr M if slope M = 2;
! 				= M otherwise;
  
! rol (bin _ X1 M1 (bin _ X2 M2 M3))
! 				= mkbin X2 (mkbin X1 M1 M2) M3;
! ror (bin _ X1 (bin _ X2 M1 M2) M3)
! 				= mkbin X2 M1 (mkbin X1 M2 M3);
  
! shl (bin H X M1 M2)		= rol (mkbin X M1 (ror M2)) if slope M2 = 1;
! 				= rol (bin H X M1 M2) otherwise;
  
! shr (bin H X M1 M2)		= ror (mkbin X (rol M1) M2)
! 				      if slope M1 = -1;
! 				= ror (bin H X M1 M2) otherwise;
  
! join nil M2			= M2;
! join M1 M2			= rebal (mkbin (last M1) (rmlast M1) M2)
! 				      otherwise;
  
  /* Public Functions: *******************************************************/
--- 71,266 ----
  @0
  
+ /* Private Types: **********************************************************/
+ 
+ // For better readability of the code
+ private type Balance		= const islt, iseq, isgt;
+ private type Side		= const left, right;
+ 
  /* Private Functions: ******************************************************/
  
! private inserta Tree Key;
! 	// insert a new (or replace an existing) member in the tree
  
! private rmfirsta Tree;
! 	// remove the first member from the tree
  
! private rmlasta Tree;
! 	// remove the last member from the tree
  
! private deletea Tree Key;
! 	// delete member with Key from the tree
  
! private adjusti TreeHasChanged Tree LeftOrRight;
! 	// decide changes needed in order to make a well
! 	// shaped tree after an insertion
  
! private rebali ToBeRebalanced Tree NewBalance;
! 	// if ToBeRabalanced = false then set the balance of the root node
! 	// to NewBalance else call avl_geq
  
! private adjustd TreeHasChanged Tree LeftOrRight;
! 	// decide changes needed in order to make a well
! 	// shaped tree after a deletion
  
! private rebald ToBeRebalanced Tree NewBalance WhatHasChanged;
! 	// if ToBeRabalanced = false then set the balance of the root node
! 	// to NewBalance else call avl_geq
  
! private avl_geq Tree;
! 	// single and double rotations of the tree
  
! private tablei BalanceBefore WhereInserted;
! 	// insert balance rules
  
! private tabled BalanceBefore WhereDeleted;
! 	// delete balance rules
! 
! private table2 BalanceOfSubSubNode;
! 	// balance rules for double rotations
! 
! /*
! Tree is either:
! 
! -  nil  (empty tree) or
! -  bin Key Balance Left Right  (Left, Right: trees)
!    Balance: islt, iseq, or isgt denoting |L|-|R| = 1, 0, or -1, respectively
! */
! 
! inserta nil Key			= ((bin Key iseq nil nil), true);
! 
! inserta (bin K B L R) Key if Key < K:
! 		= adjusti LeftHasChanged (bin K B NewL R) left
! 		    where (NewL, LeftHasChanged) = inserta L Key;
! 
! inserta (bin K B L R) Key if Key >= K:
! 		= adjusti RightHasChanged (bin K B L NewR) right
! 		    where (NewR, RightHasChanged) = inserta R Key;
! 
! rmfirsta nil			= (nil, false);
! rmfirsta (bin _ _ nil R)	= (R, true);
! 
! rmfirsta (bin K B L   R)
! 		= adjustd LeftHasChanged (bin K B NewL R) left
! 		    where (NewL, LeftHasChanged) = rmfirsta L;
! 
! rmlasta nil			= (nil false);
! rmlasta (bin _ _ L nil)		= (L, true);
! 
! rmlasta (bin K B L   R)
! 		= adjustd RightHasChanged (bin K B L NewR) right
! 		    where (NewR, RightHasChanged) = rmlasta R;
! 
! deletea nil _			= (nil, false);
! deletea (bin Key _ nil R  ) Key	= (R, true);
! deletea (bin Key _ L   nil) Key	= (L, true);
! 
! deletea (bin Key B (bin KL BL RL LL) R) Key
! 		= adjustd LeftHasChanged (bin LastK B NewL R) left
! 		    where
! 		      LastK			= last (bin KL BL RL LL),
! 		      (NewL, LeftHasChanged)	= rmlasta (bin KL BL RL LL);
! 
! deletea (bin K B L R) Key if Key < K:
! 		= adjustd LeftHasChanged (bin K B NewL R) left
! 		    where
! 		      (NewL, LeftHasChanged) = deletea L Key;
! 
! deletea (bin K B L R) Key if Key > K:
! 		= adjustd RightHasChanged (bin K B L NewR) right
! 		    where
! 		      (NewR, RightHasChanged) = deletea R Key;
! 
! // The insertions and deletions are dealt with separately.
! // Insertions
! adjusti false OldTree _		= (OldTree, false);
! 
! adjusti true (bin Key B0 L R) LoR
! 		= (rebali ToBeRebalanced (bin Key B0 L R) B1, WhatHasChanged)
! 		    where
! 		      (B1, WhatHasChanged, ToBeRebalanced) = tablei B0 LoR;
! 
! rebali false (bin K _ L R) B	= bin K B L R;
! rebali true  OldTree _		= fst (avl_geq OldTree);
! 
! // Balance rules for insertions
! //	balance	where		balance	  whole tree	to be
! //	before	inserted	after	  increased	rebalanced
! tablei	iseq	left		= (islt,  true,		false);
! tablei	iseq	right		= (isgt,  true,		false);
! tablei	islt	left		= (iseq,  false,	true);
! tablei	islt	right		= (iseq,  false,	false);
! tablei	isgt	left		= (iseq,  false,	false);
! tablei	isgt	right		= (iseq,  false,	true);
! 
! // Deletions
! adjustd false OldTree _		= (OldTree, false);
! 
! adjustd true (bin Key B0 L R) LoR
! 		= rebald ToBeRebalanced (bin Key B0 L R) B1 WhatHasChanged
! 		    where
! 		      (B1, WhatHasChanged, ToBeRebalanced) = tabled B0 LoR;
! 
! // Balance rules for deletions
! //	balance	where		balance	  whole tree	to be
! //	before	deleted		after	  decreased	rebalanced
! tabled	iseq	right		= (islt,  false,	false);
! tabled	iseq	left		= (isgt,  false,	false);
! tabled	islt	right		= (iseq,  true,		true);
! //					  ^^^^
! // It depends on the tree pattern in avl_geq whether it really decreases
! 
! tabled	islt	left		= (iseq,  true, 	false);
! tabled	isgt	right		= (iseq,  true,		false);
! tabled	isgt	left		= (iseq,  true,		true);
! //					  ^^^^
! // It depends on the tree pattern in avl_geq whether it really decreases
! 
! /*
!    Note that rebali and rebald are not symmetrical. With insertions it is
!    sufficient to know the original balance and insertion side in order to
!    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.
! */
! rebald false (bin K _ L R) B WhatHasChanged
! 				= (bin K B L R, WhatHasChanged);
! rebald true  OldTree _ _	= avl_geq OldTree;
! 
! // Single and double tree rotations - these are common for insert and delete
! /*
!   The patterns isgt-isgt, isgt-islt, islt-islt and islt-isgt 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 isgt-iseq and islt-iseq do not change the tree height. After a
!   deletion any pattern can occur and so we return true or false as a flag of
!   a height change.
! */
! avl_geq (bin A isgt Alpha (bin B isgt Beta Gamma))
! 		= (bin B iseq (bin A iseq Alpha Beta) Gamma, true);
! 
! avl_geq (bin A isgt Alpha (bin B iseq Beta Gamma))
! 		= (bin B islt (bin A isgt Alpha Beta) Gamma, false);
! 			// the tree doesn't decrease with this pattern
! 
! avl_geq (bin A isgt Alpha (bin B islt (bin X B1 Beta Gamma) Delta))
! 		= (bin X iseq (bin A B2 Alpha Beta)
! 		   (bin B B3 Gamma Delta), true)
! 		    where (B2, B3) = table2 B1;
! 
! avl_geq (bin B islt (bin A islt Alpha Beta) Gamma)
! 		= (bin A iseq Alpha (bin B iseq Beta  Gamma), true);
! 
! avl_geq (bin B islt (bin A iseq Alpha Beta) Gamma)
! 		= (bin A isgt Alpha (bin B islt Beta  Gamma), false);
! 			// the tree doesn't decrease with this pattern
! 
! avl_geq (bin B islt (bin A isgt Alpha (bin X B1 Beta Gamma)) Delta)
! 		= (bin X iseq (bin A B2 Alpha Beta)
! 		   (bin B B3 Gamma Delta), true)
! 		    where (B2, B3) = table2 B1;
! 
! table2 islt			= (iseq, isgt);
! table2 isgt			= (islt, iseq);
! table2 iseq			= (iseq, iseq);
  
  /* Public Functions: *******************************************************/
***************
*** 115,145 ****
  
  member nil _			= false;
! member (bin _ X M1 M2) Y	= member M1 Y if X>Y;
  				= member M2 Y if X<Y;
  				= true if X=Y;
  
  members nil			= [];
! members (bin _ X M1 M2)		= members M1 ++ [X|members M2];
  
! first (bin _ X nil _)		= X;
  first (bin _ _ M1 _)		= first M1 otherwise;
  
! last (bin _ X _ nil)		= X;
  last (bin _ _ _ M2)		= last M2 otherwise;
  
! rmlast (bin _ _ M1 nil)		= M1;
! rmlast (bin _ X M1 M2)		= rebal (mkbin X M1 (rmlast M2)) otherwise;
  
! rmfirst (bin _ _ nil M2)	= M2;
! rmfirst (bin _ X M1 M2)		= rebal (mkbin X (rmfirst M1) M2) otherwise;
  
! insert nil Y			= bin 1 Y nil nil;
! insert (bin _ X M1 M2) Y	= rebal (mkbin X (insert M1 Y) M2) if X>Y;
! 				= rebal (mkbin X M1 (insert M2 Y)) if X<=Y;
  
! delete nil _			= nil;
! delete (bin _ X M1 M2) Y	= rebal (mkbin X (delete M1 Y) M2) if X>Y;
! 				= rebal (mkbin X M1 (delete M2 Y)) if X<Y;
! 				= join M1 M2 if X=Y;
  
  /* bag comparison, union, difference and intersection: */
--- 279,302 ----
  
  member nil _			= false;
! member (bin X _ M1 M2) Y	= member M1 Y if X>Y;
  				= member M2 Y if X<Y;
  				= true if X=Y;
  
  members nil			= [];
! members (bin X _ M1 M2)		= members M1 ++ [X|members M2];
  
! first (bin X _ nil _)		= X;
  first (bin _ _ M1 _)		= first M1 otherwise;
  
! last (bin X _ _ nil)		= X;
  last (bin _ _ _ M2)		= last M2 otherwise;
  
! rmlast Xs			= fst (rmlasta Xs);
  
! rmfirst Xs			= fst (rmfirsta Xs);
  
! insert Xs Y			= fst (inserta Xs Y);
  
! delete Xs Y			= fst (deletea Xs Y);
  
  /* bag comparison, union, difference and intersection: */

Index: hdict.q
===================================================================
RCS file: /cvsroot/q-lang/q/stdlib/hdict.q,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** hdict.q	2 Oct 2007 00:56:24 -0000	1.6
--- hdict.q	21 Feb 2008 07:58:13 -0000	1.7
***************
*** 19,22 ****
--- 19,37 ----
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  
+ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    Updated: 18 February 2008 by Jiri Spitz
+ 
+    Purpose: More efficient algorithm for association lists implemented
+    as AVL trees.
+ 
+    The used algorithm 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 deletion stuff (delete) is new, it was missing in the original
+    assoc.pl file.
+ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+ 
  /* This is a variation of the dictionary data structure using hashed key
     values (commonly called "hashes" or "associative arrays" in other
***************
*** 32,36 ****
     permutations of each other. */
  
! public type HDict = virtual hdict XYs | private const nil, bin H XY D1 D2;
  
  /* Construction and type checking: */
--- 47,51 ----
     permutations of each other. */
  
! public type HDict = virtual hdict XYs | private const nil, bin K V B D1 D2;
  
  /* Construction and type checking: */
***************
*** 70,129 ****
  @0
  
  /* Private Functions: ******************************************************/
  
! private height D;		// return height of tree
! private slope D;		// return slope (height diff between left and
! 				// right subtree)
! private mkbin U D1 D2;		// construct node, recomputing height
  
! private rebal D;		// rebalance tree after insertions and 
! 				// deletions
! private rol D, ror D;		// single rotation left/right
! private shl D, shr D;		// shift to left/right (single or double
! 				// rotation)
  
! private last D, rmlast D;	// get/remove last bucket from dictionary
! private join D1 D2;		// join two balanced subtrees
  
! height nil			= 0;
! height (bin H _ _ _)		= H;
  
! slope nil			= 0;
! slope (bin _ _ D1 D2)		= height D1 - height D2;
  
! mkbin U D1 D2			= bin (max (height D1) (height D2) + 1)
! 				  U D1 D2;
  
! rebal D				= shl D if slope D = -2;
! 				= shr D if slope D = 2;
! 				= D otherwise;
  
! rol (bin H1 U1 D1 (bin H2 U2 D2 D3))
! 				= mkbin U2 (mkbin U1 D1 D2) D3;
! ror (bin H1 U1 (bin H2 U2 D1 D2) D3)
! 				= mkbin U2 D1 (mkbin U1 D2 D3);
  
! shl (bin H U D1 D2)		= rol (mkbin U D1 (ror D2))
! 				      if slope D2 = 1;
! 				= rol (bin H U D1 D2) otherwise;
  
! shr (bin H U D1 D2)		= ror (mkbin U (rol D1) D2)
! 				      if slope D1 = -1;
! 				= ror (bin H U D1 D2) otherwise;
  
! last (bin _ U _ nil)		= U;
! last (bin _ _ _ D2)		= last D2 otherwise;
  
! rmlast (bin _ _ D1 nil)		= D1;
! rmlast (bin _ U D1 D2)		= rebal (mkbin U D1 (rmlast D2))
! 				      otherwise;
  
! join nil D2			= D2;
! join D1 D2			= rebal (mkbin (last D1) (rmlast D1) D2)
! 				      otherwise;
  
! /* look up the value for a (K,X) pair in a dictionary, where K = hash X */
  
! private lookup _ _;
  
  /* If we can't find X, pretend we got a `nil!X', so the user can supply a
--- 85,145 ----
  @0
  
+ /* Private Types: **********************************************************/
+ 
+ // For better readability of the code
+ private type Balance		= const islt, iseq, isgt;
+ private type Side		= const left, right;
+ 
  /* Private Functions: ******************************************************/
  
! private last Tree;
! 	// find the last element in the tree
  
! private inserta Tree Hash Key Val;
! 	// insert a new (or replace an existing) member in the tree
  
! private rmlasta Tree;
! 	// remove the last member from the tree
  
! private deletea Tree Hash Key;
! 	// delete member with Key from the tree
  
! private adjusti TreeHasChanged Tree LeftOrRight;
! 	// decide changes needed in order to make a well
! 	// shaped tree after an insertion
  
! private rebali ToBeRebalanced Tree NewBalance;
! 	// if ToBeRabalanced = false then set the balance of the root node
! 	// to NewBalance else call avl_geq
  
! private adjustd TreeHasChanged Tree LeftOrRight;
! 	// decide changes needed in order to make a well
! 	// shaped tree after a deletion
  
! private rebald ToBeRebalanced Tree NewBalance WhatHasChanged;
! 	// if ToBeRabalanced = false then set the balance of the root node
! 	// to NewBalance else call avl_geq
  
! private avl_geq Tree;
! 	// single and double rotations of the tree
  
! private tablei BalanceBefore WhereInserted;
! 	// insert balance rules
  
! private tabled BalanceBefore WhereDeleted;
! 	// delete balance rules
  
! private table2 BalanceOfSubSubNode;
! 	// balance rules for double rotations
  
! /*
! Tree is either:
  
! -  nil  (empty tree) or
! -  bin Key Value Balance Left Right  (Left, Right: trees)
!    Balance: islt, iseq, or isgt denoting |L|-|R| = 1, 0, or -1, respectively
! */
  
! /* look up the value for a (K,X) pair in a dictionary, where K = hash X */
  
  /* If we can't find X, pretend we got a `nil!X', so the user can supply a
***************
*** 131,192 ****
     consistent with dict.q. */
  
! lookup nil (K,X)		= nil!X;
! lookup (bin _ (K,XYs) D1 D2) (K1,X1)
! 				= lookup D1 (K1,X1) if K>K1;
! 				= lookup D2 (K1,X1) if K<K1;
! 				= lookup XYs X1 otherwise;
  
! lookup [] X			= nil!X;
! lookup [(X,Y)|_] X		= Y;
! lookup [_|XYs] X		= lookup XYs X otherwise;
  
  /* check whether value is in given bucket of a dictionary */
  
! private memberk _ _;
  
! memberk nil _			= false;
! memberk (bin _ (K,XYs) D1 D2) (K1,X1)
! 				= memberk D1 (K1,X1) if K>K1;
! 				= memberk D2 (K1,X1) if K<K1;
! 				= memberk XYs X1 otherwise;
  
! memberk [] _			= false;
! memberk [(X,Y)|_] X		= true;
! memberk [_|XYs] X		= memberk XYs X otherwise;
  
! /* insert value for a given hash key */
  
! private insertk _ _;
  
! insertk nil (K1,X1,Y1)		= bin 1 (K1,[(X1,Y1)]) nil nil;
! insertk (bin H (K,XYs) D1 D2) (K1,X1,Y1)
! 				= rebal (mkbin (K,XYs) (insertk D1 (K1,X1,Y1))
! 					 D2) if K>K1;
! 				= rebal (mkbin (K,XYs) D1
! 					 (insertk D2 (K1,X1,Y1))) if K<K1;
! 				= bin H (K1,insertk XYs (X1,Y1)) D1 D2
! 				    otherwise;
  
! insertk [] (X,Y)		= [(X,Y)];
! insertk [(X,Y)|XYs] (X,Y1)	= [(X,Y1)|XYs];
! insertk [(X,Y)|XYs] (X1,Y1)	= [(X,Y)|insertk XYs (X1,Y1)] otherwise;
  
! /* delete value for a given hash key */
  
! private deletek _ _;
  
! deletek nil _			= nil;
! deletek (bin H (K,XYs) D1 D2) (K1,X1)
! 				= rebal (mkbin (K,XYs) (deletek D1 (K1,X1)) D2)
! 				      if K>K1;
! 				= rebal (mkbin (K,XYs) D1 (deletek D2 (K1,X1)))
! 				      if K<K1;
! 				= bin H (K,XYs1) D1 D2 if not null XYs1
! 				    where XYs1 = deletek XYs X1;
! 				= join D1 D2 otherwise;
  
! deletek [] _			= [];
! deletek [(X,_)|XYs] X		= XYs;
! deletek [(X,Y)|XYs] X1		= [(X,Y)|deletek XYs X1] otherwise;
  
  /* Public Functions: *******************************************************/
--- 147,339 ----
     consistent with dict.q. */
  
! private lookup _ _ _, lookup2 _ _;
  
! lookup nil K X			= nil!X;
! lookup (bin K XYs _ D1 D2) K1 X1
! 				= lookup D1 K1 X1 if K>K1;
! 				= lookup D2 K1 X1 if K<K1;
! 				= lookup2 XYs X1 otherwise;
! 
! lookup2 [] X			= nil!X;
! lookup2 [(X,Y)|_] X		= Y;
! lookup2 [_|XYs] X		= lookup2 XYs X otherwise;
  
  /* check whether value is in given bucket of a dictionary */
  
! private memberk _ _ _, memberk2 _ _;
  
! memberk nil _ _			= false;
! memberk (bin K XYs _ D1 D2) K1 X1
! 				= memberk D1 K1 X1 if K>K1;
! 				= memberk D2 K1 X1 if K<K1;
! 				= memberk2 XYs X1 otherwise;
  
! memberk2 [] _			= false;
! memberk2 [(X,Y)|_] X		= true;
! memberk2 [_|XYs] X		= memberk2 XYs X otherwise;
  
! /* insertions */
  
! private inserta2 _ _ _;
  
! inserta nil K X Y		= ((bin K [(X, Y)] iseq nil nil), true);
! inserta (bin K V B L R) K X Y	= ((bin K (inserta2 V X Y) B L R), false);
  
! inserta (bin K V B L R) Key X Y	if Key < K:
! 		= adjusti LeftHasChanged (bin K V B NewL R) left
! 		    where (NewL, LeftHasChanged) = inserta L Key X Y;
  
! inserta (bin K V B L R) Key X Y if Key > K:
! 		= adjusti RightHasChanged (bin K V B L NewR) right
! 		    where (NewR, RightHasChanged) = inserta R Key X Y;
  
! inserta2 [] X Y			= [(X,Y)];
! inserta2 [(X,Y)|XYs] X Y1	= [(X,Y1)|XYs];
! inserta2 [(X,Y)|XYs] X1 Y1	= [(X,Y)|inserta2 XYs X1 Y1] otherwise;
  
! /* deletions */
  
! // find the last value in the tree
! last (bin Key Val _ _ nil)	= (Key, Val);
! last (bin _ _ _ _ R)		= last R;
! 
! // remove last value from the tree
! rmlasta nil			= (nil false);
! rmlasta (bin _ _ _ L nil)	= (L, true);
! 
! rmlasta (bin K V B L   R)
! 		= adjustd RightHasChanged (bin K V B L NewR) right
! 		    where (NewR, RightHasChanged) = rmlasta R;
! 
! private deletea2 _ _;
! 
! deletea nil _			= (nil, false);
! 
! deletea (bin Key XYs B nil R  ) Key X
! 		= if null NewXYs then (R, true)
! 		  else (bin Key NewXYs B nil R, false)
! 		    where NewXYs = deletea2 XYs X;
! 
! deletea (bin Key XYs B L   nil) Key X
! 		= if null NewXYs then (L, true)
! 		  else (bin Key NewXYs B L nil, false)
! 		    where NewXYs = deletea2 XYs X;
! 
! deletea (bin Key XYs B (bin KL VL BL RL LL) R) Key X if null (deletea2 XYs X):
! 		= adjustd LeftHasChanged (bin LastK LastV B NewL R) left
! 		    where
! 		      (LastK, LastV)		= last (bin KL VL BL RL LL),
! 		      (NewL, LeftHasChanged)	= rmlasta (bin KL VL BL RL LL);
! 
! deletea (bin Key XYs B L R) Key X
! 		= (bin Key (deletea2 XYs X) B L R, false);
! 
! deletea (bin K V B L R) Key X if Key < K:
! 		= adjustd LeftHasChanged (bin K V B NewL R) left
! 		    where
! 		      (NewL, LeftHasChanged) = deletea L Key X;
! 
! deletea (bin K V B L R) Key X if Key > K:
! 		= adjustd RightHasChanged (bin K V B L NewR) right
! 		    where
! 		      (NewR, RightHasChanged) = deletea R Key X;
! 
! deletea2 [] _			= [];
! deletea2 [(X,_)|XYs] X		= XYs;
! deletea2 [(X,Y)|XYs] X1		= [(X,Y)|deletea2 XYs X1] otherwise;
! 
! // The insertions and deletions are dealt with separately.
! // Insertions
! adjusti false OldTree _		= (OldTree, false);
! 
! adjusti true (bin Key Val B0 L R) LoR
! 		= (rebali ToBeRebalanced (bin Key Val B0 L R) B1,
! 		   WhatHasChanged)
! 		    where
! 		      (B1, WhatHasChanged, ToBeRebalanced) = tablei B0 LoR;
! 
! rebali false (bin K V _ L R) B	= bin K V B L R;
! rebali true  OldTree _		= fst (avl_geq OldTree);
! 
! // Balance rules for insertions
! //	balance	where		balance	  whole tree	to be
! //	before	inserted	after	  increased	rebalanced
! tablei	iseq	left		= (islt,  true,		false);
! tablei	iseq	right		= (isgt,  true,		false);
! tablei	islt	left		= (iseq,  false,	true);
! tablei	islt	right		= (iseq,  false,	false);
! tablei	isgt	left		= (iseq,  false,	false);
! tablei	isgt	right		= (iseq,  false,	true);
! 
! // Deletions
! adjustd false OldTree _		= (OldTree, false);
! 
! adjustd true (bin Key Val B0 L R) LoR
! 		= rebald ToBeRebalanced (bin Key Val B0 L R) B1 WhatHasChanged
! 		    where
! 		      (B1, WhatHasChanged, ToBeRebalanced) = tabled B0 LoR;
! 
! // Balance rules for deletions
! //	balance	where		balance	  whole tree	to be
! //	before	deleted		after	  decreased	rebalanced
! tabled	iseq	right		= (islt,  false,	false);
! tabled	iseq	left		= (isgt,  false,	false);
! tabled	islt	right		= (iseq,  true,		true);
! //					  ^^^^
! // It depends on the tree pattern in avl_geq whether it really decreases
! 
! tabled	islt	left		= (iseq,  true, 	false);
! tabled	isgt	right		= (iseq,  true,		false);
! tabled	isgt	left		= (iseq,  true,		true);
! //					  ^^^^
! // It depends on the tree pattern in avl_geq whether it really decreases
! 
! /*
!    Note that rebali and rebald are not symmetrical. With insertions it is
!    sufficient to know the original balance and insertion side in order to
!    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.
! */
! rebald false (bin K V _ L R) B WhatHasChanged
! 				= (bin K V B L R, WhatHasChanged);
! rebald true  OldTree _ _	= avl_geq OldTree;
! 
! // Single and double tree rotations - these are common for insert and delete
! /*
!   The patterns isgt-isgt, isgt-islt, islt-islt and islt-isgt 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 isgt-iseq and islt-iseq do not change the tree height. After a
!   deletion any pattern can occur and so we return true or false as a flag of
!   a height change.
! */
! avl_geq (bin A VA isgt Alpha (bin B VB isgt Beta Gamma))
! 		= (bin B VB iseq (bin A VA iseq Alpha Beta) Gamma, true);
! 
! avl_geq (bin A VA isgt Alpha (bin B VB iseq Beta Gamma))
! 		= (bin B VB islt (bin A VA isgt Alpha Beta) Gamma, false);
! 			// the tree doesn't decrease with this pattern
! 
! avl_geq (bin A VA isgt Alpha (bin B VB islt (bin X VX B1 Beta Gamma) Delta))
! 		= (bin X VX iseq (bin A VA B2 Alpha Beta)
! 		   (bin B VB B3 Gamma Delta), true)
! 		    where (B2, B3) = table2 B1;
! 
! avl_geq (bin B VB islt (bin A VA islt Alpha Beta) Gamma)
! 		= (bin A VA iseq Alpha (bin B VB iseq Beta  Gamma), true);
! 
! avl_geq (bin B VB islt (bin A VA iseq Alpha Beta) Gamma)
! 		= (bin A VA isgt Alpha (bin B VB islt Beta  Gamma), false);
! 			// the tree doesn't decrease with this pattern
! 
! avl_geq (bin B VB islt (bin A VA isgt Alpha(bin X VX B1 Beta Gamma)) Delta)
! 		= (bin X VX iseq (bin A VA B2 Alpha Beta)
! 		   (bin B VB B3 Gamma Delta), true)
! 		    where (B2, B3) = table2 B1;
! 
! table2 islt			= (iseq, isgt);
! table2 isgt			= (islt, iseq);
! table2 iseq			= (iseq, iseq);
  
  /* Public Functions: *******************************************************/
***************
*** 200,224 ****
  
  #nil				= 0;
! #bin _ (_,XYs) D1 D2		= #D1+#D2+#XYs;
  
! D:HDict!X			= lookup D (hash X,X) if not null D;
  
  null nil			= true;
  null _:HDict			= false otherwise;
  
! member D:HDict X		= memberk D (hash X,X);
  
  members nil			= [];
! members (bin _ (_,XYs) D1 D2)	= members D1 ++ XYs ++ members D2;
  
  keys nil			= [];
! keys (bin _ (_,XYs) D1 D2)	= keys D1 ++ map fst XYs ++ keys D2;
  
  vals nil			= [];
! vals (bin _ (_,XYs) D1 D2)	= vals D1 ++ map snd XYs ++ vals D2;
  
! insert D:HDict (X,Y)		= insertk D (hash X,X,Y);
  
! delete D:HDict X		= deletek D (hash X,X);
  
  update D:HDict X Y		= insert D (X,Y);
--- 347,371 ----
  
  #nil				= 0;
! #bin _ XYs _ D1 D2		= #D1+#D2+#XYs;
  
! D:HDict!X			= lookup D (hash X) X if not null D;
  
  null nil			= true;
  null _:HDict			= false otherwise;
  
! member D:HDict X		= memberk D (hash X) X;
  
  members nil			= [];
! members (bin _ XYs _ D1 D2)	= members D1 ++ XYs ++ members D2;
  
  keys nil			= [];
! keys (bin _ XYs _ D1 D2)	= keys D1 ++ map fst XYs ++ keys D2;
  
  vals nil			= [];
! vals (bin _ XYs _ D1 D2)	= vals D1 ++ map snd XYs ++ vals D2;
  
! insert D:HDict (X,Y)		= fst (inserta D (hash X) X Y);
  
! delete D:HDict X		= fst (deletea D (hash X) X);
  
  update D:HDict X Y		= insert D (X,Y);

Index: dict.q
===================================================================
RCS file: /cvsroot/q-lang/q/stdlib/dict.q,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** dict.q	2 Oct 2007 00:56:23 -0000	1.5
--- dict.q	21 Feb 2008 07:58:13 -0000	1.6
***************
*** 19,23 ****
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  
! public type Dict = virtual dict XYs | private const nil, bin H XY D1 D2;
  
  /* Construction and type checking: */
--- 19,38 ----
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  
! /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!    Updated: 18 February 2008 by Jiri Spitz
! 
!    Purpose: More efficient algorithm for association lists implemented
!    as AVL trees.
! 
!    The used algorithm 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 deletion stuff (rmfirst, rmlast, delete) is new, it was missing
!    in the original assoc.pl file.
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
! 
! public type Dict = virtual dict XYs | private const nil, bin K V B D1 D2;
  
  /* Construction and type checking: */
***************
*** 60,173 ****
  @0
  
  /* Private Functions: ******************************************************/
  
! private height D;		// return height of tree
! private slope D;		// return slope (height diff between left and
! 				// right subtree)
! private mkbin XY D1 D2;		// construct node, recomputing height
  
! private rebal D;		// rebalance tree after insertions and 
! 				// deletions
! private rol D, ror D;		// single rotation left/right
! private shl D, shr D;		// shift to left/right (single or double
! 				// rotation)
  
! private join D1 D2;		// join two balanced subtrees
  
! height nil			= 0;
! height (bin H _ _ _)		= H;
  
! slope nil			= 0;
! slope (bin _ _ D1 D2)		= height D1 - height D2;
  
! mkbin XY D1 D2			= bin (max (height D1) (height D2) + 1)
! 				  XY D1 D2;
  
! rebal D				= shl D if slope D = -2;
! 				= shr D if slope D = 2;
! 				= D otherwise;
  
! rol (bin H1 XY1 D1 (bin H2 XY2 D2 D3))
! 				= mkbin XY2 (mkbin XY1 D1 D2) D3;
! ror (bin H1 XY1 (bin H2 XY2 D1 D2) D3)
! 				= mkbin XY2 D1 (mkbin XY1 D2 D3);
  
! shl (bin H XY D1 D2)		= rol (mkbin XY D1 (ror D2))
! 				      if slope D2 = 1;
! 				= rol (bin H XY D1 D2) otherwise;
  
! shr (bin H XY D1 D2)		= ror (mkbin XY (rol D1) D2)
! 				      if slope D1 = -1;
! 				= ror (bin H XY D1 D2) otherwise;
  
! join nil D2			= D2;
! join D1 D2			= rebal (mkbin (last D1) (rmlast D1) D2)
! 				      otherwise;
  
! /* Public Functions: *******************************************************/
  
! emptydict			= nil;
! dict XYs:List			= foldl insert nil XYs;
! mkdict Y Xs			= dict (zip Xs (mklist Y (#Xs)));
  
! isdict _:Dict			= true;
! isdict _			= false otherwise;
  
! #nil				= 0;
! #bin _ _ D1 D2			= #D1+#D2+1;
  
! bin _ (X,Y) D1 D2 !X1		= D1!X1 if X>X1;
! 				= D2!X1 if X<X1;
! 				= Y if X=X1;
  
! null nil			= true;
! null _:Dict			= false otherwise;
  
! member nil _			= false;
! member (bin _ (X,_) D1 D2) X1
! 				= member D1 X1 if X>X1;
! 				= member D2 X1 if X<X1;
! 				= true if X=X1;
  
! members nil			= [];
! members (bin _ XY D1 D2)	= members D1 ++ [XY|members D2];
  
! keys nil			= [];
! keys (bin _ (X,_) D1 D2)	= keys D1 ++ [X|keys D2];
  
! vals nil			= [];
! vals (bin _ (_,Y) D1 D2)	= vals D1 ++ [Y|vals D2];
  
! first (bin _ XY nil _)		= XY;
! first (bin _ _ D1 _)		= first D1 otherwise;
  
! last (bin _ XY _ nil)		= XY;
! last (bin _ _ _ D2)		= last D2 otherwise;
  
! rmfirst (bin _ _ nil D2)	= D2;
! rmfirst (bin _ XY D1 D2)	= rebal (mkbin XY (rmfirst D1) D2)
! 				      otherwise;
  
! rmlast (bin _ _ D1 nil)		= D1;
! rmlast (bin _ XY D1 D2)		= rebal (mkbin XY D1 (rmlast D2))
! 				      otherwise;
  
! insert nil (X1,Y1)		= bin 1 (X1,Y1) nil nil;
! insert (bin H (X,Y) D1 D2) (X1,Y1)
! 				= rebal (mkbin (X,Y) (insert D1 (X1,Y1))
! 					 D2) if X>X1;
! 				= rebal (mkbin (X,Y) D1
! 					 (insert D2 (X1,Y1))) if X<X1;
! 				= bin H (X1,Y1) D1 D2 if X=X1;
  
! delete nil _			= nil;
! delete (bin _ (X,Y) D1 D2) X1	= rebal (mkbin (X,Y) (delete D1 X1) D2)
! 				      if X>X1;
! 				= rebal (mkbin (X,Y) D1 (delete D2 X1))
! 				      if X<X1;
! 				= join D1 D2 if X=X1;
  
! update D:Dict X Y		= insert D (X,Y);
  
  (D1:Dict = D2:Dict)		= (members D1 = members D2);
  D1:Dict <> D2:Dict		= members D1 <> members D2;
--- 75,326 ----
  @0
  
+ /* Private Types: **********************************************************/
+ 
+ // For better readability of the code
+ private type Balance		= const islt, iseq, isgt;
+ private type Side		= const left, right;
+ 
  /* Private Functions: ******************************************************/
  
! private inserta Tree Key Val;
! 	// insert a new (or replace an existing) member in the tree
  
! private rmfirsta Tree;
! 	// remove the first member from the tree
  
! private rmlasta Tree;
! 	// remove the last member from the tree
  
! private deletea Tree Key;
! 	// delete member with Key from the tree
  
! private adjusti TreeHasChanged Tree LeftOrRight;
! 	// decide changes needed in order to make a well
! 	// shaped tree after an insertion
  
! private rebali ToBeRebalanced Tree NewBalance;
! 	// if ToBeRabalanced = false then set the balance of the root node
! 	// to NewBalance else call avl_geq
  
! private adjustd TreeHasChanged Tree LeftOrRight;
! 	// decide changes needed in order to make a well
! 	// shaped tree after a deletion
  
! private rebald ToBeRebalanced Tree NewBalance WhatHasChanged;
! 	// if ToBeRabalanced = false then set the balance of the root node
! 	// to NewBalance else call avl_geq
  
! private avl_geq Tree;
! 	// single and double rotations of the tree
  
! private tablei BalanceBefore WhereInserted;
! 	// insert balance rules
  
! private tabled BalanceBefore WhereDeleted;
! 	// delete balance rules
  
! private table2 BalanceOfSubSubNode;
! 	// balance rules for double rotations
  
! /*
! Tree is either:
  
! -  nil  (empty tree) or
! -  bin Key Value Balance Left Right  (Left, Right: trees)
!    Balance: islt, iseq, or isgt denoting |L|-|R| = 1, 0, or -1, respectively
! */
  
! inserta nil Key Val		= ((bin Key Val iseq nil nil), true);
! inserta (bin Key _ B L R) Key Val
! 				= ((bin Key Val B L R), false);
  
! inserta (bin K V B L R) Key Val if Key < K:
! 		= adjusti LeftHasChanged (bin K V B NewL R) left
! 		    where (NewL, LeftHasChanged) = inserta L Key Val;
  
! inserta (bin K V B L R) Key Val if Key > K:
! 		= adjusti RightHasChanged (bin K V B L NewR) right
! 		    where (NewR, RightHasChanged) = inserta R Key Val;
  
! rmfirst D			= fst (rmfirsta D);
  
! rmfirsta nil			= (nil, false);
! rmfirsta (bin _ _ _ nil R)	= (R, true);
  
! rmfirsta (bin K V B L   R)
! 		= adjustd LeftHasChanged (bin K V B NewL R) left
! 		    where (NewL, LeftHasChanged) = rmfirsta L;
  
! rmlast D			= fst (rmlasta D);
  
! rmlasta nil			= (nil false);
! rmlasta (bin _ _ _ L nil)	= (L, true);
  
! rmlasta (bin K V B L   R)
! 		= adjustd RightHasChanged (bin K V B L NewR) right
! 		    where (NewR, RightHasChanged) = rmlasta R;
  
! delete D Key			= fst (deletea D Key);
  
! deletea nil _			= (nil, false);
! deletea (bin Key _ _ nil R  ) Key
! 				= (R, true);
! deletea (bin Key _ _ L   nil) Key
! 				= (L, true);
  
! deletea (bin Key _ B (bin KL VL BL RL LL) R  ) Key
! 		= adjustd LeftHasChanged (bin LastK LastV B NewL R) left
! 		    where
! 		      (LastK, LastV)		= last (bin KL VL BL RL LL),
! 		      (NewL, LeftHasChanged)	= rmlasta (bin KL VL BL RL LL);
  
! deletea (bin K V B L R) Key if Key < K:
! 		= adjustd LeftHasChanged (bin K V B NewL R) left
! 		    where
! 		      (NewL, LeftHasChanged) = deletea L Key;
  
! deletea (bin K V B L R) Key if Key > K:
! 		= adjustd RightHasChanged (bin K V B L NewR) right
! 		    where
! 		      (NewR, RightHasChanged) = deletea R Key;
! 
! // The insertions and deletions are dealt with separately.
! // Insertions
! adjusti false OldTree _		= (OldTree, false);
! 
! adjusti true (bin Key Val B0 L R) LoR
! 		= (rebali ToBeRebalanced (bin Key Val B0 L R) B1,
! 		   WhatHasChanged)
! 		    where
! 		      (B1, WhatHasChanged, ToBeRebalanced) = tablei B0 LoR;
! 
! rebali false (bin K V _ L R) B	= bin K V B L R;
! rebali true  OldTree _		= fst (avl_geq OldTree);
! 
! // Balance rules for insertions
! //	balance	where		balance	  whole tree	to be
! //	before	inserted	after	  increased	rebalanced
! tablei	iseq	left		= (islt,  true,		false);
! tablei	iseq	right		= (isgt,  true,		false);
! tablei	islt	left		= (iseq,  false,	true);
! tablei	islt	right		= (iseq,  false,	false);
! tablei	isgt	left		= (iseq,  false,	false);
! tablei	isgt	right		= (iseq,  false,	true);
! 
! // Deletions
! adjustd false OldTree _		= (OldTree, false);
! 
! adjustd true (bin Key Val B0 L R) LoR
! 		= rebald ToBeRebalanced (bin Key Val B0 L R) B1 WhatHasChanged
! 		    where
! 		      (B1, WhatHasChanged, ToBeRebalanced) = tabled B0 LoR;
! 
! // Balance rules for deletions
! //	balance	where		balance	  whole tree	to be
! //	before	deleted		after	  decreased	rebalanced
! tabled	iseq	right		= (islt,  false,	false);
! tabled	iseq	left		= (isgt,  false,	false);
! tabled	islt	right		= (iseq,  true,		true);
! //					  ^^^^
! // It depends on the tree pattern in avl_geq whether it really decreases
! 
! tabled	islt	left		= (iseq,  true, 	false);
! tabled	isgt	right		= (iseq,  true,		false);
! tabled	isgt	left		= (iseq,  true,		true);
! //					  ^^^^
! // It depends on the tree pattern in avl_geq whether it really decreases
! 
! /*
!    Note that rebali and rebald are not symmetrical. With insertions it is
!    sufficient to know the original balance and insertion side in order to
!    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.
! */
! rebald false (bin K V _ L R) B WhatHasChanged
! 				= (bin K V B L R, WhatHasChanged);
! rebald true  OldTree _ _	= avl_geq OldTree;
! 
! // Single and double tree rotations - these are common for insert and delete
! /*
!   The patterns isgt-isgt, isgt-islt, islt-islt and islt-isgt 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 isgt-iseq and islt-iseq do not change the tree height. After a
!   deletion any pattern can occur and so we return true or false as a flag of
!   a height change.
! */
! avl_geq (bin A VA isgt Alpha (bin B VB isgt Beta Gamma))
! 		= (bin B VB iseq (bin A VA iseq Alpha Beta) Gamma, true);
! 
! avl_geq (bin A VA isgt Alpha (bin B VB iseq Beta Gamma))
! 		= (bin B VB islt (bin A VA isgt Alpha Beta) Gamma, false);
! 			// the tree doesn't decrease with this pattern
! 
! avl_geq (bin A VA isgt Alpha (bin B VB islt (bin X VX B1 Beta Gamma) Delta))
! 		= (bin X VX iseq (bin A VA B2 Alpha Beta)
! 		   (bin B VB B3 Gamma Delta), true)
! 		    where (B2, B3) = table2 B1;
! 
! avl_geq (bin B VB islt (bin A VA islt Alpha Beta) Gamma)
! 		= (bin A VA iseq Alpha (bin B VB iseq Beta  Gamma), true);
! 
! avl_geq (bin B VB islt (bin A VA iseq Alpha Beta) Gamma)
! 		= (bin A VA isgt Alpha (bin B VB islt Beta  Gamma), false);
! 			// the tree doesn't decrease with this pattern
! 
! avl_geq (bin B VB islt (bin A VA isgt Alpha (bin X VX B1 Beta Gamma)) Delta)
! 		= (bin X VX iseq (bin A VA B2 Alpha Beta)
! 		   (bin B VB B3 Gamma Delta), true)
! 		    where (B2, B3) = table2 B1;
! 
! table2 islt			= (iseq, isgt);
! table2 isgt			= (islt, iseq);
! table2 iseq			= (iseq, iseq);
! 
! /* Public Functions: *******************************************************/
! 
! emptydict			= nil;
! 
! dict Members:List		= foldl insert emptydict Members;
! 
! mkdict Val Keys			= dict (zip Keys (mklist Val (#Keys)));
! 
! #nil				= 0;
! #bin _ _ _ D1 D2		= #D1 + #D2 + 1;
! 
! null nil			= true;
! 				= false otherwise;
! 
! isdict D:Dict			= true;
! 				= false otherwise;
  
  (D1:Dict = D2:Dict)		= (members D1 = members D2);
  D1:Dict <> D2:Dict		= members D1 <> members D2;
+ 
+ (bin K V _ L R)!Key		= L!Key if Key < K;
+ 				= R!Key if Key > K;
+ 				= V;
+ member nil _			= false;
+ member (bin K _ _ L R) Key
+ 				= member L Key if K > Key;
+ 				= member R Key if K < Key;
+ 				= true if K = Key;
+ 
+ members	 nil			= [];
+ members (bin Key Val _ L R)	= members L ++ [(Key, Val) | members R];
+ 
+ keys nil			= [];
+ keys (bin Key _ _ L R)		= keys L ++ [Key | keys R];
+ 
+ vals nil			= [];
+ vals (bin _ Val _ L R)		= vals L ++ [Val | vals R];
+ 
+ last (bin Key Val _ _ nil)	= (Key, Val);
+ last (bin _ _ _ _ R)		= last R;
+ 
+ first (bin Key Val _ nil _)	= (Key, Val);
+ first (bin _ _ _ L _)		= first L;
+ 
+ insert D (Key, Val)		= fst (inserta D Key Val);
+ update D KV			= insert D KV;

Index: set.q
===================================================================
RCS file: /cvsroot/q-lang/q/stdlib/set.q,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** set.q	2 Oct 2007 00:56:24 -0000	1.6
--- set.q	21 Feb 2008 07:58:13 -0000	1.7
***************
*** 19,23 ****
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  
! public type Set = virtual set Xs | private const nil, bin H X M1 M2;
  
  /* Construction and type checking: */
--- 19,38 ----
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  
! /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!    Updated: 18 February 2008 by Jiri Spitz
! 
!    Purpose: More efficient algorithm for association lists implemented
!    as AVL trees.
! 
!    The used algorithm 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 deletion stuff (rmfirst, rmlast, delete) is new, it was missing
!    in the original assoc.pl file.
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
! 
! public type Set = virtual set Xs | private const nil, bin X B M1 M2;
  
  /* Construction and type checking: */
***************
*** 58,104 ****
  @0
  
  /* Private Functions: ******************************************************/
  
! private height M;		// return height of tree
! private slope M;		// return slope (height diff between left and
! 				// right subtree)
! private mkbin X M1 M2;		// construct node, recomputing height
  
! private rebal M;		// rebalance tree after insertions and 
! 				// deletions
! private rol M, ror M;		// single rotation left/right
! private shl M, shr M;		// shift to left/right (single or double
! 				// rotation)
  
! private join M1 M2;		// join two balanced subtrees
  
! height nil			= 0;
! height (bin H _ _ _)		= H;
  
! slope nil			= 0;
! slope (bin _ _ M1 M2)		= height M1 - height M2;
  
! mkbin X M1 M2			= bin (max (height M1) (height M2) + 1)
! 				  X M1 M2;
  
! rebal M				= shl M if slope M = -2;
! 				= shr M if slope M = 2;
! 				= M otherwise;
  
! rol (bin _ X1 M1 (bin _ X2 M2 M3))
! 				= mkbin X2 (mkbin X1 M1 M2) M3;
! ror (bin _ X1 (bin _ X2 M1 M2) M3)
! 				= mkbin X2 M1 (mkbin X1 M2 M3);
  
! shl (bin H X M1 M2)		= rol (mkbin X M1 (ror M2)) if slope M2 = 1;
! 				= rol (bin H X M1 M2) otherwise;
  
! shr (bin H X M1 M2)		= ror (mkbin X (rol M1) M2)
! 				      if slope M1 = -1;
! 				= ror (bin H X M1 M2) otherwise;
  
! join nil M2			= M2;
! join M1 M2			= rebal (mkbin (last M1) (rmlast M1) M2)
! 				      otherwise;
  
  /* Public Functions: *******************************************************/
--- 73,267 ----
  @0
  
+ /* Private Types: **********************************************************/
+ 
+ // For better readability of the code
+ private type Balance		= const islt, iseq, isgt;
+ private type Side		= const left, right;
+ 
  /* Private Functions: ******************************************************/
  
! private inserta Tree Key;
! 	// insert a new (or replace an existing) member in the tree
  
! private rmfirsta Tree;
! 	// remove the first member from the tree
  
! private rmlasta Tree;
! 	// remove the last member from the tree
  
! private deletea Tree Key;
! 	// delete member with Key from the tree
  
! private adjusti TreeHasChanged Tree LeftOrRight;
! 	// decide changes needed in order to make a well
! 	// shaped tree after an insertion
  
! private rebali ToBeRebalanced Tree NewBalance;
! 	// if ToBeRabalanced = false then set the balance of the root node
! 	// to NewBalance else call avl_geq
  
! private adjustd TreeHasChanged Tree LeftOrRight;
! 	// decide changes needed in order to make a well
! 	// shaped tree after a deletion
  
! private rebald ToBeRebalanced Tree NewBalance WhatHasChanged;
! 	// if ToBeRabalanced = false then set the balance of the root
! 	// node to NewBalance else call avl_geq
  
! private avl_geq Tree;
! 	// single and double rotations of the tree
  
! private tablei BalanceBefore WhereInserted;
! 	// insert balance rules
  
! private tabled BalanceBefore WhereDeleted;
! 	// delete balance rules
! 
! private table2 BalanceOfSubSubNode;
! 	// balance rules for double rotations
! 
! /*
! Tree is either:
! 
! -  nil  (empty tree) or
! -  bin Key Balance Left Right  (Left, Right: trees)
!    Balance: islt, iseq, or isgt denoting |L|-|R| = 1, 0, or -1, respectively
! */
! 
! inserta nil Key			= ((bin Key iseq nil nil), true);
! inserta (bin Key B L R) Key	= ((bin Key B L R), false);
! 
! inserta (bin K B L R) Key if Key < K:
! 		= adjusti LeftHasChanged (bin K B NewL R) left
! 		    where (NewL, LeftHasChanged) = inserta L Key;
! 
! inserta (bin K B L R) Key if Key > K:
! 		= adjusti RightHasChanged (bin K B L NewR) right
! 		    where (NewR, RightHasChanged) = inserta R Key;
! 
! rmfirsta nil			= (nil, false);
! rmfirsta (bin _ _ nil R)	= (R, true);
! 
! rmfirsta (bin K B L   R)
! 		= adjustd LeftHasChanged (bin K B NewL R) left
! 		    where (NewL, LeftHasChanged) = rmfirsta L;
! 
! rmlasta nil			= (nil false);
! rmlasta (bin _ _ L nil)		= (L, true);
! 
! rmlasta (bin K B L   R)
! 		= adjustd RightHasChanged (bin K B L NewR) right
! 		    where (NewR, RightHasChanged) = rmlasta R;
! 
! deletea nil _			= (nil, false);
! deletea (bin Key _ nil R  ) Key	= (R, true);
! deletea (bin Key _ L   nil) Key	= (L, true);
! 
! deletea (bin Key B (bin KL BL RL LL) R) Key
! 		= adjustd LeftHasChanged (bin LK B NewL R) left
! 		    where
! 		      LK			= last (bin KL BL RL LL),
! 		      (NewL, LeftHasChanged)	= rmlasta (bin KL BL RL LL);
! 
! deletea (bin K B L R) Key if Key < K:
! 		= adjustd LeftHasChanged (bin K B NewL R) left
! 		    where
! 		      (NewL, LeftHasChanged) = deletea L Key;
! 
! deletea (bin K B L R) Key if Key > K:
! 		= adjustd RightHasChanged (bin K B L NewR) right
! 		    where
! 		      (NewR, RightHasChanged) = deletea R Key;
! 
! // The insertions and deletions are dealt with separately.
! // Insertions
! adjusti false OldTree _		= (OldTree, false);
! adjusti true (bin Key B0 L R) LoR
! 		= (rebali ToBeRebalanced (bin Key B0 L R) B1, WhatHasChanged)
! 		    where
! 		      (B1, WhatHasChanged, ToBeRebalanced) = tablei B0 LoR;
! 
! rebali false (bin K _ L R) B	= bin K B L R;
! rebali true  OldTree _		= fst (avl_geq OldTree);
! 
! // Balance rules for insertions
! //	balance	where		balance	  whole tree	to be
! //	before	inserted	after	  increased	rebalanced
! tablei	iseq	left		= (islt,  true,		false);
! tablei	iseq	right		= (isgt,  true,		false);
! tablei	islt	left		= (iseq,  false,	true);
! tablei	islt	right		= (iseq,  false,	false);
! tablei	isgt	left		= (iseq,  false,	false);
! tablei	isgt	right		= (iseq,  false,	true);
! 
! // Deletions
! adjustd false OldTree _		= (OldTree, false);
! adjustd true (bin Key B0 L R) LoR
! 		= rebald ToBeRebalanced (bin Key B0 L R) B1 WhatHasChanged
! 		    where
! 		      (B1, WhatHasChanged, ToBeRebalanced) = tabled B0 LoR;
! 
! // Balance rules for deletions
! //	balance	where		balance	  whole tree	to be
! //	before	deleted		after	  decreased	rebalanced
! tabled	iseq	right		= (islt,  false,	false);
! tabled	iseq	left		= (isgt,  false,	false);
! tabled	islt	right		= (iseq,  true,		true);
! //					  ^^^^
! // It depends on the tree pattern in avl_geq whether it really decreases
! 
! tabled	islt	left		= (iseq,  true, 	false);
! tabled	isgt	right		= (iseq,  true,		false);
! tabled	isgt	left		= (iseq,  true,		true);
! //					  ^^^^
! // It depends on the tree pattern in avl_geq whether it really decreases
! 
! /*
!    Note that rebali and rebald are not symmetrical. With insertions it is
!    sufficient to know the original balance and insertion side in order to
!    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.
! */
! rebald false (bin K _ L R) B WhatHasChanged
! 				= (bin K B L R, WhatHasChanged);
! rebald true  OldTree _ _	= avl_geq OldTree;
! 
! // Single and double tree rotations - these are common for insert and delete
! /*
!   The patterns isgt-isgt, isgt-islt, islt-islt and islt-isgt 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 isgt-iseq and islt-iseq do not change the tree height. After a
!   deletion any pattern can occur and so we return true or false as a flag of
!   a height change.
! */
! avl_geq (bin A isgt Alpha (bin B isgt Beta Gamma))
! 		= (bin B iseq (bin A iseq Alpha Beta) Gamma, true);
! 
! avl_geq (bin A isgt Alpha (bin B iseq Beta Gamma))
! 		= (bin B islt (bin A isgt Alpha Beta) Gamma, false);
! 			// the tree doesn't decrease with this pattern
! 
! avl_geq (bin A isgt Alpha (bin B islt (bin X B1 Beta Gamma) Delta))
! 		= (bin X iseq (bin A B2 Alpha Beta)
! 		   (bin B B3 Gamma Delta), true)
! 		    where (B2, B3) = table2 B1;
! 
! avl_geq (bin B islt (bin A islt Alpha Beta) Gamma)
! 		= (bin A iseq Alpha (bin B iseq Beta  Gamma), true);
! 
! avl_geq (bin B islt (bin A iseq Alpha Beta) Gamma)
! 		= (bin A isgt Alpha (bin B islt Beta  Gamma), false);
! 			// the tree doesn't decrease with this pattern
! 
! avl_geq (bin B islt (bin A isgt Alpha (bin X B1 Beta Gamma)) Delta)
! 		= (bin X iseq (bin A B2 Alpha Beta)
! 		   (bin B B3 Gamma Delta), true)
! 		    where (B2, B3) = table2 B1;
! 
! table2 islt			= (iseq, isgt);
! table2 isgt			= (islt, iseq);
! table2 iseq			= (iseq, iseq);
  
  /* Public Functions: *******************************************************/
***************
*** 117,148 ****
  
  member nil _			= false;
! member (bin _ X M1 M2) Y	= member M1 Y if X>Y;
  				= member M2 Y if X<Y;
  				= true if X=Y;
  
  members nil			= [];
! members (bin _ X M1 M2)		= members M1 ++ [X|members M2];
  
! first (bin _ X nil _)		= X;
  first (bin _ _ M1 _)		= first M1 otherwise;
  
! last (bin _ X _ nil)		= X;
  last (bin _ _ _ M2)		= last M2 otherwise;
  
! rmlast (bin _ _ M1 nil)		= M1;
! rmlast (bin _ X M1 M2)		= rebal (mkbin X M1 (rmlast M2)) otherwise;
  
! rmfirst (bin _ _ nil M2)	= M2;
! rmfirst (bin _ X M1 M2)		= rebal (mkbin X (rmfirst M1) M2) otherwise;
  
! insert nil Y			= bin 1 Y nil nil;
! insert (bin H X M1 M2) Y	= rebal (mkbin X (insert M1 Y) M2) if X>Y;
! 				= rebal (mkbin X M1 (insert M2 Y)) if X<Y;
! 				= bin H Y M1 M2 if X=Y;
  
! delete nil Y			= nil;
! delete (bin _ X M1 M2) Y	= rebal (mkbin X (delete M1 Y) M2) if X>Y;
! 				= rebal (mkbin X M1 (delete M2 Y)) if X<Y;
! 				= join M1 M2 if X=Y;
  
  /* Set comparison, union, difference and intersection: */
--- 280,303 ----
  
  member nil _			= false;
! member (bin X _ M1 M2) Y	= member M1 Y if X>Y;
  				= member M2 Y if X<Y;
  				= true if X=Y;
  
  members nil			= [];
! members (bin X _ M1 M2)		= members M1 ++ [X|members M2];
  
! first (bin X _ nil _)		= X;
  first (bin _ _ M1 _)		= first M1 otherwise;
  
! last (bin X _ _ nil)		= X;
  last (bin _ _ _ M2)		= last M2 otherwise;
  
! rmlast Xs			= fst (rmlasta Xs);
  
! rmfirst Xs			= fst (rmfirsta Xs);
  
! insert Xs Y			= fst (inserta Xs Y);
  
! delete Xs Y			= fst (deletea Xs Y);
  
  /* Set comparison, union, difference and intersection: */

[q-lang-cvs] q/modules/odbc README-ODBC,1.3,1.4

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q/modules/odbc
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv8106

Modified Files:
	README-ODBC 
Log Message:
update README

Index: README-ODBC
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/README-ODBC,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** README-ODBC	16 Feb 2008 06:53:46 -0000	1.3
--- README-ODBC	16 Feb 2008 07:29:20 -0000	1.4
***************
*** 357,361 ****
  Enjoy! :)
  
! Sep 13 2003
  Albert Graef
  ag...@mu..., Dr....@t-...
--- 357,361 ----
  Enjoy! :)
  
! Feb 16 2008
  Albert Graef
  ag...@mu..., Dr....@t-...

[q-lang-cvs] q NEWS,1.141,1.142

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv26012

Modified Files:
	NEWS 
Log Message:
update NEWS

Index: NEWS
===================================================================
RCS file: /cvsroot/q-lang/q/NEWS,v
retrieving revision 1.141
retrieving revision 1.142
diff -C2 -d -r1.141 -r1.142
*** NEWS	15 Feb 2008 11:37:49 -0000	1.141
--- NEWS	16 Feb 2008 06:59:08 -0000	1.142
***************
*** 3,7 ****
  =======
  
! * 7.11	15 February 2008
  
  - As suggested by Rob Hubbard and John Cowan, special Unicode characters in
--- 3,7 ----
  =======
  
! * 7.11	16 February 2008
  
  - As suggested by Rob Hubbard and John Cowan, special Unicode characters in
***************
*** 22,28 ****
    reject NULL and empty string parameter values in SQL insert statements.
    (Bug reported by Jiri Spitz.) The odbc_examp.q script now also works with MS
!   Access on Windows. Moreover, as suggested by Tim Haynes, two new functions
!   (odbc_getinfo, odbc_typeinfo) to retrieve metadata and type information of a
!   data source have been added.
  
  
--- 22,27 ----
    reject NULL and empty string parameter values in SQL insert statements.
    (Bug reported by Jiri Spitz.) The odbc_examp.q script now also works with MS
!   Access on Windows. Moreover, as suggested by Tim Haynes, there are a couple
!   of new functions to retrieve additional metadata about a data source.
  
  

[q-lang-cvs] q ChangeLog,1.328,1.329

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv25977

Modified Files:
	ChangeLog 
Log Message:
update ChangeLog

Index: ChangeLog
===================================================================
RCS file: /cvsroot/q-lang/q/ChangeLog,v
retrieving revision 1.328
retrieving revision 1.329
diff -C2 -d -r1.328 -r1.329
*** ChangeLog	15 Feb 2008 11:53:35 -0000	1.328
--- ChangeLog	16 Feb 2008 06:58:43 -0000	1.329
***************
*** 1,2 ****
--- 1,10 ----
+ 2008-02-16  Albert Graef  <Dr....@t-...>
+ 
+ 	+ 7.11
+ 
+ 	* modules/odbc/odbc.c, odbc.q: add odbc_tables, odbc_columns,
+ 	odbc_primary_keys, odbc_foreign_keys functions to retrieve
+ 	information about tables in the current database
+ 
  2008-02-15  Albert Graef  <Dr....@t-...>
  

[q-lang-cvs] q/modules/odbc odbc.c,1.11,1.12 odbc.q,1.6,1.7

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q/modules/odbc
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv24276

Modified Files:
	odbc.c odbc.q 
Log Message:
add more ODBC routines to retrieve meta information

Index: odbc.q
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/odbc.q,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** odbc.q	15 Feb 2008 11:33:22 -0000	1.6
--- odbc.q	16 Feb 2008 06:54:32 -0000	1.7
***************
*** 84,88 ****
     an integer or a string which can be converted to a Q value using bint or
     bstr, respectively. See SQLGetInfo() in the ODBC API reference for
!    information about which information types are available and which type of
     information they return. */
  
--- 84,88 ----
     an integer or a string which can be converted to a Q value using bint or
     bstr, respectively. See SQLGetInfo() in the ODBC API reference for
!    information about which information types are available and which types of
     information they return. */
  
***************
*** 354,358 ****
  
     Note that fields which don't apply to a given type are left empty,
!    indicated by a NULL value (() in Q land). */
  
  public extern odbc_typeinfo DB TYPE_ID;
--- 354,358 ----
  
     Note that fields which don't apply to a given type are left empty,
!    indicated by a () a.k.a. NULL value. */
  
  public extern odbc_typeinfo DB TYPE_ID;
***************
*** 432,435 ****
--- 432,458 ----
    SQL_CODE_MINUTE_TO_SECOND =	   13;
  
+ /* Retrieve information about all tables in the current database. Returns a
+    list of (NAME,TYPE) string pairs, where NAME denotes the name and TYPE the
+    type of a table ("TABLE", "VIEW", etc.). */
+ 
+ public extern odbc_tables DB;
+ 
+ /* Retrieve information about the columns of the table with the given name.
+    Returns a list of string tuples with the following information: NAME
+    (column name), TYPE (SQL data type), NULLABLE (whether the field is
+    nullable, "YES" or "NO") and DEFAULT (default value, as a string). The
+    NULLABLE and DEFAULT values may be () if not available. */
+ 
+ public extern odbc_columns DB TABLE_NAME;
+ 
+ /* Retrieve information about the primary and foreign keys of the given table.
+    odbc_primary_keys returns the primary keys of the given table as a list of
+    strings (column names), while odbc_foreign_keys returns a list of string
+    triples (NAME,PKTAB,PKCOL) where NAME is the name of a column in the given
+    table with a foreign key which refers to the primary key colum PKCOL in
+    table PKTAB. */
+ 
+ public extern odbc_primary_keys DB TABLE_NAME, odbc_foreign_keys DB TABLE_NAME;
+ 
  /* Execute an SQL query and fetch results. SQL queries generally come in two
     different flavours: queries returning data (so-called result sets), and

Index: odbc.c
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/odbc.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** odbc.c	15 Feb 2008 20:58:12 -0000	1.11
--- odbc.c	16 Feb 2008 06:54:32 -0000	1.12
***************
*** 635,638 ****
--- 635,641 ----
  #define NMAX 128
  
+ /* Maximum length of string values. */
+ #define SL 256
+ 
  #define checkstr(s,l) ((l==SQL_NULL_DATA)?mkvoid:mkstr(to_utf8(s, NULL)))
  #define checkint(x,l) ((l==SQL_NULL_DATA)?mkvoid:mkint(x))
***************
*** 649,653 ****
      int i, n = 0, m = NMAX;
  
!     UCHAR  name[80], prefix[80], suffix[80], params[80], local_name[80];
      SWORD  type, nullable, case_sen, searchable, unsign, money, auto_inc;
      SWORD  min_scale, max_scale;
--- 652,656 ----
      int i, n = 0, m = NMAX;
  
!     UCHAR  name[SL], prefix[SL], suffix[SL], params[SL], local_name[SL];
      SWORD  type, nullable, case_sen, searchable, unsign, money, auto_inc;
      SWORD  min_scale, max_scale;
***************
*** 660,669 ****
      sql_close(db);
  
!     ret = SQLBindCol(db->hstmt,  1, SQL_C_CHAR,  name,       80, &len[1]);
      ret = SQLBindCol(db->hstmt,  2, SQL_C_SHORT, &type,       0, &len[2]);
      ret = SQLBindCol(db->hstmt,  3, SQL_C_LONG,  &prec,       0, &len[3]);
!     ret = SQLBindCol(db->hstmt,  4, SQL_C_CHAR,  prefix,     80, &len[4]);
!     ret = SQLBindCol(db->hstmt,  5, SQL_C_CHAR,  suffix,     80, &len[5]);
!     ret = SQLBindCol(db->hstmt,  6, SQL_C_CHAR,  params,     80, &len[6]);
      ret = SQLBindCol(db->hstmt,  7, SQL_C_SHORT, &nullable,   0, &len[7]);
      ret = SQLBindCol(db->hstmt,  8, SQL_C_SHORT, &case_sen,   0, &len[8]);
--- 663,672 ----
      sql_close(db);
  
!     ret = SQLBindCol(db->hstmt,  1, SQL_C_CHAR,  name,       SL, &len[1]);
      ret = SQLBindCol(db->hstmt,  2, SQL_C_SHORT, &type,       0, &len[2]);
      ret = SQLBindCol(db->hstmt,  3, SQL_C_LONG,  &prec,       0, &len[3]);
!     ret = SQLBindCol(db->hstmt,  4, SQL_C_CHAR,  prefix,     SL, &len[4]);
!     ret = SQLBindCol(db->hstmt,  5, SQL_C_CHAR,  suffix,     SL, &len[5]);
!     ret = SQLBindCol(db->hstmt,  6, SQL_C_CHAR,  params,     SL, &len[6]);
      ret = SQLBindCol(db->hstmt,  7, SQL_C_SHORT, &nullable,   0, &len[7]);
      ret = SQLBindCol(db->hstmt,  8, SQL_C_SHORT, &case_sen,   0, &len[8]);
***************
*** 672,676 ****
      ret = SQLBindCol(db->hstmt, 11, SQL_C_SHORT, &money,      0, &len[11]);
      ret = SQLBindCol(db->hstmt, 12, SQL_C_SHORT, &auto_inc,   0, &len[12]);
!     ret = SQLBindCol(db->hstmt, 13, SQL_C_CHAR,  local_name, 80, &len[13]);
      ret = SQLBindCol(db->hstmt, 14, SQL_C_SHORT, &min_scale,  0, &len[14]);
      ret = SQLBindCol(db->hstmt, 15, SQL_C_SHORT, &max_scale,  0, &len[15]);
--- 675,679 ----
      ret = SQLBindCol(db->hstmt, 11, SQL_C_SHORT, &money,      0, &len[11]);
      ret = SQLBindCol(db->hstmt, 12, SQL_C_SHORT, &auto_inc,   0, &len[12]);
!     ret = SQLBindCol(db->hstmt, 13, SQL_C_CHAR,  local_name, SL, &len[13]);
      ret = SQLBindCol(db->hstmt, 14, SQL_C_SHORT, &min_scale,  0, &len[14]);
      ret = SQLBindCol(db->hstmt, 15, SQL_C_SHORT, &max_scale,  0, &len[15]);
***************
*** 744,747 ****
--- 747,1029 ----
  }
  
+ FUNCTION(odbc,odbc_tables,argc,argv)
+ {
+   ODBCHandle *db;
+   if (argc == 1 && isobj(argv[0], type(ODBCHandle), (void**)&db) &&
+       db->henv) {
+     expr res, *xs = (expr*)malloc(NMAX*sizeof(expr)), *xs1;
+     int i, n = 0, m = NMAX;
+ 
+     UCHAR  name[SL], type[SL];
+     SDWORD len[6], ret;
+ 
+     if (!xs) return __ERROR;
+     sql_close(db);
+ 
+     ret = SQLBindCol(db->hstmt,  3, SQL_C_CHAR,  name,       SL, &len[3]);
+     ret = SQLBindCol(db->hstmt,  4, SQL_C_CHAR,  type,       SL, &len[4]);
+ 
+     ret = SQLTables(db->hstmt, NULL, 0, NULL, 0, NULL, 0, NULL,0);
+     if (ret != SQL_SUCCESS && ret != SQL_SUCCESS_WITH_INFO) goto err;
+ 
+     do {
+       ret = SQLFetch(db->hstmt);
+       switch (ret) {
+        case SQL_SUCCESS_WITH_INFO:
+        case SQL_SUCCESS:
+ 	 if (n >= m)
+ 	   if ((xs1 = (expr*)realloc(xs, (m+=NMAX)*sizeof(expr))))
+ 	     xs = xs1;
+ 	   else
+ 	     goto fatal;
+ 	 xs[n++] = mktuplel(2,
+ 			    checkstr(name, len[3]),
+ 			    checkstr(type, len[4]));
+ 	 break;
+        case SQL_NO_DATA_FOUND:
+ 	 break;
+       default:
+ 	goto err;
+       }
+     } while (ret != SQL_NO_DATA_FOUND);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     if (n == 0) {
+       free(xs);
+       return mknil;
+     } else
+       return mklistv(n, xs);
+   err:
+     for (i = 0; i < n; i++) dispose(xs[i]);
+     free(xs);
+     res = mkerr(db->henv, db->hdbc, db->hstmt);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     return res;
+   fatal:
+     for (i = 0; i < n; i++) dispose(xs[i]);
+     free(xs);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     return __ERROR;
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(odbc,odbc_columns,argc,argv)
+ {
+   ODBCHandle *db;
+   char *tab;
+   if (argc == 2 && isobj(argv[0], type(ODBCHandle), (void**)&db) &&
+       db->henv && isstr(argv[1], &tab)) {
+     expr res, *xs = (expr*)malloc(NMAX*sizeof(expr)), *xs1;
+     int i, n = 0, m = NMAX;
+ 
+     UCHAR  name[SL], type[SL], nullable[SL], deflt[SL];
+     SDWORD len[19], ret;
+ 
+     if (!xs) return __ERROR;
+     tab = from_utf8(tab, NULL);
+     if (!tab) { free(xs); return __ERROR; }
+     sql_close(db);
+ 
+     ret = SQLBindCol(db->hstmt,  4, SQL_C_CHAR,  name,       SL, &len[4]);
+     ret = SQLBindCol(db->hstmt,  6, SQL_C_CHAR,  type,       SL, &len[6]);
+     ret = SQLBindCol(db->hstmt, 13, SQL_C_CHAR,  deflt,      SL, &len[13]);
+     ret = SQLBindCol(db->hstmt, 18, SQL_C_CHAR,  nullable,   SL, &len[18]);
+ 
+     ret = SQLColumns(db->hstmt, NULL, 0, NULL, 0, (SQLCHAR*)tab, SQL_NTS,
+ 		     NULL, 0);
+     if (ret != SQL_SUCCESS && ret != SQL_SUCCESS_WITH_INFO) goto err;
+ 
+     do {
+       ret = SQLFetch(db->hstmt);
+       switch (ret) {
+        case SQL_SUCCESS_WITH_INFO:
+        case SQL_SUCCESS:
+ 	 if (n >= m)
+ 	   if ((xs1 = (expr*)realloc(xs, (m+=NMAX)*sizeof(expr))))
+ 	     xs = xs1;
+ 	   else
+ 	     goto fatal;
+ 	 xs[n++] = mktuplel(4,
+ 			    checkstr(name, len[4]),
+ 			    checkstr(type, len[6]),
+ 			    checkstr(nullable, len[18]),
+ 			    checkstr(deflt, len[13]));
+ 	 break;
+        case SQL_NO_DATA_FOUND:
+ 	 break;
+       default:
+ 	goto err;
+       }
+     } while (ret != SQL_NO_DATA_FOUND);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     free(tab);
+     if (n == 0) {
+       free(xs);
+       return mknil;
+     } else
+       return mklistv(n, xs);
+   err:
+     for (i = 0; i < n; i++) dispose(xs[i]);
+     free(xs);
+     res = mkerr(db->henv, db->hdbc, db->hstmt);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     free(tab);
+     return res;
+   fatal:
+     for (i = 0; i < n; i++) dispose(xs[i]);
+     free(xs);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     free(tab);
+     return __ERROR;
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(odbc,odbc_primary_keys,argc,argv)
+ {
+   ODBCHandle *db;
+   char *tab;
+   if (argc == 2 && isobj(argv[0], type(ODBCHandle), (void**)&db) &&
+       db->henv && isstr(argv[1], &tab)) {
+     expr res, *xs = (expr*)malloc(NMAX*sizeof(expr)), *xs1;
+     int i, n = 0, m = NMAX;
+ 
+     UCHAR  name[SL];
+     SDWORD len[5], ret;
+ 
+     if (!xs) return __ERROR;
+     tab = from_utf8(tab, NULL);
+     if (!tab) { free(xs); return __ERROR; }
+     sql_close(db);
+ 
+     ret = SQLBindCol(db->hstmt,  4, SQL_C_CHAR,  name,       SL, &len[4]);
+ 
+     ret = SQLPrimaryKeys(db->hstmt, NULL, 0, NULL, 0, (SQLCHAR*)tab, SQL_NTS);
+     if (ret != SQL_SUCCESS && ret != SQL_SUCCESS_WITH_INFO) goto err;
+ 
+     do {
+       ret = SQLFetch(db->hstmt);
+       switch (ret) {
+        case SQL_SUCCESS_WITH_INFO:
+        case SQL_SUCCESS:
+ 	 if (n >= m)
+ 	   if ((xs1 = (expr*)realloc(xs, (m+=NMAX)*sizeof(expr))))
+ 	     xs = xs1;
+ 	   else
+ 	     goto fatal;
+ 	 xs[n++] = checkstr(name, len[4]);
+ 	 break;
+        case SQL_NO_DATA_FOUND:
+ 	 break;
+       default:
+ 	goto err;
+       }
+     } while (ret != SQL_NO_DATA_FOUND);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     free(tab);
+     if (n == 0) {
+       free(xs);
+       return mknil;
+     } else
+       return mklistv(n, xs);
+   err:
+     for (i = 0; i < n; i++) dispose(xs[i]);
+     free(xs);
+     res = mkerr(db->henv, db->hdbc, db->hstmt);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     free(tab);
+     return res;
+   fatal:
+     for (i = 0; i < n; i++) dispose(xs[i]);
+     free(xs);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     free(tab);
+     return __ERROR;
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(odbc,odbc_foreign_keys,argc,argv)
+ {
+   ODBCHandle *db;
+   char *tab;
+   if (argc == 2 && isobj(argv[0], type(ODBCHandle), (void**)&db) &&
+       db->henv && isstr(argv[1], &tab)) {
+     expr res, *xs = (expr*)malloc(NMAX*sizeof(expr)), *xs1;
+     int i, n = 0, m = NMAX;
+ 
+     UCHAR  name[SL], pktabname[SL], pkname[SL];
+     SDWORD len[9], ret;
+ 
+     if (!xs) return __ERROR;
+     tab = from_utf8(tab, NULL);
+     if (!tab) { free(xs); return __ERROR; }
+     sql_close(db);
+ 
+     ret = SQLBindCol(db->hstmt,  3, SQL_C_CHAR,  pktabname,  SL, &len[3]);
+     ret = SQLBindCol(db->hstmt,  4, SQL_C_CHAR,  pkname,     SL, &len[4]);
+     ret = SQLBindCol(db->hstmt,  8, SQL_C_CHAR,  name,       SL, &len[8]);
+ 
+     ret = SQLForeignKeys(db->hstmt, NULL, 0, NULL, 0, NULL, 0, NULL, 0,
+ 			 NULL, 0, (SQLCHAR*)tab, SQL_NTS);
+     if (ret != SQL_SUCCESS && ret != SQL_SUCCESS_WITH_INFO) goto err;
+ 
+     do {
+       ret = SQLFetch(db->hstmt);
+       switch (ret) {
+        case SQL_SUCCESS_WITH_INFO:
+        case SQL_SUCCESS:
+ 	 if (n >= m)
+ 	   if ((xs1 = (expr*)realloc(xs, (m+=NMAX)*sizeof(expr))))
+ 	     xs = xs1;
+ 	   else
+ 	     goto fatal;
+ 	 xs[n++] = mktuplel(3,
+ 			    checkstr(name, len[8]),
+ 			    checkstr(pktabname, len[3]),
+ 			    checkstr(pkname, len[4]));
+ 	 break;
+        case SQL_NO_DATA_FOUND:
+ 	 break;
+       default:
+ 	goto err;
+       }
+     } while (ret != SQL_NO_DATA_FOUND);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     free(tab);
+     if (n == 0) {
+       free(xs);
+       return mknil;
+     } else
+       return mklistv(n, xs);
+   err:
+     for (i = 0; i < n; i++) dispose(xs[i]);
+     free(xs);
+     res = mkerr(db->henv, db->hdbc, db->hstmt);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     free(tab);
+     return res;
+   fatal:
+     for (i = 0; i < n; i++) dispose(xs[i]);
+     free(xs);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     free(tab);
+     return __ERROR;
+   } else
+     return __FAIL;
+ }
+ 
  #define BUFSZ 65536
  #define BUFSZ2 5000

[q-lang-cvs] q/modules/odbc README-ODBC,1.2,1.3

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q/modules/odbc
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv23844

Modified Files:
	README-ODBC 
Log Message:
update README

Index: README-ODBC
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/README-ODBC,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** README-ODBC	14 Feb 2008 01:14:14 -0000	1.2
--- README-ODBC	16 Feb 2008 06:53:46 -0000	1.3
***************
*** 119,130 ****
  
  ==> odbc_info DB
! ("myodbc","test","MySQL","3.23.55-Max-log","myodbc.dll","2.50.39","02.50",
! "03.80")
  
! As of Q 7.11, a bunch of additional meta information is available using the
! odbc_getinfo function which provides a direct interface to the SQLGetInfo()
! routine. The result of odbc_getinfo is a byte string which can be converted to
! an integer or string value, depending on the type of information requested.
! For instance:
  
  ==> bint $ odbc_getinfo DB SQL_MAX_TABLES_IN_SELECT
--- 119,130 ----
  
  ==> odbc_info DB
! ("myodbc","test","MySQL","5.0.18","myodbc3.dll","03.51.12","03.51","03.52")
  
! As of Q 7.11, the odbc module now provides a number of new operations to
! retrieve a bunch of additional meta information about the given database
! connection. In particular, the odbc_getinfo function provides a direct
! interface to the SQLGetInfo() routine. The result of odbc_getinfo is a byte
! string which can be converted to an integer or string value, depending on the
! type of information requested. For instance:
  
  ==> bint $ odbc_getinfo DB SQL_MAX_TABLES_IN_SELECT
***************
*** 134,137 ****
--- 134,168 ----
  "`"
  
+ Information about supported SQL data types is available with the odbc_typeinfo
+ routine (this returns a lot of data, see odbc.q for an explanation):
+ 
+ ==> odbc_typeinfo DB SQL_ALL_TYPES
+ 
+ Moreover, information about the tables in the current database, as well as the
+ structure of the tables and their primary and foreign keys can be retrieved
+ with the odbc_tables, odbc_columns, odbc_primary_keys and odbc_foreign_keys
+ functions:
+ 
+ ==> odbc_tables DB
+ [("event","TABLE"),("pet","TABLE")]
+ 
+ ==> odbc_columns DB "pet"
+ [("name","varchar","NO","''"),("owner","varchar","YES",()),
+ ("species","varchar","YES",()),("sex","char","YES",()),
+ ("birth","date","YES",()),("death","date","YES",())]
+ 
+ ==> odbc_primary_keys DB "pet"
+ ["name"]
+ 
+ ==> odbc_foreign_keys DB "event"
+ [("name","pet","name")]
+ 
+ This often provides a convenient and portable means to retrieve basic
+ information about table structures, at least on RDBMS which properly implement
+ the corresponding ODBC calls (which unfortunately isn't the case for all ODBC
+ drivers yet). Also note that while this information is also available through
+ special system catalogs in most databases, the details of accessing these vary
+ a lot among implementations.
+ 
  
  EXECUTING SQL QUERIES

[q-lang-cvs] q/modules/odbc odbc.c,1.10,1.11

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q/modules/odbc
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv22305

Modified Files:
	odbc.c 
Log Message:
bugfixes

Index: odbc.c
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/odbc.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** odbc.c	15 Feb 2008 11:33:22 -0000	1.10
--- odbc.c	15 Feb 2008 20:58:12 -0000	1.11
***************
*** 720,723 ****
--- 720,724 ----
        }
      } while (ret != SQL_NO_DATA_FOUND);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
      SQLFreeStmt(db->hstmt, SQL_CLOSE);
      if (n == 0) {
***************
*** 730,733 ****
--- 731,735 ----
      free(xs);
      res = mkerr(db->henv, db->hdbc, db->hstmt);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
      SQLFreeStmt(db->hstmt, SQL_CLOSE);
      return res;
***************
*** 735,738 ****
--- 737,741 ----
      for (i = 0; i < n; i++) dispose(xs[i]);
      free(xs);
+     SQLFreeStmt(db->hstmt, SQL_RESET_PARAMS);
      SQLFreeStmt(db->hstmt, SQL_CLOSE);
      return __ERROR;

[q-lang-cvs] q ChangeLog,1.327,1.328

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv25126

Modified Files:
	ChangeLog 
Log Message:
update ChangeLog

Index: ChangeLog
===================================================================
RCS file: /cvsroot/q-lang/q/ChangeLog,v
retrieving revision 1.327
retrieving revision 1.328
diff -C2 -d -r1.327 -r1.328
*** ChangeLog	15 Feb 2008 11:33:52 -0000	1.327
--- ChangeLog	15 Feb 2008 11:53:35 -0000	1.328
***************
*** 1,4 ****
--- 1,8 ----
  2008-02-15  Albert Graef  <Dr....@t-...>
  
+ 	* modules/odbc/examples/odbc_examp.q: fix up sample menagerie
+ 	database so that it works with strictly ANSI-compliant RDBMS's
+ 	without any ado
+ 
  	* modules/odbc/odbc.c, odbc.q: add odbc_typeinfo function
  	(interface to SQLGetTypeInfo()), as suggested by Tim Haynes

[q-lang-cvs] q/modules/odbc/examples odbc_examp.q,1.9,1.10

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q/modules/odbc/examples
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv25030

Modified Files:
	odbc_examp.q 
Log Message:
make the sample database work with strictly ANSI-compliant RDBMS like MS Access

Index: odbc_examp.q
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/examples/odbc_examp.q,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** odbc_examp.q	12 Feb 2008 02:26:54 -0000	1.9
--- odbc_examp.q	15 Feb 2008 11:53:06 -0000	1.10
***************
*** 25,31 ****
  		// connect to an existing MS access database (Windows)
  
- // Uncomment this line to make the script work with MS Access.
- //fields DESC		= join "," (map (sprintf "\"%s\" %s") DESC);
- 
  /****************************************************************************/
  
--- 25,28 ----
***************
*** 41,44 ****
--- 38,44 ----
  def DB = catch report (odbc_connect CONNECT);
  
+ /* Determine the identifier quote char. */
+ def QCH = bstr $ odbc_getinfo DB SQL_IDENTIFIER_QUOTE_CHAR;
+ 
  /****************************************************************************/
  
***************
*** 95,99 ****
  			      (NAME,params DESC);
  
! fields DESC		= join "," (map (sprintf "%s %s") DESC);
  
  params DESC		= join "," (map (cst "?") DESC);
--- 95,100 ----
  			      (NAME,params DESC);
  
! fields DESC		= join "," (map (sprintf FORMAT) DESC)
! 			    where FORMAT = sprintf "%s%%s%s %%s" (QCH,QCH);
  
  params DESC		= join "," (map (cst "?") DESC);

[q-lang-cvs] q NEWS,1.140,1.141

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv18375

Modified Files:
	NEWS 
Log Message:
update NEWS

Index: NEWS
===================================================================
RCS file: /cvsroot/q-lang/q/NEWS,v
retrieving revision 1.140
retrieving revision 1.141
diff -C2 -d -r1.140 -r1.141
*** NEWS	15 Feb 2008 11:36:53 -0000	1.140
--- NEWS	15 Feb 2008 11:37:49 -0000	1.141
***************
*** 3,7 ****
  =======
  
! * 7.11	12 February 2008
  
  - As suggested by Rob Hubbard and John Cowan, special Unicode characters in
--- 3,7 ----
  =======
  
! * 7.11	15 February 2008
  
  - As suggested by Rob Hubbard and John Cowan, special Unicode characters in

[q-lang-cvs] q NEWS,1.139,1.140

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv17936

Modified Files:
	NEWS 
Log Message:
update NEWS

Index: NEWS
===================================================================
RCS file: /cvsroot/q-lang/q/NEWS,v
retrieving revision 1.139
retrieving revision 1.140
diff -C2 -d -r1.139 -r1.140
*** NEWS	12 Feb 2008 02:25:57 -0000	1.139
--- NEWS	15 Feb 2008 11:36:53 -0000	1.140
***************
*** 22,27 ****
    reject NULL and empty string parameter values in SQL insert statements.
    (Bug reported by Jiri Spitz.) The odbc_examp.q script now also works with MS
!   Access on Windows, if you uncomment a single line in the script (see the
!   ChangeLog for details).
  
  
--- 22,28 ----
    reject NULL and empty string parameter values in SQL insert statements.
    (Bug reported by Jiri Spitz.) The odbc_examp.q script now also works with MS
!   Access on Windows. Moreover, as suggested by Tim Haynes, two new functions
!   (odbc_getinfo, odbc_typeinfo) to retrieve metadata and type information of a
!   data source have been added.
  
  

[q-lang-cvs] q ChangeLog,1.326,1.327

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv16668

Modified Files:
	ChangeLog 
Log Message:
update ChangeLog

Index: ChangeLog
===================================================================
RCS file: /cvsroot/q-lang/q/ChangeLog,v
retrieving revision 1.326
retrieving revision 1.327
diff -C2 -d -r1.326 -r1.327
*** ChangeLog	14 Feb 2008 00:53:48 -0000	1.326
--- ChangeLog	15 Feb 2008 11:33:52 -0000	1.327
***************
*** 1,2 ****
--- 1,7 ----
+ 2008-02-15  Albert Graef  <Dr....@t-...>
+ 
+ 	* modules/odbc/odbc.c, odbc.q: add odbc_typeinfo function
+ 	(interface to SQLGetTypeInfo()), as suggested by Tim Haynes
+ 
  2008-02-14  Albert Graef  <Dr....@t-...>
  

[q-lang-cvs] q/modules/odbc odbc.c,1.9,1.10 odbc.q,1.5,1.6

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q/modules/odbc
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv16634

Modified Files:
	odbc.c odbc.q 
Log Message:
add odbc_typeinfo function, per request by Tim Haynes

Index: odbc.q
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/odbc.q,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** odbc.q	14 Feb 2008 00:48:47 -0000	1.5
--- odbc.q	15 Feb 2008 11:33:22 -0000	1.6
***************
*** 318,321 ****
--- 318,435 ----
    SQL_OJ_CAPABILITIES =			65003;
  
+ /* Retrieve information about SQL data types supported by the given data
+    source. TYPE_ID may be any of the constants listed below. This returns a
+    list of tuples with the following fields (see SQLGetTypeInfo() in the ODBC
+    API reference for more information):
+ 
+    - TYPE_NAME: the name of the type (string)
+    - DATA_TYPE: a small integer identifying the data type
+    - PRECISION: maximum precision/column size (integer)
+    - PREFIX, SUFFIX: characters used as prefixes and suffixes in literals of
+      the type, respectively (string)
+    - PARAMS: comma-delimited list of keywords describing the parameters of the
+      type, in the order in which they have to be specified in a declaration
+    - NULLABLE: whether the field is nullable (one of the constants
+      SQL_NO_NULLS, SQL_NULLABLE, SQL_NULLABLE_UNKNOWN defined below)
+    - CASE_SENSITIVE: whether a character data type is case-sensitive (boolean)
+    - SEARCHABLE: describes how the data type can be used in SQL where clauses
+      (one of the SQL_PRED_XXX constants defined below)
+    - UNSIGNED: whether the data type is unsigned (boolean)
+    - MONEY: whether the data type has predefined fixed precision, like the
+      money type (boolean)
+    - AUTO_INCREMENT: whether the data type is autoincrementing (boolean)
+    - LOCAL_TYPE_NAME: localized (display) name of the type, if available
+      (string)
+    - MINIMUM_SCALE, MAXIMUM_SCALE: minimum and maximum scale of the data type
+      (integer)
+    - SQL_DATA_TYPE: SQL data type id (integer); normally, this is the same as
+      DATA_TYPE, except for interval and datetime data types, where
+      SQL_DATA_TYPE is either SQL_INTERVAL or SQL_DATETIME, and the
+      SQL_DATETIME_SUB field (see below) has the datetime/interval subcode
+    - SQL_DATETIME_SUB: datetime/interval subcode (integer) when SQL_DATA_TYPE
+      is SQL_INTERVAL or SQL_DATETIME (see above)
+    - NUM_PREC_RADIX: radix for the precision of numeric types (2 or 10)
+    - INTERVAL_PRECISION: interval leading precision (integer) when
+      SQL_DATA_TYPE is SQL_INTERVAL
+ 
+    Note that fields which don't apply to a given type are left empty,
+    indicated by a NULL value (() in Q land). */
+ 
+ public extern odbc_typeinfo DB TYPE_ID;
+ 
+ /* Possible values for the TYPE_ID parameter of odbc_typeinfo. Note that some
+    drivers may support additional codes. Use SQL_ALL_TYPES to retrieve
+    information for all supported types. */
+ 
+ public const var
+   SQL_ALL_TYPES =		    0,
+   SQL_CHAR =			    1,
+   SQL_NUMERIC =			    2,
+   SQL_DECIMAL =			    3,
+   SQL_INTEGER =			    4,
+   SQL_SMALLINT =		    5,
+   SQL_FLOAT =			    6,
+   SQL_REAL =			    7,
+   SQL_DOUBLE =			    8,
+   SQL_DATE =			    9,
+   SQL_DATETIME =		    9, // ODBC 3.x
+   SQL_TIME =			   10,
+   SQL_INTERVAL =		   10, // ODBC 3.x
+   SQL_TIMESTAMP =		   11,
+   SQL_VARCHAR =			   12,
+   SQL_TYPE_DATE =		   91, // ODBC 3.x
+   SQL_TYPE_TIME =		   92, // ODBC 3.x
+   SQL_TYPE_TIMESTAMP =		   93, // ODBC 3.x
+   SQL_LONGVARCHAR =		   -1,
+   SQL_BINARY =			   -2,
+   SQL_VARBINARY =		   -3,
+   SQL_LONGVARBINARY =		   -4,
+   SQL_BIGINT =			   -5,
+   SQL_TINYINT =			   -6,
+   SQL_BIT =			   -7,
+   SQL_GUID =			  -11; // ODBC 3.x
+ 
+ /* Possible values of the NULLABLE field. */
+ 
+ public const var
+   SQL_NO_NULLS =		    0,
+   SQL_NULLABLE =		    1,
+   SQL_NULLABLE_UNKNOWN =	    2;
+ 
+ /* Possible values of the SEARCHABLE field. */
+ 
+ public const var
+   SQL_UNSEARCHABLE =		    0,
+   SQL_LIKE_ONLY =		    1,
+   SQL_ALL_EXCEPT_LIKE =		    2,
+   SQL_SEARCHABLE =		    3,
+   // ODBC 3.x synonyms
+   SQL_PRED_NONE =		    0,
+   SQL_PRED_CHAR =		    1,
+   SQL_PRED_BASIC =		    2,
+   SQL_PRED_SEARCHABLE =		    3;
+ 
+ /* Possible values of the SQL_DATETIME_SUB field (ODBC 3.x). */
+ 
+ public const var
+   // date/time types
+   SQL_CODE_DATE =		    1,
+   SQL_CODE_TIME =		    2,
+   SQL_CODE_TIMESTAMP =		    3,
+   // interval types
+   SQL_CODE_YEAR =		    1,
+   SQL_CODE_MONTH =		    2,
+   SQL_CODE_DAY =		    3,
+   SQL_CODE_HOUR =		    4,
+   SQL_CODE_MINUTE =		    5,
+   SQL_CODE_SECOND =		    6,
+   SQL_CODE_YEAR_TO_MONTH =	    7,
+   SQL_CODE_DAY_TO_HOUR =	    8,
+   SQL_CODE_DAY_TO_MINUTE =	    9,
+   SQL_CODE_DAY_TO_SECOND =	   10,
+   SQL_CODE_HOUR_TO_MINUTE =	   11,
+   SQL_CODE_HOUR_TO_SECOND =	   12,
+   SQL_CODE_MINUTE_TO_SECOND =	   13;
+ 
  /* Execute an SQL query and fetch results. SQL queries generally come in two
     different flavours: queries returning data (so-called result sets), and

Index: odbc.c
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/odbc.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** odbc.c	14 Feb 2008 00:48:47 -0000	1.9
--- odbc.c	15 Feb 2008 11:33:22 -0000	1.10
***************
*** 631,634 ****
--- 631,744 ----
  }
  
+ /* Number of entries in SQLGetTypeInfo() result set. Table entries are
+    allocated in chunks of this value. */
+ #define NMAX 128
+ 
+ #define checkstr(s,l) ((l==SQL_NULL_DATA)?mkvoid:mkstr(to_utf8(s, NULL)))
+ #define checkint(x,l) ((l==SQL_NULL_DATA)?mkvoid:mkint(x))
+ #define checkuint(x,l) ((l==SQL_NULL_DATA)?mkvoid:mkuint(x))
+ #define checkbool(x,l) ((l==SQL_NULL_DATA)?mkvoid:mkbool(x))
+ 
+ FUNCTION(odbc,odbc_typeinfo,argc,argv)
+ {
+   ODBCHandle *db;
+   long id;
+   if (argc == 2 && isobj(argv[0], type(ODBCHandle), (void**)&db) &&
+       db->henv && isint(argv[1], &id)) {
+     expr res, *xs = (expr*)malloc(NMAX*sizeof(expr)), *xs1;
+     int i, n = 0, m = NMAX;
+ 
+     UCHAR  name[80], prefix[80], suffix[80], params[80], local_name[80];
+     SWORD  type, nullable, case_sen, searchable, unsign, money, auto_inc;
+     SWORD  min_scale, max_scale;
+     UDWORD prec;
+     SDWORD len[20], ret;
+     SWORD  sql_type, subcode, intv_prec;
+     UDWORD prec_radix;
+ 
+     if (!xs) return __ERROR;
+     sql_close(db);
+ 
+     ret = SQLBindCol(db->hstmt,  1, SQL_C_CHAR,  name,       80, &len[1]);
+     ret = SQLBindCol(db->hstmt,  2, SQL_C_SHORT, &type,       0, &len[2]);
+     ret = SQLBindCol(db->hstmt,  3, SQL_C_LONG,  &prec,       0, &len[3]);
+     ret = SQLBindCol(db->hstmt,  4, SQL_C_CHAR,  prefix,     80, &len[4]);
+     ret = SQLBindCol(db->hstmt,  5, SQL_C_CHAR,  suffix,     80, &len[5]);
+     ret = SQLBindCol(db->hstmt,  6, SQL_C_CHAR,  params,     80, &len[6]);
+     ret = SQLBindCol(db->hstmt,  7, SQL_C_SHORT, &nullable,   0, &len[7]);
+     ret = SQLBindCol(db->hstmt,  8, SQL_C_SHORT, &case_sen,   0, &len[8]);
+     ret = SQLBindCol(db->hstmt,  9, SQL_C_SHORT, &searchable, 0, &len[9]);
+     ret = SQLBindCol(db->hstmt, 10, SQL_C_SHORT, &unsign,     0, &len[10]);
+     ret = SQLBindCol(db->hstmt, 11, SQL_C_SHORT, &money,      0, &len[11]);
+     ret = SQLBindCol(db->hstmt, 12, SQL_C_SHORT, &auto_inc,   0, &len[12]);
+     ret = SQLBindCol(db->hstmt, 13, SQL_C_CHAR,  local_name, 80, &len[13]);
+     ret = SQLBindCol(db->hstmt, 14, SQL_C_SHORT, &min_scale,  0, &len[14]);
+     ret = SQLBindCol(db->hstmt, 15, SQL_C_SHORT, &max_scale,  0, &len[15]);
+     ret = SQLBindCol(db->hstmt, 16, SQL_C_SHORT, &sql_type,   0, &len[16]);
+     ret = SQLBindCol(db->hstmt, 17, SQL_C_SHORT, &subcode,    0, &len[17]);
+     ret = SQLBindCol(db->hstmt, 18, SQL_C_LONG,  &prec_radix, 0, &len[18]);
+     ret = SQLBindCol(db->hstmt, 19, SQL_C_SHORT, &intv_prec,  0, &len[19]);
+ 
+     ret = SQLGetTypeInfo(db->hstmt, id);
+     if (ret != SQL_SUCCESS && ret != SQL_SUCCESS_WITH_INFO) goto err;
+ 
+     do {
+       ret = SQLFetch(db->hstmt);
+       switch (ret) {
+        case SQL_SUCCESS_WITH_INFO:
+        case SQL_SUCCESS:
+ 	 if (n >= m)
+ 	   if ((xs1 = (expr*)realloc(xs, (m+=NMAX)*sizeof(expr))))
+ 	     xs = xs1;
+ 	   else
+ 	     goto fatal;
+ 	 xs[n++] = mktuplel(19,
+ 			    checkstr(name, len[1]),
+ 			    checkint(type, len[2]),
+ 			    checkuint(prec, len[3]),
+ 			    checkstr(prefix, len[4]),
+ 			    checkstr(suffix, len[5]),
+ 			    checkstr(params, len[6]),
+ 			    checkint(nullable, len[7]),
+ 			    checkbool(case_sen, len[8]),
+ 			    checkint(searchable, len[9]),
+ 			    checkbool(unsign, len[10]),
+ 			    checkbool(money, len[11]),
+ 			    checkbool(auto_inc, len[12]),
+ 			    checkstr(local_name, len[13]),
+ 			    checkint(min_scale, len[14]),
+ 			    checkint(max_scale, len[15]),
+ 			    checkint(sql_type, len[16]),
+ 			    checkint(subcode, len[17]),
+ 			    checkuint(prec_radix, len[18]),
+ 			    checkint(intv_prec, len[19]));
+ 	 break;
+        case SQL_NO_DATA_FOUND:
+ 	 break;
+       default:
+ 	goto err;
+       }
+     } while (ret != SQL_NO_DATA_FOUND);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     if (n == 0) {
+       free(xs);
+       return mknil;
+     } else
+       return mklistv(n, xs);
+   err:
+     for (i = 0; i < n; i++) dispose(xs[i]);
+     free(xs);
+     res = mkerr(db->henv, db->hdbc, db->hstmt);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     return res;
+   fatal:
+     for (i = 0; i < n; i++) dispose(xs[i]);
+     free(xs);
+     SQLFreeStmt(db->hstmt, SQL_CLOSE);
+     return __ERROR;
+   } else
+     return __FAIL;
+ }
+ 
  #define BUFSZ 65536
  #define BUFSZ2 5000

[q-lang-cvs] q/modules/odbc README-ODBC,1.1.1.1,1.2

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q/modules/odbc
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv2009

Modified Files:
	README-ODBC 
Log Message:
update documentation

Index: README-ODBC
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/README-ODBC,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -d -r1.1.1.1 -r1.2
*** README-ODBC	15 Dec 2003 10:21:23 -0000	1.1.1.1
--- README-ODBC	14 Feb 2008 01:14:14 -0000	1.2
***************
*** 89,96 ****
  The `odbc_connect' function returns an `ODBCHandle' object which is used to
  refer to the database connection in the other routines provided by this
! module. You can get general information about the connection with the
  `odbc_info' function. This function returns a tuple of strings with the
! following items (see the corresponding item descriptions in the ODBC API
! reference for more information):
  
  - DATA_SOURCE_NAME: the data source name
--- 89,109 ----
  The `odbc_connect' function returns an `ODBCHandle' object which is used to
  refer to the database connection in the other routines provided by this
! module. An ODBCHandle object is closed automatically when it is no longer
! accessible.  You can also close it explicitly with a call to the
! `odbc_disconnect' function:
! 
! ==> odbc_disconnect DB
! 
! After `odbc_disconnect' has been invoked on a handle, any further operations
! on it will fail.
! 
! 
! GETTING INFORMATION ABOUT A DATA SOURCE
! ======= =========== ===== = ==== ======
! 
! You can get general information about an open database connection with the
  `odbc_info' function. This function returns a tuple of strings with the
! following items (see the description of the SQLGetInfo() function in the ODBC
! API reference for more information):
  
  - DATA_SOURCE_NAME: the data source name
***************
*** 109,120 ****
  "03.80")
  
! An ODBCHandle object is closed automatically when it is no longer accessible.
! You can also close it explicitly with a call to the `odbc_disconnect'
! function:
  
! ==> odbc_disconnect DB
  
! After `odbc_disconnect' has been invoked on a handle, any further operations
! on it will fail.
  
  
--- 122,136 ----
  "03.80")
  
! As of Q 7.11, a bunch of additional meta information is available using the
! odbc_getinfo function which provides a direct interface to the SQLGetInfo()
! routine. The result of odbc_getinfo is a byte string which can be converted to
! an integer or string value, depending on the type of information requested.
! For instance:
  
! ==> bint $ odbc_getinfo DB SQL_MAX_TABLES_IN_SELECT
! 31
  
! ==> bstr $ odbc_getinfo DB SQL_IDENTIFIER_QUOTE_CHAR
! "`"
  
  

[q-lang-cvs] q ChangeLog,1.325,1.326

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv27412

Modified Files:
	ChangeLog 
Log Message:
update ChangeLog

Index: ChangeLog
===================================================================
RCS file: /cvsroot/q-lang/q/ChangeLog,v
retrieving revision 1.325
retrieving revision 1.326
diff -C2 -d -r1.325 -r1.326
*** ChangeLog	14 Feb 2008 00:52:25 -0000	1.325
--- ChangeLog	14 Feb 2008 00:53:48 -0000	1.326
***************
*** 1,6 ****
  2008-02-14  Albert Graef  <Dr....@t-...>
  
! 	* modules/odbc/odbc.c: add odbc_getinfo function (direct interface
! 	to SQLGetInfo())
  
  2008-02-12  Albert Graef  <Dr....@t-...>
--- 1,6 ----
  2008-02-14  Albert Graef  <Dr....@t-...>
  
! 	* modules/odbc/odbc.c, odbc.q: add odbc_getinfo function (direct
! 	interface to SQLGetInfo())
  
  2008-02-12  Albert Graef  <Dr....@t-...>

[q-lang-cvs] q ChangeLog,1.324,1.325

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv26991

Modified Files:
	ChangeLog 
Log Message:
update ChangeLog

Index: ChangeLog
===================================================================
RCS file: /cvsroot/q-lang/q/ChangeLog,v
retrieving revision 1.324
retrieving revision 1.325
diff -C2 -d -r1.324 -r1.325
*** ChangeLog	12 Feb 2008 02:25:32 -0000	1.324
--- ChangeLog	14 Feb 2008 00:52:25 -0000	1.325
***************
*** 1,2 ****
--- 1,7 ----
+ 2008-02-14  Albert Graef  <Dr....@t-...>
+ 
+ 	* modules/odbc/odbc.c: add odbc_getinfo function (direct interface
+ 	to SQLGetInfo())
+ 
  2008-02-12  Albert Graef  <Dr....@t-...>
  

[q-lang-cvs] q/modules/odbc odbc.c,1.8,1.9 odbc.q,1.4,1.5

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q/modules/odbc
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv25356

Modified Files:
	odbc.c odbc.q 
Log Message:
add odbc_getinfo function and related information type constants

Index: odbc.q
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/odbc.q,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** odbc.q	11 Jul 2005 14:30:20 -0000	1.4
--- odbc.q	14 Feb 2008 00:48:47 -0000	1.5
***************
*** 63,70 ****
  public extern odbc_connect CONN, odbc_disconnect DB;
  
! /* Obtain information about an ODBC connection. Right now only a small subset
!    of the information specified by the ODBC API is supported. Returns a tuple
!    of strings with the following items (see the corresponding item
!    descriptions in the ODBC API reference for more information):
  
     - DATA_SOURCE_NAME: the data source name
--- 63,69 ----
  public extern odbc_connect CONN, odbc_disconnect DB;
  
! /* Obtain general information about an ODBC connection. Returns a tuple of
!    strings with the following items (see SQLGetInfo() in the ODBC API
!    reference for more information):
  
     - DATA_SOURCE_NAME: the data source name
***************
*** 79,82 ****
--- 78,321 ----
  public extern odbc_info DB;
  
+ /* More information is available using the following odbc_getinfo function
+    which provides a direct interface to SQLGetInfo(). The INFO_TYPE argument
+    (a nonnegative integer) specifies the requested type of information. The
+    result is always a byte string which, depending on INFO_TYPE, may contain
+    an integer or a string which can be converted to a Q value using bint or
+    bstr, respectively. See SQLGetInfo() in the ODBC API reference for
+    information about which information types are available and which type of
+    information they return. */
+ 
+ public extern odbc_getinfo DB INFO_TYPE;
+ 
+ /* Some common INFO_TYPE values which can be passed to the odbc_getinfo
+    function. This also includes some aliases defined by the ISO SQL/CLI
+    standard.  Please refer to SQLGetInfo() in the ODBC API reference for
+    details. Note that not all values may be supported by all implementations,
+    and some ODBC drivers may offer additional information types not listed
+    here. */
+ 
+ public const var
+   SQL_ACTIVE_CONNECTIONS =		    0,
+   SQL_MAXIMUM_DRIVER_CONNECTIONS =	    0,
+   SQL_MAX_DRIVER_CONNECTIONS =		    0,
+   SQL_INFO_FIRST =			    0,
+   SQL_ACTIVE_STATEMENTS =		    1,
+   SQL_MAX_CONCURRENT_ACTIVITIES =	    1,
+   SQL_MAXIMUM_CONCURRENT_ACTIVITIES =	    1,
+   SQL_DATA_SOURCE_NAME =		    2,
+   SQL_DRIVER_HDBC =			    3,
+   SQL_DRIVER_HENV =			    4,
+   SQL_DRIVER_HSTMT =			    5,
+   SQL_DRIVER_NAME =			    6,
+   SQL_DRIVER_VER =			    7,
+   SQL_FETCH_DIRECTION =			    8,
+   SQL_ODBC_API_CONFORMANCE =		    9,
+   SQL_ODBC_VER =			   10,
+   SQL_ROW_UPDATES =			   11,
+   SQL_ODBC_SAG_CLI_CONFORMANCE =	   12,
+   SQL_SERVER_NAME =			   13,
+   SQL_SEARCH_PATTERN_ESCAPE =		   14,
+   SQL_ODBC_SQL_CONFORMANCE =		   15,
+   SQL_DBMS_NAME =			   17,
+   SQL_DBMS_VER =			   18,
+   SQL_DBMS_VERSION =			   18,
+   SQL_ACCESSIBLE_TABLES =		   19,
+   SQL_ACCESSIBLE_PROCEDURES =		   20,
+   SQL_PROCEDURES =			   21,
+   SQL_CONCAT_NULL_BEHAVIOR =		   22,
+   SQL_CURSOR_COMMIT_BEHAVIOR =		   23,
+   SQL_CURSOR_ROLLBACK_BEHAVIOR =	   24,
+   SQL_DATA_SOURCE_READ_ONLY =		   25,
+   SQL_DEFAULT_TXN_ISOLATION =		   26,
+   SQL_DEFAULT_TRANSACTION_ISOLATION =	   26,
+   SQL_EXPRESSIONS_IN_ORDERBY =		   27,
+   SQL_IDENTIFIER_CASE =			   28,
+   SQL_IDENTIFIER_QUOTE_CHAR =		   29,
+   SQL_MAXIMUM_COLUMN_NAME_LENGTH =	   30,
+   SQL_MAX_COLUMN_NAME_LEN =		   30,
+   SQL_MAXIMUM_CURSOR_NAME_LENGTH =	   31,
+   SQL_MAX_CURSOR_NAME_LEN =		   31,
+   SQL_MAX_OWNER_NAME_LEN =		   32,
+   SQL_MAXIMUM_SCHEMA_NAME_LENGTH =	   32,
+   SQL_MAX_SCHEMA_NAME_LEN =		   32,
+   SQL_MAX_PROCEDURE_NAME_LEN =		   33,
+   SQL_MAX_CATALOG_NAME_LEN =		   34,
+   SQL_MAXIMUM_CATALOG_NAME_LENGTH =	   34,
+   SQL_MAX_QUALIFIER_NAME_LEN =		   34,
+   SQL_MAX_TABLE_NAME_LEN =		   35,
+   SQL_MAXIMUM_TABLE_NAME_LENGTH =	   35,
+   SQL_MULT_RESULT_SETS =		   36,
+   SQL_MULTIPLE_ACTIVE_TXN =		   37,
+   SQL_OUTER_JOINS =			   38,
+   SQL_OWNER_TERM =			   39,
+   SQL_SCHEMA_TERM =			   39,
+   SQL_PROCEDURE_TERM =			   40,
+   SQL_CATALOG_NAME_SEPARATOR =		   41,
+   SQL_QUALIFIER_NAME_SEPARATOR =	   41,
+   SQL_QUALIFIER_TERM =			   42,
+   SQL_CATALOG_TERM =			   42,
+   SQL_SCROLL_CONCURRENCY =		   43,
+   SQL_SCROLL_OPTIONS =			   44,
+   SQL_TABLE_TERM =			   45,
+   SQL_TXN_CAPABLE =			   46,
+   SQL_TRANSACTION_CAPABLE =		   46,
+   SQL_USER_NAME =			   47,
+   SQL_CONVERT_FUNCTIONS =		   48,
+   SQL_NUMERIC_FUNCTIONS =		   49,
+   SQL_STRING_FUNCTIONS =		   50,
+   SQL_SYSTEM_FUNCTIONS =		   51,
+   SQL_TIMEDATE_FUNCTIONS =		   52,
+   SQL_CONVERT_BIGINT =			   53,
+   SQL_CONVERT_BINARY =			   54,
+   SQL_CONVERT_BIT =			   55,
+   SQL_CONVERT_CHAR =			   56,
+   SQL_CONVERT_DATE =			   57,
+   SQL_CONVERT_DECIMAL =			   58,
+   SQL_CONVERT_DOUBLE =			   59,
+   SQL_CONVERT_FLOAT =			   60,
+   SQL_CONVERT_INTEGER =			   61,
+   SQL_CONVERT_LONGVARCHAR =		   62,
+   SQL_CONVERT_NUMERIC =			   63,
+   SQL_CONVERT_REAL =			   64,
+   SQL_CONVERT_SMALLINT =		   65,
+   SQL_CONVERT_TIME =			   66,
+   SQL_CONVERT_TIMESTAMP =		   67,
+   SQL_CONVERT_TINYINT =			   68,
+   SQL_CONVERT_VARBINARY =		   69,
+   SQL_CONVERT_VARCHAR =			   70,
+   SQL_CONVERT_LONGVARBINARY =		   71,
+   SQL_TXN_ISOLATION_OPTION =		   72,
+   SQL_TRANSACTION_ISOLATION_OPTION =	   72,
+   SQL_INTEGRITY =			   73,
+   SQL_ODBC_SQL_OPT_IEF =		   73,
+   SQL_CORRELATION_NAME =		   74,
+   SQL_NON_NULLABLE_COLUMNS =		   75,
+   SQL_DRIVER_HLIB =			   76,
+   SQL_DRIVER_ODBC_VER =			   77,
+   SQL_LOCK_TYPES =			   78,
+   SQL_POS_OPERATIONS =			   79,
+   SQL_POSITIONED_STATEMENTS =		   80,
+   SQL_GETDATA_EXTENSIONS =		   81,
+   SQL_BOOKMARK_PERSISTENCE =		   82,
+   SQL_STATIC_SENSITIVITY =		   83,
+   SQL_FILE_USAGE =			   84,
+   SQL_NULL_COLLATION =			   85,
+   SQL_ALTER_TABLE =			   86,
+   SQL_COLUMN_ALIAS =			   87,
+   SQL_GROUP_BY =			   88,
+   SQL_KEYWORDS =			   89,
+   SQL_ORDER_BY_COLUMNS_IN_SELECT =	   90,
+   SQL_OWNER_USAGE =			   91,
+   SQL_SCHEMA_USAGE =			   91,
+   SQL_QUALIFIER_USAGE =			   92,
+   SQL_CATALOG_USAGE =			   92,
+   SQL_QUOTED_IDENTIFIER_CASE =		   93,
+   SQL_SPECIAL_CHARACTERS =		   94,
+   SQL_SUBQUERIES =			   95,
+   SQL_UNION_STATEMENT =			   96,
+   SQL_UNION =				   96,
+   SQL_MAXIMUM_COLUMNS_IN_GROUP_BY =	   97,
+   SQL_MAX_COLUMNS_IN_GROUP_BY =		   97,
+   SQL_MAXIMUM_COLUMNS_IN_INDEX =	   98,
+   SQL_MAX_COLUMNS_IN_INDEX =		   98,
+   SQL_MAX_COLUMNS_IN_ORDER_BY =		   99,
+   SQL_MAXIMUM_COLUMNS_IN_ORDER_BY =	   99,
+   SQL_MAX_COLUMNS_IN_SELECT =		  100,
+   SQL_MAXIMUM_COLUMNS_IN_SELECT =	  100,
+   SQL_MAXIMUM_COLUMNS_IN_TABLE =	  101,
+   SQL_MAX_COLUMNS_IN_TABLE =		  101,
+   SQL_MAXIMUM_INDEX_SIZE =		  102,
+   SQL_MAX_INDEX_SIZE =			  102,
+   SQL_MAX_ROW_SIZE_INCLUDES_LONG =	  103,
+   SQL_MAX_ROW_SIZE =			  104,
+   SQL_MAXIMUM_ROW_SIZE =		  104,
+   SQL_MAX_STATEMENT_LEN =		  105,
+   SQL_MAXIMUM_STATEMENT_LENGTH =	  105,
+   SQL_MAXIMUM_TABLES_IN_SELECT =	  106,
+   SQL_MAX_TABLES_IN_SELECT =		  106,
+   SQL_MAX_USER_NAME_LEN =		  107,
+   SQL_MAXIMUM_USER_NAME_LENGTH =	  107,
+   SQL_MAX_CHAR_LITERAL_LEN =		  108,
+   SQL_TIMEDATE_ADD_INTERVALS =		  109,
+   SQL_TIMEDATE_DIFF_INTERVALS =		  110,
+   SQL_NEED_LONG_DATA_LEN =		  111,
+   SQL_MAX_BINARY_LITERAL_LEN =		  112,
+   SQL_LIKE_ESCAPE_CLAUSE =		  113,
+   SQL_INFO_LAST =			  114,
+   SQL_QUALIFIER_LOCATION =		  114,
+   SQL_CATALOG_LOCATION =		  114,
+   SQL_OUTER_JOIN_CAPABILITIES =		  115,
+   SQL_ACTIVE_ENVIRONMENTS =		  116,
+   SQL_ALTER_DOMAIN =			  117,
+   SQL_SQL_CONFORMANCE =			  118,
+   SQL_DATETIME_LITERALS =		  119,
+   SQL_BATCH_ROW_COUNT =			  120,
+   SQL_BATCH_SUPPORT =			  121,
+   SQL_CONVERT_WCHAR =			  122,
+   SQL_CONVERT_INTERVAL_DAY_TIME =	  123,
+   SQL_CONVERT_INTERVAL_YEAR_MONTH =	  124,
+   SQL_CONVERT_WLONGVARCHAR =		  125,
+   SQL_CONVERT_WVARCHAR =		  126,
+   SQL_CREATE_ASSERTION =		  127,
+   SQL_CREATE_CHARACTER_SET =		  128,
+   SQL_CREATE_COLLATION =		  129,
+   SQL_CREATE_DOMAIN =			  130,
+   SQL_CREATE_SCHEMA =			  131,
+   SQL_CREATE_TABLE =			  132,
+   SQL_CREATE_TRANSLATION =		  133,
+   SQL_CREATE_VIEW =			  134,
+   SQL_DRIVER_HDESC =			  135,
+   SQL_DROP_ASSERTION =			  136,
+   SQL_DROP_CHARACTER_SET =		  137,
+   SQL_DROP_COLLATION =			  138,
+   SQL_DROP_DOMAIN =			  139,
+   SQL_DROP_SCHEMA =			  140,
+   SQL_DROP_TABLE =			  141,
+   SQL_DROP_TRANSLATION =		  142,
+   SQL_DROP_VIEW =			  143,
+   SQL_DYNAMIC_CURSOR_ATTRIBUTES1 =	  144,
+   SQL_DYNAMIC_CURSOR_ATTRIBUTES2 =	  145,
+   SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1 =	  146,
+   SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2 =	  147,
+   SQL_INDEX_KEYWORDS =			  148,
+   SQL_INFO_SCHEMA_VIEWS =		  149,
+   SQL_KEYSET_CURSOR_ATTRIBUTES1 =	  150,
+   SQL_KEYSET_CURSOR_ATTRIBUTES2 =	  151,
+   SQL_ODBC_INTERFACE_CONFORMANCE =	  152,
+   SQL_PARAM_ARRAY_ROW_COUNTS =		  153,
+   SQL_PARAM_ARRAY_SELECTS =		  154,
+   SQL_SQL92_DATETIME_FUNCTIONS =	  155,
+   SQL_SQL92_FOREIGN_KEY_DELETE_RULE =	  156,
+   SQL_SQL92_FOREIGN_KEY_UPDATE_RULE =	  157,
+   SQL_SQL92_GRANT =			  158,
+   SQL_SQL92_NUMERIC_VALUE_FUNCTIONS =	  159,
+   SQL_SQL92_PREDICATES =		  160,
+   SQL_SQL92_RELATIONAL_JOIN_OPERATORS =	  161,
+   SQL_SQL92_REVOKE =			  162,
+   SQL_SQL92_ROW_VALUE_CONSTRUCTOR =	  163,
+   SQL_SQL92_STRING_FUNCTIONS =		  164,
+   SQL_SQL92_VALUE_EXPRESSIONS =		  165,
+   SQL_STANDARD_CLI_CONFORMANCE =	  166,
+   SQL_STATIC_CURSOR_ATTRIBUTES1 =	  167,
+   SQL_STATIC_CURSOR_ATTRIBUTES2 =	  168,
+   SQL_AGGREGATE_FUNCTIONS =		  169,
+   SQL_DDL_INDEX =			  170,
+   SQL_DM_VER =				  171,
+   SQL_INSERT_STATEMENT =		  172,
+   SQL_CONVERT_GUID =			  173,
+   SQL_INFO_DRIVER_START =		 1000,
+   SQL_XOPEN_CLI_YEAR =			10000,
+   SQL_CURSOR_SENSITIVITY =		10001,
+   SQL_DESCRIBE_PARAMETER =		10002,
+   SQL_CATALOG_NAME =			10003,
+   SQL_COLLATING_SEQUENCE =		10004,
+   SQL_COLLATION_SEQ =			10004,
+   SQL_MAXIMUM_IDENTIFIER_LENGTH =	10005,
+   SQL_MAX_IDENTIFIER_LEN =		10005,
+   SQL_ASYNC_MODE =			10021,
+   SQL_MAX_ASYNC_CONCURRENT_STATEMENTS =	10022,
+   SQL_OJ_CAPABILITIES =			65003;
+ 
  /* Execute an SQL query and fetch results. SQL queries generally come in two
     different flavours: queries returning data (so-called result sets), and

Index: odbc.c
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/odbc.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** odbc.c	12 Feb 2008 00:37:23 -0000	1.8
--- odbc.c	14 Feb 2008 00:48:47 -0000	1.9
***************
*** 25,28 ****
--- 25,29 ----
  #define HAVE_STRDUP 1
  #define HAVE_MEMCPY 1
+ #define HAVE_MEMSET 1
  #define HAVE_LIMITS_H 1
  #include <windows.h>
***************
*** 109,112 ****
--- 110,132 ----
  #endif
  
+ #ifndef HAVE_MEMSET
+ 
+ #if __GNUC__ > 1
+ #define memset(TO,C,COUNT)	__builtin_memset(TO,C,COUNT)
+ #else
+ static void *memset (char *to, int c, int count)
+ {
+   register char f = (char)c;
+   register char *t = to;
+   register int i = count;
+ 
+   while (i-- > 0)
+     *t++ = f;
+   return (void*)to;
+ }
+ #endif
+ 
+ #endif
+ 
  /* ByteStr data structure, see clib.c */
  
***************
*** 566,569 ****
--- 586,634 ----
  }
  
+ static expr mkbstr(long size, void *v)
+ {
+   bstr_t *m;
+   if ((m = malloc(sizeof(bstr_t)))) {
+     if (size > 0 && v) {
+       m->size = size;
+       m->v = (unsigned char*)malloc(size);
+       if (!m->v) {
+ 	free(m);
+ 	return __ERROR;
+       }
+       memcpy(m->v, v, size);
+     } else {
+       m->size = 0;
+       m->v = NULL;
+     }
+     return mkobj(type(ByteStr), m);
+   } else {
+     return __ERROR;
+   }
+ }
+ 
+ FUNCTION(odbc,odbc_getinfo,argc,argv)
+ {
+   ODBCHandle *db;
+   unsigned long info_type;
+   if (argc == 2 && isobj(argv[0], type(ODBCHandle), (void**)&db) &&
+       db->henv && isuint(argv[1], &info_type)) {
+     long ret;
+     char info[1024];
+     short len;
+     /* A few queries (which are not supported by this interface right now)
+        take pointer arguments, therefore we initialize the beginning of the
+        buffer to prevent segfaults. */
+     memset(info, 0, 32);
+     if ((ret  = SQLGetInfo(db->hdbc, info_type,
+ 			   info, sizeof(info), &len)) == SQL_SUCCESS ||
+ 	ret == SQL_SUCCESS_WITH_INFO)
+       return mkbstr(len, info);
+     else
+       return mkerr(db->henv, db->hdbc, 0);
+   } else
+     return __FAIL;
+ }
+ 
  #define BUFSZ 65536
  #define BUFSZ2 5000

[q-lang-cvs] q/modules/odbc/examples odbc_examp.q,1.8,1.9

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q/modules/odbc/examples
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv727/modules/odbc/examples

Modified Files:
	odbc_examp.q 
Log Message:
cosmetic changes

Index: odbc_examp.q
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/examples/odbc_examp.q,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** odbc_examp.q	12 Feb 2008 02:05:17 -0000	1.8
--- odbc_examp.q	12 Feb 2008 02:26:54 -0000	1.9
***************
*** 25,28 ****
--- 25,31 ----
  		// connect to an existing MS access database (Windows)
  
+ // Uncomment this line to make the script work with MS Access.
+ //fields DESC		= join "," (map (sprintf "\"%s\" %s") DESC);
+ 
  /****************************************************************************/
  
***************
*** 92,97 ****
  			      (NAME,params DESC);
  
- // try this with MS Access
- //fields DESC		= join "," (map (sprintf "\"%s\" %s") DESC);
  fields DESC		= join "," (map (sprintf "%s %s") DESC);
  
--- 95,98 ----

[q-lang-cvs] q NEWS,1.138,1.139

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv311

Modified Files:
	NEWS 
Log Message:
update NEWS

Index: NEWS
===================================================================
RCS file: /cvsroot/q-lang/q/NEWS,v
retrieving revision 1.138
retrieving revision 1.139
diff -C2 -d -r1.138 -r1.139
*** NEWS	23 Jan 2008 05:34:05 -0000	1.138
--- NEWS	12 Feb 2008 02:25:57 -0000	1.139
***************
*** 3,7 ****
  =======
  
! * 7.11	January 2008 (work in progress)
  
  - As suggested by Rob Hubbard and John Cowan, special Unicode characters in
--- 3,7 ----
  =======
  
! * 7.11	12 February 2008
  
  - As suggested by Rob Hubbard and John Cowan, special Unicode characters in
***************
*** 19,23 ****
  - The glob and regex functions were moved back from system into clib.
  
! As usual, please see the ChangeLog for details.
  
  
--- 19,27 ----
  - The glob and regex functions were moved back from system into clib.
  
! - Worked around some quirks with the MS Access ODBC driver which caused it to
!   reject NULL and empty string parameter values in SQL insert statements.
!   (Bug reported by Jiri Spitz.) The odbc_examp.q script now also works with MS
!   Access on Windows, if you uncomment a single line in the script (see the
!   ChangeLog for details).
  
  

[q-lang-cvs] q ChangeLog,1.323,1.324

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv32760

Modified Files:
	ChangeLog 
Log Message:
update ChangeLog

Index: ChangeLog
===================================================================
RCS file: /cvsroot/q-lang/q/ChangeLog,v
retrieving revision 1.323
retrieving revision 1.324
diff -C2 -d -r1.323 -r1.324
*** ChangeLog	12 Feb 2008 02:06:20 -0000	1.323
--- ChangeLog	12 Feb 2008 02:25:32 -0000	1.324
***************
*** 1,10 ****
  2008-02-12  Albert Graef  <Dr....@t-...>
  
  	* modules\odbc\examples\odbc_examp.q: fixes for compatibility with
  	MS Access
  
! 	Uncomment line 95 in odbc_examp.q to make this example work with
! 	MS Access. (Note that you first need to create an ODBC data source
! 	named "myodbc" before you can initialize the sample tables.)
  
  2008-02-12  Albert Graef  <Dr....@t-...>
--- 1,16 ----
  2008-02-12  Albert Graef  <Dr....@t-...>
  
+ 	+ 7.11 RC2
+ 
  	* modules\odbc\examples\odbc_examp.q: fixes for compatibility with
  	MS Access
  
! 	Unfortunately this isn't automatic yet, as the current workaround
! 	doesn't work with other databases, but there's a single line in
! 	the config section at the beginning of odbc_examp.q which you can
! 	uncomment to make this example work with MS Access on Windows.
! 	Note that you also have to create an ODBC data source named
! 	"myodbc" before you can initialize the sample tables with the
! 	'init' routine.
  
  2008-02-12  Albert Graef  <Dr....@t-...>

[q-lang-cvs] q ChangeLog,1.322,1.323

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv25077

Modified Files:
	ChangeLog 
Log Message:
update ChangeLog

Index: ChangeLog
===================================================================
RCS file: /cvsroot/q-lang/q/ChangeLog,v
retrieving revision 1.322
retrieving revision 1.323
diff -C2 -d -r1.322 -r1.323
*** ChangeLog	12 Feb 2008 01:16:07 -0000	1.322
--- ChangeLog	12 Feb 2008 02:06:20 -0000	1.323
***************
*** 1,7 ****
! 2008-02-12    <Dr....@t-...>
  
  	* modules\odbc\examples\odbc_examp.q: fixes for compatibility with
  	MS Access
  
  2008-02-12  Albert Graef  <Dr....@t-...>
  
--- 1,11 ----
! 2008-02-12  Albert Graef  <Dr....@t-...>
  
  	* modules\odbc\examples\odbc_examp.q: fixes for compatibility with
  	MS Access
  
+ 	Uncomment line 95 in odbc_examp.q to make this example work with
+ 	MS Access. (Note that you first need to create an ODBC data source
+ 	named "myodbc" before you can initialize the sample tables.)
+ 
  2008-02-12  Albert Graef  <Dr....@t-...>
  

[q-lang-cvs] q/modules/odbc/examples odbc_examp.q,1.7,1.8

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q/modules/odbc/examples
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv24679

Modified Files:
	odbc_examp.q 
Log Message:
comment out modified definition for use with MS Access (doesn't work with MySQL)

Index: odbc_examp.q
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/examples/odbc_examp.q,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** odbc_examp.q	12 Feb 2008 01:15:11 -0000	1.7
--- odbc_examp.q	12 Feb 2008 02:05:17 -0000	1.8
***************
*** 92,96 ****
  			      (NAME,params DESC);
  
! fields DESC		= join "," (map (sprintf "\"%s\" %s") DESC);
  
  params DESC		= join "," (map (cst "?") DESC);
--- 92,98 ----
  			      (NAME,params DESC);
  
! // try this with MS Access
! //fields DESC		= join "," (map (sprintf "\"%s\" %s") DESC);
! fields DESC		= join "," (map (sprintf "%s %s") DESC);
  
  params DESC		= join "," (map (cst "?") DESC);

[q-lang-cvs] q ChangeLog,1.321,1.322

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv4266

Modified Files:
	ChangeLog 
Log Message:
update ChangeLog

Index: ChangeLog
===================================================================
RCS file: /cvsroot/q-lang/q/ChangeLog,v
retrieving revision 1.321
retrieving revision 1.322
diff -C2 -d -r1.321 -r1.322
*** ChangeLog	12 Feb 2008 00:40:07 -0000	1.321
--- ChangeLog	12 Feb 2008 01:16:07 -0000	1.322
***************
*** 1,2 ****
--- 1,7 ----
+ 2008-02-12    <Dr....@t-...>
+ 
+ 	* modules\odbc\examples\odbc_examp.q: fixes for compatibility with
+ 	MS Access
+ 
  2008-02-12  Albert Graef  <Dr....@t-...>
  

[q-lang-cvs] q/modules/odbc/examples odbc_examp.q,1.6,1.7

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q/modules/odbc/examples
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv4224/odbc/examples

Modified Files:
	odbc_examp.q 
Log Message:
fixes for MS Access compatibility

Index: odbc_examp.q
===================================================================
RCS file: /cvsroot/q-lang/q/modules/odbc/examples/odbc_examp.q,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** odbc_examp.q	15 Jun 2006 07:26:57 -0000	1.6
--- odbc_examp.q	12 Feb 2008 01:15:11 -0000	1.7
***************
*** 92,96 ****
  			      (NAME,params DESC);
  
! fields DESC		= join "," (map (sprintf "%s %s") DESC);
  
  params DESC		= join "," (map (cst "?") DESC);
--- 92,96 ----
  			      (NAME,params DESC);
  
! fields DESC		= join "," (map (sprintf "\"%s\" %s") DESC);
  
  params DESC		= join "," (map (cst "?") DESC);

[q-lang-cvs] q ChangeLog,1.320,1.321

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv22035

Modified Files:
	ChangeLog 
Log Message:
update ChangeLog

Index: ChangeLog
===================================================================
RCS file: /cvsroot/q-lang/q/ChangeLog,v
retrieving revision 1.320
retrieving revision 1.321
diff -C2 -d -r1.320 -r1.321
*** ChangeLog	11 Feb 2008 23:05:09 -0000	1.320
--- ChangeLog	12 Feb 2008 00:40:07 -0000	1.321
***************
*** 4,7 ****
--- 4,11 ----
  	binding and error checking of SQLBindParameter() calls
  
+ 	This also works around some bugs in the MS Access ODBC driver,
+ 	which causes it to reject NULL and empty string parameter values
+ 	in SQL insert statements. (Bug reported by Jiri Spitz.)
+ 
  2008-01-23  Albert Graef  <Dr....@t-...>