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

Trim requires.

Browse Source 
Eliminates another ~300 instantiations from `racket -cl racket/base`.

small-scheme.rkt is no longer used in `racket/private`.

c.rkt was an accidentally-committe file.
This commit is contained in:
Sam Tobin-Hochstadt 2019-12-17 11:56:28 -05:00 committed by Sam Tobin-Hochstadt
parent 81d73d9849
commit 6b1dad21eb
38 changed files with 79 additions and 433 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
racket/collects/racket/block.rkt
View File

@ -2,7 +2,9 @@
(#%require "private/define.rkt"
(for-syntax '#%kernel
"private/stx.rkt"
"private/small-scheme.rkt"
"private/qq-and-or.rkt"
"private/define-et-al.rkt"
"private/cond.rkt"
"private/stxcase-scheme.rkt"
"private/qqstx.rkt"
syntax/intdef))

366
racket/collects/racket/private/c.rkt
View File

@ -1,366 +0,0 @@
;;----------------------------------------------------------------------
;; case: based on Clinger, "Rapid Case Dispatch in Scheme"
;; [http://scheme2006.cs.uchicago.edu/07-clinger.pdf]
(module case '#%kernel
(#%require '#%paramz '#%unsafe "small-scheme.rkt" "define.rkt"
(for-syntax '#%kernel "small-scheme.rkt" "stxcase-scheme.rkt"
"qqstx.rkt" "define.rkt" "sort.rkt"))
(#%provide case)
(define-syntax (case stx)
(syntax-case stx (else)
;; Empty case
[(_ v)
(syntax-protect
(syntax/loc stx (#%expression (begin v (void)))))]
;; Else-only case
[(_ v [else e es ...])
(syntax-protect
(syntax/loc stx (#%expression (begin v (let-values () e es ...)))))]
;; If we have a syntactically correct form without an 'else' clause,
;; add the default 'else' and try again.
[(self v [(k ...) e1 e2 ...] ...)
(syntax-protect
(syntax/loc stx (self v [(k ...) e1 e2 ...] ... [else (void)])))]
;; The general case
[(_ v [(k ...) e1 e2 ...] ... [else x1 x2 ...])
(syntax-protect
(if (< (length (syntax-e #'(k ... ...))) *sequential-threshold*)
(syntax/loc stx (let ([tmp v])
(case/sequential tmp [(k ...) e1 e2 ...] ... [else x1 x2 ...])))
(syntax/loc stx (let ([tmp v])
(case/dispatch tmp [(k ...) e1 e2 ...] ... [else x1 x2 ...])))))]
;; Error cases
[(_ v clause ...)
(let loop ([clauses (syntax->list #'(clause ...))])
(unless (null? clauses)
(let ([clause (car clauses)])
(syntax-case clause ()
[((_ ...) _ _ ...)
(loop (cdr clauses))]
[((_ ...) . _)
(syntax-case clause ()
[(_)
(raise-syntax-error
#f
"bad syntax (missing expression after datum sequence)"
stx
clause)]
[(_ . _)
(raise-syntax-error
#f
"bad syntax (illegal use of `.' in clause)"
stx
clause)]
[_
(raise-syntax-error
#f
"bad syntax (ill-formed clause)"
stx
clause)])]
[(bad . _)
(raise-syntax-error
#f
;; If #'bad is an identifier, report its binding in the error message.
;; This helps resolving the syntax error when `else' is shadowed somewhere
(if (not (symbol? (syntax-e (syntax bad))))
"bad syntax (not a datum sequence)"
(string-append
"bad syntax (not a datum sequence)\n"
" expected: a datum sequence or the binding 'else' from racket/base\n"
" given: "
(let ([binding (identifier-binding (syntax bad))])
(cond
[(not binding) "an unbound identifier"]
[(eq? binding 'lexical) "a locally bound identifier"]
[else
(let*-values ([(src) (car binding)]
[(mpath base) (module-path-index-split src)])
(cond
[(not mpath)
"an identifier bound by the current module"]
[else
(format "an identifier required from the module ~a"
(resolved-module-path-name
(module-path-index-resolve src)))]))]))))
stx
(syntax bad))]
[_
(raise-syntax-error
#f
"bad syntax (ill-formed clause)"
stx
(syntax bad))]))))]
[(_ . v)
(not (null? (syntax-e (syntax v))))
(raise-syntax-error
#f
"bad syntax (illegal use of `.')"
stx)]))
;; Sequential case:
;; Turn the expression into a sequence of if-then-else.
(define-syntax (case/sequential stx)
(syntax-case stx (else)
[(_ v [(k ...) es ...] arms ... [else xs ...])
(syntax-protect
#'(if (case/sequential-test v (k ...))
(let-values () es ...)
(case/sequential v arms ... [else xs ...])))]
[(_ v [(k ...) es ...] [else xs ...])
(syntax-protect
#'(if (case/sequential-test v (k ...))
(let-values () es ...)
(let-values () xs ...)))]
[(_ v [else xs ...])
(syntax-protect
#'(let-values () xs ...))]))
(define-syntax (case/sequential-test stx)
(syntax-protect
(syntax-case stx ()
[(_ v ()) #'#f]
[(_ v (k)) #`(equal? v 'k)]
[(_ v (k ks ...)) #`(if (equal? v 'k)
#t
(case/sequential-test v (ks ...)))])))
;; Triple-dispatch case:
;; (1) From the type of the value to a type-specific mechanism for
;; (2) mapping the value to the index of the consequent we need. Then,
;; (3) from the index, perform a binary search to find the consequent code.
;; Note: the else clause is given index 0.
(define-syntax (case/dispatch stx)
(syntax-case stx (else)
[(_ v [(k ...) es ...] ... [else xs ...])
(syntax-protect
#`(let ([index
#,(let* ([ks (partition-constants #'((k ...) ...))]
[exp #'0]
[exp (if (null? (consts-other ks))
exp
(dispatch-other #'v (consts-other ks) exp))]
[exp (if (null? (consts-char ks))
exp
#`(if (char? v)
#,(dispatch-char #'v (consts-char ks))
#,exp))]
[exp (if (null? (consts-symbol ks))
exp
#`(if #,(test-for-symbol #'v (consts-symbol ks))
#,(dispatch-symbol #'v (consts-symbol ks) #'0)
#,exp))]
[exp (if (null? (consts-fixnum ks))
exp
#`(if (fixnum? v)
#,(dispatch-fixnum #'v (consts-fixnum ks))
#,exp))])
exp)])
#,(index-binary-search #'index #'([xs ...] [es ...] ...))))]))
(begin-for-syntax
(define *sequential-threshold* 12)
(define *hash-threshold* 10)
(define nothing (gensym))
(define interval-lo car)
(define interval-hi cadr)
(define interval-index caddr)
(define (partition-constants stx)
(define h (make-hash))
(define (duplicate? x)
(not (eq? (hash-ref h x nothing) nothing)))
(define (add xs x idx)
(hash-set! h x idx)
(cons (cons x idx) xs))
(let loop ([f '()] [s '()] [c '()] [o '()] [idx 1] [xs (syntax->list stx)])
(cond [(null? xs)
(list (cons 'fixnum f)
(cons 'symbol s)
(cons 'char c)
(cons 'other o))]
[else (let inner ([f f] [s s] [c c] [o o] [ys (syntax->list (car xs))])
(cond [(null? ys) (loop f s c o (add1 idx) (cdr xs))]
[else
(let ([y (syntax->datum (car ys))])
(cond [(duplicate? y) (inner f s c o (cdr ys))]
[(fixnum? y) (inner (add f y idx) s c o (cdr ys))]
[(symbol? y) (inner f (add s y idx) c o (cdr ys))]
[(keyword? y) (inner f (add s y idx) c o (cdr ys))]
[(char? y) (inner f s (add c y idx) o (cdr ys))]
[else (inner f s c (add o y idx) (cdr ys))]))]))])))
(define (consts-fixnum ks) (cdr (assq 'fixnum ks)))
(define (consts-symbol ks) (cdr (assq 'symbol ks)))
(define (consts-char ks) (cdr (assq 'char ks)))
(define (consts-other ks) (cdr (assq 'other ks)))
;; Character dispatch is fixnum dispatch.
(define (dispatch-char tmp-stx char-alist)
#`(let ([codepoint (char->integer #,tmp-stx)])
#,(dispatch-fixnum #'codepoint
(map (λ (x)
(cons (char->integer (car x))
(cdr x)))
char-alist))))
;; Symbol and "other" dispatch is either sequential or
;; hash-table-based, depending on how many constants we
;; have. Assume that `alist' does not map anything to `#f'.
(define (dispatch-hashable tmp-stx alist make-hashX else-exp)
(if (< (length alist) *hash-threshold*)
#`(case/sequential #,tmp-stx
#,@(map (λ (x)
#`[(#,(car x)) #,(cdr x)])
alist)
[else #,else-exp])
(let ([tbl (make-hashX alist)])
(if (literal-expression? else-exp)
#`(hash-ref #,tbl #,tmp-stx (lambda () #,else-exp))
#`(or (hash-ref #,tbl #,tmp-stx (lambda () #f))
#,else-exp)))))
(define (dispatch-symbol tmp-stx symbol-alist else-exp)
(dispatch-hashable tmp-stx symbol-alist make-immutable-hasheq else-exp))
(define (dispatch-other tmp-stx other-alist else-exp)
(dispatch-hashable tmp-stx other-alist make-immutable-hash else-exp))
(define (test-for-symbol tmp-stx alist)
(define (contains? pred)
(ormap (lambda (p) (pred (car p))) alist))
(if (contains? symbol?)
(if (contains? keyword?)
#`(or (symbol? #,tmp-stx) (keyword? #,tmp-stx))
#`(symbol? #,tmp-stx))
#`(keyword? #,tmp-stx)))
(define (literal-expression? else-exp)
(define v (syntax-e else-exp))
(or (boolean? v) (number? v)))
;; Fixnum dispatch is either table lookup or binary search.
(define (dispatch-fixnum tmp-stx fixnum-alist)
(define (go intervals lo hi lo-bound hi-bound)
(define len (length intervals))
(cond [(or (>= lo-bound hi)
(<= hi-bound lo))
#'0]
[(and (> len 1)
(< (- hi lo) (* len 5)))
(fixnum-table-lookup intervals lo hi lo-bound hi-bound)]
[else
(fixnum-binary-search intervals lo hi lo-bound hi-bound)]))
(define (fixnum-table-lookup intervals lo hi lo-bound hi-bound)
(define index-lists
(map (λ (int)
(vector->list
(make-vector (- (interval-hi int)
(interval-lo int))
(interval-index int))))
intervals))
#`(let ([tbl #,(list->vector (apply append index-lists))])
#,(bounded-expr tmp-stx lo hi lo-bound hi-bound
#`(unsafe-vector*-ref tbl (unsafe-fx- #,tmp-stx #,lo)))))
(define (fixnum-binary-search intervals lo hi lo-bound hi-bound)
(cond [(null? (cdr intervals))
#`#,(interval-index (car intervals))]
[else
(define-values (lo-ints hi-ints) (split-intervals intervals))
(define-values (lo-lo lo-hi) (lo+hi lo-ints))
(define-values (hi-lo hi-hi) (lo+hi hi-ints))
#`(if (unsafe-fx< #,tmp-stx #,hi-lo)
#,(go lo-ints lo-lo lo-hi lo-bound hi-lo)
#,(go hi-ints hi-lo hi-hi hi-lo hi-bound))]))
(define (split-intervals intervals)
(define n (quotient (length intervals) 2))
(let loop ([n n] [lo '()] [hi intervals])
(cond [(zero? n) (values (reverse lo) hi)]
[else (loop (sub1 n) (cons (car hi) lo) (cdr hi))])))
(define (lo+hi intervals)
(values (interval-lo (car intervals))
(interval-hi (car (reverse intervals)))))
(define intervals (alist->intervals fixnum-alist))
(define-values (lo hi) (lo+hi intervals))
#`(if (and (unsafe-fx>= #,tmp-stx #,lo)
(unsafe-fx< #,tmp-stx #,hi))
#,(go intervals lo hi lo hi)
0))
;; Once we have the index of the consequent we want, perform
;; a binary search to find it.
(define (index-binary-search index-stx leg-stx)
(define legs (list->vector (syntax->list leg-stx)))
(define (go min max)
(cond [(= min max)
#`(let-values () #,@(vector-ref legs min))]
[(= max (add1 min))
#`(if (unsafe-fx< #,index-stx #,max)
(let-values () #,@(vector-ref legs min))
(let-values () #,@(vector-ref legs max)))]
[else
(let ([mid (quotient (+ min max) 2)])
#`(if (unsafe-fx< #,index-stx #,mid)
#,(go min (sub1 mid))
#,(go mid max)))]))
(go 0 (sub1 (vector-length legs))))
(define (bounded-expr tmp-stx lo hi lo-bound hi-bound exp-stx)
(cond [(and (<= hi-bound hi)
(>= lo-bound lo))
exp-stx]
[(<= hi-bound hi)
#`(if (unsafe-fx>= #,tmp-stx #,lo) exp-stx 0)]
[(>= lo-bound lo)
#`(if (unsafe-fx< #,tmp-stx #,hi) exp-stx 0)]
[else
#`(if (and (unsafe-fx>= #,tmp-stx #,lo)
(unsafe-fx< #,tmp-stx #,hi))
exp-stx
0)]))
(define (alist->intervals alist)
(let loop ([xs (sort alist < car)] [start-idx #f] [end-idx #f] [cur-val #f] [res '()])
(cond [(null? xs)
(if start-idx
(reverse (cons (list start-idx end-idx cur-val) res))
'())]
[else
(let* ([x (car xs)]
[k (car x)]
[v (cdr x)])
(cond [(not start-idx)
(loop (cdr xs) k (add1 k) v res)]
[(and (= end-idx k) (= cur-val v))
(loop (cdr xs) start-idx (add1 end-idx) cur-val res)]
[(= end-idx k)
(let ([interval (list start-idx end-idx cur-val)])
(loop (cdr xs) k (add1 k) v (cons interval res)))]
[else
;; insert an interval in the gap for the default
(let ([int1 (list start-idx end-idx cur-val)]
[int2 (list end-idx k 0)])
(loop (cdr xs) k (add1 k) v (cons int2 (cons int1 res))))]))])))))

5
racket/collects/racket/private/case.rkt
View File

@ -3,8 +3,9 @@
;; [http://scheme2006.cs.uchicago.edu/07-clinger.pdf]
(module case '#%kernel
(#%require '#%paramz '#%unsafe "small-scheme.rkt" "define.rkt" "fixnum.rkt"
(for-syntax '#%kernel "small-scheme.rkt" "stxcase-scheme.rkt"
(#%require '#%paramz '#%unsafe "qq-and-or.rkt" "cond.rkt" "define.rkt" "fixnum.rkt"
(for-syntax '#%kernel "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt"
"stxcase-scheme.rkt"
"qqstx.rkt" "define.rkt" "sort.rkt" "fixnum.rkt"))
(#%provide case)

5
racket/collects/racket/private/define-struct.rkt
View File

@ -2,12 +2,13 @@
;; (planet "struct.ss" ("ryanc" "macros.plt" 1 0)))
(module define-struct '#%kernel
(#%require "small-scheme.rkt" "define.rkt" "../stxparam.rkt"
(#%require "define-et-al.rkt" "qq-and-or.rkt" "define.rkt" "../stxparam.rkt"
"generic-methods.rkt"
(for-syntax '#%kernel "define.rkt"
"procedure-alias.rkt"
"member.rkt"
"stx.rkt" "stxcase-scheme.rkt" "small-scheme.rkt"
"stx.rkt" "stxcase-scheme.rkt" "qq-and-or.rkt" "cond.rkt"
"define-et-al.rkt"
"stxloc.rkt" "qqstx.rkt"
"struct-info.rkt"))

5
racket/collects/racket/private/for.rkt
View File

@ -1,7 +1,6 @@
(module for '#%kernel
(#%require "more-scheme.rkt"
"misc.rkt"
(#%require "misc.rkt"
"define.rkt"
"letstx-scheme.rkt"
"member.rkt"
@ -16,7 +15,7 @@
"qqstx.rkt"
"define.rkt"
"member.rkt"
"small-scheme.rkt"
"define-et-al.rkt" "qq-and-or.rkt" "cond.rkt"
"stxcase-scheme.rkt"))
(#%provide for/fold for*/fold

3
racket/collects/racket/private/generic-methods.rkt
View File

@ -1,6 +1,6 @@
(module generic-methods '#%kernel
(#%require (for-syntax '#%kernel "small-scheme.rkt" "define.rkt"
(#%require (for-syntax '#%kernel "qq-and-or.rkt" "define-et-al.rkt" "cond.rkt" "define.rkt"
"stx.rkt" "stxcase-scheme.rkt")
"define.rkt" "../stxparam.rkt")
@ -20,7 +20,6 @@
make-method-delta))
(begin-for-syntax
(define-values (struct:generic-info
make-generic-info
generic-info?

2
racket/collects/racket/private/immediate-default.rkt
View File

@ -1,6 +1,6 @@
(module kw '#%kernel
(#%require "define.rkt"
"small-scheme.rkt"
"define-et-al.rkt" "qq-and-or.rkt"
"stxcase-scheme.rkt"
(for-template '#%kernel))

11
racket/collects/racket/private/kw.rkt
View File

@ -1,6 +1,8 @@
(module kw '#%kernel
(#%require "define.rkt"
"small-scheme.rkt"
"qq-and-or.rkt"
"cond.rkt"
"define-et-al.rkt"
"more-scheme.rkt"
(only '#%unsafe
unsafe-chaperone-procedure
@ -10,7 +12,9 @@
'#%unsafe
"procedure-alias.rkt"
"stx.rkt"
"small-scheme.rkt"
"qq-and-or.rkt"
"define-et-al.rkt"
"cond.rkt"
"stxcase-scheme.rkt"
"member.rkt"
"name.rkt"
@ -20,7 +24,8 @@
"kw-prop-key.rkt"
"immediate-default.rkt")
(for-meta 2 '#%kernel
"small-scheme.rkt"
"qq-and-or.rkt"
"cond.rkt"
"stxcase-scheme.rkt"
"qqstx.rkt"))

4
racket/collects/racket/private/letstx-scheme.rkt
View File

@ -3,7 +3,7 @@
;; #%stxcase-scheme: adds let-syntax, letrec-syntax, etc.
(module letstx-scheme '#%kernel
(#%require "small-scheme.rkt"
(#%require "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt"
(for-syntax '#%kernel "stxcase.rkt"
"with-stx.rkt" "stxloc.rkt"))
@ -49,5 +49,5 @@
(let-syntaxes ([(id) expr] ...)
body1 body ...))])))
(#%provide (all-from "small-scheme.rkt")
(#%provide (all-from "define-et-al.rkt") (all-from "qq-and-or.rkt") (all-from "cond.rkt")
letrec-syntaxes letrec-syntax let-syntaxes let-syntax))

5
racket/collects/racket/private/logger.rkt
View File

@ -1,7 +1,8 @@
(module logger '#%kernel
(#%require "small-scheme.rkt" "define.rkt"
(for-syntax '#%kernel "stx.rkt" "small-scheme.rkt" "stxcase-scheme.rkt"))
(#%require "define-et-al.rkt" "qq-and-or.rkt" "define.rkt"
(for-syntax '#%kernel "stx.rkt" "define-et-al.rkt" "qq-and-or.rkt"
"stxcase-scheme.rkt"))
(#%provide log-fatal log-error log-warning log-info log-debug
define-logger)

2
racket/collects/racket/private/map.rkt
View File

@ -3,7 +3,7 @@
;; but the JIT generates faster code, especially for the common cases.
(module map '#%kernel
(#%require "small-scheme.rkt" "define.rkt"
(#%require "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt" "define.rkt"
"performance-hint.rkt"
"kw.rkt"
'#%paramz

2
racket/collects/racket/private/misc.rkt
View File

@ -3,7 +3,7 @@
;; #%misc : file utilities, etc. - remaining functions
(module misc '#%kernel
(#%require "small-scheme.rkt" "define.rkt" "path.rkt" "old-path.rkt"
(#%require "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt" "define.rkt" "path.rkt" "old-path.rkt"
"path-list.rkt" "executable-path.rkt"
"reading-param.rkt" "../repl.rkt"
(for-syntax '#%kernel "qq-and-or.rkt" "stx.rkt" "stxcase-scheme.rkt" "stxcase.rkt"))

4
racket/collects/racket/private/more-scheme.rkt
View File

@ -3,9 +3,9 @@
;; more-scheme : case, do, etc. - remaining syntax
(module more-scheme '#%kernel
(#%require "small-scheme.rkt" "define.rkt" '#%paramz "case.rkt" "logger.rkt"
(#%require "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt" "define.rkt" '#%paramz "case.rkt" "logger.rkt"
"member.rkt"
(for-syntax '#%kernel "stx.rkt" "small-scheme.rkt" "stxcase-scheme.rkt" "qqstx.rkt"))
(for-syntax '#%kernel "stx.rkt" "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt" "stxcase-scheme.rkt" "qqstx.rkt"))
;; For `old-case`:
(define-syntax case-test

2
racket/collects/racket/private/name.rkt
View File

@ -1,6 +1,6 @@
(module name '#%kernel
(#%require "define.rkt" "small-scheme.rkt")
(#%require "define.rkt" "qq-and-or.rkt" "cond.rkt")
(#%provide syntax-local-infer-name)
(define syntax-local-infer-name

2
racket/collects/racket/private/namespace.rkt
View File

@ -1,7 +1,7 @@
(module namespace "pre-base.rkt"
(require (for-syntax '#%kernel "define.rkt"
"member.rkt"
"stx.rkt" "stxcase-scheme.rkt" "small-scheme.rkt"
"stx.rkt" "stxcase-scheme.rkt" "define-et-al.rkt" "qq-and-or.rkt"
"stxloc.rkt"))
(provide make-base-empty-namespace

2
racket/collects/racket/private/norm-arity.rkt
View File

@ -1,5 +1,5 @@
(module norm-arity '#%kernel
(#%require "define.rkt" "small-scheme.rkt" "sort.rkt")
(#%require "define.rkt" "qq-and-or.rkt" "define-et-al.rkt" "sort.rkt")
(#%provide normalize-arity)
;; normalize-arity : (or/c arity (listof arity))

2
racket/collects/racket/private/norm-define.rkt
View File

@ -1,6 +1,6 @@
(module norm-define '#%kernel
(#%require "small-scheme.rkt" "stxcase-scheme.rkt"
(#%require "define-et-al.rkt" "qq-and-or.rkt" "stxcase-scheme.rkt"
"member.rkt" "stx.rkt" "qqstx.rkt")
(#%provide normalize-definition normalize-definition/mk-rhs)

4
racket/collects/racket/private/promise.rkt
View File

@ -1,10 +1,10 @@
(module promise '#%kernel
(#%require "small-scheme.rkt"
(#%require "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt"
"more-scheme.rkt"
"define.rkt"
(rename "define-struct.rkt" define-struct define-struct*)
(for-syntax '#%kernel
"small-scheme.rkt"
"cond.rkt" "qq-and-or.rkt"
"define.rkt"
"struct.rkt"
"stxcase-scheme.rkt"

4
racket/collects/racket/private/qqstx.rkt
View File

@ -2,8 +2,8 @@
;; #%qqstx : quasisyntax
(module qqstx '#%kernel
(#%require "small-scheme.rkt" "stxcase-scheme.rkt" "stx.rkt" "template.rkt"
(for-syntax '#%kernel "small-scheme.rkt" "stxcase-scheme.rkt" "stx.rkt"))
(#%require "define-et-al.rkt" "stxcase-scheme.rkt" "stx.rkt" "template.rkt"
(for-syntax '#%kernel "qq-and-or.rkt" "cond.rkt" "stxcase-scheme.rkt" "stx.rkt"))
(#%provide quasisyntax
quasisyntax/loc

4
racket/collects/racket/private/reqprov.rkt
View File

@ -1,9 +1,9 @@
(module reqprov '#%kernel
(#%require "define.rkt"
(for-syntax '#%kernel
"stx.rkt" "stxcase-scheme.rkt" "small-scheme.rkt"
"stx.rkt" "stxcase-scheme.rkt" "define-et-al.rkt"
"qq-and-or.rkt" "cond.rkt"
"stxloc.rkt" "qqstx.rkt" "more-scheme.rkt"
"member.rkt"
"../require-transform.rkt"
"../provide-transform.rkt"
"struct-info.rkt"))

2
racket/collects/racket/private/sc.rkt
View File

@ -3,7 +3,7 @@
;; based on Shriram's pattern matcher for Zodiac
(module sc '#%kernel
(#%require "stx.rkt" "small-scheme.rkt"
(#%require "stx.rkt" "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt"
(for-template (only '#%kernel set!)
"ellipses.rkt"))

2
racket/collects/racket/private/small-scheme.rkt
View File

@ -2,6 +2,8 @@
;;----------------------------------------------------------------------
;; assembles all basic forms we have so far
;; Not used in racket/base but kept for backwards-compatibility
(module small-scheme '#%kernel
(#%require "qq-and-or.rkt" "cond.rkt" "define-et-al.rkt")

2
racket/collects/racket/private/sort.rkt
View File

@ -1,6 +1,6 @@
(module sort '#%kernel
(#%require "small-scheme.rkt" "define.rkt" (for-syntax "stxcase-scheme.rkt"))
(#%require "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt" "define.rkt" (for-syntax "stxcase-scheme.rkt"))
;; note, these are the raw interfaces --- user-facing definitions
;; are exported from private/list.rkt and vector.rkt

2
racket/collects/racket/private/struct-info.rkt
View File

@ -3,7 +3,7 @@
;; record for static info produced by `define-struct'
(module struct-info '#%kernel
(#%require "small-scheme.rkt")
(#%require "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt")
(#%provide make-struct-info
struct-info?

2
racket/collects/racket/private/struct.rkt
View File

@ -3,7 +3,7 @@
(#%require "define.rkt"
"define-struct.rkt"
(for-syntax '#%kernel "define.rkt"
"stx.rkt" "stxcase-scheme.rkt" "small-scheme.rkt"
"stx.rkt" "stxcase-scheme.rkt" "qq-and-or.rkt" "cond.rkt"
"stxloc.rkt"))
(#%provide struct)

4
racket/collects/racket/private/stxcase-scheme.rkt
View File

@ -4,8 +4,8 @@
;; check-duplicate-identifier, and assembles everything we have so far
(module stxcase-scheme '#%kernel
(#%require "small-scheme.rkt" "stx.rkt" "stxcase.rkt" "with-stx.rkt" "stxloc.rkt"
(for-syntax '#%kernel "small-scheme.rkt" "stx.rkt" "stxcase.rkt"
(#%require "define-et-al.rkt" "qq-and-or.rkt" "stx.rkt" "stxcase.rkt" "with-stx.rkt" "stxloc.rkt"
(for-syntax '#%kernel "define-et-al.rkt" "stx.rkt" "stxcase.rkt"
"stxloc.rkt"))
(-define (check-duplicate-identifier names)

6
racket/collects/racket/private/stxcase.rkt
View File

@ -2,10 +2,10 @@
;; syntax-case and syntax
(module stxcase '#%kernel
(#%require "stx.rkt" "small-scheme.rkt" '#%paramz '#%unsafe
(#%require "stx.rkt" "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt" '#%paramz '#%unsafe
"ellipses.rkt"
(for-syntax "stx.rkt" "small-scheme.rkt"
"gen-temp.rkt" "member.rkt" "sc.rkt" '#%kernel))
(for-syntax "stx.rkt" "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt"
"gen-temp.rkt" "sc.rkt" '#%kernel))
(-define interp-match
(lambda (pat e literals immediate=?)

4
racket/collects/racket/private/stxloc.rkt
View File

@ -3,8 +3,8 @@
;; syntax/loc
(module stxloc '#%kernel
(#%require "qq-and-or.rkt" "stxcase.rkt" "define-et-al.rkt"
(for-syntax '#%kernel "stxcase.rkt" "sc.rkt"))
(#%require "stxcase.rkt" "define-et-al.rkt"
(for-syntax '#%kernel "stxcase.rkt"))
(begin-for-syntax
(define-values (transform-to-syntax-case**)

3
racket/collects/racket/private/stxparam.rkt
View File

@ -3,8 +3,7 @@
(#%require "define.rkt"
(for-syntax '#%kernel
"stx.rkt" "stxcase-scheme.rkt"
"small-scheme.rkt"
"more-scheme.rkt"
"define-et-al.rkt" "qq-and-or.rkt"
"stxloc.rkt" "stxparamkey.rkt"))
(#%provide (for-syntax do-syntax-parameterize)

2
racket/collects/racket/private/stxparamkey.rkt
View File

@ -1,6 +1,6 @@
(module stxparamkey '#%kernel
(#%require "small-scheme.rkt" "define.rkt"
(#%require "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt" "define.rkt"
"stxcase.rkt" "stxloc.rkt" "with-stx.rkt"
(only '#%unsafe unsafe-root-continuation-prompt-tag)
(for-template '#%kernel))

6
racket/collects/racket/private/submodule.rkt
View File

@ -1,7 +1,5 @@
(module module+ '#%kernel
(#%require "more-scheme.rkt"
"modbeg.rkt"
(for-syntax '#%kernel
(module submodule '#%kernel
(#%require (for-syntax '#%kernel
"stxcase-scheme.rkt"
"more-scheme.rkt"
"letstx-scheme.rkt"

14
racket/collects/racket/private/template.rkt
View File

@ -1,12 +1,12 @@
(module template '#%kernel
(#%require "stx.rkt" "small-scheme.rkt" "performance-hint.rkt"
(rename "small-scheme.rkt" define -define)
(rename "small-scheme.rkt" define-syntax -define-syntax)
(#%require "stx.rkt" "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt" "performance-hint.rkt"
(rename "define-et-al.rkt" define -define)
(rename "define-et-al.rkt" define-syntax -define-syntax)
"ellipses.rkt"
(for-syntax "stx.rkt" "small-scheme.rkt"
(rename "small-scheme.rkt" define -define)
(rename "small-scheme.rkt" define-syntax -define-syntax)
"member.rkt" "sc.rkt" '#%kernel))
(for-syntax "stx.rkt" "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt"
(rename "define-et-al.rkt" define -define)
(rename "define-et-al.rkt" define-syntax -define-syntax)
#;"member.rkt" "sc.rkt" '#%kernel))
(#%provide syntax
syntax/loc
datum

4
racket/collects/racket/private/with-stx.rkt
View File

@ -2,8 +2,8 @@
;; with-syntax, generate-temporaries
(module with-stx '#%kernel
(#%require "stx.rkt" "small-scheme.rkt" "stxcase.rkt"
(for-syntax '#%kernel "stx.rkt" "stxcase.rkt" "stxloc.rkt"
(#%require "stx.rkt" "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt" "stxcase.rkt"
(for-syntax '#%kernel "stxcase.rkt" "stxloc.rkt"
"gen-temp.rkt" "sc.rkt" "qq-and-or.rkt" "cond.rkt"))
(-define (with-syntax-fail stx)

4
racket/collects/racket/provide-transform.rkt
View File

@ -2,7 +2,9 @@
(#%require "private/stxcase-scheme.rkt"
"private/stx.rkt"
"private/define-struct.rkt"
"private/small-scheme.rkt"
"private/define-et-al.rkt"
"private/qq-and-or.rkt"
"private/cond.rkt"
"private/define.rkt")
(#%provide expand-export pre-expand-export

4
racket/collects/racket/require-transform.rkt
View File

@ -2,7 +2,9 @@
(#%require "private/stxcase-scheme.rkt"
"private/stx.rkt"
"private/define-struct.rkt"
"private/small-scheme.rkt"
"private/define-et-al.rkt"
"private/qq-and-or.rkt"
"private/cond.rkt"
"private/define.rkt"
(for-template (only '#%kernel quote))
(for-syntax '#%kernel))

3
racket/collects/racket/stxparam-exptime.rkt
View File

@ -1,7 +1,8 @@
(module stxparam-exptime '#%kernel
(#%require "private/stxcase-scheme.rkt"
"private/small-scheme.rkt"
"private/define-et-al.rkt"
"private/qq-and-or.rkt"
"private/stxparamkey.rkt")
(#%provide syntax-parameter-value

2
racket/collects/racket/stxparam.rkt
View File

@ -6,7 +6,7 @@
(for-syntax '#%kernel
"stxparam-exptime.rkt"
"private/stxcase-scheme.rkt"
"private/small-scheme.rkt"
"private/qq-and-or.rkt"
"private/stxloc.rkt"
"private/stxparamkey.rkt"))

2
racket/src/expander/namespace/module.rkt
View File

@ -80,7 +80,7 @@
get-all-variables) ; for `module->indirect-exports`
#:authentic)
;; [*] Beware that tabels in `provides` may map non-interned symbols
;; [*] Beware that tables in `provides` may map non-interned symbols
;; to provided bindings, in case something like a lifted
;; identifier was provided. Since lifting generates a locally
;; deterministic unreadable symbol that is intended to be specific