added 'range' to *sl per jpr's request and #lang-ified a couple of files
This commit is contained in:
Matthias Felleisen
parent
2fcb635790
commit
f1c1376d87
|
|
@ -2,88 +2,86 @@
|
|||
;; forms and procedures. The reader-level aspects of the language
|
||||
;; (e.g., case-sensitivity) are not implemented here.
|
||||
|
||||
(module htdp-beginner scheme/base
|
||||
(require mzlib/etc
|
||||
mzlib/list
|
||||
syntax/docprovide
|
||||
"private/rewrite-error-message.rkt"
|
||||
(for-syntax "private/rewrite-error-message.rkt")
|
||||
(for-syntax scheme/base))
|
||||
#lang scheme/base
|
||||
(require mzlib/etc
|
||||
mzlib/list
|
||||
syntax/docprovide
|
||||
"private/rewrite-error-message.rkt"
|
||||
(for-syntax "private/rewrite-error-message.rkt")
|
||||
(for-syntax scheme/base))
|
||||
|
||||
;; Implements the forms:
|
||||
(require "private/teach.rkt"
|
||||
"private/teach-module-begin.rkt"
|
||||
test-engine/scheme-tests)
|
||||
;; Implements the forms:
|
||||
(require "private/teach.rkt"
|
||||
"private/teach-module-begin.rkt"
|
||||
test-engine/scheme-tests)
|
||||
|
||||
;; syntax:
|
||||
(provide (rename-out
|
||||
[beginner-define define]
|
||||
[beginner-define-struct define-struct]
|
||||
[beginner-lambda lambda]
|
||||
[beginner-app #%app]
|
||||
[beginner-top #%top]
|
||||
[beginner-cond cond]
|
||||
[beginner-else else]
|
||||
[beginner-if if]
|
||||
[beginner-and and]
|
||||
[beginner-or or]
|
||||
[beginner-quote quote]
|
||||
[beginner-module-begin #%module-begin]
|
||||
[beginner-require require]
|
||||
[beginner-dots ..]
|
||||
[beginner-dots ...]
|
||||
[beginner-dots ....]
|
||||
[beginner-dots .....]
|
||||
[beginner-dots ......]
|
||||
[beginner-true true]
|
||||
[beginner-false false]
|
||||
)
|
||||
check-expect
|
||||
check-within
|
||||
check-error
|
||||
check-member-of
|
||||
check-range
|
||||
;; define-wish
|
||||
#%datum
|
||||
#%top-interaction
|
||||
empty
|
||||
;; syntax:
|
||||
(provide (rename-out
|
||||
[beginner-define define]
|
||||
[beginner-define-struct define-struct]
|
||||
[beginner-lambda lambda]
|
||||
[beginner-app #%app]
|
||||
[beginner-top #%top]
|
||||
[beginner-cond cond]
|
||||
[beginner-else else]
|
||||
[beginner-if if]
|
||||
[beginner-and and]
|
||||
[beginner-or or]
|
||||
[beginner-quote quote]
|
||||
[beginner-module-begin #%module-begin]
|
||||
[beginner-require require]
|
||||
[beginner-dots ..]
|
||||
[beginner-dots ...]
|
||||
[beginner-dots ....]
|
||||
[beginner-dots .....]
|
||||
[beginner-dots ......]
|
||||
[beginner-true true]
|
||||
[beginner-false false]
|
||||
)
|
||||
check-expect
|
||||
check-within
|
||||
check-error
|
||||
check-member-of
|
||||
check-range
|
||||
;; define-wish
|
||||
#%datum
|
||||
#%top-interaction
|
||||
empty
|
||||
|
||||
; signature : -> mixed one-of predicate combined
|
||||
; Number Real Rational Integer Natural Boolean True False String Symbol Char Empty-list Any
|
||||
; cons-of
|
||||
; Property
|
||||
; check-property for-all ==> expect expect-within expect-member-of expect-range
|
||||
)
|
||||
|
||||
; signature : -> mixed one-of predicate combined
|
||||
; Number Real Rational Integer Natural Boolean True False String Symbol Char Empty-list Any
|
||||
; cons-of
|
||||
; Property
|
||||
; check-property for-all ==> expect expect-within expect-member-of expect-range
|
||||
)
|
||||
|
||||
(require (for-syntax "private/firstorder.rkt"))
|
||||
(require (for-syntax "private/firstorder.rkt"))
|
||||
|
||||
|
||||
(define-syntax (in-rator-position-only stx)
|
||||
(syntax-case stx ()
|
||||
[(_ new-name orig-name)
|
||||
(let ([new (syntax new-name)]
|
||||
[orig (syntax orig-name)])
|
||||
;; Some things are not really functions:
|
||||
(if (memq (syntax-e orig) '(beginner:pi beginner:e beginner:null beginner:eof))
|
||||
#'(define new-name orig-name)
|
||||
#'(define-syntax new-name
|
||||
(make-first-order
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(id . args)
|
||||
(syntax/loc stx (beginner-app orig-name . args))]
|
||||
[_else
|
||||
(raise-syntax-error
|
||||
#f
|
||||
(format
|
||||
"expected a function call, but there is no open parenthesis before this function")
|
||||
stx)]))
|
||||
#'orig-name))))]))
|
||||
|
||||
;; procedures:
|
||||
(provide-and-document/wrap
|
||||
procedures
|
||||
in-rator-position-only
|
||||
(all-from beginner: lang/private/beginner-funs procedures))
|
||||
|
||||
)
|
||||
(define-syntax (in-rator-position-only stx)
|
||||
(syntax-case stx ()
|
||||
[(_ new-name orig-name)
|
||||
(let ([new (syntax new-name)]
|
||||
[orig (syntax orig-name)])
|
||||
;; Some things are not really functions:
|
||||
(if (memq (syntax-e orig) '(beginner:pi beginner:e beginner:null beginner:eof))
|
||||
#'(define new-name orig-name)
|
||||
#'(define-syntax new-name
|
||||
(make-first-order
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(id . args)
|
||||
(syntax/loc stx (beginner-app orig-name . args))]
|
||||
[_else
|
||||
(raise-syntax-error
|
||||
#f
|
||||
(format
|
||||
"expected a function call, but there is no open parenthesis before this function")
|
||||
stx)]))
|
||||
#'orig-name))))]))
|
||||
|
||||
;; procedures:
|
||||
(provide-and-document/wrap
|
||||
procedures
|
||||
in-rator-position-only
|
||||
(all-from beginner: lang/private/beginner-funs procedures))
|
||||
|
|
|
|||
|
|
@ -1,497 +1,499 @@
|
|||
(module beginner-funs scheme
|
||||
(require mzlib/etc mzlib/list mzlib/math syntax/docprovide)
|
||||
#lang scheme
|
||||
(require mzlib/etc mzlib/list mzlib/math syntax/docprovide)
|
||||
|
||||
;; Implements the procedures:
|
||||
(require "teachprims.rkt"
|
||||
"../posn.rkt"
|
||||
"../imageeq.rkt")
|
||||
;; Implements the procedures:
|
||||
(require "teachprims.rkt"
|
||||
"../posn.rkt"
|
||||
"../imageeq.rkt")
|
||||
|
||||
;; procedures with documentation:
|
||||
(provide-and-document
|
||||
procedures
|
||||
|
||||
("Numbers: Integers, Rationals, Reals, Complex, Exacts, Inexacts"
|
||||
(number? (any -> boolean)
|
||||
"Determines whether some value is a number.")
|
||||
(= (number number number ... -> boolean)
|
||||
"Compares numbers for equality.")
|
||||
(< (real real real ... -> boolean)
|
||||
"Compares real numbers for less-than.")
|
||||
(> (real real real ... -> boolean)
|
||||
"Compares real numbers for greater-than.")
|
||||
(<= (real real real ... -> boolean)
|
||||
"Compares real numbers for less-than or equality.")
|
||||
(>= (real real real ... -> boolean)
|
||||
"Compares real numbers for greater-than or equality.")
|
||||
|
||||
((beginner-+ +) (number number number ... -> number)
|
||||
"Evaluates the sum of the input numbers.")
|
||||
(- (number number ... -> number)
|
||||
"subtracts the second (and following) number(s) from the first; negate the number if there is only one argument.")
|
||||
((beginner-* *) (number number number ... -> number)
|
||||
"Evaluates the product of all of the input numbers.")
|
||||
((beginner-/ /) (number number number ... -> number)
|
||||
"Divides the first by the second (and all following) number(s); try (/ 3 4) and (/ 3 2 2)"
|
||||
" only the first number can be zero.")
|
||||
(max (real real ... -> real)
|
||||
"Determines the largest number.")
|
||||
(min (real real ... -> real)
|
||||
"Determines the smallest number.")
|
||||
(quotient (integer integer -> integer)
|
||||
"Divides the second integer---also called divisor---into the first---known as dividend---to obtain the quotient; try (quotient 3 4) and (quotient 4 3).")
|
||||
(remainder (integer integer -> integer)
|
||||
"Determines the remainder of dividing the first by the second integer (exact or inexact).")
|
||||
(modulo (integer integer -> integer)
|
||||
"Finds the remainder of the division of the first number by the second; try (modulo 4 3) (modulo 4 -3).")
|
||||
((beginner-sqr sqr) (number -> number)
|
||||
"Evaluates the square of a number.")
|
||||
(sqrt (number -> number)
|
||||
"Evaluates the square root of a number.")
|
||||
(integer-sqrt (number -> integer)
|
||||
"Evaluates the integer (exact or inexact) square root of a number.")
|
||||
(expt (number number -> number)
|
||||
"Evaluates the power of the first to the second number.")
|
||||
(abs (real -> real)
|
||||
"Evaluates the absolute value of a real number.")
|
||||
(sgn (real -> (union 1 #i1.0 0 #i0.0 -1 #i-1.0))
|
||||
"Evaluates the sign of a real number.")
|
||||
|
||||
;; fancy numeric
|
||||
(exp (number -> number)
|
||||
"Evaluates e raised to a number.")
|
||||
(log (number -> number)
|
||||
"Evaluates the base-e logarithm of a number.")
|
||||
|
||||
;; trigonometry
|
||||
(sin (number -> number)
|
||||
"Evaluates the sine of a number (radians).")
|
||||
(cos (number -> number)
|
||||
"Evaluates the cosine of a number (radians).")
|
||||
(tan (number -> number)
|
||||
"Evaluates the tangent of a number (radians).")
|
||||
(asin (number -> number)
|
||||
"Evaluates the arcsine (inverse of sin) of a number.")
|
||||
(acos (number -> number)
|
||||
"Evaluates the arccosine (inverse of cos) of a number.")
|
||||
(atan (number [number] -> number)
|
||||
"Evaluates the arctan of the given number or the ratio of the two given numbers.")
|
||||
|
||||
(sinh (number -> number)
|
||||
"Evaluates the hyperbolic sine of a number.")
|
||||
(cosh (number -> number)
|
||||
"Evaluates the hyperbolic cosine of a number.")
|
||||
|
||||
(exact? (number -> boolean)
|
||||
"Determines whether some number is exact.")
|
||||
|
||||
(integer? (any -> boolean)
|
||||
"Determines whether some value is an integer (exact or inexact).")
|
||||
|
||||
(zero? (number -> boolean)
|
||||
"Determines if some value is zero or not.")
|
||||
(positive? (number -> boolean)
|
||||
"Determines if some value is strictly larger than zero.")
|
||||
(negative? (number -> boolean)
|
||||
"Determines if some value is strictly smaller than zero.")
|
||||
(odd? (integer -> boolean)
|
||||
"Determines if some integer (exact or inexact) is odd or not.")
|
||||
(even? (integer -> boolean)
|
||||
"Determines if some integer (exact or inexact) is even or not.")
|
||||
|
||||
(add1 (number -> number)
|
||||
"Evaluates a number one larger than a given number.")
|
||||
(sub1 (number -> number)
|
||||
"Evaluates a number one smaller than a given number.")
|
||||
|
||||
(lcm (integer integer ... -> integer)
|
||||
"Evaluates the least common multiple of two integers (exact or inexact).")
|
||||
|
||||
(gcd (integer integer ... -> integer)
|
||||
"Evaluates the greatest common divisior of two integers (exact or inexact).")
|
||||
|
||||
(rational? (any -> boolean)
|
||||
"Determines whether some value is a rational number.")
|
||||
|
||||
(numerator (rat -> integer)
|
||||
"Evaluates the numerator of a rational.")
|
||||
|
||||
(denominator (rat -> integer)
|
||||
"Evaluates the denominator of a rational.")
|
||||
|
||||
(inexact? (number -> boolean)
|
||||
"Determines whether some number is inexact.")
|
||||
|
||||
(real? (any -> boolean)
|
||||
"Determines whether some value is a real number.")
|
||||
|
||||
(floor (real -> integer)
|
||||
"Determines the closest integer (exact or inexact) below a real number.")
|
||||
|
||||
(ceiling (real -> integer)
|
||||
"Determines the closest integer (exact or inexact) above a real number.")
|
||||
|
||||
(round (real -> integer)
|
||||
"Rounds a real number to an integer (rounds to even to break ties).")
|
||||
|
||||
(complex? (any -> boolean)
|
||||
"Determines whether some value is complex.")
|
||||
|
||||
(make-polar (real real -> number)
|
||||
"Creates a complex from a magnitude and angle.")
|
||||
|
||||
(make-rectangular (real real -> number)
|
||||
"Creates a complex from a real and an imaginary part.")
|
||||
|
||||
(real-part (number -> real)
|
||||
"Extracts the real part from a complex number.")
|
||||
|
||||
(imag-part (number -> real)
|
||||
"Extracts the imaginary part from a complex number.")
|
||||
|
||||
(magnitude (number -> real)
|
||||
"Determines the magnitude of a complex number.")
|
||||
|
||||
(angle (number -> real)
|
||||
"Extracts the angle from a complex number.")
|
||||
|
||||
(conjugate (number -> number)
|
||||
"Evaluates the conjugate of a complex number.")
|
||||
|
||||
(exact->inexact (number -> number)
|
||||
"Converts an exact number to an inexact one.")
|
||||
|
||||
(inexact->exact (number -> number)
|
||||
"Approximates an inexact number by an exact one.")
|
||||
|
||||
; "Odds and ends"
|
||||
|
||||
(number->string (number -> string)
|
||||
"Converts a number to a string.")
|
||||
|
||||
(integer->char (integer -> char)
|
||||
"Lookups the character that corresponds to the given integer (exact only!) in the ASCII table (if any).")
|
||||
|
||||
((beginner-random random) (integer -> integer)
|
||||
"Generates a random natural number less than some given integer (exact only!).")
|
||||
|
||||
(current-seconds (-> integer)
|
||||
"Evaluates the current time in seconds elapsed"
|
||||
" (since a platform-specific starting date).")
|
||||
|
||||
(e real
|
||||
"Euler's number.")
|
||||
(pi real
|
||||
"The ratio of a circle's circumference to its diameter."))
|
||||
|
||||
("Booleans"
|
||||
(boolean? (any -> boolean)
|
||||
"Determines whether some value is a boolean.")
|
||||
|
||||
(boolean=? (boolean boolean -> boolean)
|
||||
"Determines whether two booleans are equal.")
|
||||
|
||||
(false? (any -> boolean)
|
||||
"Determines whether a value is false.")
|
||||
|
||||
((beginner-not not) (boolean -> boolean)
|
||||
"Evaluates the negation of a boolean value."))
|
||||
|
||||
("Symbols"
|
||||
(symbol? (any -> boolean)
|
||||
"Determines whether some value is a symbol.")
|
||||
|
||||
(symbol=? (symbol symbol -> boolean)
|
||||
"Determines whether two symbols are equal.")
|
||||
|
||||
(symbol->string (symbol -> string)
|
||||
"Converts a symbol to a string.") )
|
||||
|
||||
("Lists"
|
||||
(cons? (any -> boolean)
|
||||
"Determines whether some value is a constructed list.")
|
||||
#;
|
||||
(pair? (any -> boolean)
|
||||
"Determines whether some value is a constructed list.")
|
||||
(empty? (any -> boolean)
|
||||
"Determines whether some value is the empty list.")
|
||||
(null? (any -> boolean)
|
||||
"Determines whether some value is the empty list.")
|
||||
|
||||
((beginner-cons cons) (X (listof X) -> (listof X))
|
||||
"Constructs a list.")
|
||||
|
||||
(null empty
|
||||
"The empty list.")
|
||||
|
||||
((beginner-first first) ( (cons Y (listof X)) -> Y )
|
||||
"Selects the first item of a non-empty list.")
|
||||
((beginner-car car) ( (cons Y (listof X)) -> Y )
|
||||
"Selects the first item of a non-empty list.")
|
||||
((beginner-rest rest) ((cons Y (listof X)) -> (listof X))
|
||||
"Selects the rest of a non-empty list.")
|
||||
((beginner-cdr cdr) ((cons Y (listof X)) -> (listof X))
|
||||
"Selects the rest of a non-empty list.")
|
||||
|
||||
(second ( (cons Z (cons Y (listof X))) -> Y )
|
||||
"Selects the second item of a non-empty list.")
|
||||
(cadr ( (cons Z (cons Y (listof X))) -> Y )
|
||||
"Selects the second item of a non-empty list.")
|
||||
(cdar ( (cons (cons Z (listof Y)) (listof X)) -> (listof Y) )
|
||||
"Selects the rest of a non-empty list in a list.")
|
||||
(caar ( (cons (cons Z (listof Y)) (listof X)) -> Z )
|
||||
"Selects the first item of the first list in a list.")
|
||||
(cddr ( (cons Z (cons Y (listof X))) -> (listof X) )
|
||||
"Selects the rest of the rest of a list.")
|
||||
(third ( (cons W (cons Z (cons Y (listof X)))) -> Y )
|
||||
"Selects the third item of a non-empty list.")
|
||||
(caddr ( (cons W (cons Z (cons Y (listof X)))) -> Y )
|
||||
"Selects the third item of a non-empty list.")
|
||||
(caadr ( (cons (cons (cons W (listof Z)) (listof Y)) (listof X)) -> (listof Z) )
|
||||
"Selects the rest of the first list in the first list of a list.")
|
||||
(caaar ( (cons (cons (cons W (listof Z)) (listof Y)) (listof X)) -> W )
|
||||
"Selects the first item of the first list in the first list of a list.")
|
||||
(cdaar ( (cons (cons (cons W (listof Z)) (listof Y)) (listof X)) -> (listof Z) )
|
||||
"Selects the rest of the first list in the first list of a list.")
|
||||
(cdadr ( (cons W (cons (cons Z (listof Y)) (listof X))) -> (listof Y) )
|
||||
"Selects the rest of the first list in the rest of a list.")
|
||||
(cadar ( (cons (cons W (cons Z (listof Y))) (listof X)) -> Z )
|
||||
"Selects the second item of the first list of a list.")
|
||||
(cddar ( (cons (cons W (cons Z (listof Y))) (listof X)) -> (listof Y) )
|
||||
"Selects the rest of the rest of the first list of a list.")
|
||||
(cdddr ( (cons W (cons Z (cons Y (listof X)))) -> (listof X) )
|
||||
"Selects the rest of the rest of the rest of a list.")
|
||||
(fourth ( (listof Y) -> Y ) ; domain: (cons V (cons W (cons Z (cons Y (listof X)))))
|
||||
"Selects the fourth item of a non-empty list.")
|
||||
(cadddr ( (listof Y) -> Y ) ; domain: (cons V (cons W (cons Z (cons Y (listof X)))))
|
||||
"Selects the fourth item of a non-empty list.")
|
||||
(fifth ( (listof Y) -> Y ) ; domain: (cons U (cons V (cons W (cons Z (cons Y (listof X))))))
|
||||
"Selects the fifth item of a non-empty list.")
|
||||
(sixth ( (listof Y) -> Y ) ; domain: (cons T (cons U (cons V (cons W (cons Z (cons Y (listof X)))))))
|
||||
"Selects the sixth item of a non-empty list.")
|
||||
(seventh ( (listof Y) -> Y ) ; domain: (cons S (cons T (cons U (cons V (cons W (cons Z (cons Y (listof X))))))))
|
||||
"Selects the seventh item of a non-empty list.")
|
||||
(eighth ( (listof Y) -> Y ) ; domain: (cons R (cons S (cons T (cons U (cons V (cons W (cons Z (cons Y (listof X)))))))))
|
||||
"Selects the eighth item of a non-empty list.")
|
||||
|
||||
(list-ref ((listof X) natural-number -> X )
|
||||
"Extracts the indexed item from the list.")
|
||||
|
||||
(list (any ... -> (listof any)) "Constructs a list of its arguments.")
|
||||
|
||||
(make-list (natural-number any -> (listof any))
|
||||
"Constructs a list of k (the first argument) copies of x (the second argument).")
|
||||
|
||||
((beginner-list* list*) (any ... (listof any) -> (listof any))
|
||||
"Constructs a list by adding multiple items to a list.")
|
||||
|
||||
((beginner-append append) ((listof any) (listof any) (listof any) ... -> (listof any))
|
||||
"Creates a single list from several, by juxtaposition of the items.")
|
||||
(length ((listof any) -> number)
|
||||
"Evaluates the number of items on a list.")
|
||||
(memq (any (listof any) -> (union false list))
|
||||
"Determines whether some value is on some list"
|
||||
" if so, it produces the suffix of the list that starts with x"
|
||||
" if not, it produces false."
|
||||
" (It compares values with the eq? predicate.)")
|
||||
(memv (any (listof any) -> (union false list))
|
||||
"Determines whether some value is on the list"
|
||||
" if so, it produces the suffix of the list that starts with x"
|
||||
" if not, it produces false."
|
||||
" (It compares values with the eqv? predicate.)")
|
||||
((beginner-member? member?) (any (listof any) -> boolean)
|
||||
"Determines whether some value is on the list"
|
||||
" (comparing values with equal?).")
|
||||
((beginner-member member) (any (listof any) -> boolean)
|
||||
"Determines whether some value is on the list"
|
||||
" (comparing values with equal?).")
|
||||
((beginner-remove remove) (any (listof any) -> (listof any))
|
||||
"Constructs a list like the given one with the first occurrence of the given item removed"
|
||||
" (comparing values with equal?).")
|
||||
(reverse ((listof any) -> list)
|
||||
"Creates a reversed version of a list.")
|
||||
(assq (X (listof (cons X Y)) -> (union false (cons X Y)))
|
||||
"Determines whether some item is the first item of a pair"
|
||||
" in a list of pairs."))
|
||||
|
||||
("Posns"
|
||||
(posn signature "Signature for posns.")
|
||||
(make-posn (any any -> posn) "Constructs a posn from two arbitrary values.")
|
||||
(posn? (any -> boolean) "Determines if its input is a posn.")
|
||||
(posn-x (posn -> any) "Extracts the x component of a posn.")
|
||||
(posn-y (posn -> any) "Extracts the y component of a posn."))
|
||||
|
||||
("Characters"
|
||||
(char? (any -> boolean)
|
||||
"Determines whether a value is a character.")
|
||||
(char=? (char char char ... -> boolean)
|
||||
"Determines whether two characters are equal.")
|
||||
(char<? (char char char ... -> boolean)
|
||||
"Determines whether a character precedes another.")
|
||||
(char>? (char char char ... -> boolean)
|
||||
"Determines whether a character succeeds another.")
|
||||
(char<=? (char char char ... -> boolean)
|
||||
"Determines whether a character precedes another"
|
||||
" (or is equal to it).")
|
||||
(char>=? (char char char ... -> boolean)
|
||||
"Determines whether a character succeeds another"
|
||||
" (or is equal to it).")
|
||||
|
||||
(char-ci=? (char char char ... -> boolean)
|
||||
"Determines whether two characters are equal"
|
||||
" in a case-insensitive manner.")
|
||||
(char-ci<? (char char char ... -> boolean)
|
||||
"Determines whether a character precedes another"
|
||||
" in a case-insensitive manner.")
|
||||
(char-ci>? (char char char ... -> boolean)
|
||||
"Determines whether a character succeeds another"
|
||||
" in a case-insensitive manner.")
|
||||
(char-ci<=? (char char char ... -> boolean)
|
||||
"Determines whether a character precedes another"
|
||||
" (or is equal to it) in a case-insensitive manner.")
|
||||
(char-ci>=? (char char char ... -> boolean)
|
||||
"Determines whether a character succeeds another"
|
||||
" (or is equal to it) in a case-insensitive manner.")
|
||||
|
||||
(char-numeric? (char -> boolean)
|
||||
"Determines whether a character represents a digit.")
|
||||
(char-alphabetic? (char -> boolean)
|
||||
"Determines whether a character represents"
|
||||
" an alphabetic character.")
|
||||
(char-whitespace? (char -> boolean)
|
||||
"Determines whether a character represents space.")
|
||||
(char-upper-case? (char -> boolean)
|
||||
"Determines whether a character is an"
|
||||
" upper-case character.")
|
||||
(char-lower-case? (char -> boolean)
|
||||
"Determines whether a character is a"
|
||||
" lower-case character.")
|
||||
(char-upcase (char -> char)
|
||||
"Determines the equivalent upper-case character.")
|
||||
(char-downcase (char -> char)
|
||||
"Determines the equivalent lower-case character.")
|
||||
(char->integer (char -> integer)
|
||||
"Lookups the number that corresponds to the"
|
||||
" given character in the ASCII table (if any)."))
|
||||
|
||||
("Strings"
|
||||
(string? (any -> boolean)
|
||||
"Determines whether a value is a string.")
|
||||
(string-length (string -> nat)
|
||||
"Determines the length of a string.")
|
||||
|
||||
((beginner-string-ith string-ith) (string nat -> string)
|
||||
"Extracts the ith 1-letter substring from the given one.")
|
||||
((beginner-replicate replicate) (nat string -> string)
|
||||
"Replicates the given string.")
|
||||
((beginner-int->string int->string) (integer -> string)
|
||||
"Converts an integer in [0,55295] or [57344 1114111] to a 1-letter string.")
|
||||
((beginner-string->int string->int) (string -> integer)
|
||||
"Converts a 1-letter string to an integer in [0,55295] or [57344, 1114111].")
|
||||
((beginner-explode explode) (string -> (listof string))
|
||||
"Translates a string into a list of 1-letter strings.")
|
||||
((beginner-implode implode) ((listof string) -> string)
|
||||
"Concatenates the list of 1-letter strings into one string.")
|
||||
((beginner-string-numeric? string-numeric?) (string -> boolean)
|
||||
"Determines whether all 'letters' in the string are numeric.")
|
||||
((beginner-string-alphabetic? string-alphabetic?) (string -> boolean)
|
||||
"Determines whether all 'letters' in the string are alphabetic.")
|
||||
((beginner-string-whitespace? string-whitespace?) (string -> boolean)
|
||||
"Determines whether all 'letters' in the string are white space.")
|
||||
((beginner-string-upper-case? string-upper-case?) (string -> boolean)
|
||||
"Determines whether all 'letters' in the string are upper case.")
|
||||
((beginner-string-lower-case? string-lower-case?) (string -> boolean)
|
||||
"Determines whether all 'letters' in the string are lower case.")
|
||||
;; procedures with documentation:
|
||||
(provide-and-document
|
||||
procedures
|
||||
|
||||
(string (char ... -> string)
|
||||
"Builds a string of the given characters.")
|
||||
(make-string (nat char -> string)
|
||||
"Produces a string of given length"
|
||||
" from a single given character.")
|
||||
(string-ref (string nat -> char)
|
||||
"Extracts the i-the character from a string.")
|
||||
|
||||
(substring (string nat nat -> string)
|
||||
"Extracts the substring starting at a 0-based index"
|
||||
" up to the second 0-based index (exclusive).")
|
||||
(string-copy (string -> string)
|
||||
"Copies a string.")
|
||||
(string-append (string ... -> string)
|
||||
"Juxtaposes the characters of several strings.")
|
||||
|
||||
(string=? (string string string ... -> boolean)
|
||||
"Compares two strings character-wise.")
|
||||
(string<? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" precedes another.")
|
||||
(string>? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" succeeds another.")
|
||||
(string<=? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" precedes another (or is equal to it).")
|
||||
(string>=? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" succeeds another (or is equal to it).")
|
||||
|
||||
(string-ci=? (string string string ... -> boolean)
|
||||
"Compares two strings character-wise"
|
||||
" in a case-insensitive manner.")
|
||||
(string-ci<? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" precedes another in a case-insensitive manner.")
|
||||
(string-ci>? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" succeeds another in a case-insensitive manner.")
|
||||
(string-ci<=? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" precedes another (or is equal to it)"
|
||||
" in a case-insensitive manner.")
|
||||
(string-ci>=? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" succeeds another (or is equal to it)"
|
||||
" in a case-insensitive manner.")
|
||||
|
||||
(string->symbol (string -> symbol)
|
||||
"Converts a string into a symbol.")
|
||||
(string->number (string -> (union number false))
|
||||
"Converts a string into a number,"
|
||||
" produce false if impossible.")
|
||||
(string->list (string -> (listof char))
|
||||
"Converts a string into a list of characters.")
|
||||
(list->string ((listof char) -> string)
|
||||
"Converts a s list of characters into a string.")
|
||||
|
||||
(format (string any ... -> string)
|
||||
"Formats a string, possibly embedding values."))
|
||||
|
||||
("Images"
|
||||
(image? (any -> boolean)
|
||||
"Determines whether a value is an image.")
|
||||
(image=? (image image -> boolean)
|
||||
"Determines whether two images are equal."))
|
||||
|
||||
("Misc"
|
||||
(identity (any -> any)
|
||||
"Returns the argument unchanged.")
|
||||
((beginner-error error) (any ... -> void) "signals an error, combining the given values into an error message.\n\nIf any of the values' printed representations is too long, it is truncated and ``...'' is put into the string. If the first value is a symbol, it is treated specially; it is suffixed with a colon and a space (the intention is that the symbol is the name of the function signaling the error).")
|
||||
((beginner-struct? struct?) (any -> boolean)
|
||||
"Determines whether some value is a structure.")
|
||||
((beginner-equal? equal?) (any any -> boolean)
|
||||
"Determines whether two values are structurally equal"
|
||||
" where basic values are compared with the eqv? predicate.")
|
||||
(eq? (any any -> boolean)
|
||||
"Determines whether two values are equivalent from the"
|
||||
" computer's perspective (intensional).")
|
||||
(eqv? (any any -> boolean)
|
||||
"Determines whether two values are equivalent from the"
|
||||
" perspective of all functions that can be applied to it (extensional).")
|
||||
((beginner-=~ =~) (number number non-negative-real -> boolean)
|
||||
"Checks whether two numbers are within some amount (the third argument) of either other.")
|
||||
((beginner-equal~? equal~?) (any any non-negative-real -> boolean)
|
||||
"Compares like equal? on the first two arguments, except using =~ in the case of numbers.")
|
||||
(eof eof
|
||||
"The end-of-file value.")
|
||||
(eof-object? (any -> boolean)
|
||||
"Determines whether some value is the end-of-file value.")
|
||||
((beginner-exit exit) ( -> void)
|
||||
"Exits the running program."))))
|
||||
("Numbers: Integers, Rationals, Reals, Complex, Exacts, Inexacts"
|
||||
(number? (any -> boolean)
|
||||
"Determines whether some value is a number.")
|
||||
(= (number number number ... -> boolean)
|
||||
"Compares numbers for equality.")
|
||||
(< (real real real ... -> boolean)
|
||||
"Compares real numbers for less-than.")
|
||||
(> (real real real ... -> boolean)
|
||||
"Compares real numbers for greater-than.")
|
||||
(<= (real real real ... -> boolean)
|
||||
"Compares real numbers for less-than or equality.")
|
||||
(>= (real real real ... -> boolean)
|
||||
"Compares real numbers for greater-than or equality.")
|
||||
|
||||
((beginner-+ +) (number number number ... -> number)
|
||||
"Evaluates the sum of the input numbers.")
|
||||
(- (number number ... -> number)
|
||||
"subtracts the second (and following) number(s) from the first; negate the number if there is only one argument.")
|
||||
((beginner-* *) (number number number ... -> number)
|
||||
"Evaluates the product of all of the input numbers.")
|
||||
((beginner-/ /) (number number number ... -> number)
|
||||
"Divides the first by the second (and all following) number(s); try (/ 3 4) and (/ 3 2 2)"
|
||||
" only the first number can be zero.")
|
||||
(max (real real ... -> real)
|
||||
"Determines the largest number.")
|
||||
(min (real real ... -> real)
|
||||
"Determines the smallest number.")
|
||||
(quotient (integer integer -> integer)
|
||||
"Divides the second integer---also called divisor---into the first---known as dividend---to obtain the quotient; try (quotient 3 4) and (quotient 4 3).")
|
||||
(remainder (integer integer -> integer)
|
||||
"Determines the remainder of dividing the first by the second integer (exact or inexact).")
|
||||
(modulo (integer integer -> integer)
|
||||
"Finds the remainder of the division of the first number by the second; try (modulo 4 3) (modulo 4 -3).")
|
||||
((beginner-sqr sqr) (number -> number)
|
||||
"Evaluates the square of a number.")
|
||||
(sqrt (number -> number)
|
||||
"Evaluates the square root of a number.")
|
||||
(integer-sqrt (number -> integer)
|
||||
"Evaluates the integer (exact or inexact) square root of a number.")
|
||||
(expt (number number -> number)
|
||||
"Evaluates the power of the first to the second number.")
|
||||
(abs (real -> real)
|
||||
"Evaluates the absolute value of a real number.")
|
||||
(sgn (real -> (union 1 #i1.0 0 #i0.0 -1 #i-1.0))
|
||||
"Evaluates the sign of a real number.")
|
||||
|
||||
;; fancy numeric
|
||||
(exp (number -> number)
|
||||
"Evaluates e raised to a number.")
|
||||
(log (number -> number)
|
||||
"Evaluates the base-e logarithm of a number.")
|
||||
|
||||
;; trigonometry
|
||||
(sin (number -> number)
|
||||
"Evaluates the sine of a number (radians).")
|
||||
(cos (number -> number)
|
||||
"Evaluates the cosine of a number (radians).")
|
||||
(tan (number -> number)
|
||||
"Evaluates the tangent of a number (radians).")
|
||||
(asin (number -> number)
|
||||
"Evaluates the arcsine (inverse of sin) of a number.")
|
||||
(acos (number -> number)
|
||||
"Evaluates the arccosine (inverse of cos) of a number.")
|
||||
(atan (number [number] -> number)
|
||||
"Evaluates the arctan of the given number or the ratio of the two given numbers.")
|
||||
|
||||
(sinh (number -> number)
|
||||
"Evaluates the hyperbolic sine of a number.")
|
||||
(cosh (number -> number)
|
||||
"Evaluates the hyperbolic cosine of a number.")
|
||||
|
||||
(exact? (number -> boolean)
|
||||
"Determines whether some number is exact.")
|
||||
|
||||
(integer? (any -> boolean)
|
||||
"Determines whether some value is an integer (exact or inexact).")
|
||||
|
||||
(zero? (number -> boolean)
|
||||
"Determines if some value is zero or not.")
|
||||
(positive? (number -> boolean)
|
||||
"Determines if some value is strictly larger than zero.")
|
||||
(negative? (number -> boolean)
|
||||
"Determines if some value is strictly smaller than zero.")
|
||||
(odd? (integer -> boolean)
|
||||
"Determines if some integer (exact or inexact) is odd or not.")
|
||||
(even? (integer -> boolean)
|
||||
"Determines if some integer (exact or inexact) is even or not.")
|
||||
|
||||
(add1 (number -> number)
|
||||
"Evaluates a number one larger than a given number.")
|
||||
(sub1 (number -> number)
|
||||
"Evaluates a number one smaller than a given number.")
|
||||
|
||||
(lcm (integer integer ... -> integer)
|
||||
"Evaluates the least common multiple of two integers (exact or inexact).")
|
||||
|
||||
(gcd (integer integer ... -> integer)
|
||||
"Evaluates the greatest common divisior of two integers (exact or inexact).")
|
||||
|
||||
(rational? (any -> boolean)
|
||||
"Determines whether some value is a rational number.")
|
||||
|
||||
(numerator (rat -> integer)
|
||||
"Evaluates the numerator of a rational.")
|
||||
|
||||
(denominator (rat -> integer)
|
||||
"Evaluates the denominator of a rational.")
|
||||
|
||||
(inexact? (number -> boolean)
|
||||
"Determines whether some number is inexact.")
|
||||
|
||||
(real? (any -> boolean)
|
||||
"Determines whether some value is a real number.")
|
||||
|
||||
(floor (real -> integer)
|
||||
"Determines the closest integer (exact or inexact) below a real number.")
|
||||
|
||||
(ceiling (real -> integer)
|
||||
"Determines the closest integer (exact or inexact) above a real number.")
|
||||
|
||||
(round (real -> integer)
|
||||
"Rounds a real number to an integer (rounds to even to break ties).")
|
||||
|
||||
(complex? (any -> boolean)
|
||||
"Determines whether some value is complex.")
|
||||
|
||||
(make-polar (real real -> number)
|
||||
"Creates a complex from a magnitude and angle.")
|
||||
|
||||
(make-rectangular (real real -> number)
|
||||
"Creates a complex from a real and an imaginary part.")
|
||||
|
||||
(real-part (number -> real)
|
||||
"Extracts the real part from a complex number.")
|
||||
|
||||
(imag-part (number -> real)
|
||||
"Extracts the imaginary part from a complex number.")
|
||||
|
||||
(magnitude (number -> real)
|
||||
"Determines the magnitude of a complex number.")
|
||||
|
||||
(angle (number -> real)
|
||||
"Extracts the angle from a complex number.")
|
||||
|
||||
(conjugate (number -> number)
|
||||
"Evaluates the conjugate of a complex number.")
|
||||
|
||||
(exact->inexact (number -> number)
|
||||
"Converts an exact number to an inexact one.")
|
||||
|
||||
(inexact->exact (number -> number)
|
||||
"Approximates an inexact number by an exact one.")
|
||||
|
||||
; "Odds and ends"
|
||||
|
||||
(number->string (number -> string)
|
||||
"Converts a number to a string.")
|
||||
|
||||
(integer->char (integer -> char)
|
||||
"Lookups the character that corresponds to the given integer (exact only!) in the ASCII table (if any).")
|
||||
|
||||
((beginner-random random) (integer -> integer)
|
||||
"Generates a random natural number less than some given integer (exact only!).")
|
||||
|
||||
(current-seconds (-> integer)
|
||||
"Evaluates the current time in seconds elapsed"
|
||||
" (since a platform-specific starting date).")
|
||||
|
||||
(e real
|
||||
"Euler's number.")
|
||||
(pi real
|
||||
"The ratio of a circle's circumference to its diameter."))
|
||||
|
||||
("Booleans"
|
||||
(boolean? (any -> boolean)
|
||||
"Determines whether some value is a boolean.")
|
||||
|
||||
(boolean=? (boolean boolean -> boolean)
|
||||
"Determines whether two booleans are equal.")
|
||||
|
||||
(false? (any -> boolean)
|
||||
"Determines whether a value is false.")
|
||||
|
||||
((beginner-not not) (boolean -> boolean)
|
||||
"Evaluates the negation of a boolean value."))
|
||||
|
||||
("Symbols"
|
||||
(symbol? (any -> boolean)
|
||||
"Determines whether some value is a symbol.")
|
||||
|
||||
(symbol=? (symbol symbol -> boolean)
|
||||
"Determines whether two symbols are equal.")
|
||||
|
||||
(symbol->string (symbol -> string)
|
||||
"Converts a symbol to a string.") )
|
||||
|
||||
("Lists"
|
||||
(cons? (any -> boolean)
|
||||
"Determines whether some value is a constructed list.")
|
||||
#;
|
||||
(pair? (any -> boolean)
|
||||
"Determines whether some value is a constructed list.")
|
||||
(empty? (any -> boolean)
|
||||
"Determines whether some value is the empty list.")
|
||||
(null? (any -> boolean)
|
||||
"Determines whether some value is the empty list.")
|
||||
|
||||
((beginner-cons cons) (X (listof X) -> (listof X))
|
||||
"Constructs a list.")
|
||||
|
||||
(null empty
|
||||
"The empty list.")
|
||||
|
||||
((beginner-first first) ( (cons Y (listof X)) -> Y )
|
||||
"Selects the first item of a non-empty list.")
|
||||
((beginner-car car) ( (cons Y (listof X)) -> Y )
|
||||
"Selects the first item of a non-empty list.")
|
||||
((beginner-rest rest) ((cons Y (listof X)) -> (listof X))
|
||||
"Selects the rest of a non-empty list.")
|
||||
((beginner-cdr cdr) ((cons Y (listof X)) -> (listof X))
|
||||
"Selects the rest of a non-empty list.")
|
||||
|
||||
(second ( (cons Z (cons Y (listof X))) -> Y )
|
||||
"Selects the second item of a non-empty list.")
|
||||
(cadr ( (cons Z (cons Y (listof X))) -> Y )
|
||||
"Selects the second item of a non-empty list.")
|
||||
(cdar ( (cons (cons Z (listof Y)) (listof X)) -> (listof Y) )
|
||||
"Selects the rest of a non-empty list in a list.")
|
||||
(caar ( (cons (cons Z (listof Y)) (listof X)) -> Z )
|
||||
"Selects the first item of the first list in a list.")
|
||||
(cddr ( (cons Z (cons Y (listof X))) -> (listof X) )
|
||||
"Selects the rest of the rest of a list.")
|
||||
(third ( (cons W (cons Z (cons Y (listof X)))) -> Y )
|
||||
"Selects the third item of a non-empty list.")
|
||||
(caddr ( (cons W (cons Z (cons Y (listof X)))) -> Y )
|
||||
"Selects the third item of a non-empty list.")
|
||||
(caadr ( (cons (cons (cons W (listof Z)) (listof Y)) (listof X)) -> (listof Z) )
|
||||
"Selects the rest of the first list in the first list of a list.")
|
||||
(caaar ( (cons (cons (cons W (listof Z)) (listof Y)) (listof X)) -> W )
|
||||
"Selects the first item of the first list in the first list of a list.")
|
||||
(cdaar ( (cons (cons (cons W (listof Z)) (listof Y)) (listof X)) -> (listof Z) )
|
||||
"Selects the rest of the first list in the first list of a list.")
|
||||
(cdadr ( (cons W (cons (cons Z (listof Y)) (listof X))) -> (listof Y) )
|
||||
"Selects the rest of the first list in the rest of a list.")
|
||||
(cadar ( (cons (cons W (cons Z (listof Y))) (listof X)) -> Z )
|
||||
"Selects the second item of the first list of a list.")
|
||||
(cddar ( (cons (cons W (cons Z (listof Y))) (listof X)) -> (listof Y) )
|
||||
"Selects the rest of the rest of the first list of a list.")
|
||||
(cdddr ( (cons W (cons Z (cons Y (listof X)))) -> (listof X) )
|
||||
"Selects the rest of the rest of the rest of a list.")
|
||||
(fourth ( (listof Y) -> Y ) ; domain: (cons V (cons W (cons Z (cons Y (listof X)))))
|
||||
"Selects the fourth item of a non-empty list.")
|
||||
(cadddr ( (listof Y) -> Y ) ; domain: (cons V (cons W (cons Z (cons Y (listof X)))))
|
||||
"Selects the fourth item of a non-empty list.")
|
||||
(fifth ( (listof Y) -> Y ) ; domain: (cons U (cons V (cons W (cons Z (cons Y (listof X))))))
|
||||
"Selects the fifth item of a non-empty list.")
|
||||
(sixth ( (listof Y) -> Y ) ; domain: (cons T (cons U (cons V (cons W (cons Z (cons Y (listof X)))))))
|
||||
"Selects the sixth item of a non-empty list.")
|
||||
(seventh ( (listof Y) -> Y ) ; domain: (cons S (cons T (cons U (cons V (cons W (cons Z (cons Y (listof X))))))))
|
||||
"Selects the seventh item of a non-empty list.")
|
||||
(eighth ( (listof Y) -> Y ) ; domain: (cons R (cons S (cons T (cons U (cons V (cons W (cons Z (cons Y (listof X)))))))))
|
||||
"Selects the eighth item of a non-empty list.")
|
||||
|
||||
(list-ref ((listof X) natural-number -> X )
|
||||
"Extracts the indexed item from the list.")
|
||||
|
||||
(list (any ... -> (listof any)) "Constructs a list of its arguments.")
|
||||
|
||||
(make-list (natural-number any -> (listof any))
|
||||
"Constructs a list of k (the first argument) copies of x (the second argument).")
|
||||
|
||||
((beginner-list* list*) (any ... (listof any) -> (listof any))
|
||||
"Constructs a list by adding multiple items to a list.")
|
||||
((beginner-range range) (number number number -> (listof number))
|
||||
"(range start end step) constructs a list of numbers by _step_ping from _start_ to _end_ list.")
|
||||
|
||||
((beginner-append append) ((listof any) (listof any) (listof any) ... -> (listof any))
|
||||
"Creates a single list from several, by juxtaposition of the items.")
|
||||
(length ((listof any) -> number)
|
||||
"Evaluates the number of items on a list.")
|
||||
(memq (any (listof any) -> (union false list))
|
||||
"Determines whether some value is on some list"
|
||||
" if so, it produces the suffix of the list that starts with x"
|
||||
" if not, it produces false."
|
||||
" (It compares values with the eq? predicate.)")
|
||||
(memv (any (listof any) -> (union false list))
|
||||
"Determines whether some value is on the list"
|
||||
" if so, it produces the suffix of the list that starts with x"
|
||||
" if not, it produces false."
|
||||
" (It compares values with the eqv? predicate.)")
|
||||
((beginner-member? member?) (any (listof any) -> boolean)
|
||||
"Determines whether some value is on the list"
|
||||
" (comparing values with equal?).")
|
||||
((beginner-member member) (any (listof any) -> boolean)
|
||||
"Determines whether some value is on the list"
|
||||
" (comparing values with equal?).")
|
||||
((beginner-remove remove) (any (listof any) -> (listof any))
|
||||
"Constructs a list like the given one with the first occurrence of the given item removed"
|
||||
" (comparing values with equal?).")
|
||||
(reverse ((listof any) -> list)
|
||||
"Creates a reversed version of a list.")
|
||||
(assq (X (listof (cons X Y)) -> (union false (cons X Y)))
|
||||
"Determines whether some item is the first item of a pair"
|
||||
" in a list of pairs."))
|
||||
|
||||
("Posns"
|
||||
(posn signature "Signature for posns.")
|
||||
(make-posn (any any -> posn) "Constructs a posn from two arbitrary values.")
|
||||
(posn? (any -> boolean) "Determines if its input is a posn.")
|
||||
(posn-x (posn -> any) "Extracts the x component of a posn.")
|
||||
(posn-y (posn -> any) "Extracts the y component of a posn."))
|
||||
|
||||
("Characters"
|
||||
(char? (any -> boolean)
|
||||
"Determines whether a value is a character.")
|
||||
(char=? (char char char ... -> boolean)
|
||||
"Determines whether two characters are equal.")
|
||||
(char<? (char char char ... -> boolean)
|
||||
"Determines whether a character precedes another.")
|
||||
(char>? (char char char ... -> boolean)
|
||||
"Determines whether a character succeeds another.")
|
||||
(char<=? (char char char ... -> boolean)
|
||||
"Determines whether a character precedes another"
|
||||
" (or is equal to it).")
|
||||
(char>=? (char char char ... -> boolean)
|
||||
"Determines whether a character succeeds another"
|
||||
" (or is equal to it).")
|
||||
|
||||
(char-ci=? (char char char ... -> boolean)
|
||||
"Determines whether two characters are equal"
|
||||
" in a case-insensitive manner.")
|
||||
(char-ci<? (char char char ... -> boolean)
|
||||
"Determines whether a character precedes another"
|
||||
" in a case-insensitive manner.")
|
||||
(char-ci>? (char char char ... -> boolean)
|
||||
"Determines whether a character succeeds another"
|
||||
" in a case-insensitive manner.")
|
||||
(char-ci<=? (char char char ... -> boolean)
|
||||
"Determines whether a character precedes another"
|
||||
" (or is equal to it) in a case-insensitive manner.")
|
||||
(char-ci>=? (char char char ... -> boolean)
|
||||
"Determines whether a character succeeds another"
|
||||
" (or is equal to it) in a case-insensitive manner.")
|
||||
|
||||
(char-numeric? (char -> boolean)
|
||||
"Determines whether a character represents a digit.")
|
||||
(char-alphabetic? (char -> boolean)
|
||||
"Determines whether a character represents"
|
||||
" an alphabetic character.")
|
||||
(char-whitespace? (char -> boolean)
|
||||
"Determines whether a character represents space.")
|
||||
(char-upper-case? (char -> boolean)
|
||||
"Determines whether a character is an"
|
||||
" upper-case character.")
|
||||
(char-lower-case? (char -> boolean)
|
||||
"Determines whether a character is a"
|
||||
" lower-case character.")
|
||||
(char-upcase (char -> char)
|
||||
"Determines the equivalent upper-case character.")
|
||||
(char-downcase (char -> char)
|
||||
"Determines the equivalent lower-case character.")
|
||||
(char->integer (char -> integer)
|
||||
"Lookups the number that corresponds to the"
|
||||
" given character in the ASCII table (if any)."))
|
||||
|
||||
("Strings"
|
||||
(string? (any -> boolean)
|
||||
"Determines whether a value is a string.")
|
||||
(string-length (string -> nat)
|
||||
"Determines the length of a string.")
|
||||
|
||||
((beginner-string-ith string-ith) (string nat -> string)
|
||||
"Extracts the ith 1-letter substring from the given one.")
|
||||
((beginner-replicate replicate) (nat string -> string)
|
||||
"Replicates the given string.")
|
||||
((beginner-int->string int->string) (integer -> string)
|
||||
"Converts an integer in [0,55295] or [57344 1114111] to a 1-letter string.")
|
||||
((beginner-string->int string->int) (string -> integer)
|
||||
"Converts a 1-letter string to an integer in [0,55295] or [57344, 1114111].")
|
||||
((beginner-explode explode) (string -> (listof string))
|
||||
"Translates a string into a list of 1-letter strings.")
|
||||
((beginner-implode implode) ((listof string) -> string)
|
||||
"Concatenates the list of 1-letter strings into one string.")
|
||||
((beginner-string-numeric? string-numeric?) (string -> boolean)
|
||||
"Determines whether all 'letters' in the string are numeric.")
|
||||
((beginner-string-alphabetic? string-alphabetic?) (string -> boolean)
|
||||
"Determines whether all 'letters' in the string are alphabetic.")
|
||||
((beginner-string-whitespace? string-whitespace?) (string -> boolean)
|
||||
"Determines whether all 'letters' in the string are white space.")
|
||||
((beginner-string-upper-case? string-upper-case?) (string -> boolean)
|
||||
"Determines whether all 'letters' in the string are upper case.")
|
||||
((beginner-string-lower-case? string-lower-case?) (string -> boolean)
|
||||
"Determines whether all 'letters' in the string are lower case.")
|
||||
|
||||
(string (char ... -> string)
|
||||
"Builds a string of the given characters.")
|
||||
(make-string (nat char -> string)
|
||||
"Produces a string of given length"
|
||||
" from a single given character.")
|
||||
(string-ref (string nat -> char)
|
||||
"Extracts the i-the character from a string.")
|
||||
|
||||
(substring (string nat nat -> string)
|
||||
"Extracts the substring starting at a 0-based index"
|
||||
" up to the second 0-based index (exclusive).")
|
||||
(string-copy (string -> string)
|
||||
"Copies a string.")
|
||||
(string-append (string ... -> string)
|
||||
"Juxtaposes the characters of several strings.")
|
||||
|
||||
(string=? (string string string ... -> boolean)
|
||||
"Compares two strings character-wise.")
|
||||
(string<? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" precedes another.")
|
||||
(string>? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" succeeds another.")
|
||||
(string<=? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" precedes another (or is equal to it).")
|
||||
(string>=? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" succeeds another (or is equal to it).")
|
||||
|
||||
(string-ci=? (string string string ... -> boolean)
|
||||
"Compares two strings character-wise"
|
||||
" in a case-insensitive manner.")
|
||||
(string-ci<? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" precedes another in a case-insensitive manner.")
|
||||
(string-ci>? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" succeeds another in a case-insensitive manner.")
|
||||
(string-ci<=? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" precedes another (or is equal to it)"
|
||||
" in a case-insensitive manner.")
|
||||
(string-ci>=? (string string string ... -> boolean)
|
||||
"Determines whether one string alphabetically"
|
||||
" succeeds another (or is equal to it)"
|
||||
" in a case-insensitive manner.")
|
||||
|
||||
(string->symbol (string -> symbol)
|
||||
"Converts a string into a symbol.")
|
||||
(string->number (string -> (union number false))
|
||||
"Converts a string into a number,"
|
||||
" produce false if impossible.")
|
||||
(string->list (string -> (listof char))
|
||||
"Converts a string into a list of characters.")
|
||||
(list->string ((listof char) -> string)
|
||||
"Converts a s list of characters into a string.")
|
||||
|
||||
(format (string any ... -> string)
|
||||
"Formats a string, possibly embedding values."))
|
||||
|
||||
("Images"
|
||||
(image? (any -> boolean)
|
||||
"Determines whether a value is an image.")
|
||||
(image=? (image image -> boolean)
|
||||
"Determines whether two images are equal."))
|
||||
|
||||
("Misc"
|
||||
(identity (any -> any)
|
||||
"Returns the argument unchanged.")
|
||||
((beginner-error error) (any ... -> void) "signals an error, combining the given values into an error message.\n\nIf any of the values' printed representations is too long, it is truncated and ``...'' is put into the string. If the first value is a symbol, it is treated specially; it is suffixed with a colon and a space (the intention is that the symbol is the name of the function signaling the error).")
|
||||
((beginner-struct? struct?) (any -> boolean)
|
||||
"Determines whether some value is a structure.")
|
||||
((beginner-equal? equal?) (any any -> boolean)
|
||||
"Determines whether two values are structurally equal"
|
||||
" where basic values are compared with the eqv? predicate.")
|
||||
(eq? (any any -> boolean)
|
||||
"Determines whether two values are equivalent from the"
|
||||
" computer's perspective (intensional).")
|
||||
(eqv? (any any -> boolean)
|
||||
"Determines whether two values are equivalent from the"
|
||||
" perspective of all functions that can be applied to it (extensional).")
|
||||
((beginner-=~ =~) (number number non-negative-real -> boolean)
|
||||
"Checks whether two numbers are within some amount (the third argument) of either other.")
|
||||
((beginner-equal~? equal~?) (any any non-negative-real -> boolean)
|
||||
"Compares like equal? on the first two arguments, except using =~ in the case of numbers.")
|
||||
(eof eof
|
||||
"The end-of-file value.")
|
||||
(eof-object? (any -> boolean)
|
||||
"Determines whether some value is the end-of-file value.")
|
||||
((beginner-exit exit) ( -> void)
|
||||
"Exits the running program.")))
|
||||
|
|
|
|||
|
|
@ -38,21 +38,8 @@ namespace.
|
|||
(lambda (x)
|
||||
(or (null? x) (pair? x))))
|
||||
|
||||
;; Don't need this anymore, since we just check for pairs:
|
||||
#;
|
||||
(define cyclic-list?
|
||||
(lambda (l)
|
||||
(or (list? l)
|
||||
(and (pair? l)
|
||||
(let loop ([hare (cdr l)][turtle l])
|
||||
(cond
|
||||
[(eq? hare turtle) #t]
|
||||
[(not (pair? hare)) #f]
|
||||
[(eq? (cdr hare) turtle) #t]
|
||||
[(not (pair? (cdr hare))) #f]
|
||||
[else (loop (cddr hare) (cdr turtle))]))))))
|
||||
|
||||
(define cyclic-list? beginner-list?)
|
||||
;; don't need a special anymore, since we just check for pairs:
|
||||
|
||||
(define (build-arg-list args)
|
||||
(let loop ([args args][n 0])
|
||||
|
|
@ -189,6 +176,13 @@ namespace.
|
|||
(check-last 'list* x)
|
||||
(apply list* x)))
|
||||
|
||||
(define-teach beginner range
|
||||
(lambda (start end step)
|
||||
(cerr 'range (real? start) "real" start)
|
||||
(cerr 'range (real? end) "real" end)
|
||||
(cerr 'range (real? step) "real" step)
|
||||
(range start end step)))
|
||||
|
||||
(define-teach beginner append
|
||||
(lambda (a b . x)
|
||||
(check-last 'append (cons a (cons b x)))
|
||||
|
|
@ -415,6 +409,7 @@ namespace.
|
|||
beginner-first
|
||||
beginner-rest
|
||||
beginner-list*
|
||||
beginner-range
|
||||
beginner-append
|
||||
intermediate-append
|
||||
beginner-error
|
||||
|
|
|
|||
|
|
@ -1,265 +1,265 @@
|
|||
(module docprovide racket/base
|
||||
(require (for-syntax racket/base
|
||||
"private/doctable.rkt"))
|
||||
#lang racket/base
|
||||
(require (for-syntax racket/base
|
||||
"private/doctable.rkt"))
|
||||
|
||||
(define-syntaxes (provide-and-document provide-and-document/wrap)
|
||||
(let ()
|
||||
(define (add-prefix prefix rows)
|
||||
(map (lambda (row)
|
||||
(cons (car row)
|
||||
(map
|
||||
(lambda (x)
|
||||
(cons prefix x))
|
||||
(cdr row))))
|
||||
rows))
|
||||
|
||||
(define (remove-prefixes rows)
|
||||
(map (lambda (row)
|
||||
(cons (car row)
|
||||
(map (lambda (proc)
|
||||
(let ([rest (cdr proc)])
|
||||
(if (pair? (car rest))
|
||||
(cons (cadar rest)
|
||||
(cdr rest))
|
||||
rest)))
|
||||
(cdr row))))
|
||||
rows))
|
||||
|
||||
(define (remove-docs rows exceptions)
|
||||
(map (lambda (row)
|
||||
(cons (car row)
|
||||
(let loop ([l (cdr row)])
|
||||
(cond
|
||||
[(null? l) null]
|
||||
[(memq (let ([i (cadar l)])
|
||||
(if (symbol? i)
|
||||
i
|
||||
(cadr i)))
|
||||
exceptions)
|
||||
(loop (cdr l))]
|
||||
[else (cons (car l) (loop (cdr l)))]))))
|
||||
rows))
|
||||
|
||||
(define (go stx label wrap rows)
|
||||
(unless (identifier? label)
|
||||
(raise-syntax-error
|
||||
'provide-and-document
|
||||
"label is not an identifier"
|
||||
stx
|
||||
label))
|
||||
(when wrap
|
||||
(unless (identifier? wrap)
|
||||
(raise-syntax-error
|
||||
'provide-and-document
|
||||
"wrap is not an identifier"
|
||||
stx
|
||||
wrap)))
|
||||
(let ([rows (map (lambda (row)
|
||||
;; Helper:
|
||||
(define (get-existing tag path label exceptions)
|
||||
(unless (identifier? tag)
|
||||
(raise-syntax-error
|
||||
'provide-and-document
|
||||
"prefix tag is not an identifier"
|
||||
stx
|
||||
tag))
|
||||
(unless (identifier? label)
|
||||
(raise-syntax-error
|
||||
'provide-and-document
|
||||
"label is not an identifier"
|
||||
stx
|
||||
label))
|
||||
(for-each
|
||||
(lambda (except)
|
||||
(unless (identifier? except)
|
||||
(raise-syntax-error
|
||||
'provide-and-document
|
||||
"exclusion is not an identifier"
|
||||
stx
|
||||
except)))
|
||||
exceptions)
|
||||
(let ([mod ((current-module-name-resolver) path #f #f)])
|
||||
;; Execute syntax part at top-level:
|
||||
(dynamic-require mod (void))
|
||||
;; Extract documentation via top-level:
|
||||
(let ([docs ((dynamic-require-for-syntax
|
||||
'syntax/private/doctable
|
||||
'lookup-documentation)
|
||||
mod
|
||||
(syntax-e label))])
|
||||
(unless docs
|
||||
(raise-syntax-error
|
||||
'provide-and-document
|
||||
"could not find provided documentation"
|
||||
stx
|
||||
row))
|
||||
(remove-docs (add-prefix tag docs)
|
||||
(map syntax-e exceptions)))))
|
||||
;; Parse row:
|
||||
(syntax-case row ()
|
||||
[(header proc ...)
|
||||
(string? (syntax-e (syntax header)))
|
||||
(begin
|
||||
;; check form:
|
||||
(map (lambda (proc)
|
||||
(syntax-case proc ()
|
||||
[(name type-sexpr doc-string ...)
|
||||
(and (or (identifier? (syntax name))
|
||||
(let ([l (syntax->list (syntax name))])
|
||||
(and l
|
||||
(= (length l) 2)
|
||||
(andmap identifier? l))))
|
||||
(andmap (lambda (s) (string? (syntax-e s)))
|
||||
(syntax->list (syntax (doc-string ...)))))
|
||||
'ok]))
|
||||
(syntax->list (syntax (proc ...))))
|
||||
(add-prefix #f (list (syntax->datum row))))]
|
||||
[(all-from tag path label)
|
||||
(eq? 'all-from (syntax-e (syntax all-from)))
|
||||
(let ([tag (syntax tag)]
|
||||
[label (syntax label)]
|
||||
[path (syntax->datum (syntax path))])
|
||||
(get-existing tag path label null))]
|
||||
[(all-from-except tag path label exception ...)
|
||||
(eq? 'all-from-except (syntax-e (syntax all-from-except)))
|
||||
(let ([tag (syntax tag)]
|
||||
[label (syntax label)]
|
||||
[path (syntax->datum (syntax path))]
|
||||
[exceptions (syntax->list (syntax (exception ...)))])
|
||||
(get-existing tag path label exceptions))]))
|
||||
rows)]
|
||||
[imports (apply
|
||||
append
|
||||
(map (lambda (row)
|
||||
(syntax-case row ()
|
||||
[(header . _)
|
||||
(string? (syntax-e (syntax header)))
|
||||
null]
|
||||
[(all-from/-except tag path label except ...)
|
||||
(list (with-syntax ([pf (datum->syntax
|
||||
stx
|
||||
(syntax-e
|
||||
(syntax (prefix-in tag path))))])
|
||||
(syntax (require pf))))]))
|
||||
rows))])
|
||||
;; Collapse rows for a section name:
|
||||
(let ([rows (let loop ([rows (apply append rows)])
|
||||
(if (null? rows)
|
||||
null
|
||||
(let ([rest (loop (cdr rows))])
|
||||
(let ([a (assoc (caar rows) rest)])
|
||||
(if a
|
||||
(cons (cons (caar rows)
|
||||
(append (cdar rows)
|
||||
(cdr a)))
|
||||
(let loop ([l rest])
|
||||
(cond
|
||||
[(null? l) null]
|
||||
[(equal? (caar l) (caar rows))
|
||||
(cdr l)]
|
||||
[else (cons (car l) (loop (cdr l)))])))
|
||||
(cons (car rows) rest))))))])
|
||||
;; Extract procs and eliminate duplicates
|
||||
(let ([procs (let ([ht (make-hasheq)])
|
||||
(for-each
|
||||
(lambda (proc-line)
|
||||
(let-values ([(loc-name ext-name)
|
||||
(let ([n (cadr proc-line)])
|
||||
(if (pair? n)
|
||||
(values (car n) (cadr n))
|
||||
(values n n)))])
|
||||
(hash-set! ht ext-name (list* (car proc-line)
|
||||
loc-name
|
||||
ext-name))))
|
||||
(apply append (map cdr rows)))
|
||||
(hash-map ht (lambda (key val) val)))])
|
||||
(let ([names (map (lambda (proc)
|
||||
(cond
|
||||
[(car proc)
|
||||
;; Source prefixed:
|
||||
`(,#'rename-out [,(string->symbol (format "~a~a"
|
||||
(syntax-e (car proc))
|
||||
(cadr proc)))
|
||||
,(cadr proc)])]
|
||||
[(eq? (cadr proc) (cddr proc))
|
||||
;; Plain
|
||||
(cadr proc)]
|
||||
[else
|
||||
;; Local renamed:
|
||||
`(,#'rename-out [,(cadr proc)
|
||||
,(cddr proc)])]))
|
||||
procs)]
|
||||
[wrapped-name
|
||||
(lambda (name)
|
||||
(string->symbol (format "~a>>~a"
|
||||
(syntax-e wrap)
|
||||
(if (pair? name)
|
||||
(cadadr name)
|
||||
name))))])
|
||||
(with-syntax ([procs (datum->syntax
|
||||
stx
|
||||
(if wrap
|
||||
(map (lambda (name)
|
||||
`(,#'rename-out
|
||||
[,(wrapped-name name)
|
||||
,(if (pair? name)
|
||||
(cadadr name)
|
||||
name)]))
|
||||
names)
|
||||
names))]
|
||||
[(wrap ...) (if wrap
|
||||
(map (lambda (name)
|
||||
`(,wrap ,(datum->syntax
|
||||
wrap
|
||||
(wrapped-name name))
|
||||
,(datum->syntax
|
||||
wrap
|
||||
(if (pair? name)
|
||||
(caadr name)
|
||||
name))))
|
||||
names)
|
||||
null)]
|
||||
[(import ...) imports]
|
||||
[src (datum->syntax stx 'source)]
|
||||
[rows (remove-prefixes rows)]
|
||||
[label label])
|
||||
(syntax/loc stx
|
||||
(begin
|
||||
import ...
|
||||
wrap ...
|
||||
(provide . procs)
|
||||
(define-syntaxes ()
|
||||
(begin
|
||||
(register-documentation (quote-syntax src) 'label 'rows)
|
||||
(values)))))))))))
|
||||
|
||||
(values
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ label row ...)
|
||||
(go stx
|
||||
(syntax label)
|
||||
#f
|
||||
(syntax->list (syntax (row ...))))]))
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ label wrap row ...)
|
||||
(go stx
|
||||
(syntax label)
|
||||
(let ([s (syntax wrap)])
|
||||
(and (syntax-e s) s))
|
||||
(syntax->list (syntax (row ...))))])))))
|
||||
(define-syntaxes (provide-and-document provide-and-document/wrap)
|
||||
(let ()
|
||||
(define (add-prefix prefix rows)
|
||||
(map (lambda (row)
|
||||
(cons (car row)
|
||||
(map
|
||||
(lambda (x)
|
||||
(cons prefix x))
|
||||
(cdr row))))
|
||||
rows))
|
||||
|
||||
(define (remove-prefixes rows)
|
||||
(map (lambda (row)
|
||||
(cons (car row)
|
||||
(map (lambda (proc)
|
||||
(let ([rest (cdr proc)])
|
||||
(if (pair? (car rest))
|
||||
(cons (cadar rest)
|
||||
(cdr rest))
|
||||
rest)))
|
||||
(cdr row))))
|
||||
rows))
|
||||
|
||||
(define (remove-docs rows exceptions)
|
||||
(map (lambda (row)
|
||||
(cons (car row)
|
||||
(let loop ([l (cdr row)])
|
||||
(cond
|
||||
[(null? l) null]
|
||||
[(memq (let ([i (cadar l)])
|
||||
(if (symbol? i)
|
||||
i
|
||||
(cadr i)))
|
||||
exceptions)
|
||||
(loop (cdr l))]
|
||||
[else (cons (car l) (loop (cdr l)))]))))
|
||||
rows))
|
||||
|
||||
(define (go stx label wrap rows)
|
||||
(unless (identifier? label)
|
||||
(raise-syntax-error
|
||||
'provide-and-document
|
||||
"label is not an identifier"
|
||||
stx
|
||||
label))
|
||||
(when wrap
|
||||
(unless (identifier? wrap)
|
||||
(raise-syntax-error
|
||||
'provide-and-document
|
||||
"wrap is not an identifier"
|
||||
stx
|
||||
wrap)))
|
||||
(let ([rows (map (lambda (row)
|
||||
;; Helper:
|
||||
(define (get-existing tag path label exceptions)
|
||||
(unless (identifier? tag)
|
||||
(raise-syntax-error
|
||||
'provide-and-document
|
||||
"prefix tag is not an identifier"
|
||||
stx
|
||||
tag))
|
||||
(unless (identifier? label)
|
||||
(raise-syntax-error
|
||||
'provide-and-document
|
||||
"label is not an identifier"
|
||||
stx
|
||||
label))
|
||||
(for-each
|
||||
(lambda (except)
|
||||
(unless (identifier? except)
|
||||
(raise-syntax-error
|
||||
'provide-and-document
|
||||
"exclusion is not an identifier"
|
||||
stx
|
||||
except)))
|
||||
exceptions)
|
||||
(let ([mod ((current-module-name-resolver) path #f #f)])
|
||||
;; Execute syntax part at top-level:
|
||||
(dynamic-require mod (void))
|
||||
;; Extract documentation via top-level:
|
||||
(let ([docs ((dynamic-require-for-syntax
|
||||
'syntax/private/doctable
|
||||
'lookup-documentation)
|
||||
mod
|
||||
(syntax-e label))])
|
||||
(unless docs
|
||||
(raise-syntax-error
|
||||
'provide-and-document
|
||||
"could not find provided documentation"
|
||||
stx
|
||||
row))
|
||||
(remove-docs (add-prefix tag docs)
|
||||
(map syntax-e exceptions)))))
|
||||
;; Parse row:
|
||||
(syntax-case row ()
|
||||
[(header proc ...)
|
||||
(string? (syntax-e (syntax header)))
|
||||
(begin
|
||||
;; check form:
|
||||
(map (lambda (proc)
|
||||
(syntax-case proc ()
|
||||
[(name type-sexpr doc-string ...)
|
||||
(and (or (identifier? (syntax name))
|
||||
(let ([l (syntax->list (syntax name))])
|
||||
(and l
|
||||
(= (length l) 2)
|
||||
(andmap identifier? l))))
|
||||
(andmap (lambda (s) (string? (syntax-e s)))
|
||||
(syntax->list (syntax (doc-string ...)))))
|
||||
'ok]))
|
||||
(syntax->list (syntax (proc ...))))
|
||||
(add-prefix #f (list (syntax->datum row))))]
|
||||
[(all-from tag path label)
|
||||
(eq? 'all-from (syntax-e (syntax all-from)))
|
||||
(let ([tag (syntax tag)]
|
||||
[label (syntax label)]
|
||||
[path (syntax->datum (syntax path))])
|
||||
(get-existing tag path label null))]
|
||||
[(all-from-except tag path label exception ...)
|
||||
(eq? 'all-from-except (syntax-e (syntax all-from-except)))
|
||||
(let ([tag (syntax tag)]
|
||||
[label (syntax label)]
|
||||
[path (syntax->datum (syntax path))]
|
||||
[exceptions (syntax->list (syntax (exception ...)))])
|
||||
(get-existing tag path label exceptions))]))
|
||||
rows)]
|
||||
[imports (apply
|
||||
append
|
||||
(map (lambda (row)
|
||||
(syntax-case row ()
|
||||
[(header . _)
|
||||
(string? (syntax-e (syntax header)))
|
||||
null]
|
||||
[(all-from/-except tag path label except ...)
|
||||
(list (with-syntax ([pf (datum->syntax
|
||||
stx
|
||||
(syntax-e
|
||||
(syntax (prefix-in tag path))))])
|
||||
(syntax (require pf))))]))
|
||||
rows))])
|
||||
;; Collapse rows for a section name:
|
||||
(let ([rows (let loop ([rows (apply append rows)])
|
||||
(if (null? rows)
|
||||
null
|
||||
(let ([rest (loop (cdr rows))])
|
||||
(let ([a (assoc (caar rows) rest)])
|
||||
(if a
|
||||
(cons (cons (caar rows)
|
||||
(append (cdar rows)
|
||||
(cdr a)))
|
||||
(let loop ([l rest])
|
||||
(cond
|
||||
[(null? l) null]
|
||||
[(equal? (caar l) (caar rows))
|
||||
(cdr l)]
|
||||
[else (cons (car l) (loop (cdr l)))])))
|
||||
(cons (car rows) rest))))))])
|
||||
;; Extract procs and eliminate duplicates
|
||||
(let ([procs (let ([ht (make-hasheq)])
|
||||
(for-each
|
||||
(lambda (proc-line)
|
||||
(let-values ([(loc-name ext-name)
|
||||
(let ([n (cadr proc-line)])
|
||||
(if (pair? n)
|
||||
(values (car n) (cadr n))
|
||||
(values n n)))])
|
||||
(hash-set! ht ext-name (list* (car proc-line)
|
||||
loc-name
|
||||
ext-name))))
|
||||
(apply append (map cdr rows)))
|
||||
(hash-map ht (lambda (key val) val)))])
|
||||
(let ([names (map (lambda (proc)
|
||||
(cond
|
||||
[(car proc)
|
||||
;; Source prefixed:
|
||||
`(,#'rename-out [,(string->symbol (format "~a~a"
|
||||
(syntax-e (car proc))
|
||||
(cadr proc)))
|
||||
,(cadr proc)])]
|
||||
[(eq? (cadr proc) (cddr proc))
|
||||
;; Plain
|
||||
(cadr proc)]
|
||||
[else
|
||||
;; Local renamed:
|
||||
`(,#'rename-out [,(cadr proc)
|
||||
,(cddr proc)])]))
|
||||
procs)]
|
||||
[wrapped-name
|
||||
(lambda (name)
|
||||
(string->symbol (format "~a>>~a"
|
||||
(syntax-e wrap)
|
||||
(if (pair? name)
|
||||
(cadadr name)
|
||||
name))))])
|
||||
(with-syntax ([procs (datum->syntax
|
||||
stx
|
||||
(if wrap
|
||||
(map (lambda (name)
|
||||
`(,#'rename-out
|
||||
[,(wrapped-name name)
|
||||
,(if (pair? name)
|
||||
(cadadr name)
|
||||
name)]))
|
||||
names)
|
||||
names))]
|
||||
[(wrap ...) (if wrap
|
||||
(map (lambda (name)
|
||||
`(,wrap ,(datum->syntax
|
||||
wrap
|
||||
(wrapped-name name))
|
||||
,(datum->syntax
|
||||
wrap
|
||||
(if (pair? name)
|
||||
(caadr name)
|
||||
name))))
|
||||
names)
|
||||
null)]
|
||||
[(import ...) imports]
|
||||
[src (datum->syntax stx 'source)]
|
||||
[rows (remove-prefixes rows)]
|
||||
[label label])
|
||||
(syntax/loc stx
|
||||
(begin
|
||||
import ...
|
||||
wrap ...
|
||||
(provide . procs)
|
||||
(define-syntaxes ()
|
||||
(begin
|
||||
(register-documentation (quote-syntax src) 'label 'rows)
|
||||
(values)))))))))))
|
||||
|
||||
(values
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ label row ...)
|
||||
(go stx
|
||||
(syntax label)
|
||||
#f
|
||||
(syntax->list (syntax (row ...))))]))
|
||||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ label wrap row ...)
|
||||
(go stx
|
||||
(syntax label)
|
||||
(let ([s (syntax wrap)])
|
||||
(and (syntax-e s) s))
|
||||
(syntax->list (syntax (row ...))))])))))
|
||||
|
||||
|
||||
(define (lookup-documentation path label)
|
||||
(let ([mod ((current-module-name-resolver) path #f #f)])
|
||||
(dynamic-require mod (void))
|
||||
((dynamic-require-for-syntax
|
||||
'syntax/private/doctable
|
||||
'lookup-documentation)
|
||||
mod
|
||||
label)))
|
||||
|
||||
(provide provide-and-document
|
||||
provide-and-document/wrap
|
||||
lookup-documentation))
|
||||
(define (lookup-documentation path label)
|
||||
(let ([mod ((current-module-name-resolver) path #f #f)])
|
||||
(dynamic-require mod (void))
|
||||
((dynamic-require-for-syntax
|
||||
'syntax/private/doctable
|
||||
'lookup-documentation)
|
||||
mod
|
||||
label)))
|
||||
|
||||
(provide provide-and-document
|
||||
provide-and-document/wrap
|
||||
lookup-documentation)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user