adjust psyntax benchmark

The psyntax implementation relies on 3-D syntax like
   (let ([s (string #\i)])
     (eq? s (eval `',s)))
producing true, or maybe
   (let ([s1 (string #\i)]
         [s2 (string #\i)])
     (eval `(eq? ',s1 ',s2)))
producing false, or probably both. Neither works now
in Racket. Hack around the problem well enough for
benchmarking purposes by using numbers in place of
strings.
This commit is contained in:
Matthew Flatt 2011-11-22 17:48:58 -07:00
parent 4c7727e7af
commit f4c1d9da06
2 changed files with 7 additions and 6 deletions

View File

@ -1,6 +1,7 @@
;;; Portable implementation of syntax-case
;;; Extracted from Chez Scheme Version 7.3 (Feb 26, 2007)
;;; Authors: R. Kent Dybvig, Oscar Waddell, Bob Hieb, Carl Bruggeman
;;; Modifications to reflect "psyntax.sch": see << >>
;;; Copyright (c) 1992-2002 Cadence Research Systems
;;; Permission to copy this software, in whole or in part, to use this
@ -1050,7 +1051,7 @@
;;; labels
;;; simple labels must be comparable with "eq?" and distinct from symbols
;;; and pairs.
;;; and pairs <<and preserve identity through `eval'>>
;;; indirect labels, which are implemented as pairs, are used to support
;;; import aliasing for identifiers exported (explictly or implicitly) from
@ -1069,10 +1070,10 @@
(define set-indirect-label! (lambda (x v) (set-indirect-label-label! x v))))
(define gen-label
(lambda () (string #\i)))
(let ([n 0]) (lambda () (set! n (+ 1 n)) n))) ; <<changed from (string #\i)>>
(define label?
(lambda (x)
(or (string? x) ; normal lexical labels
(or (number? x) ; normal lexical labels <<changed to number>>
(symbol? x) ; global labels (symbolic names)
(indirect-label? x))))

View File

@ -644,7 +644,7 @@
(set-indirect-label-label!358
x2406
v2405)))
(gen-label362 (lambda () (string '#\i)))
(gen-label362 (let ([n 0]) (lambda () (set! n (+ 1 n)) n)))
(label?363 (lambda (x2402)
((lambda (t2403)
(if t2403
@ -654,7 +654,7 @@
t2404
(indirect-label?356 x2402)))
(symbol? x2402))))
(string? x2402))))
(number? x2402))))
(gen-labels364 (lambda (ls2401)
(if (null? ls2401)
'()
@ -4908,7 +4908,7 @@
e1563
(anti-mark400 w1561)
ae1560)))
(string '#\m)))))
(string #\m)))))
(chi-body503 (lambda (body1547 outer-form1546 r1545 mr1544
w1543 m?1542)
((lambda (ribcage1548)