suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

upgrade to #lang scheme

Browse Source 
svn: r15344
This commit is contained in:
Jon Rafkind 2009-06-30 20:57:23 +00:00
parent 616630f862
commit 3d356123cf
1 changed files with 43 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
collects/honu/private/util.ss
View File

@ -1,14 +1,14 @@
#lang scheme
(module util mzscheme
(provide delim-identifier=?
(provide delim-identifier=?
extract-until)
(require syntax/stx)
(require syntax/stx)
(define (delim-identifier=? a b)
(define (delim-identifier=? a b)
(eq? (syntax-e a) (syntax-e b)))
(define extract-until
(define extract-until
(case-lambda
[(r ids keep?)
(let loop ([r r][val-stxs null])
@ -28,7 +28,7 @@
(loop (stx-cdr r) (cons (stx-car r) val-stxs))]))]
[(r ids) (extract-until r ids #f)]))
(define (test)
(define (test)
(let* ([original #'(a b c d e)]
[delimiter #'c]
[expected-before #'(a b)]
@ -37,18 +37,16 @@
)
(let-values ([(before rest hit) (extract-until original (list delimiter))])
;; is there a better way to test equality between two syntaxes?
(when (not (and (equal? (syntax-object->datum expected-before)
(map syntax-object->datum before))
(equal? (syntax-object->datum expected-rest)
(map syntax-object->datum rest))
(equal? (syntax-object->datum expected-delimiter)
(syntax-object->datum hit))))
(printf "failure: original ~a until ~a\n" (syntax-object->datum original) (map syntax-object->datum (list delimiter)))
(printf " before expected ~a actual ~a\n" (syntax-object->datum expected-before) (map syntax-object->datum before))
(printf " rest expected ~a actual ~a\n" (syntax-object->datum expected-rest) (map syntax-object->datum rest))
(printf " delimiter expected ~a actual ~a\n" (syntax-object->datum expected-delimiter) (syntax-object->datum hit))
(when (not (and (equal? (syntax->datum expected-before)
(map syntax->datum before))
(equal? (syntax->datum expected-rest)
(map syntax->datum rest))
(equal? (syntax->datum expected-delimiter)
(syntax->datum hit))))
(printf "failure: original ~a until ~a\n" (syntax->datum original) (map syntax->datum (list delimiter)))
(printf " before expected ~a actual ~a\n" (syntax->datum expected-before) (map syntax->datum before))
(printf " rest expected ~a actual ~a\n" (syntax->datum expected-rest) (map syntax->datum rest))
(printf " delimiter expected ~a actual ~a\n" (syntax->datum expected-delimiter) (syntax->datum hit))
))))
(test)
)
(test)