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

Remove dependencies on srfis and r6rs.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2014-11-30 22:50:58 -05:00
parent 013a1cba6c
commit e3f8b7e9ce
10 changed files with 29 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/drracket-pkgs/drracket/drracket/private/colored-errors.rkt
View File

@ -7,8 +7,6 @@
racket/match
parser-tools/lex
(prefix-in : parser-tools/lex-sre)
(rename-in srfi/26 [cut //])
(only-in srfi/1 break)
unstable/contract)
(define-syntax (test stx) #'(begin)) ;; TODO: convert my test into DrRacket's test framework
@ -94,8 +92,8 @@
(map promote
(append
(append*
(filter-map (// match <> [(colored-msg-fragment locs _ _ c)
(map (// list <> c) (if (list? locs) locs (list locs)))] [_ #f])
(filter-map (λ (x) (match x [(colored-msg-fragment locs _ _ c)
(map (λ (x) (list x c)) (if (list? locs) locs (list locs)))] [_ #f]))
(colored-error-message-fragments msg)))
(colored-error-message-additional-highlights msg))))
@ -121,7 +119,7 @@
(match v [pattern #t] [_ #f]))]))
(define (check-tildas-are-paired parsed)
(let loop ([tildas (filter (// match? <> (or 'TildaPipe 'PipeTilda)) parsed)] [i 1])
(let loop ([tildas (filter (λ (x) (match? x (or 'TildaPipe 'PipeTilda))) parsed)] [i 1])
(match tildas
[(list) (void)]
[(list 'PipeTilda rst ...)
@ -187,7 +185,7 @@
(list/c srcloc-syntax/c symbol? boolean?))
the-arg 'caller 'TildaPipe)
(define is-important (and (list? the-arg) (findf (// eq? <> #t) the-arg)))
(define is-important (and (list? the-arg) (findf (λ (x) (eq? x #t)) the-arg)))
(define color (and (list? the-arg) (findf symbol? the-arg)))
(values (colored-msg-fragment (if (list? the-arg) (first the-arg) the-arg) sub is-important color) rest-args))
@ -223,7 +221,7 @@
(error 'colored-format "There are ~a unused arguments" (length args)))
empty]
[(list 'TildaPipe tail ...)
(define-values (left right) (break (// match? <> 'PipeTilda) tail))
(define-values (left right) (splitf-at tail (λ (x) (match? x 'PipeTilda))))
(define-values (result rest-args) (colored-format:TildaPipe left args))
(cons result (loop (rest right) rest-args))]
[(list f tail ...)
@ -268,7 +266,7 @@
(define (important-srclocs msg)
(append
(flatten
(filter-map (// match <> [(colored-msg-fragment locs _ #t _) locs] [_ #f])
(filter-map (λ (x) (match x [(colored-msg-fragment locs _ #t _) locs] [_ #f]))
(colored-error-message-fragments msg)))
(colored-error-message-additional-highlights msg)))

5
pkgs/drracket-pkgs/drracket/gui-debugger/annotator.rkt
View File

@ -3,7 +3,6 @@
(require (prefix-in kernel: syntax/kerncase)
gui-debugger/marks
mzlib/etc
(prefix-in srfi: srfi/1/search)
(for-syntax scheme/base)
(only-in mzscheme [apply plain-apply])
)
@ -324,7 +323,7 @@
(disarm expr) #f
[var-stx (identifier? (syntax var-stx))
(let ([binder (and (syntax-original? expr)
(srfi:member expr bound-vars free-identifier=?))])
(member expr bound-vars free-identifier=?))])
(if binder
(record-bound-id 'ref expr (car binder))
(record-bound-id 'top-level expr expr))
@ -365,7 +364,7 @@
[(set! var val)
(let ([binder (and (syntax-original? #'var)
(srfi:member #'var bound-vars free-identifier=?))])
(member #'var bound-vars free-identifier=?))])
(when binder
(record-bound-id 'set expr (car binder)))
(quasisyntax/loc expr (set! var #,(annotate #`val bound-vars #f module-name ))))]

2
pkgs/drracket-pkgs/drracket/info.rkt
View File

@ -32,8 +32,6 @@
"trace"
"macro-debugger"
"net-lib"
"srfi-lib"
"srfi-doc"
"tex-table"
"unstable-lib"
"drracket-plugin-lib"

1
pkgs/math-pkgs/math-lib/info.rkt
View File

@ -3,7 +3,6 @@
(define collection 'multi)
(define deps '("base"
"r6rs-lib"
"typed-racket-lib"
"typed-racket-more"
("math-i386-macosx" #:platform "i386-macosx")

10
pkgs/math-pkgs/math-lib/math/private/bigfloat/mpfr.rkt
View File

@ -9,8 +9,6 @@
racket/runtime-path
racket/promise
racket/serialize
(only-in rnrs/arithmetic/bitwise-6
bitwise-first-bit-set)
"gmp.rkt"
"utils.rkt")
@ -127,6 +125,14 @@
(or (and (bfnan? x1) (bfnan? x2))
(bf=? x1 x2)))
(define (bitwise-first-bit-set b)
(if (zero? b)
-1
(let loop ([b b][pos 0])
(if (zero? (bitwise-and b 1))
(loop (arithmetic-shift b -1) (add1 pos))
pos))))
(define (canonicalize-sig+exp sig exp)
(cond [(zero? sig) (values 0 0)]
[else

1
pkgs/plt-services/meta/props
View File

@ -1151,7 +1151,6 @@ path/s is either such a string or a list of them.
"pkgs/srfi-pkgs/srfi-lib/srfi/78/check-reference.scm" drdr:command-line #f
"pkgs/srfi-pkgs/srfi-lib/srfi/78/examples-78.scm" drdr:command-line #f
"pkgs/string-constants-pkgs" responsible (robby)
"pkgs/swindle" responsible (eli)
"pkgs/syntax-color-pkgs" responsible (mflatt)
"pkgs/trace" responsible (mflatt robby)
"pkgs/typed-racket-pkgs" responsible (samth stamourv asumu endobson)

5
pkgs/typed-racket-pkgs/typed-racket-doc/typed-racket/scribblings/guide/varargs.scrbl
View File

@ -1,6 +1,6 @@
#lang scribble/manual
@begin[(require "../utils.rkt" (for-label typed/racket/base) (for-label (only-in rnrs/lists-6 fold-left)))]
@begin[(require "../utils.rkt" (for-label typed/racket/base))]
@title[#:tag "varargs"]{Variable-Arity Functions: Programming with Rest Arguments}
@ -43,7 +43,8 @@ of the rest parameter is used at the same type.
@section{Non-Uniform Variable-Arity Functions}
However, the rest argument may be used as a heterogeneous list.
Take this (simplified) definition of the R6RS function @racket[fold-left]:
Take this (simplified) definition of the R6RS function @tt{fold-left}:
@; the above is not a link to avoid a dependency on the r6rs package
@racketmod[
racket

1
pkgs/unstable-pkgs/unstable-test/info.rkt
View File

@ -12,7 +12,6 @@
"planet-lib"
"racket-test"
"rackunit-lib"
"srfi-lib"
"syntax-color-lib"
"typed-racket-lib"
"unstable-contract-lib"

4
pkgs/unstable-pkgs/unstable-test/tests/unstable/helpers.rkt
View File

@ -7,7 +7,7 @@
check/sort
with/c)
(require rackunit racket/pretty srfi/67)
(require rackunit racket/pretty)
(define-syntax-rule (test e ...)
(test-case (parameterize ([pretty-print-columns 50])
@ -38,7 +38,7 @@
(lambda () (fail-check))))))))
(define (check/sort actual expected
#:< [<< (<? default-compare)]
#:< <<
#:= [== equal?])
(with-check-info*
(list (make-check-name 'check/sort)

14
pkgs/unstable-pkgs/unstable-test/tests/unstable/set.rkt
View File

@ -2,8 +2,10 @@
(require rackunit rackunit/text-ui racket/set "helpers.rkt")
(define (check/set a-set a-list #:= [== equal?])
(check/sort (set->list a-set) a-list #:= ==))
(define (check/set a-set a-list
#:= [== equal?]
#:< [< symbol<?])
(check/sort (set->list a-set) a-list #:= == #:< <))
(define-syntax-rule (test/set arg ...)
(test (check/set arg ...)))
@ -21,7 +23,7 @@
(test/set (list->seteqv (list 'a 'b 'c)) (list 'a 'b 'c))
(test/set (list->seteqv (list 'c 'b 'a)) (list 'a 'b 'c)))
(test-suite "set->list"
(test (check/sort (set->list (set 1 2 3)) (list 1 2 3)))))
(test (check/sort (set->list (set 1 2 3)) (list 1 2 3) #:< <))))
(test-suite "Comparisons"
(test-suite "set=?"
(test (check-false (set=? (set 1) (set 1 2 3))))
@ -33,6 +35,6 @@
(test (check-false (proper-subset? (set 1 2 3) (set 1 2 3))))))
(test-suite "Combinations"
(test-suite "set-symmetric-difference"
(test/set (set-symmetric-difference (set 1) (set 1 2) (set 1 2 3)) (list 1 3))
(test/set (set-symmetric-difference (set 1) (set 2) (set 3)) (list 1 2 3))
(test/set (set-symmetric-difference (set 1 2) (set 2 3) (set 1 3)) (list))))))
(test/set (set-symmetric-difference (set 1) (set 1 2) (set 1 2 3)) (list 1 3) #:< <)
(test/set (set-symmetric-difference (set 1) (set 2) (set 3)) (list 1 2 3) #:< <)
(test/set (set-symmetric-difference (set 1 2) (set 2 3) (set 1 3)) (list) #:< <)))))