Raise an error when trying to iterate over an infinite trie
This commit is contained in:
parent
a045d54071
commit
b7775efd9b
|
@ -21,6 +21,16 @@
|
||||||
outer-stx
|
outer-stx
|
||||||
(list temp1 temp2 pat match-pat))))
|
(list temp1 temp2 pat match-pat))))
|
||||||
|
|
||||||
|
;; trie projection symbol -> (U set exn:fail?)
|
||||||
|
;; tries to project the trie. If the resulting trie would be infinite, raise an
|
||||||
|
;; error, using the third argument to describe the pattern being projected.
|
||||||
|
;; If the resulting trie is finite, return it as a set.
|
||||||
|
(define (project-finite t proj pat)
|
||||||
|
(define s? (trie-project/set t (compile-projection (?! proj))))
|
||||||
|
(unless s?
|
||||||
|
(error "pattern projection created infinite trie:" pat))
|
||||||
|
s?)
|
||||||
|
|
||||||
(define-syntax (for-trie/fold stx)
|
(define-syntax (for-trie/fold stx)
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
[(_ ([acc-id acc-init] ...)
|
[(_ ([acc-id acc-init] ...)
|
||||||
|
@ -31,8 +41,7 @@
|
||||||
(with-syntax* ([(set-tmp loop-tmp proj-stx match-pat)
|
(with-syntax* ([(set-tmp loop-tmp proj-stx match-pat)
|
||||||
(helper #'pat_0 #'body)]
|
(helper #'pat_0 #'body)]
|
||||||
[new-acc (generate-temporary 'acc)])
|
[new-acc (generate-temporary 'acc)])
|
||||||
#`(let ([set-tmp (trie-project/set trie_0
|
#`(let ([set-tmp (project-finite trie_0 proj-stx 'pat_0)])
|
||||||
(compile-projection (?! proj-stx)))])
|
|
||||||
(for/fold/derived #,stx ([acc-id acc-init]
|
(for/fold/derived #,stx ([acc-id acc-init]
|
||||||
...)
|
...)
|
||||||
([loop-tmp (in-set set-tmp)])
|
([loop-tmp (in-set set-tmp)])
|
||||||
|
@ -166,5 +175,14 @@
|
||||||
([$x (make-trie 1 2 3)])
|
([$x (make-trie 1 2 3)])
|
||||||
(void)
|
(void)
|
||||||
(+ acc x))
|
(+ acc x))
|
||||||
6))
|
6)
|
||||||
|
;; projecting an infinite set out of an infinite trie raisies an error
|
||||||
|
(check-exn (lambda (e) (and (exn:fail? e) (not (exn:fail:contract? e))))
|
||||||
|
(lambda ()
|
||||||
|
(for-trie/list ([$x (pattern->trie 'x (projection->pattern ?))])
|
||||||
|
x)))
|
||||||
|
;; projecting something finite out is ok
|
||||||
|
(check-equal? (for-trie/list ([1 (pattern->trie 'x (projection->pattern ?))])
|
||||||
|
1)
|
||||||
|
(list 1)))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue