syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Handle empty matchers better in dot rendering

This commit is contained in:
Tony Garnock-Jones 2015-07-14 17:56:10 -04:00
parent b2e94f63b4
commit 2e3a8fceaa
1 changed files with 21 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
prospect/route.rkt
View File

@ -871,16 +871,14 @@
(define nodes (hasheq)) (define nodes (hasheq))
(define edges '()) (define edges '())
(define (add-edge! source-id label target) (define (add-edge! source-id label target)
(let ((target-id (walk target))) (set! edges (cons (list source-id label (walk target)) edges)))
(when target-id
(set! edges (cons (list source-id label target-id) edges)))))
(define (walk m) (define (walk m)
(and m
(car (car
(hash-ref nodes m (hash-ref nodes m
(lambda () (lambda ()
(define node-info (define node-info
(match m (match m
[#f (list 'fail)]
[(wildcard-sequence _) (list 'tail)] [(wildcard-sequence _) (list 'tail)]
[(success v) (list 'ok v)] [(success v) (list 'ok v)]
[(? treap?) (list 'branch)])) [(? treap?) (list 'branch)]))
@ -888,12 +886,13 @@
(define entry (cons source-id node-info)) (define entry (cons source-id node-info))
(set! nodes (hash-set nodes m entry)) (set! nodes (hash-set nodes m entry))
(match m (match m
[#f (void)]
[(wildcard-sequence k) (add-edge! source-id #f k)] [(wildcard-sequence k) (add-edge! source-id #f k)]
[(success _) (void)] [(success _) (void)]
[(? treap? h) (treap-fold h [(? treap? h) (treap-fold h
(lambda (seed k v) (add-edge! source-id k v)) (lambda (seed k v) (add-edge! source-id k v))
(void))]) (void))])
entry))))) entry))))
(walk m) (walk m)
(list (hash-values nodes) edges)) (list (hash-values nodes) edges))