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

43
prospect/route.rkt
View File

@ -871,29 +871,28 @@
(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)]))
(define source-id (gensym 'i)) (define source-id (gensym 'i))
(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
[(wildcard-sequence k) (add-edge! source-id #f k)] [#f (void)]
[(success _) (void)] [(wildcard-sequence k) (add-edge! source-id #f k)]
[(? treap? h) (treap-fold h [(success _) (void)]
(lambda (seed k v) (add-edge! source-id k v)) [(? treap? h) (treap-fold h
(void))]) (lambda (seed k v) (add-edge! source-id k v))
entry))))) (void))])
entry))))
(walk m) (walk m)
(list (hash-values nodes) edges)) (list (hash-values nodes) edges))