Changeset 14334 in project


Ignore:
Timestamp:
04/22/09 08:00:51 (11 years ago)
Author:
Ivan Raikov
Message:

Ported digraph library to Chicken 4.

Location:
release/4/digraph
Files:
5 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/digraph/trunk/digraph-eggdoc.scm

    r12070 r14334  
    11
    2 (use eggdoc)
     2
     3(require-library eggdoc)
     4(import eggdoc)
    35
    46(define doc
     
    68     (name "digraph")
    79     (description "Directed graph in adjacency list format.")
    8      (author (url "http://chicken.wiki.br/ivan raikov" "Ivan Raikov"))
     10     (author (url "http://chicken.wiki.br/users/ivan-raikov" "Ivan Raikov"))
    911
    1012     (history
     13      (version "1.11" "Ported to Chicken 4")
    1114      (version "1.10" "Now using matchable extension")
    1215      (version "1.9" "Added procedures pred-list and succ-list")
  • release/4/digraph/trunk/digraph.meta

    r12070 r14334  
     1;;;; -*- Hen -*-
     2
    13((egg "digraph.egg") ; This should never change
    24
    35 ; List here all the files that should be bundled as part of your egg. 
    46
    5  (files "digraph.scm" "digraph-eggdoc.scm" "digraph.setup" "tests/run.scm")
     7 (files "digraph.scm" "digraph-eggdoc.scm" "digraph.setup" "tests")
    68
    79 ; Your egg's license:
     
    1618 ; A list of eggs digraph depends on.
    1719
    18  (needs testbase eggdoc dyn-vector syntax-case matchable)
     20 (needs eggdoc dyn-vector matchable)
    1921
    2022 (eggdoc "digraph-eggdoc.scm")
  • release/4/digraph/trunk/digraph.scm

    r12070 r14334  
    44;; Based on code from MLRISC
    55;;
    6 ;; Version $Revision$
    7 ;;
    8 ;;
    9 ;; Copyright 2007 Ivan Raikov and the Okinawa Institute of Science and Technology
     6;; Copyright 2007-2009 Ivan Raikov and the Okinawa Institute of Science and Technology.
    107;;
    118;;
     
    2320;; <http://www.gnu.org/licenses/>.
    2421
    25 (require-extension srfi-1)
    26 (require-extension dyn-vector)
    27 (require-extension syntax-case)
    28 (require-extension matchable)
    29 
    30 (define-extension digraph)
    31 
    32 (declare (export make-digraph))
     22(module digraph
     23
     24 (make-digraph)
     25                   
     26 (import scheme chicken data-structures extras )
     27
     28 (require-extension srfi-1 dyn-vector matchable )
    3329
    3430(define (digraph:error x . rest)
     
    241237        (else
    242238          (digraph:error 'selector ": unknown message " selector " sent to a graph"))))))
     239)
  • release/4/digraph/trunk/digraph.setup

    r12070 r14334  
     1;;;; -*- Hen -*-
    12
    23(define has-exports? (string>=? (chicken-version) "2.310"))
     
    56  (make-pathname #f fn ##sys#load-dynamic-extension))   
    67
    7 (compile -O2 -d0 -s
    8          ,@(if has-exports? '(-check-imports -emit-exports digraph.exports) '())
    9          digraph.scm -lchicken -ldl -lm)
     8(compile -O2 -d0 -s digraph.scm -j digraph)
     9(compile -O2 -d0 -s digraph.import.scm)
    1010
    11 (run (csi -qbs digraph-eggdoc.scm > digraph.html))
     11(run (csi -s digraph-eggdoc.scm > digraph.html))
    1212
    1313(install-extension
     
    1717
    1818  ; Files to install for your extension:
    19   `(,(dynld-name "digraph") "digraph.html"
    20     ,@(if has-exports? '("digraph.exports") (list)) )
     19  `(,(dynld-name "digraph") ,(dynld-name "digraph.import") )
    2120
    2221  ; Assoc list with properties for your extension:
    23   `((version 1.10)
     22  `((version 1.11)
    2423    (documentation "digraph.html")
    25     ,@(if has-exports? `((exports "digraph.exports")) (list)) ))
     24    ))
     25
  • release/4/digraph/trunk/tests/run.scm

    r11562 r14334  
    66;;
    77;;
    8 ;; Copyright 2007 Ivan Raikov and the Okinawa Institute of Science and Technology
     8;; Copyright 2007-2009 Ivan Raikov and the Okinawa Institute of Science and Technology
    99;;
    1010;; This program is free software; you can redistribute it and/or
     
    2929;;
    3030
    31 (require-extension srfi-1)
    32 (require-extension digraph)
    33 (require-extension testbase)
    34 (require-extension testbase-output-compact)
     31(require-library srfi-1 digraph test)
     32(import srfi-1 digraph test)
    3533
    36 (define-expect-unary pair?)
    3734
    3835(define used-by
     
    4744    (cons 'zag_o 'libzigzag_a) (cons 'libzigzag_a 'killerapp)))
    4845
     46(define g (void))
    4947
    50 (define-test digraph-test "digraph test"
    51   (initial
    52    (define g (void))
     48(define node-list
     49  (delete-duplicates
     50   (concatenate (list (map car used-by) (map cdr used-by)))))
    5351
    54    (define node-list
    55      (delete-duplicates
    56       (concatenate (list (map car used-by) (map cdr used-by)))))
     52(define node-ids
     53  (list-tabulate (length node-list) values))
    5754
    58    (define node-ids
    59      (list-tabulate (length node-list) values))
     55(define node-map  (zip node-list node-ids))
    6056
    61    (define node-map  (zip node-list node-ids)) )
    62 
    63   ;; can we make a graph
    64   (expect-set! g (make-digraph 'depgraph "dependency graph"))
     57(test-group "digraph test"
     58  (let ((g (make-digraph 'depgraph "dependency graph")))
    6559
    6660  ;; add the nodes to the graph
    67   (test-eval 'add-nodes
    68              (for-each (lambda (i n) ((g 'add-node!) i n))
    69                        node-ids node-list))
     61    (for-each (lambda (i n) ((g 'add-node!) i n))
     62              node-ids node-list)
    7063
    7164  ;; make sure all nodes got inserted
    72   (test/equal 'nodes-inserted?
     65  (test "add nodes to the graph"
    7366   ((g 'nodes))
    7467   '((14 killerapp)
     
    7972
    8073  ;; add the edges to the graph
    81   (test/collect 'add-edges
    82     (for-each (lambda (e)
    83                 (collect-test (expect-pair (conc "valid edge: " e) e))
    84                 (let* ((ni (car e))
    85                        (nj (cdr e))
    86                        (i (car (alist-ref ni node-map)))
    87                        (j (car (alist-ref nj node-map))))
    88                   (collect-test
    89                     (expect-success "adding edge"
    90                       ((g 'add-edge!) (list i j (format "~A->~A" ni nj))))) ) )
    91               used-by))
     74  (for-each (lambda (e)
     75              (let* ((ni (car e))
     76                     (nj (cdr e))
     77                     (i (car (alist-ref ni node-map)))
     78                     (j (car (alist-ref nj node-map))))
     79                ((g 'add-edge!) (list i j (format "~A->~A" ni nj)))))
     80            used-by)
    9281
    9382   ;; make sure all edges got correctly created
    94    (test/equal 'edges-inserted?
    95                ((g 'edges))
    96                '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
    97                 (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
    98                 (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
    99                 (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
    100                 (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
    101                 (3 4 "zow_h->foo_cpp") (2 11 "boz_h->zag_cpp")
    102                 (2 9 "boz_h->zig_cpp") (2 6 "boz_h->bar_cpp")
    103                 (1 11 "yow_h->zag_cpp") (1 6 "yow_h->bar_cpp")
    104                 (0 1 "dax_h->yow_h") (0 6 "dax_h->bar_cpp") (0 4 "dax_h->foo_cpp")))
     83   (test "add edges to the graph"
     84    ((g 'edges))
     85    '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
     86      (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
     87      (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
     88      (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
     89      (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
     90      (3 4 "zow_h->foo_cpp") (2 11 "boz_h->zag_cpp")
     91      (2 9 "boz_h->zig_cpp") (2 6 "boz_h->bar_cpp")
     92      (1 11 "yow_h->zag_cpp") (1 6 "yow_h->bar_cpp")
     93      (0 1 "dax_h->yow_h") (0 6 "dax_h->bar_cpp") (0 4 "dax_h->foo_cpp")))
    10594
    10695    ;; remove node 0 from graph
    107    (test-eval 'remove-node-0
    108               ((g 'remove-node!) 0))
     96   ((g 'remove-node!) 0)
    10997
    11098   ;; make sure node 0 got removed
    111    (test/equal 'node-0-removed?
    112                ((g 'nodes))
    113                '((14 killerapp) (13 libzigzag_a) (12 zag_o)
    114                 (11 zag_cpp) (10 zig_o) (9 zig_cpp) (8 libfoobar_a)
    115                 (7 bar_o) (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h)
    116                 (2 boz_h) (1 yow_h)))
     99   (test "remove node 0"
     100    ((g 'nodes))
     101    '((14 killerapp) (13 libzigzag_a) (12 zag_o)
     102      (11 zag_cpp) (10 zig_o) (9 zig_cpp) (8 libfoobar_a)
     103      (7 bar_o) (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h)
     104      (2 boz_h) (1 yow_h)))
    117105
    118106    ;; make sure the edges of node 0 got removed
    119    (test/equal 'node-0-edges-removed?
    120                ((g 'edges))
    121                '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
    122                 (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
    123                 (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
    124                 (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
    125                 (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
    126                 (3 4 "zow_h->foo_cpp") (2 11 "boz_h->zag_cpp")
    127                 (2 9 "boz_h->zig_cpp") (2 6 "boz_h->bar_cpp")
    128                 (1 11 "yow_h->zag_cpp") (1 6 "yow_h->bar_cpp")))
     107   (test "make sure node 0 edges got removed"
     108    ((g 'edges))
     109    '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
     110      (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
     111      (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
     112      (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
     113      (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
     114      (3 4 "zow_h->foo_cpp") (2 11 "boz_h->zag_cpp")
     115      (2 9 "boz_h->zig_cpp") (2 6 "boz_h->bar_cpp")
     116      (1 11 "yow_h->zag_cpp") (1 6 "yow_h->bar_cpp")))
    129117
    130118    ;; remove node 2 from graph
    131    (test-eval 'remove-node-2
    132     ((g 'remove-node!) 2))
     119   ((g 'remove-node!) 2)
    133120
    134     ;; make sure node 2 got removed
    135    (test/equal 'node-0-removed?
    136                ((g 'nodes))
    137                '((14 killerapp) (13 libzigzag_a) (12 zag_o)
    138                 (11 zag_cpp) (10 zig_o) (9 zig_cpp) (8 libfoobar_a)
    139                 (7 bar_o) (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h) (1 yow_h)))
     121   ;; make sure node 2 got removed
     122   (test "remove node 2"
     123    ((g 'nodes))
     124    '((14 killerapp) (13 libzigzag_a) (12 zag_o)
     125      (11 zag_cpp) (10 zig_o) (9 zig_cpp) (8 libfoobar_a)
     126      (7 bar_o) (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h) (1 yow_h)))
    140127
    141     ;; make sure the edges of node 2 got removed
    142    (test/equal 'node-2-edges-removed?
    143                ((g 'edges))
    144                '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
    145                  (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
    146                  (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
    147                  (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
    148                  (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
    149                  (3 4 "zow_h->foo_cpp") (1 11 "yow_h->zag_cpp")
    150                  (1 6 "yow_h->bar_cpp"))))
    151 
    152 (test::styler-set! digraph-test test::output-style-compact)
    153 (run-test "digraph test")
     128   ;; make sure the edges of node 2 got removed
     129   (test "make sure node 2 edges got removed"
     130    ((g 'edges))
     131    '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
     132      (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
     133      (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
     134      (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
     135      (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
     136      (3 4 "zow_h->foo_cpp") (1 11 "yow_h->zag_cpp")
     137      (1 6 "yow_h->bar_cpp")))
     138  ))
     139 
Note: See TracChangeset for help on using the changeset viewer.