unstable: added class-iop, gui/prefs (needs doc), gui/notify (needs doc)
macro-debugger: changed imports for above, deleted dead code svn: r16781
This commit is contained in:
Ryan Culpepper
parent
cecac1c6c1
commit
2051f3ab2a
|
|
@ -6,8 +6,7 @@
|
|||
path-get
|
||||
pathseg-get
|
||||
path-replace
|
||||
pathseg-replace
|
||||
find-subterm-paths)
|
||||
pathseg-replace)
|
||||
|
||||
;; A Path is a (list-of PathSeg)
|
||||
;; where the PathSegs are listed outermost to innermost
|
||||
|
|
@ -117,25 +116,3 @@
|
|||
|
||||
(define (sd x)
|
||||
(syntax->datum (datum->syntax #f x)))
|
||||
|
||||
;;=======
|
||||
|
||||
;; find-subterm-paths : syntax syntax -> (list-of Path)
|
||||
(define (find-subterm-paths subterm term)
|
||||
(let outer-loop ([term term])
|
||||
(cond [(eq? subterm term)
|
||||
(list null)]
|
||||
[(stx-pair? term)
|
||||
;; Optimized for lists...
|
||||
(let loop ([term term] [n 0])
|
||||
(if (stx-pair? term)
|
||||
(let* ([seg0 (make-ref n)])
|
||||
(append (map (lambda (p) (cons seg0 p)) (outer-loop (stx-car term)))
|
||||
(if (eq? subterm (stx-cdr term))
|
||||
(list (list (make-tail n)))
|
||||
(loop (stx-cdr term) (add1 n)))))
|
||||
(let ([seg0 (make-tail n)])
|
||||
(map (lambda (p) (cons seg0 p))
|
||||
(outer-loop term)))))]
|
||||
;; FIXME: more structured cases here: box, vector, ...
|
||||
[else null])))
|
||||
|
|
|
|||
|
|
@ -1,111 +0,0 @@
|
|||
#lang scheme/base
|
||||
(require (for-syntax scheme/base)
|
||||
scheme/match
|
||||
scheme/contract
|
||||
"deriv.ss"
|
||||
"deriv-util.ss"
|
||||
"reductions-config.ss"
|
||||
"stx-util.ss")
|
||||
|
||||
(provide current-unvisited-lifts
|
||||
current-unhidden-lifts
|
||||
|
||||
current-hiding-warning-handler
|
||||
|
||||
handle-hiding-failure
|
||||
warn
|
||||
|
||||
DEBUG-LIFTS
|
||||
|
||||
add-unhidden-lift
|
||||
extract/remove-unvisited-lift)
|
||||
|
||||
;; Parameters
|
||||
|
||||
;; current-hiding-warning-handler : (parameter-of (symbol any -> void))
|
||||
(define current-hiding-warning-handler
|
||||
(make-parameter
|
||||
(lambda (tag args) (printf "hiding warning: ~a\n" tag))))
|
||||
|
||||
;; current-unvisited-lifts : (paramter-of Derivation)
|
||||
;; The derivs for the lifts yet to be seen in the processing
|
||||
;; of the first part of the current lift-deriv.
|
||||
(define current-unvisited-lifts (make-parameter null))
|
||||
|
||||
;; current-unhidden-lifts : (parameter-of Derivation)
|
||||
;; The derivs for those lifts that occur within unhidden macros.
|
||||
;; Derivs are moved from the current-unvisited-lifts to this list.
|
||||
(define current-unhidden-lifts (make-parameter null))
|
||||
|
||||
;; Helper
|
||||
|
||||
(define-syntax DEBUG-LIFTS
|
||||
(syntax-rules ()
|
||||
[(DEBUG-LIFTS . b)
|
||||
(void)]
|
||||
#;
|
||||
[(DEBUG-LIFTS . b)
|
||||
(begin . b)]))
|
||||
|
||||
;; Operations
|
||||
|
||||
;; add-unhidden-lift : Derivation -> void
|
||||
(define (add-unhidden-lift d)
|
||||
(when d
|
||||
(current-unhidden-lifts
|
||||
(cons d (current-unhidden-lifts)))))
|
||||
|
||||
;; extract/remove-unvisted-lift : identifier -> Derivation
|
||||
(define (extract/remove-unvisited-lift id)
|
||||
(define (get-defined-id d)
|
||||
(match d
|
||||
[(Wrap deriv (e1 e2))
|
||||
(with-syntax ([(?define-values (?id) ?expr) e1])
|
||||
#'?id)]))
|
||||
;; The Wrong Way
|
||||
(let ([unvisited (current-unvisited-lifts)])
|
||||
(if (null? unvisited)
|
||||
(begin (DEBUG-LIFTS
|
||||
(printf "hide:extract/remove-unvisited-lift: out of lifts!"))
|
||||
#f)
|
||||
(let ([lift (car unvisited)])
|
||||
(DEBUG-LIFTS
|
||||
(printf "extracting lift: ~s left\n" (length (cdr unvisited))))
|
||||
(current-unvisited-lifts (cdr unvisited))
|
||||
lift)))
|
||||
;; The Right Way
|
||||
;; FIXME: Doesn't work inside of modules. Why not?
|
||||
#;
|
||||
(let loop ([lifts (current-unvisited-lifts)]
|
||||
[prefix null])
|
||||
(cond [(null? lifts)
|
||||
(DEBUG-LIFTS
|
||||
(fprintf (current-error-port)
|
||||
"hide:extract/remove-unvisited-lift: can't find lift for ~s~n"
|
||||
id))
|
||||
(raise (make localactions))]
|
||||
[(bound-identifier=? id (get-defined-id (car lifts)))
|
||||
(let ([lift (car lifts)])
|
||||
(current-unvisited-lifts
|
||||
(let loop ([prefix prefix] [lifts (cdr lifts)])
|
||||
(if (null? prefix)
|
||||
lifts
|
||||
(loop (cdr prefix) (cons (car prefix) lifts)))))
|
||||
lift)]
|
||||
[else
|
||||
(loop (cdr lifts) (cons (car lifts) prefix))])))
|
||||
|
||||
;; Warnings
|
||||
|
||||
(define (warn tag . args)
|
||||
((current-hiding-warning-handler) tag args))
|
||||
|
||||
(define (handle-hiding-failure d failure)
|
||||
(match failure
|
||||
[(struct nonlinearity (term paths))
|
||||
(warn 'nonlinearity term paths d)]
|
||||
[(struct localactions ())
|
||||
(warn 'localactions d)]
|
||||
[(struct hidden-lift-site ())
|
||||
(warn 'hidden-lift-site d)]))
|
||||
|
||||
|
|
@ -1,10 +1,11 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require scheme/class
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[send/i send:]
|
||||
[init-field/i init-field:])
|
||||
"interfaces.ss"
|
||||
"partition.ss"
|
||||
"../util/notify.ss")
|
||||
unstable/gui/notify)
|
||||
(provide controller%)
|
||||
|
||||
;; displays-manager-mixin
|
||||
|
|
|
|||
|
|
@ -2,7 +2,9 @@
|
|||
(require scheme/class
|
||||
scheme/gui
|
||||
scheme/list
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[send/i send:]
|
||||
[init-field/i init-field:])
|
||||
(only-in mzlib/etc begin-with-definitions)
|
||||
"pretty-printer.ss"
|
||||
"interfaces.ss"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,10 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[define/i define:]
|
||||
[send/i send:]
|
||||
[send*/i send*:]
|
||||
[init-field/i init-field:])
|
||||
scheme/gui
|
||||
framework/framework
|
||||
scheme/list
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
macro-debugger/util/class-iop
|
||||
unstable/class-iop
|
||||
(for-syntax scheme/base))
|
||||
(provide (all-defined-out))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
scheme/gui
|
||||
"../util/notify.ss"
|
||||
unstable/gui/notify
|
||||
"interfaces.ss"
|
||||
"partition.ss")
|
||||
(provide smart-keymap%
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
(require scheme/class
|
||||
framework/framework
|
||||
"interfaces.ss"
|
||||
"../util/notify.ss"
|
||||
"../util/misc.ss")
|
||||
unstable/gui/notify
|
||||
unstable/gui/prefs)
|
||||
(provide prefs-base%
|
||||
syntax-prefs-base%
|
||||
syntax-prefs%
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require scheme/class
|
||||
scheme/pretty
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[send/i send:])
|
||||
syntax/stx
|
||||
unstable/struct
|
||||
"interfaces.ss")
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require scheme/class
|
||||
scheme/gui
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[send/i send:])
|
||||
"interfaces.ss"
|
||||
"util.ss"
|
||||
"../util/mpi.ss")
|
||||
|
|
|
|||
|
|
@ -1,13 +1,13 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require scheme/class
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[send/i send:])
|
||||
scheme/match
|
||||
scheme/list
|
||||
mzlib/string
|
||||
mred
|
||||
framework
|
||||
"../util/notify.ss"
|
||||
unstable/gui/notify
|
||||
"interfaces.ss"
|
||||
"display.ss"
|
||||
"controller.ss"
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
scheme/gui
|
||||
drscheme/arrow
|
||||
framework/framework
|
||||
"../util/notify.ss")
|
||||
unstable/gui/notify)
|
||||
|
||||
(provide text:hover<%>
|
||||
text:hover-identifier<%>
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require scheme/class
|
||||
mred
|
||||
|
|
@ -6,7 +5,8 @@
|
|||
scheme/list
|
||||
scheme/match
|
||||
syntax/id-table
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[send/i send:])
|
||||
"interfaces.ss"
|
||||
"controller.ss"
|
||||
"display.ss"
|
||||
|
|
|
|||
|
|
@ -1,25 +0,0 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require (for-syntax scheme/base)
|
||||
scheme/class
|
||||
framework/framework)
|
||||
(provide closure-mixin
|
||||
pref:get/set)
|
||||
|
||||
(define-syntax pref:get/set
|
||||
(syntax-rules ()
|
||||
[(_ get/set prop)
|
||||
(define get/set
|
||||
(case-lambda
|
||||
[() (preferences:get 'prop)]
|
||||
[(newval) (preferences:set 'prop newval)]))]))
|
||||
|
||||
(define-syntax (closure-mixin stx)
|
||||
(syntax-case stx ()
|
||||
[(closure-mixin interfaces [name proc] ...)
|
||||
(with-syntax ([(iname ...) (generate-temporaries #'(name ...))])
|
||||
#'(let ([iname proc] ...)
|
||||
(mixin () interfaces
|
||||
(define/public (name . args) (apply iname args))
|
||||
...
|
||||
(super-new))))]))
|
||||
|
|
@ -1,8 +1,8 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require scheme/pretty
|
||||
scheme/class
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[send/i send:])
|
||||
"interfaces.ss"
|
||||
"debug-format.ss"
|
||||
"prefs.ss"
|
||||
|
|
|
|||
|
|
@ -1,7 +1,9 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require scheme/class
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[send/i send:]
|
||||
[send*/i send*:]
|
||||
[init-field/i init-field:])
|
||||
scheme/unit
|
||||
scheme/list
|
||||
scheme/match
|
||||
|
|
@ -20,7 +22,7 @@
|
|||
"../model/trace.ss"
|
||||
"../model/steps.ss"
|
||||
"cursor.ss"
|
||||
"../util/notify.ss")
|
||||
unstable/gui/notify)
|
||||
(provide stepper-keymap%
|
||||
stepper-syntax-widget%)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require scheme/class
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[define/i define:]
|
||||
[send/i send:])
|
||||
scheme/unit
|
||||
scheme/list
|
||||
scheme/file
|
||||
|
|
@ -21,7 +22,7 @@
|
|||
"../model/trace.ss"
|
||||
"../model/steps.ss"
|
||||
"cursor.ss"
|
||||
"../util/notify.ss")
|
||||
unstable/gui/notify)
|
||||
(provide macro-stepper-frame-mixin)
|
||||
|
||||
(define (macro-stepper-frame-mixin base-frame%)
|
||||
|
|
|
|||
|
|
@ -1,14 +1,15 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require scheme/class
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[send/i send:]
|
||||
[init-field/i init-field:])
|
||||
scheme/gui
|
||||
scheme/list
|
||||
syntax/boundmap
|
||||
"interfaces.ss"
|
||||
"../model/hiding-policies.ss"
|
||||
"../util/mpi.ss"
|
||||
"../util/notify.ss")
|
||||
unstable/gui/notify)
|
||||
(provide macro-hiding-prefs-widget%)
|
||||
|
||||
(define mode:disable "Disable")
|
||||
|
|
|
|||
|
|
@ -1,6 +1,5 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require macro-debugger/util/class-iop
|
||||
(require unstable/class-iop
|
||||
(prefix-in sb: "../syntax-browser/interfaces.ss"))
|
||||
(provide (all-defined-out))
|
||||
|
||||
|
|
|
|||
|
|
@ -4,8 +4,8 @@
|
|||
framework/framework
|
||||
"interfaces.ss"
|
||||
"../syntax-browser/prefs.ss"
|
||||
"../util/notify.ss"
|
||||
"../util/misc.ss")
|
||||
unstable/gui/notify
|
||||
unstable/gui/prefs)
|
||||
(provide pref:macro-step-limit
|
||||
macro-stepper-config-base%
|
||||
macro-stepper-config/prefs%
|
||||
|
|
|
|||
|
|
@ -1,7 +1,9 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require scheme/class
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[send/i send:]
|
||||
[send*/i send*:]
|
||||
[init-field/i init-field:])
|
||||
scheme/unit
|
||||
scheme/list
|
||||
scheme/match
|
||||
|
|
@ -20,7 +22,7 @@
|
|||
"../model/reductions-config.ss"
|
||||
"../model/reductions.ss"
|
||||
"../model/steps.ss"
|
||||
"../util/notify.ss"
|
||||
unstable/gui/notify
|
||||
(prefix-in sb: "../syntax-browser/interfaces.ss")
|
||||
"cursor.ss"
|
||||
"debug-format.ss")
|
||||
|
|
|
|||
|
|
@ -1,7 +1,10 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require scheme/class
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[define/i define:]
|
||||
[send/i send:]
|
||||
[send*/i send*:]
|
||||
[init-field/i init-field:])
|
||||
scheme/unit
|
||||
scheme/list
|
||||
scheme/match
|
||||
|
|
@ -22,7 +25,7 @@
|
|||
"../model/reductions.ss"
|
||||
"../model/steps.ss"
|
||||
"cursor.ss"
|
||||
"../util/notify.ss"
|
||||
unstable/gui/notify
|
||||
(only-in mzscheme [#%top-interaction mz-top-interaction]))
|
||||
(provide macro-stepper-widget%
|
||||
macro-stepper-widget/process-mixin)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,9 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[define/i define:]
|
||||
[send/i send:]
|
||||
[init-field/i init-field:])
|
||||
scheme/unit
|
||||
scheme/list
|
||||
scheme/match
|
||||
|
|
@ -22,7 +25,7 @@
|
|||
"../model/reductions-config.ss"
|
||||
"../model/reductions.ss"
|
||||
"../model/steps.ss"
|
||||
"../util/notify.ss"
|
||||
unstable/gui/notify
|
||||
"cursor.ss"
|
||||
"debug-format.ss")
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require scheme/class
|
||||
macro-debugger/util/class-iop
|
||||
(rename-in unstable/class-iop
|
||||
[send/i send:])
|
||||
scheme/pretty
|
||||
scheme/gui
|
||||
framework/framework
|
||||
|
|
|
|||
|
|
@ -3,20 +3,21 @@
|
|||
(for-syntax scheme/base
|
||||
syntax/parse
|
||||
unstable/syntax
|
||||
"class-ct.ss"))
|
||||
"private/class-iop-ct.ss"))
|
||||
(provide define-interface
|
||||
define-interface/dynamic
|
||||
define-interface-expander
|
||||
|
||||
send:
|
||||
send*:
|
||||
send/apply:
|
||||
(rename-out [send: send/i]
|
||||
[send*: send*/i]
|
||||
[send/apply: send/apply/i]
|
||||
|
||||
define:
|
||||
lambda:
|
||||
init:
|
||||
init-field:
|
||||
init-private:)
|
||||
[define: define/i]
|
||||
#| lambda: |#
|
||||
|
||||
[init: init/i]
|
||||
[init-field: init-field/i]
|
||||
[init-private: init-private/i]))
|
||||
|
||||
;; Configuration
|
||||
(define-for-syntax warn-on-dynamic-interfaces? #f)
|
||||
|
|
@ -65,7 +66,7 @@
|
|||
(begin-for-syntax
|
||||
(define (check-method-in-interface for-whom method si)
|
||||
(unless (member (syntax-e method) (static-interface-members si))
|
||||
(raise-syntax-error for-whom
|
||||
(raise-syntax-error (syntax-e for-whom)
|
||||
"method not in static interface"
|
||||
method))))
|
||||
|
||||
|
|
@ -74,7 +75,7 @@
|
|||
(define-syntax (send: stx)
|
||||
(syntax-parse stx
|
||||
[(send: obj:expr iface:static-interface method:id . args)
|
||||
(begin (check-method-in-interface 'send: #'method (attribute iface.value))
|
||||
(begin (check-method-in-interface #'send: #'method (attribute iface.value))
|
||||
(syntax/loc stx
|
||||
(send (check-object<:interface send: obj iface)
|
||||
method . args)))]))
|
||||
|
|
@ -83,7 +84,7 @@
|
|||
(syntax-parse stx
|
||||
[(send*: obj:expr iface:static-interface (method:id . args) ...)
|
||||
(begin (for ([method (syntax->list #'(method ...))])
|
||||
(check-method-in-interface 'send*: method (attribute iface.value)))
|
||||
(check-method-in-interface #'send*: method (attribute iface.value)))
|
||||
(syntax/loc stx
|
||||
(send* (check-object<:interface send*: obj iface)
|
||||
(method . args) ...)))]))
|
||||
|
|
@ -91,9 +92,9 @@
|
|||
(define-syntax (send/apply: stx)
|
||||
(syntax-parse stx
|
||||
[(send/apply: obj:expr iface:static-interface method:id . args)
|
||||
(begin (check-method-in-interface 'send/apply: #'method (attribute iface.value))
|
||||
(begin (check-method-in-interface #'send/apply: #'method (attribute iface.value))
|
||||
(syntax/loc stx
|
||||
(send/apply (check-object<:interface send/apply obj iface)
|
||||
(send/apply (check-object<:interface send/apply: obj iface)
|
||||
method . args)))]))
|
||||
|
||||
;;
|
||||
|
|
@ -3,7 +3,6 @@
|
|||
(require (for-syntax scheme/base unstable/syntax)
|
||||
scheme/list
|
||||
scheme/class
|
||||
macro-debugger/util/class-iop
|
||||
scheme/gui)
|
||||
(provide define/listen
|
||||
field/notify
|
||||
13
collects/unstable/gui/prefs.ss
Normal file
13
collects/unstable/gui/prefs.ss
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
|
||||
#lang scheme/base
|
||||
(require (for-syntax scheme/base)
|
||||
framework/framework)
|
||||
(provide pref:get/set)
|
||||
|
||||
(define-syntax pref:get/set
|
||||
(syntax-rules ()
|
||||
[(_ get/set prop)
|
||||
(define get/set
|
||||
(case-lambda
|
||||
[() (preferences:get 'prop)]
|
||||
[(newval) (preferences:set 'prop newval)]))]))
|
||||
125
collects/unstable/scribblings/class-iop.scrbl
Normal file
125
collects/unstable/scribblings/class-iop.scrbl
Normal file
|
|
@ -0,0 +1,125 @@
|
|||
#lang scribble/manual
|
||||
@(require scribble/eval
|
||||
(for-label unstable/class-iop
|
||||
scheme/class
|
||||
scheme/contract
|
||||
scheme/base))
|
||||
|
||||
@title[#:tag "class-iop"]{Interface-Oriented Programming for Classes}
|
||||
|
||||
@(define the-eval (make-base-eval))
|
||||
@(the-eval '(require scheme/class unstable/class-iop))
|
||||
|
||||
@defmodule[unstable/class-iop]
|
||||
|
||||
@defform[(define-interface name-id (super-ifc-id ...) (method-id ...))]{
|
||||
|
||||
Defines @scheme[name-id] as a static interface extending the
|
||||
interfaces named by the @scheme[super-ifc-id]s and containing the
|
||||
methods specified by the @scheme[method-id]s.
|
||||
|
||||
A static interface name is used by the checked method call variants
|
||||
(@scheme[send/i], @scheme[send*/i], and @scheme[send/apply/i]). When
|
||||
used as an expression, a static interface name evaluates to an
|
||||
interface value.
|
||||
|
||||
@examples[#:eval the-eval
|
||||
(define-interface stack<%> () (empty? push pop))
|
||||
stack<%>
|
||||
(define stack%
|
||||
(class* object% (stack<%>)
|
||||
(define items null)
|
||||
(define/public (empty?) (null? items))
|
||||
(define/public (push x) (set! items (cons x items)))
|
||||
(define/public (pop) (begin (car items) (set! items (cdr items))))
|
||||
(super-new)))
|
||||
]
|
||||
}
|
||||
|
||||
@defform[(define-interface/dynamic name-id ifc-expr (method-id ...))]{
|
||||
|
||||
Defines @scheme[name-id] as a static interface with dynamic
|
||||
counterpart @scheme[ifc-expr], which must evaluate to an interface
|
||||
value. The static interface contains the methods named by the
|
||||
@scheme[method-id]s. A run-time error is raised if any
|
||||
@scheme[method-id] is not a member of the dynamic interface
|
||||
@scheme[ifc-expr].
|
||||
|
||||
Use @scheme[define-interface/dynamic] to wrap interfaces from other
|
||||
sources.
|
||||
|
||||
@examples[#:eval the-eval
|
||||
(define-interface/dynamic object<%> (class->interface object%) ())
|
||||
object<%>
|
||||
]
|
||||
}
|
||||
|
||||
@defform[(send/i obj-exp static-ifc-id method-id arg-expr ...)]{
|
||||
|
||||
Checked variant of @scheme[send].
|
||||
|
||||
The argument @scheme[static-ifc-id] must be defined as a static
|
||||
interface. The method @scheme[method-id] must be a member of the
|
||||
static interface @scheme[static-ifc-id]; otherwise a compile-time
|
||||
error is raised.
|
||||
|
||||
The value of @scheme[obj-expr] must be an instance of the interface
|
||||
@scheme[static-ifc-id]; otherwise, a run-time error is raised.
|
||||
|
||||
@examples[#:eval the-eval
|
||||
(define s (new stack%))
|
||||
(send/i s stack<%> push 1)
|
||||
(send/i s stack<%> popp)
|
||||
(send/i (new object%) stack<%> push 2)
|
||||
]
|
||||
}
|
||||
|
||||
@defform[(send*/i obj-expr static-ifc-id (method-id arg-expr ...) ...)]{
|
||||
|
||||
Checked variant of @scheme[send*].
|
||||
|
||||
@examples[#:eval the-eval
|
||||
(send*/i s stack<%>
|
||||
(push 2)
|
||||
(pop))
|
||||
]
|
||||
}
|
||||
|
||||
@defform[(send/apply/i obj-expr static-ifc-id method-id arg-expr ... list-arg-expr)]{
|
||||
|
||||
Checked variant of @scheme[send/apply].
|
||||
|
||||
@examples[#:eval the-eval
|
||||
(send/apply/i s stack<%> push (list 5))
|
||||
]
|
||||
}
|
||||
|
||||
@defform[(define/i id static-ifc-id expr)]{
|
||||
|
||||
Checks that @scheme[expr] evaluates to an instance of
|
||||
@scheme[static-ifc-id] before binding it to @scheme[id]. If
|
||||
@scheme[id] is subsequently changed (with @scheme[set!]), the check is
|
||||
performed again.
|
||||
|
||||
No dynamic object check is performed when calling a method (using
|
||||
@scheme[send/i], etc) on a name defined via @scheme[define/i].
|
||||
|
||||
}
|
||||
|
||||
@deftogether[[
|
||||
@defform[(init/i (id static-ifc-id maybe-default-expr) ...)]
|
||||
@defform[(init-field/i (id static-ifc-id maybe-default-expr) ...)]
|
||||
@defform/subs[(init-private/i (id static-ifc-id maybe-default-expr) ...)
|
||||
([maybe-default-expr (code:blank)
|
||||
default-expr])]]]{
|
||||
|
||||
Checked versions of @scheme[init] and @scheme[init-field]. The value
|
||||
attached to each @scheme[id] is checked against the given interface.
|
||||
|
||||
No dynamic object check is performed when calling a method (using
|
||||
@scheme[send/i], etc) on a name bound via one of these forms. Note
|
||||
that in the case of @scheme[init-field/i] this check omission is
|
||||
unsound in the presence of mutation from outside the class. This
|
||||
should be fixed.
|
||||
|
||||
}
|
||||
|
|
@ -60,7 +60,7 @@ mutable table.
|
|||
[#:default default any/c (lambda () (error ....))])
|
||||
any/c]{
|
||||
|
||||
Like @scheme[find-first], but only returns the first match. If no
|
||||
Like @scheme[find], but only returns the first match. If no
|
||||
matches are found, @scheme[default] is applied as a thunk if it is a
|
||||
procedure or returned otherwise.
|
||||
|
||||
|
|
|
|||
|
|
@ -83,6 +83,7 @@ Keep documentation and tests up to date.
|
|||
@include-section["poly-c.scrbl"]
|
||||
@include-section["mutated-vars.scrbl"]
|
||||
@include-section["find.scrbl"]
|
||||
@include-section["class-iop.scrbl"]
|
||||
|
||||
@;{--------}
|
||||
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@
|
|||
(define dummy-value (box 'dummy))
|
||||
|
||||
;; struct->list : struct?
|
||||
;; #:on-opaque? (or/c 'error 'return-false 'skip)
|
||||
;; #:on-opaque (or/c 'error 'return-false 'skip)
|
||||
;; -> (listof any/c)
|
||||
(define (struct->list s
|
||||
#:on-opaque [on-opaque 'error])
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user