[q-lang-cvs] qcalc calclib.q,1.19,1.20 qcalc.q,1.114,1.115

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

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

Modified Files:
	calclib.q qcalc.q 
Log Message:
switch to new depth-first computation order which can also handle cyclic dependencies

Index: qcalc.q
===================================================================
RCS file: /cvsroot/q-lang/qcalc/qcalc.q,v
retrieving revision 1.114
retrieving revision 1.115
diff -C2 -d -r1.114 -r1.115
*** qcalc.q	9 Nov 2007 10:41:22 -0000	1.114
--- qcalc.q	9 Nov 2007 22:14:22 -0000	1.115
***************
*** 39,43 ****
    COPYRIGHT = "Copyright \169 2007 by Albert Gr\228f";

! import smokeqt, hdict, set, system;

  /* The GUI. ****************************************************************/
--- 39,43 ----
    COPYRIGHT = "Copyright \169 2007 by Albert Gr\228f";

! import smokeqt, dict, hdict, set, reftypes, system;

  /* The GUI. ****************************************************************/
***************
*** 735,739 ****
  yyval KEY\n\
  = get YYDATA!KEY if member (get YYDATA) KEY;\n\
! = throw \"NOVAL\" otherwise;\n\
  yyeval KEY VAL\n\
  = YYDATA := insert (get YYDATA) (KEY,VAL) || YYKEY := () ||\n\
--- 735,739 ----
  yyval KEY\n\
  = get YYDATA!KEY if member (get YYDATA) KEY;\n\
! = 0 otherwise;\n\
  yyeval KEY VAL\n\
  = YYDATA := insert (get YYDATA) (KEY,VAL) || YYKEY := () ||\n\
***************
*** 1610,1616 ****
  		  htmlquote $ get FILENAME;

! cellcmp ((I1,J1),_) ((I2,J2),_)
  		= (I1<I2) or else (I1=I2) and then (J1<J2);

  save_as X D A if is_global:
  		= FILENAME := S || save X D A
--- 1610,1619 ----
  		  htmlquote $ get FILENAME;

! indexcmp (I1,J1) (I2,J2)
  		= (I1<I2) or else (I1=I2) and then (J1<J2);

+ cellcmp ((I1,J1),_) ((I2,J2),_)
+ 		= indexcmp (I1,J1) (I2,J2);
+ 
  save_as X D A if is_global:
  		= FILENAME := S || save X D A
***************
*** 2791,2795 ****
  where S:String = try2 MSGS:
  // evaluation succeeded, we're good
! 		= update_cell (I,J) S || results_loop U V
  		    where [S] = regex "" "^\\+\\+\\+ Result: (.*)$" S (reg 1);
  // errors during evaluation (these get the red flag)
--- 2794,2798 ----
  where S:String = try2 MSGS:
  // evaluation succeeded, we're good
! 		= update_cell (I,J) S || results_loop (delete U (I,J)) V
  		    where [S] = regex "" "^\\+\\+\\+ Result: (.*)$" S (reg 1);
  // errors during evaluation (these get the red flag)
***************
*** 2948,2952 ****

  process_all	= do flag U || compute_all V
! 		    where (V,U) = eval_list
  		    if check_interp;

--- 2951,2955 ----

  process_all	= do flag U || compute_all V
! 		    where (V,U) = eval_list $ sort indexcmp $ keys $ get CELLS
  		    if check_interp;

***************
*** 2957,2961 ****
  		  // do the necessary reevaluations
  		  if check_interp then compute (I,J) V
! 		    where (V,U) = eval_list,
  		      V = dropwhile (<>(I,J)) V;

--- 2960,2964 ----
  		  // do the necessary reevaluations
  		  if check_interp then compute (I,J) V
! 		    where (V,U) = eval_list (I,J),
  		      V = dropwhile (<>(I,J)) V;

***************
*** 2973,2977 ****
  		    where S = qt TABLE "text" (I,J),
  		      _ = delete_eval (I,J),
! 		      (V,U) = eval_list;

  process_gui (I,J) X
--- 2976,2980 ----
  		    where S = qt TABLE "text" (I,J),
  		      _ = delete_eval (I,J),
! 		      (V,U) = eval_list (I,J);

  process_gui (I,J) X
***************
*** 2980,2984 ****
  		  // do the necessary reevaluations
  		  if check_interp then compute (I,J) V
! 		    where (V,U) = eval_list,
  		      V = dropwhile (=(I,J)) $ dropwhile (<>(I,J)) V;

--- 2983,2987 ----
  		  // do the necessary reevaluations
  		  if check_interp then compute (I,J) V
! 		    where (V,U) = eval_list (I,J),
  		      V = dropwhile (=(I,J)) $ dropwhile (<>(I,J)) V;

***************
*** 3002,3006 ****
  		      _ = set_cells C || set_eval E,
  		      W = map (flip (flip sub 0) 1) W,
! 		      (V,U) = eval_list
  		    if not null W and then check_interp;

--- 3005,3009 ----
  		      _ = set_cells C || set_eval E,
  		      W = map (flip (flip sub 0) 1) W,
! 		      (V,U) = eval_list W
  		    if not null W and then check_interp;

***************
*** 3028,3046 ****
  		      _ = set_cells C || set_eval E,
  		      W = map (flip (flip sub 0) 1) W,
! 		      (V,U) = eval_list
  		    if not null W and then check_interp;

  clear_sel W	= do clear_cell W || compute W V
  		    where _ = delete_cells W || delete_eval W,
! 		      (V,U) = eval_list
  		    if not null W and then check_interp;

! /* Compute the evaluation order (topological sort of the evaluation graph in
!    adjacency list form). This returns a pair of two lists V and U. V contains
!    the indices of cells in the order in which they should be evaluated. U
!    contains the indices of "bad" cells which couldn't be ordered because they
!    are connected to some cyclic computation. */

! eval_list	= (V,U)
  		    where (KEYS,VALS) = unzip (list (get EVAL)),
  		      NODE_NUM = hdict (zip KEYS [0..#KEYS-1]),
--- 3031,3104 ----
  		      _ = set_cells C || set_eval E,
  		      W = map (flip (flip sub 0) 1) W,
! 		      (V,U) = eval_list W
  		    if not null W and then check_interp;

  clear_sel W	= do clear_cell W || compute W V
  		    where _ = delete_cells W || delete_eval W,
! 		      (V,U) = eval_list W
  		    if not null W and then check_interp;

! /* Compute the evaluation order. We now provide two alternative routines,
!    depth-first search (more precisely, the reversal of a depth-first
!    postorder) starting from a given node or list of nodes (which works ok with
!    cyclic dependencies, but may consider them in an apparently random order),
!    and global topological sort (which refuses to order cyclic computations).
!    In any case, the result is a pair of two lists V and U. V contains the
!    indices of cells in the order in which they should be evaluated. U contains
!    the indices of "bad" cells which is always empty for the depth-first order,
!    and for topsort contains the nodes which couldn't be ordered because they
!    are connected to some cyclic computation. The topological sort used in
!    previous cvs versions is now being phased out in favour of depth-first
!    search, which is a little more efficient for incremental computations and
!    handles a greater variety of usage cases, but is also less predictable if
!    cyclic computations have to be performed. */

! eval_list (I,J)	= eval_list [(I,J)];
! eval_list V	= dfs_list V;
! //eval_list V	= topsort_list;
! 
! /* Depth-first postorder. */
! 
! dfs_list V	= //printf "reverse dfs postorder: %s\n" $ str V ||
! 		  (V,[])
! 		    where // build a dict mapping cell indices to node numbers
! 		      ALL_CELLS = foldl insert (get CELLS) $
! 		      map (flip pair true) V,
! 		      ALL_KEYS = keys ALL_CELLS,
! 		      N = #ALL_KEYS, NODES = [0..N-1],
! 		      NODE_NUM = hdict (zip ALL_KEYS NODES),
! 		      // build a dictionary of dependencies
! 		      (KEYS,VALS) = unzip (list (get EVAL)),
! 		      KEYS = map (NODE_NUM!) KEYS,
! 		      VALS = map (map (NODE_NUM!).
! 				  filter (member NODE_NUM).trd) VALS,
! 		      D = mkdict [] NODES,
! 		      D = foldl insert D $ zip KEYS VALS,
! 		      // compute the reversal of the dependencies graph
! 		      ADJ = cat $ zipwith rev_edges NODES $ vals D,
! 		      D = dict $ zip NODES $ reflist $ mklist emptyset N,
! 		      _ = do (add_edge D) ADJ,
! 		      ADJ = map (list.get) (vals D),
! 		      // perform the depth-first traversal
! 		      V = map (NODE_NUM!) V,
! 		      V = dfs ADJ V,
! 		      V = map (ALL_KEYS!) V,
! 		      // determine the list of cells to be evaluated
! 		      V = filter (member (get EVAL)) V;
! 
! rev_edges X Ys	= map (flip pair X) Ys;
! 
! add_edge D (X,Y)
! 		= D!X := insert (D!!X) Y;
! 
! dfs ADJ V	= Xs where (_,Xs) = foldl (search ADJ) (emptyset,[]) V;
! search ADJ (V,Xs) X
! 		= (V,Xs) if member V X;
! 		= (V,[X|Xs])
! 		    where (V,Xs) = foldl (search ADJ) (insert V X,Xs) (ADJ!X);
! 
! /* Topological order. */
! 
! topsort_list	= (V,U)
  		    where (KEYS,VALS) = unzip (list (get EVAL)),
  		      NODE_NUM = hdict (zip KEYS [0..#KEYS-1]),
***************
*** 3050,3055 ****
  		      V = map (KEYS!) V, U = map (KEYS!) U;

! /* Perform a toplogical sort on a graph given by its adjacency list. Returns a
!    pair (V,U) where V is a maximal topological order and U are the remaining
     nodes which couldn't be ordered as they are connected to cycles in the
     graph. */
--- 3108,3113 ----
  		      V = map (KEYS!) V, U = map (KEYS!) U;

! /* Perform a topological sort on a graph given by its adjacency list. Returns
!    a pair (V,U) where V is a maximal topological order and U are the remaining
     nodes which couldn't be ordered as they are connected to cycles in the
     graph. */

Index: calclib.q
===================================================================
RCS file: /cvsroot/q-lang/qcalc/calclib.q,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -d -r1.19 -r1.20
*** calclib.q	9 Nov 2007 10:41:22 -0000	1.19
--- calclib.q	9 Nov 2007 22:14:22 -0000	1.20
***************
*** 135,139 ****
     cells changes. In particular, you can also use GUI elements to *display*
     values from other cells by specifying the corresponding cell as the INIT
!    parameter of the widget.

     Moreover, the values of all GUI elements except the push button (which is a
--- 135,140 ----
     cells changes. In particular, you can also use GUI elements to *display*
     values from other cells by specifying the corresponding cell as the INIT
!    parameter of the widget, or you can define "buddies" which always change
!    values in concert, like a slider and an associated spinbox.

     Moreover, the values of all GUI elements except the push button (which is a