Megatest

Check-in [74dc16bf61]
Login
Overview
Comment:Added defstruct changes to megatest.scm
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | inline-vec-to-defstruct
Files: files | file ages | folders
SHA1: 74dc16bf617c522ddd27a66285e4f81bf28e7114
User & Date: ritikaag on 2016-01-13 15:35:15
Other Links: branch diff | manifest | tags
Context
2016-01-13
16:23
converted filedb:fdb from vec to defstruct Closed-Leaf check-in: fb18a8da9e user: bjbarcla tags: inline-vec-to-defstruct
15:35
Added defstruct changes to megatest.scm check-in: 74dc16bf61 user: ritikaag tags: inline-vec-to-defstruct
2016-01-11
11:23
Create new branch named "inline-vec-to-defstruct" check-in: 26c4c3485f user: mrwellan tags: inline-vec-to-defstruct
Changes

Modified megatest.scm from [968f531533] to [cf5035193a].

10
11
12
13
14
15
16
17

18
19
20
21
22
23
24
10
11
12
13
14
15
16

17
18
19
20
21
22
23
24







-
+







;; (include "common.scm")
;; (include "megatest-version.scm")

;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 readline apropos json http-client directory-utils rpc ;; (srfi 18) extras)
     http-client srfi-18 extras format) ;;  zmq extras)
     http-client srfi-18 extras format defstruct) ;;  zmq extras)

;; Added for csv stuff - will be removed
;;
(use sparse-vectors)

(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
492
493
494
495
496
497
498


499

500

501
502
503
504
505
506

507
508
509
510
511
512
513
514
515
516










517
518
519
520

521
522
523
524
525
526
527
492
493
494
495
496
497
498
499
500
501
502

503

504
505
506
507
508
509










510
511
512
513
514
515
516
517
518
519
520
521
522

523
524
525
526
527
528
529
530







+
+

+
-
+
-





+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+



-
+







  (let ((row (sparse-vector-ref a x)))
    (if row
	(sparse-vector-set! row y val)
	(let ((new-row (make-sparse-vector)))
	  (sparse-vector-set! a x new-row)
	  (sparse-vector-set! new-row y val)))))

(defstruct refdb:csv svec rows cols maxrow maxcol)

;; csv processing record
(define (actual-make-refdb:csv)
(define (make-refdb:csv)
  (make-refdb:csv 
  (vector 
   (make-sparse-array)
   (make-hash-table)
   (make-hash-table)
   0
   0))

(define-inline (refdb:csv-get-svec     vec)    (vector-ref  vec 0))
(define-inline (refdb:csv-get-rows     vec)    (vector-ref  vec 1))
(define-inline (refdb:csv-get-cols     vec)    (vector-ref  vec 2))
(define-inline (refdb:csv-get-maxrow   vec)    (vector-ref  vec 3))
(define-inline (refdb:csv-get-maxcol   vec)    (vector-ref  vec 4))
(define-inline (refdb:csv-set-svec!    vec val)(vector-set! vec 0 val))
(define-inline (refdb:csv-set-rows!    vec val)(vector-set! vec 1 val))
(define-inline (refdb:csv-set-cols!    vec val)(vector-set! vec 2 val))
(define-inline (refdb:csv-set-maxrow!  vec val)(vector-set! vec 3 val))
(define-inline (refdb:csv-set-maxcol!  vec val)(vector-set! vec 4 val))
;; (define-inline (refdb:csv-get-svec     vec)    (vector-ref  vec 0))
;; (define-inline (refdb:csv-get-rows     vec)    (vector-ref  vec 1))
;; (define-inline (refdb:csv-get-cols     vec)    (vector-ref  vec 2))
;; (define-inline (refdb:csv-get-maxrow   vec)    (vector-ref  vec 3))
;; (define-inline (refdb:csv-get-maxcol   vec)    (vector-ref  vec 4))
;; (define-inline (refdb:csv-set-svec!    vec val)(vector-set! vec 0 val))
;; (define-inline (refdb:csv-set-rows!    vec val)(vector-set! vec 1 val))
;; (define-inline (refdb:csv-set-cols!    vec val)(vector-set! vec 2 val))
;; (define-inline (refdb:csv-set-maxrow!  vec val)(vector-set! vec 3 val))
;; (define-inline (refdb:csv-set-maxcol!  vec val)(vector-set! vec 4 val))

(define (get-dat results sheetname)
  (or (hash-table-ref/default results sheetname #f)
      (let ((tmp-vec  (make-refdb:csv)))
      (let ((tmp-vec  (actual-make-refdb:csv)))
	(hash-table-set! results sheetname tmp-vec)
	tmp-vec)))

(if (args:get-arg "-refdb2dat")
    (let* ((input-db (args:get-arg "-refdb2dat"))
	   (out-file (args:get-arg "-o"))
	   (out-fmt  (or (args:get-arg "-dumpmode") "scheme"))
566
567
568
569
570
571
572
573
574
575



576
577
578
579

580
581

582
583
584

585
586

587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609



610
611
612
613
614
615
616
569
570
571
572
573
574
575



576
577
578
579
580
581

582
583

584
585
586

587
588

589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609



610
611
612
613
614
615
616
617
618
619







-
-
-
+
+
+



-
+

-
+


-
+

-
+




















-
-
-
+
+
+







		   ;; (print "data=")
		   ;; (pp data)
		   (configf:map-all-hier-alist
		    data
		    (lambda (sheetname sectionname varname val)
		      ;; (print "sheetname: " sheetname ", sectionname: " sectionname ", varname: " varname ", val: " val)
		      (let* ((dat      (get-dat results sheetname))
			     (vec      (refdb:csv-get-svec dat))
			     (rownames (refdb:csv-get-rows dat))
			     (colnames (refdb:csv-get-cols dat))
			     (vec      (refdb:csv-svec dat))
			     (rownames (refdb:csv-rows dat))
			     (colnames (refdb:csv-cols dat))
			     (currrown (hash-table-ref/default rownames varname #f))
			     (currcoln (hash-table-ref/default colnames sectionname #f))
			     (rown     (or currrown 
					   (let* ((lastn   (refdb:csv-get-maxrow dat))
					   (let* ((lastn   (refdb:csv-maxrow dat))
						  (newrown (+ lastn 1)))
					     (refdb:csv-set-maxrow! dat newrown)
					     (refdb:csv-maxrow-set! dat newrown)
					     newrown)))
			     (coln     (or currcoln 
					   (let* ((lastn   (refdb:csv-get-maxcol dat))
					   (let* ((lastn   (refdb:csv-maxcol dat))
						  (newcoln (+ lastn 1)))
					     (refdb:csv-set-maxcol! dat newcoln)
					     (refdb:csv-maxcol-set! dat newcoln)
					     newcoln))))
			(if (not (sparse-array-ref vec 0 coln)) ;; (eq? rown 0)
			    (begin
			      (sparse-array-set! vec 0 coln sectionname)
			      ;; (print "sparse-array-ref " 0 "," coln "=" (sparse-array-ref vec 0 coln))
			      ))
			(if (not (sparse-array-ref vec rown 0)) ;; (eq? coln 0)
			    (begin
			      (sparse-array-set! vec rown 0 varname)
			      ;; (print "sparse-array-ref " rown "," 0 "=" (sparse-array-ref vec rown 0))
			      ))
			(if (not currrown)(hash-table-set! rownames varname rown))
			(if (not currcoln)(hash-table-set! colnames sectionname coln))
			;; (print "dat=" dat ", rown=" rown ", coln=" coln)
			(sparse-array-set! vec rown coln val)
			;; (print "sparse-array-ref " rown "," coln "=" (sparse-array-ref vec rown coln))
			)))
		   (for-each
		    (lambda (sheetname)
		      (let* ((sheetdat (get-dat results sheetname))
			     (svec     (refdb:csv-get-svec sheetdat))
			     (maxrow   (refdb:csv-get-maxrow sheetdat))
			     (maxcol   (refdb:csv-get-maxcol sheetdat))
			     (svec     (refdb:csv-svec sheetdat))
			     (maxrow   (refdb:csv-maxrow sheetdat))
			     (maxcol   (refdb:csv-maxcol sheetdat))
			     (fname    (if out-file 
					   (string-substitute "%s" sheetname out-file) ;; "/foo/bar/%s.csv")
					   (conc sheetname ".csv"))))
			(with-output-to-file fname
			  (lambda ()
			    ;; (print "Sheetname: " sheetname)
			    (let loop ((row       0)