cs: implement list? with list-assuming-immutable?

Use new support from Chez Scheme for constant-time `list?`.
This commit is contained in:
Matthew Flatt 2020-04-25 15:53:38 -06:00
parent ed617d76aa
commit 1d41f0c5b8
4 changed files with 4 additions and 42 deletions

View File

@ -12,7 +12,7 @@
(define collection 'multi) (define collection 'multi)
(define version "7.7.0.3") (define version "7.7.0.4")
(define deps `("racket-lib" (define deps `("racket-lib"
["racket" #:version ,version])) ["racket" #:version ,version]))

View File

@ -2,7 +2,7 @@
;; Check to make we're using a build of Chez Scheme ;; Check to make we're using a build of Chez Scheme
;; that has all the features we need. ;; that has all the features we need.
(define-values (need-maj need-min need-sub need-dev) (define-values (need-maj need-min need-sub need-dev)
(values 9 5 3 27)) (values 9 5 3 28))
(unless (guard (x [else #f]) (eval 'scheme-fork-version-number)) (unless (guard (x [else #f]) (eval 'scheme-fork-version-number))
(error 'compile-file (error 'compile-file

View File

@ -12,45 +12,7 @@
;; a sequence of `CHECK-SKIP-N`+1 results so one will hit when ;; a sequence of `CHECK-SKIP-N`+1 results so one will hit when
;; checking every `CHECK-SKIP-N` pairs. ;; checking every `CHECK-SKIP-N` pairs.
(define-thread-local lists (make-weak-eq-hashtable)) (define (list? v) (list-assuming-immutable? v))
(define CHECK-AFTER-LEN 64)
(define CHECK-SKIP-N 4)
(define (list? v)
(let loop ([v v] [count 0])
(cond
[(null? v) #t]
[(not (pair? v)) #f]
[else
(cond
[(fx<= count CHECK-AFTER-LEN)
(loop (cdr v) (fx+ count 1))]
[else
(let ([lists lists])
(let loop ([fast (cdr v)] [slow v] [slow-step? #f] [countdown 0])
(let ([return (lambda (result)
(eq-hashtable-set! lists slow result)
(unless (eq? slow fast)
(let loop ([slow (cdr slow)] [count CHECK-SKIP-N])
(unless (or (eq? slow fast)
(fx= count 0))
(eq-hashtable-set! lists slow result)
(loop (cdr slow) (fx- count 1)))))
result)])
(cond
[(null? fast) (return #t)]
[(not (pair? fast)) (return #f)]
[(eq? fast slow) (return #f)] ; cycle
[(fx= 0 countdown)
(let ([is-list? (eq-hashtable-ref lists fast none)])
(cond
[(eq? is-list? none)
(loop (cdr fast) (if slow-step? (cdr slow) slow) (not slow-step?) CHECK-SKIP-N)]
[else
(return is-list?)]))]
[else
(loop (cdr fast) (if slow-step? (cdr slow) slow) (not slow-step?) (fx- countdown 1))]))))])])))
(define (append-n l n l2) (define (append-n l n l2)
(cond (cond

View File

@ -16,7 +16,7 @@
#define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 7 #define MZSCHEME_VERSION_Y 7
#define MZSCHEME_VERSION_Z 0 #define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 3 #define MZSCHEME_VERSION_W 4
/* A level of indirection makes `#` work as needed: */ /* A level of indirection makes `#` work as needed: */
#define AS_a_STR_HELPER(x) #x #define AS_a_STR_HELPER(x) #x