Fix drdr props.

Fix the ttt tests (which I don't think have been run in years).
Fix the lists shootout benchmark to use mpairs.
Fix the regexmatch shootout benchmark, although it still needs input.
Require a current version of ssax, so that it compiles.
Fix finding the collections path.

svn: r16654
This commit is contained in:
Sam Tobin-Hochstadt 2009-11-10 15:41:32 +00:00
parent 0c61de1497
commit 7a77367040
8 changed files with 25 additions and 19 deletions

View File

@ -1,8 +1,9 @@
(let ([dir (build-path (collection-path "mzlib")
(let ([dir (build-path (collection-path "scheme")
"private")])
(with-input-from-file (build-path dir "class-internal.ss")
(lambda ()
(parameterize ([current-load-relative-directory dir])
(parameterize ([current-load-relative-directory dir]
[read-accept-reader #t])
(let ([s (read-syntax)])
(time (compile s)))))))

View File

@ -1,6 +1,6 @@
(require (lib "scheme-lexer.ss" "syntax-color"))
(require (lib "scheme-lexer.ss" "syntax-color") scheme/gui/base)
(define path "~/proj/plt/collects/framework/private/frame.ss")
(define path (build-path (collection-path "framework" "private") "frame.ss"))
(define content
(with-input-from-file path

View File

@ -1,4 +1,4 @@
(require (planet "ssax.ss" ("lizorkin" "ssax.plt" 1 3)))
(require (planet "ssax.ss" ("lizorkin" "ssax.plt" 2)))
(collect-garbage)
(time (void (ssax:xml->sxml

View File

@ -1,34 +1,35 @@
(module lists mzscheme
(require scheme/mpair)
(define SIZE 10000)
(define (sequence start stop)
(if (> start stop)
'()
(cons start (sequence (+ start 1) stop))))
(mcons start (sequence (+ start 1) stop))))
(define (head-to-tail! headlist taillist)
(when (null? taillist) (begin
(set! taillist (list (car headlist)))
(set! headlist (cdr headlist))))
(set! taillist (mlist (mcar headlist)))
(set! headlist (mcdr headlist))))
(letrec ((htt-helper (lambda (dest)
(when (not (null? headlist))
(let ((headlink headlist))
(set-cdr! dest headlink)
(set! headlist (cdr headlist))
(set-mcdr! dest headlink)
(set! headlist (mcdr headlist))
(htt-helper headlink))))))
(htt-helper taillist)
(values headlist taillist)))
(define (test-lists)
(let* ([L1 (sequence 1 SIZE)]
[L2 (append L1 '())]
[L2 (mappend L1 '())]
[L3 '()])
(set!-values (L2 L3) (head-to-tail! L2 L3))
(set!-values (L3 L2) (head-to-tail! (reverse! L3) L2))
(set! L1 (reverse! L1))
(cond ((not (= SIZE (car L1))) 0)
(set!-values (L3 L2) (head-to-tail! (mreverse! L3) L2))
(set! L1 (mreverse! L1))
(cond ((not (= SIZE (mcar L1))) 0)
((not (equal? L1 L2)) 0)
(else (length L1)))))
(else (mlength L1)))))
(define (main args)
(let ((result #f))

View File

@ -38,7 +38,7 @@
(else
(set! phonelines (cons line phonelines))
(loop (read-line)))))
(set! phonelines (reverse! phonelines))
(set! phonelines (reverse phonelines))
(do ([n (string->number n) (sub1 n)])
((negative? n))
(let loop ((phones phonelines)

View File

@ -32,14 +32,14 @@
(require srfi/29/localization)
(require srfi/30)
(require srfi/31/rec)
(require (lib "srfi/32/sort.scm"))
(require srfi/32/sort)
(require srfi/34/exception)
(require srfi/35)
(require srfi/35/condition)
(require srfi/38)
(require srfi/39)
(require srfi/40/stream)
(require srfi/42/comprehensions)
(require (lib "srfi/42/comprehensions.scm"))
(require srfi/43/vector-lib)
(require srfi/45/lazy)
(require srfi/48/format)

View File

@ -11,6 +11,8 @@
;; It relies on list-library.ss.
(load "listlib.ss")
;; representations of fields, states, and collections of states
(define BLANK 0)

View File

@ -8,9 +8,11 @@
;; It relies on list-library.ss.
(load "listlib.ss")
;; representations of fields, states, and collections of states
(define null '())
(define-structure (entry x y who))
(define-struct entry ( x y who))
(define entry-field
(lambda (an-entry)
(list (entry-x an-entry) (entry-y an-entry))))