Megatest

Changes On Branch chicken-5
Login

Changes In Branch chicken-5 Excluding Merge-Ins

This is equivalent to a diff from 1597d0801e to 21bfa4f239

2024-09-26
02:20
Added missing dependency check-in: 2b965c1a05 user: matt tags: trunk
02:11
Porting mutils.scm to chicken 5, wip Leaf check-in: 21bfa4f239 user: matt tags: chicken-5
02:10
Ported adjutant.scm to chicken 5 check-in: 1597d0801e user: matt tags: trunk
2024-09-25
19:58
Added process registration stubs to api.scm check-in: 88fa1bd8c0 user: matt tags: trunk

Modified mutils/mutils.scm from [9fa9e34972] to [8c48eb6edc].

1
2
3
4
5
6
7
8
9
10
11
12
13






14
15
16





17
18
19
20
21



























22
23
24

25
26
27
28



29
30
31
32
33
34
35
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27





28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54



55




56
57
58
59
60
61
62
63
64
65













+
+
+
+
+
+



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







;; Copyright 2006-2011, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

;; This is from the perl world, a hash of hashes is a super easy way to keep a handle on
;; lots of disparate data
;;

(cond-expand
 (chicken-4
  (use sheme chicken))
 (chicken-5
  (import scheme chicken.base)))

(module mutils
    *

(import scheme)
    
(cond-expand

 (chicken-4
  (import chicken scheme
	  ;; data-structures posix
	  srfi-1
	  ;; srfi-13
	  srfi-69
   (import chicken scheme)
   (use chicken)
   (import posix
	  data-structures
	  ports
	  extras)
   (define pseudo-random-integer random)
   (define file-writable? file-write-access?))
 
 (chicken-5
  (import scheme
	  chicken.base
	  chicken.file
	  chicken.process-context
	  chicken.process
	  chicken.port
	  chicken.io
	  system-information
	  chicken.string
	  chicken.time
	  chicken.condition
	  chicken.random
	  )))

(import srfi-1
	;; srfi-13
	srfi-69
	  ports
	  extras
	  regex
	regex
	  posix
	  data-structures
	  matchable
	  )
	matchable
	sparse-vectors
	)

(define (mutils:hierhash-ref hh . keys)
  (if (null? keys)
      #f
      (let loop ((ht   hh)
		 (key  (car keys))
		 (tail (cdr keys)))
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
118
119
120
121
122
123
124


125
126
127
128
129
130
131







-
-







      (if (eof-object? l)
	  (reverse res)
	  (if (or (string-match comment l)
		  (string-match blank l))
	      (loop (read-line fh) res)
	      (loop (read-line fh) (cons l res)))))))

(use sparse-vectors)

;; this is a simple two dimensional sparse array

;; ONLY TWO DIMENSIONS!!! SEE ARRAY-LIB IF YOUR NEEDS ARE GREATER!!
;;
(define (mutils:make-sparse-array)
  (let ((a (make-sparse-vector)))
    (sparse-vector-set! a 0 (make-sparse-vector))
187
188
189
190
191
192
193
194
195


196
197
198
199
200
201
202
215
216
217
218
219
220
221


222
223
224
225
226
227
228
229
230







-
-
+
+







	   (apply mutils:hier-list-get @hierlist @path))))

;;======================================================================
;; Other utils
;;======================================================================

(define (check-write-create fpath)
  (and (file-write-access? fpath)
       (let ((fname (conc fpath "/.junk-" (current-seconds) "-" (random 10000))))
  (and (file-writable? fpath)
       (let ((fname (conc fpath "/.junk-" (current-seconds) "-" (pseudo-random-integer 10000))))
	 ;;(print "trying to create/remove " fname)
	 (handle-exceptions
	  exn
	  #f
	  (begin
	    (with-output-to-file fname
	      (lambda ()