pruned unstable/define
This commit is contained in:
Ryan Culpepper
parent
f99d79ef10
commit
4f9da1fd1c
|
|
@ -1,85 +0,0 @@
|
|||
#lang racket
|
||||
|
||||
(require rackunit rackunit/text-ui racket/sandbox unstable/define "helpers.rkt")
|
||||
|
||||
(run-tests
|
||||
(test-suite "define.rkt"
|
||||
|
||||
(test-suite "at-end")
|
||||
|
||||
(test-suite "define-if-unbound"
|
||||
(test
|
||||
(let ()
|
||||
(define-if-unbound very-special-name 1)
|
||||
(define-if-unbound very-special-name 2)
|
||||
(check-equal? very-special-name 1)))
|
||||
(test
|
||||
(let ()
|
||||
(define-if-unbound (very-special-function) 1)
|
||||
(define-if-unbound (very-special-function) 2)
|
||||
(check-equal? (very-special-function) 1))))
|
||||
|
||||
(test-suite "define-values-if-unbound"
|
||||
(test
|
||||
(let ()
|
||||
(define-values-if-unbound [very-special-name] 1)
|
||||
(define-values-if-unbound [very-special-name] 2)
|
||||
(check-equal? very-special-name 1))))
|
||||
|
||||
(test-suite "define-syntax-if-unbound"
|
||||
(test
|
||||
(let ()
|
||||
(define-syntax-if-unbound very-special-macro
|
||||
(lambda (stx) #'(quote 1)))
|
||||
(define-syntax-if-unbound very-special-macro
|
||||
(lambda (stx) #'(quote 2)))
|
||||
(check-equal? (very-special-macro) 1)))
|
||||
(test
|
||||
(let ()
|
||||
(define-syntax-if-unbound (very-special-macro stx)
|
||||
#'(quote 1))
|
||||
(define-syntax-if-unbound (very-special-macro stx)
|
||||
#'(quote 2))
|
||||
(check-equal? (very-special-macro) 1))))
|
||||
|
||||
(test-suite "define-syntaxes-if-unbound"
|
||||
(test
|
||||
(let ()
|
||||
(define-syntaxes-if-unbound [very-special-macro]
|
||||
(lambda (stx) #'(quote 1)))
|
||||
(define-syntaxes-if-unbound [very-special-macro]
|
||||
(lambda (stx) #'(quote 2)))
|
||||
(check-equal? (very-special-macro) 1))))
|
||||
|
||||
(test-suite "define-renamings"
|
||||
(test
|
||||
(let ()
|
||||
(define-renamings [with define] [fun lambda])
|
||||
(with f (fun (x) (add1 x)))
|
||||
(check-equal? (f 7) 8))))
|
||||
|
||||
(test-suite "declare-names"
|
||||
(test
|
||||
(let ()
|
||||
(declare-names x y z)
|
||||
(define-values [x y z] (values 1 2 3))
|
||||
(check-equal? x 1)
|
||||
(check-equal? y 2)
|
||||
(check-equal? z 3))))
|
||||
|
||||
(test-suite "define-with-parameter"
|
||||
(test
|
||||
(let ()
|
||||
(define p (make-parameter 0))
|
||||
(define-with-parameter with-p p)
|
||||
(with-p 7 (check-equal? (p) 7)))))
|
||||
|
||||
(test-suite "define-single-definition"
|
||||
(test
|
||||
(let ()
|
||||
(define-single-definition with define-values)
|
||||
(with x 0)
|
||||
(check-equal? x 0))))
|
||||
|
||||
(test-suite "in-phase1")
|
||||
(test-suite "in-phase1/pass2")))
|
||||
|
|
@ -1,103 +1,12 @@
|
|||
#lang racket/base
|
||||
|
||||
(require
|
||||
(for-syntax
|
||||
racket/base
|
||||
racket/list
|
||||
racket/match
|
||||
syntax/parse
|
||||
racket/syntax
|
||||
unstable/syntax
|
||||
(for-syntax ;; phase 2!
|
||||
racket/base)))
|
||||
|
||||
(provide
|
||||
|
||||
in-phase1 in-phase1/pass2
|
||||
|
||||
at-end
|
||||
|
||||
define-syntax-block
|
||||
|
||||
declare-names
|
||||
define-renaming
|
||||
define-renamings
|
||||
define-single-definition
|
||||
define-with-parameter
|
||||
|
||||
define-if-unbound
|
||||
define-values-if-unbound
|
||||
define-syntax-if-unbound
|
||||
define-syntaxes-if-unbound)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; Macro Definitions
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-syntax define-syntax-block
|
||||
(let ()
|
||||
|
||||
(define-syntax-class declaration
|
||||
#:attributes [internal external]
|
||||
(pattern external:id
|
||||
#:attr internal
|
||||
(format-id #'external #:source #'external
|
||||
"~a/proc" #'external))
|
||||
(pattern [external:id internal:id]))
|
||||
|
||||
(syntax-parser
|
||||
[(_ (decl:declaration ...) body:expr ...)
|
||||
#:fail-when (check-duplicate-identifier
|
||||
(syntax-list decl.external ...))
|
||||
"duplicate defined name"
|
||||
#'(define-syntaxes [decl.external ...]
|
||||
(let () body ... (values decl.internal ...)))])))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; Definition Generalization
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-syntax-rule (define-single-definition define-one define-many)
|
||||
(define-syntax define-one
|
||||
(syntax-rules []
|
||||
[(_ (head . args) . body) (define-one head (lambda args . body))]
|
||||
[(_ name expr) (define-many [name] expr)])))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; Potentially Redundant Bindings
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-syntax (define-many-if-unbound stx)
|
||||
(syntax-case stx []
|
||||
[(_ def [name ...] expr)
|
||||
(let* ([ids (syntax->list #'(name ...))])
|
||||
(for ([bad (in-list ids)] #:unless (identifier? bad))
|
||||
(wrong-syntax bad "expected an identifier"))
|
||||
(let*-values ([(bound unbound) (partition identifier-binding ids)])
|
||||
(cond
|
||||
[(null? bound) (syntax/loc stx (def [name ...] expr))]
|
||||
[(null? unbound) (syntax/loc stx (def [] (values)))]
|
||||
[else (wrong-syntax
|
||||
stx
|
||||
"conflicting definitions for ~s; none for ~s"
|
||||
(map syntax-e bound)
|
||||
(map syntax-e unbound))])))]))
|
||||
|
||||
(define-syntax-rule (define-values-if-unbound [name ...] expr)
|
||||
(define-many-if-unbound define-values [name ...] expr))
|
||||
|
||||
(define-single-definition define-if-unbound define-values-if-unbound)
|
||||
|
||||
(define-syntax-rule (define-syntaxes-if-unbound [name ...] expr)
|
||||
(define-many-if-unbound define-syntaxes [name ...] expr))
|
||||
|
||||
(define-single-definition define-syntax-if-unbound define-syntaxes-if-unbound)
|
||||
(require (for-syntax racket/base
|
||||
racket/list
|
||||
racket/match
|
||||
racket/syntax
|
||||
unstable/syntax))
|
||||
(provide in-phase1
|
||||
in-phase1/pass2
|
||||
at-end)
|
||||
|
||||
(define-syntax (at-end stx)
|
||||
(syntax-case stx ()
|
||||
|
|
@ -112,23 +21,6 @@
|
|||
"can only be used in module context; got: ~s"
|
||||
ctx)])]))
|
||||
|
||||
(define-syntax-rule (define-with-parameter name parameter)
|
||||
(define-syntax-rule (name value body (... ...))
|
||||
(parameterize ([parameter value]) body (... ...))))
|
||||
|
||||
(define-syntax (declare-names stx)
|
||||
(match (syntax-local-context)
|
||||
['top-level
|
||||
(syntax-case stx []
|
||||
[(_ name ...) (syntax/loc stx (define-syntaxes [name ...] (values)))])]
|
||||
[_ (syntax/loc stx (begin))]))
|
||||
|
||||
(define-syntax-rule (define-renamings [new old] ...)
|
||||
(define-syntaxes [new ...] (values (make-rename-transformer #'old) ...)))
|
||||
|
||||
(define-syntax-rule (define-renaming new old)
|
||||
(define-renamings [new old]))
|
||||
|
||||
(define-syntax (in-phase1 stx)
|
||||
(syntax-case stx []
|
||||
[(_ e)
|
||||
|
|
|
|||
|
|
@ -1,11 +1,14 @@
|
|||
#lang racket/base
|
||||
(require slideshow/base slideshow/pict
|
||||
racket/contract/base racket/list racket/match
|
||||
unstable/define
|
||||
(for-syntax racket/base)
|
||||
"pict.rkt")
|
||||
(provide (all-from-out "pict.rkt"))
|
||||
|
||||
(define-syntax-rule (define-with-parameter name parameter)
|
||||
(define-syntax-rule (name value body (... ...))
|
||||
(parameterize ([parameter value]) body (... ...))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; Font Controls
|
||||
|
|
|
|||
|
|
@ -14,8 +14,6 @@
|
|||
|
||||
Provides macros for creating and manipulating definitions.
|
||||
|
||||
@section{Deferred Evaluation in Modules}
|
||||
|
||||
@defform[(at-end expr)]{
|
||||
|
||||
When used at the top level of a module, evaluates @racket[expr] at the end of
|
||||
|
|
@ -36,138 +34,6 @@ the module. This can be useful for calling functions before their definitions.
|
|||
|
||||
}
|
||||
|
||||
@section{Conditional Binding}
|
||||
|
||||
@deftogether[(
|
||||
@defform*[[(define-if-unbound x e)
|
||||
(define-if-unbound (f . args) body ...)]]
|
||||
@defform[(define-values-if-unbound [x ...] e)]
|
||||
@defform*[[(define-syntax-if-unbound x e)
|
||||
(define-syntax-if-unbound (f . args) body ...)]]
|
||||
@defform[(define-syntaxes-if-unbound [x ...] e)]
|
||||
)]{
|
||||
|
||||
Define each @racket[x] (or @racket[f]) if no such binding exists, or
|
||||
do nothing if the name(s) is(are) already bound. The
|
||||
@racket[define-values-if-unbound] and @racket[define-syntaxes-if-unbound] forms
|
||||
raise a syntax error if some of the given names are bound and some are not.
|
||||
|
||||
These are useful for writing programs that are portable across versions of
|
||||
Racket with different bindings, to provide an implementation of a binding for
|
||||
versions that do not have it but use the built-in one in versions that do.
|
||||
|
||||
@defexamples[
|
||||
#:eval the-eval
|
||||
(define-if-unbound x 1)
|
||||
x
|
||||
(define y 2)
|
||||
(define-if-unbound y 3)
|
||||
y
|
||||
]
|
||||
|
||||
}
|
||||
|
||||
@section{Renaming Definitions}
|
||||
|
||||
@deftogether[(
|
||||
@defform[(define-renaming new old)]
|
||||
@defform[(define-renamings [new old] ...)]
|
||||
)]{
|
||||
|
||||
Establishes a
|
||||
@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{rename transformer}
|
||||
for each @racket[new] identifier, redirecting it to the corresponding
|
||||
@racket[old] identifier.
|
||||
|
||||
@defexamples[
|
||||
#:eval the-eval
|
||||
(define-renaming use #%app)
|
||||
(define-renamings [def define] [lam lambda])
|
||||
(def plus (lam (x y) (use + x y)))
|
||||
(use plus 1 2)
|
||||
]
|
||||
|
||||
}
|
||||
|
||||
@section{Forward Declarations}
|
||||
|
||||
@defform[(declare-names x ...)]{
|
||||
|
||||
Provides forward declarations of identifiers to be defined later. It
|
||||
is useful for macros which expand to mutually recursive definitions, including
|
||||
forward references, that may be used at the Racket top level.
|
||||
|
||||
}
|
||||
|
||||
@section{Definition Shorthands}
|
||||
|
||||
@defform[(define-with-parameter name parameter)]{
|
||||
|
||||
Defines the form @racket[name] as a shorthand for setting the parameter
|
||||
@racket[parameter]. Specifically, @racket[(name value body ...)] is equivalent
|
||||
to @racket[(parameterize ([parameter value]) body ...)].
|
||||
|
||||
@defexamples[
|
||||
#:eval the-eval
|
||||
(define-with-parameter with-input current-input-port)
|
||||
(with-input (open-input-string "Tom Dick Harry") (read))
|
||||
]
|
||||
|
||||
}
|
||||
|
||||
@defform[(define-single-definition define-one-name define-many-name)]{
|
||||
|
||||
Defines a marco @racket[define-one-name] as a single identifier
|
||||
definition form with function shorthand like @racket[define] and
|
||||
@racket[define-syntax], based on an existing macro @racket[define-many-name]
|
||||
which works like @racket[define-values] or @racket[define-syntaxes].
|
||||
|
||||
@defexamples[
|
||||
#:eval the-eval
|
||||
(define-single-definition define-like define-values)
|
||||
(define-like x 0)
|
||||
x
|
||||
(define-like (f a b c) (printf "~s, ~s\n" a b) c)
|
||||
(f 1 2 3)
|
||||
]
|
||||
|
||||
}
|
||||
|
||||
@section{Macro Definitions}
|
||||
|
||||
@defform/subs[
|
||||
(define-syntax-block (macro-decl ...) body ...)
|
||||
([macro-decl macro-id [macro-id expander-id]])
|
||||
]{
|
||||
|
||||
Defines a syntax transformer for each @racket[macro-id] based on the local
|
||||
definition of each @racket[expander-id]
|
||||
(defaulting to @racket[macro-id]@racket[/proc]) in @racket[body ...].
|
||||
Especially useful for mutually recursive expander functions and phase 1 macro
|
||||
definitions. Subsumes the behavior of @racket[define-syntax-set].
|
||||
|
||||
@defexamples[
|
||||
#:eval the-eval
|
||||
(define-syntax-block
|
||||
([implies expand-implies]
|
||||
nand)
|
||||
|
||||
(define-syntax-rule (==> pattern template)
|
||||
(syntax-rules () [pattern template]))
|
||||
|
||||
(define expand-implies (==> (_ a b) (or (not a) b)))
|
||||
(define nand/proc (==> (_ a ...) (not (and a ...)))))
|
||||
(implies #t (printf "True!\n"))
|
||||
(implies #f (printf "False!\n"))
|
||||
(nand #t #t (printf "All True!\n"))
|
||||
(nand #t #f (printf "Some False!\n"))
|
||||
(define-syntax-block (undefined-macro)
|
||||
(define irrelevant "Whoops!"))
|
||||
]
|
||||
}
|
||||
|
||||
@section{Effectful Transformation}
|
||||
|
||||
@defform[(in-phase1 e)]{
|
||||
|
||||
Executes @racket[e] during phase 1 (the syntax transformation phase)
|
||||
|
|
|
|||
|
|
@ -21,7 +21,6 @@
|
|||
(check-docs (quote unstable/file))
|
||||
(check-docs (quote unstable/exn))
|
||||
(check-docs (quote unstable/dict))
|
||||
(check-docs (quote unstable/define))
|
||||
(check-docs (quote unstable/debug))
|
||||
(check-docs (quote unstable/contract))
|
||||
(check-docs (quote unstable/class-iop))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user