Changeset 10005 in project for release/3/rgraph/trunk/rgraph.scm


Ignore:
Timestamp:
03/21/08 02:51:13 (13 years ago)
Author:
Kon Lovett
Message:

Fixes for wrong param order w/ srfi-69 procs, misspelled varaiables, no feature for srfi-40, missing param. (Did this ever work?).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/rgraph/trunk/rgraph.scm

    r9978 r10005  
    55(define rgraph-doc-usage-imports #t)
    66(define rgraph-doc-usage-debugging #t)
     7
    78(cond-expand
    89  (rgraph-nodebug
     10
    911    (define-macro rgraph-debug (lambda (body) '())))
     12
    1013  ((or rgraph-debug csi)
     14
    1115   (define-macro rgraph-debug (lambda (body) body)))
    12   (else (define-macro rgraph-debug (lambda (body) '()))))
     16
     17  (else
     18
     19   (define-macro rgraph-debug (lambda (body) '()))))
     20
    1321(define rgraph-doc-adjacency-list #t)
     22
    1423(define-macro
    1524  define-adjacency-list
     
    2231           directed?
    2332           bidirectional?)
     33
    2434    (define (pad . args)
    2535      (string->symbol
     
    3040                            (else "UNKNOWN_PAD_SYMBOL")))
    3141                    args))))
     42
    3243    (define (when-bi . in-args)
    3344      (if bidirectional? in-args '()))
     45
    3446    (define (when-bi-or-dir . in-args)
    3547      (if (or bidirectional? directed?) in-args '()))
     48
    3649    (let* ((NVP (length vertex-properties))
    3750           (NEP (length edge-properties))
     
    103116         (define ,constructor
    104117           (lambda ()
    105              (let* ((pgetters (make-hash-table eq? ,(+ NVP NEP)))
    106                     (psetters (make-hash-table eq? ,(+ NVP NEP)))
     118             (let* ((pgetters (make-hash-table eq? hash-by-identity ,(+ NVP NEP)))
     119                    (psetters (make-hash-table eq? hash-by-identity ,(+ NVP NEP)))
    107120                    (rec (,make-rec #f pgetters psetters)))
    108121               (,set-rec-vl! rec (,vl-constructor rec))
     
    199212                    ,bidirectional?))
    200213                algorithms)))))
     214
    201215(define rgraph-doc-vl-vector #t)
     216
    202217(define-macro
    203218  define-vl-vector
     
    208223           vertex-properties
    209224           get-vl)
     225
    210226    (define (pad . args)
    211227      (string->symbol
     
    216232                            (else "UNKNOWN_PAD_SYMBOL")))
    217233                    args))))
     234
    218235    (define plus (if streamed? "*" ""))
     236
    219237    (define prefix-plus (if streamed? "stream-" ""))
     238
    220239    (define (when-bi . in-args)
    221240      (if bidirectional? in-args '()))
     241
    222242    (define (unless-bi . in-args)
    223243      (if bidirectional? '() in-args))
     244
    224245    (let* ((for-each+ (pad prefix-plus "for-each"))
    225246           (map+ (pad prefix-plus "map"))
     
    432453               (,set-vl-num! vl 0)
    433454               (,set-vl-vec! vl (make-vector 0)))))))))
     455
    434456(define rgraph-doc-vl-hash #t)
     457
    435458(define-macro
    436459  define-vl-hash
     
    441464           vertex-properties
    442465           get-vl)
     466
    443467    (define (pad . args)
    444468      (string->symbol
     
    449473                            (else "UNKNOWN_PAD_SYMBOL")))
    450474                    args))))
     475
    451476    (define plus (if streamed? "*" ""))
     477
    452478    (define prefix-plus (if streamed? "stream-" ""))
     479
    453480    (define (when-bi . in-args)
    454481      (if bidirectional? in-args '()))
     482
    455483    (define (unless-bi . in-args)
    456484      (if bidirectional? '() in-args))
     485
    457486    (let* ((for-each+ (pad prefix-plus "for-each"))
    458487           (map+ (pad prefix-plus "map"))
     
    600629                      (let ((v^u (,edge g v u)))
    601630                        (when v^u (,remove-edge! g v^u)))))
    602                (hash-table-remove! table u))))
     631               (hash-table-delete! table u))))
    603632         (define ,vertex-eq?
    604633           (lambda (g u v)
     
    635664           (lambda (g)
    636665             (let* ((vl (,get-vl g)) (table (,vl-table vl)))
     666               #;(hash-table-clear! table)
    637667               (##sys#setslot table 1 (make-vector (##sys#size (##sys#slot table 1)) '())))))))))
     668
    638669(define rgraph-doc-el-slist #t)
     670
    639671(define-macro
    640672  define-el-slist
     
    644676           bidirectional?
    645677           edge-properties)
     678
    646679    (define (pad . args)
    647680      (string->symbol
     
    652685                            (else "UNKNOWN_PAD_SYMBOL")))
    653686                    args))))
     687
    654688    (define (when-bi . in-args)
    655689      (if bidirectional? in-args '()))
     690
    656691    (let* ((NP (length edge-properties))
    657692           (el (pad GTYPE "-edge-list"))
     
    803838             ,@(when-bi
    804839                 `(for-each x (,el-tlist (,in-edge-list g u))))))))))
     840
    805841(define rgraph-doc-el-hash #t)
     842
    806843(define-macro
    807844  define-el-hash
     
    811848           bidirectional?
    812849           edge-properties)
     850
    813851    (define (pad . args)
    814852      (string->symbol
     
    819857                            (else "UNKNOWN_PAD_SYMBOL")))
    820858                    args))))
     859
    821860    (define (when-bi . in-args)
    822861      (if bidirectional? in-args '()))
     862
    823863    (let* ((NP (length edge-properties))
    824864           (el (pad GTYPE "-edge-list"))
     
    886926           (lambda (g)
    887927             (make-hash-table
    888                (lambda (a b) (,vertex-eq? g a b)))))
     928               (lambda (a b) (,vertex-eq? g a b))
     929               hash)))
    889930         (define ,constructor
    890931           (lambda (g) (,make-el (,pre-constructor g))))
     
    917958             (let* ((u-thash (,el-thash u-el)))
    918959               (unless
    919                  (hash-table-remove! u-thash v)
     960                 (hash-table-delete! u-thash v)
    920961                 (error "Could not remove directed edge"
    921962                        g
     
    935976           (lambda (g u u-el out?)
    936977             (hash-table-map
     978               (,el-thash u-el)
    937979               (lambda (v v-rec)
    938                  (if out? (cons u v-rec) (,edge g v u)))
    939                (,el-thash u-el))))
     980                 (if out? (cons u v-rec) (,edge g v u))))))
    940981         (define ,edges*
    941982           (lambda (g u u-el out?)
     
    9601001               (hash-table-set! new-thash (proc v) v-rec))
    9611002             (hash-table-walk
    962                (lambda (v v-rec) (x! new-out-thash v v-rec))
    963                (,el-thash (,out-edge-list g u)))
     1003               (,el-thash (,out-edge-list g u))
     1004               (lambda (v v-rec) (x! new-out-thash v v-rec)))
    9641005             (,set-el-thash!
    9651006              (,out-edge-list g u)
     
    9671008             ,@(when-bi
    9681009                 `(hash-table-walk
    969                     (lambda (v v-rec) (x! new-in-thash v v-rec))
    970                     (,el-thash (,in-edge-list g u)))
     1010                    (,el-thash (,in-edge-list g u))
     1011                    (lambda (v v-rec) (x! new-in-thash v v-rec)))
    9711012                 `(,set-el-thash! (,in-edge-list g u) new-in-thash))))))))
     1013
    9721014(define rgraph-doc-visitors #t)
    9731015(define rgraph-doc-properties #t)
    9741016(define rgraph-doc-let-rgraph #t)
     1017
    9751018(define-macro
    9761019  let-rgraph
    9771020  (lambda (GTYPE . rest)
     1021
    9781022    (define plus
    9791023      (cond-expand (srfi-40 "*") (else "")))
     1024
    9801025    (define prefix-plus
    9811026      (cond-expand (srfi-40 "stream-") (else "")))
     1027
    9821028    (define (pad . args)
    9831029      (string->symbol
     
    9881034                            (else "UNKNOWN_PAD_SYMBOL")))
    9891035                    args))))
     1036
    9901037    (let ((for-each+ (pad prefix-plus "for-each"))
    9911038          (map+ (pad prefix-plus "map"))
     
    10451092             (edge-at ,edge-at))
    10461093         ,@rest))))
     1094
    10471095(define rgraph-doc-fill-graph! #t)
     1096
    10481097(define-macro
    10491098  (import-fill-graph!
     
    10541103    directed?
    10551104    bidirectional?)
     1105
    10561106  (define (pad . args)
    10571107    (string->symbol
     
    10621112                          (else "UNKNOWN_PAD_SYMBOL")))
    10631113                  args))))
     1114
    10641115  (define (when-bi . in-args)
    10651116    (if bidirectional? in-args '()))
     1117
    10661118  (let ((algorithm (pad GTYPE "-fill-graph!"))
    10671119        (vertex-eq? (pad GTYPE "-vertex-eq?"))
     
    10901142           edges)
    10911143         g))))
     1144
    10921145(define rgraph-doc-dfs #t)
    1093 (define rgraph-doc-dfs #t)
     1146
    10941147(define-macro
    10951148  (import-depth-first-search
     
    11001153    directed?
    11011154    bidirectional?)
     1155
    11021156  (define (pad . args)
    11031157    (string->symbol
     
    11081162                          (else "UNKNOWN_PAD_SYMBOL")))
    11091163                  args))))
     1164
    11101165  (define (when-bi . in-args)
    11111166    (if bidirectional? in-args '()))
     1167
    11121168  `(begin
    11131169     ,@(map (lambda (streamed?)
     
    11871243                              #f)))))))
    11881244            (if streamed? (list #f #t) (list #f)))))
     1245
    11891246(define rgraph-doc-dfv #t)
     1247
    11901248(define-macro
    11911249  (import-depth-first-visit
     
    11961254    directed?
    11971255    bidirectional?)
     1256
     1257  (define (pad . args)
     1258    (string->symbol
     1259      (apply string-append
     1260             (map (lambda (a)
     1261                    (cond ((string? a) a)
     1262                          ((symbol? a) (symbol->string a))
     1263                          (else "UNKNOWN_PAD_SYMBOL")))
     1264                  args))))
     1265
    11981266  `(begin
    11991267     ,@(map (lambda (streamed?)
     
    12041272                    (depth-first-search+
    12051273                      (pad GTYPE "-depth-first-search" plus)))
    1206                 `(define ,algorithm
     1274                `(define ,algorithm+
    12071275                   (lambda (g dfs-visitor color-map u)
    12081276                     (,depth-first-search+
     
    12121280                      (cons 'depth-first-visit u))))))
    12131281            (if streamed? (list #f #t) (list #f)))))
    1214 (define rgraph-doc-topsort #t)
     1282
    12151283(define rgraph-doc-topsort #t)
    12161284(define rgraph-doc-topsort* #t)
     1285
    12171286(define-macro
    12181287  (import-topological-sort
     
    12231292    directed?
    12241293    bidirectional?)
     1294
    12251295  (define (pad . args)
    12261296    (string->symbol
     
    12311301                          (else "UNKNOWN_PAD_SYMBOL")))
    12321302                  args))))
     1303
    12331304  `(begin
    12341305     ,@(map (lambda (streamed?)
     
    13051376                         `first)))))
    13061377            (if streamed? (list #f #t) (list #f)))))
     1378
    13071379(define rgraph-doc-part-fidmat #t)
    13081380(define fidmat-check #t)
    13091381(define fidmat-debug #t)
     1382
    13101383(define-record partition-fm cost balance vertex)
     1384
    13111385(define-macro
    13121386  (import-partition-fidmat
     
    13171391    directed?
    13181392    bidirectional?)
     1393
    13191394  (define (pad . args)
    13201395    (string->symbol
     
    13251400                          (else "UNKNOWN_PAD_SYMBOL")))
    13261401                  args))))
     1402
    13271403  (define (when-bi . in-args)
    13281404    (if bidirectional? in-args '()))
     1405
    13291406  (define check
    13301407    (pad GTYPE "-partition-fidmat-check"))
     1408
    13311409  (define debug
    13321410    (pad GTYPE "-partition-fidmat-debug"))
     1411
    13331412  `(begin
    13341413     (define ,check #f)
     
    15551634                                      (loop1 c))))))))))))
    15561635            (if streamed? (list #f #t) (list #f)))))
     1636
    15571637(define rgraph-doc-partition-fidmat-check #t)
    15581638(define rgraph-doc-partition-fidmat-debug #t)
Note: See TracChangeset for help on using the changeset viewer.