Changeset 25487 in project
- Timestamp:
- 11/10/11 07:32:29 (9 years ago)
- Location:
- release/4/interval-digraph/trunk
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/interval-digraph/trunk/interval-digraph.scm
r24779 r25487 344 344 345 345 346 (define (foreach-edge f) ((succs 'for-each-ascending) 347 (lambda (i v) (cis:foreach (lambda (j) (f i j)) v)))) 346 (define (foreach-edge f) 347 ((succs 'for-each-ascending) 348 (lambda (e) 349 (let ((i (car e))) 350 (cis:foreach (lambda (j) (f i j)) (cdr e))) 351 ))) 352 353 354 (define (foreach-edge-with-property f p) 355 (let ((props (alist-ref p edge-props))) 356 ((succs 'for-each-ascending) 357 (lambda (e) 358 (let* ((i (car e)) 359 (i-prop ((props 'get-value) (cis:singleton i) #f))) 360 (if i-prop 361 (cis:foreach (lambda (j) (f i j ((i-prop 'get-value) (cis:singleton j) #f))) (cdr e)) 362 (cis:foreach (lambda (j) (f i j #f)) (cdr e)))) 363 )) 364 )) 348 365 349 366 … … 379 396 ((foreach-node) foreach-node) 380 397 ((foreach-node-with-label) foreach-node-with-label) 381 ((foreach-edge) foreach-edge) 398 ((foreach-edge) foreach-edge) 399 ((foreach-edge-with-property) foreach-edge-with-property) 400 382 401 383 402 ;; transformers … … 470 489 (node-interval-property (lambda (p i) (or ((a 'node-interval-property) p i) ((b 'node-interval-property) p i)))) 471 490 (node-label (lambda (i) (or ((a 'node-label) i) ((b 'node-label) i)))) 472 (edge-property-list-keys (lambda () (delete-duplicates (append ((a 'edge-property-list-keys)) ((b 'edge-property-list-keys)))))) 491 (edge-property-list-keys (lambda () (delete-duplicates (append ((a 'edge-property-list-keys)) ((b 'edge-property-list-keys)))))) 492 (edge-property-list-map (lambda () (delete-duplicates (append ((a 'edge-property-list-map)) ((b 'edge-property-list-map)))))) 473 493 (edge-property (lambda (p i j) (or ((a 'edge-property) p i j) ((b 'edge-property) i j)))) 474 494 (edge-interval-property (lambda (p i j) (or ((a 'edge-interval-property) p i j) ((b 'edge-interval-property) i j)))) … … 545 565 ((node-label) node-label) 546 566 ((edge-property) edge-property) 547 ((edge-property-list-keys) edge-property-list-keys) 567 ((edge-property-list-keys) edge-property-list-keys) 568 ((edge-property-list-map) edge-property-list-map) 548 569 ((foreach-node) foreach-node) 549 570 ((foreach-node-with-label) foreach-node-with-label) … … 573 594 574 595 (define (rename-nodes ns) (map (lambda (x) (list (fx+ k x))) ns)) 575 (define (rename-nodes-with-labels ns) (map (lambda (x) (list (fx+ k (car x) (cadr x)))) ns))596 (define (rename-nodes-with-labels ns) (map (lambda (x) (list (fx+ k (car x)) (cadr x))) ns)) 576 597 (define (rename-edges es) (map (lambda (e) (list (fx+ k (car e)) (fx+ k (cadr e)))) es)) 577 598 (define (rename-edges-with-labels es) (map (lambda (e) (list (fx+ k (car e)) (fx+ k (cadr e)) (caddr e))) es)) … … 601 622 (node-label (lambda (i) ((a 'node-label) (fx- i k)))) 602 623 (edge-property-list-keys (a 'edge-property-list-keys)) 624 (edge-property-list-map (a 'edge-property-list-map)) 603 625 (edge-property (lambda (p i j) ((a 'edge-property) p (fx- i k) (fx- j k) ))) 604 626 (edge-interval-property (lambda (p i j) ((a 'edge-interval-property) p (cis:shift (fxneg k) i) (cis:shift (fxneg k) j) ))) … … 657 679 ((node-interval-property) node-interval-property) 658 680 ((node-label) node-label) 659 ((edge-property-list-keys) edge-property-list-keys) 681 ((edge-property-list-keys) edge-property-list-keys) 682 ((edge-property-list-map) edge-property-list-map) 660 683 ((edge-property) edge-property) 661 684 ((foreach-node) foreach-node) -
release/4/interval-digraph/trunk/interval-digraph.setup
r24779 r25487 6 6 (required-extension-version 'rb-tree 4.0) 7 7 8 (compile -O2 -d0 - s interval-digraph.scm -j interval-digraph)8 (compile -O2 -d0 -S -s interval-digraph.scm -j interval-digraph) 9 9 (compile -O2 -d0 -s interval-digraph.import.scm) 10 10 … … 18 18 19 19 ; Assoc list with properties for your extension: 20 `((version 2. 0)20 `((version 2.1) 21 21 )) -
release/4/interval-digraph/trunk/tests/run.scm
r24779 r25487 134 134 (cis:singleton 220))) 135 135 136 ((g 'foreach-edge) 137 (lambda (i j) 138 (test "foreach-edge" #t (cis:in? i sources) ) 139 (test "foreach-edge" #t (cis:in? j targets) ))) 140 141 142 ((g 'foreach-edge-with-property) 143 (lambda (i j v) 144 (test "foreach-edge-with-property" #t (cis:in? i sources) ) 145 (test "foreach-edge-with-property" #t (cis:in? j targets) ) 146 (if (and (= i 10) (= j 220)) 147 (test "foreach-edge-with-property" "chicken" v)) 148 ) 149 'test 150 ) 151 152 136 153 )) 137 154 ))
Note: See TracChangeset
for help on using the changeset viewer.