From 79f7ee30487c20d9dec215360cb5fb20e6de6281 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Wed, 30 Jun 2010 16:31:48 -0600 Subject: [PATCH] macro-stepper: replaced {scheme -> racket}, {*.ss -> *.rkt}, etc original commit: efc03566055f549de2a9bf32a402185f66c14a64 --- collects/macro-debugger/expand.rkt | 10 +- collects/macro-debugger/info.rkt | 2 +- collects/macro-debugger/model/context.rkt | 3 +- collects/macro-debugger/model/debug.rkt | 35 +- collects/macro-debugger/model/deriv-c.rkt | 3 +- .../macro-debugger/model/deriv-parser.rkt | 15 +- .../macro-debugger/model/deriv-tokens.rkt | 5 +- collects/macro-debugger/model/deriv-util.rkt | 11 +- collects/macro-debugger/model/deriv.rkt | 371 +----------------- .../macro-debugger/model/hiding-policies.rkt | 12 +- .../model/reductions-config.rkt | 21 +- .../model/reductions-engine.rkt | 26 +- collects/macro-debugger/model/reductions.rkt | 13 +- collects/macro-debugger/model/steps.rkt | 6 +- collects/macro-debugger/model/stx-util.rkt | 5 +- collects/macro-debugger/model/trace-raw.rkt | 11 +- collects/macro-debugger/model/trace.rkt | 11 +- collects/macro-debugger/model/yacc-ext.rkt | 7 +- .../macro-debugger/model/yacc-interrupted.rkt | 8 +- collects/macro-debugger/stepper-text.rkt | 19 +- collects/macro-debugger/stepper.rkt | 5 +- collects/macro-debugger/syntax-browser.rkt | 5 +- .../syntax-browser/controller.rkt | 18 +- .../macro-debugger/syntax-browser/display.rkt | 70 ++-- .../macro-debugger/syntax-browser/embed.rkt | 17 +- .../macro-debugger/syntax-browser/frame.rkt | 46 +-- .../syntax-browser/hrule-snip.rkt | 10 +- .../macro-debugger/syntax-browser/image.rkt | 14 +- .../syntax-browser/interfaces.rkt | 8 +- .../macro-debugger/syntax-browser/keymap.rkt | 12 +- .../syntax-browser/partition.rkt | 5 +- .../macro-debugger/syntax-browser/prefs.rkt | 8 +- .../syntax-browser/pretty-helper.rkt | 21 +- .../syntax-browser/pretty-printer.rkt | 14 +- .../syntax-browser/properties.rkt | 23 +- .../syntax-browser/snip-decorated.rkt | 29 +- .../macro-debugger/syntax-browser/snip.rkt | 26 +- .../macro-debugger/syntax-browser/text.rkt | 10 +- .../macro-debugger/syntax-browser/util.rkt | 5 +- .../macro-debugger/syntax-browser/widget.rkt | 71 ++-- collects/macro-debugger/util/mpi.rkt | 10 +- collects/macro-debugger/util/stxobj.rkt | 2 +- collects/macro-debugger/view/cursor.rkt | 4 +- collects/macro-debugger/view/debug-format.rkt | 5 +- collects/macro-debugger/view/debug.rkt | 19 +- collects/macro-debugger/view/extensions.rkt | 59 ++- collects/macro-debugger/view/frame.rkt | 82 ++-- collects/macro-debugger/view/hiding-panel.rkt | 37 +- collects/macro-debugger/view/interfaces.rkt | 4 +- collects/macro-debugger/view/prefs.rkt | 10 +- collects/macro-debugger/view/step-display.rkt | 133 +++---- collects/macro-debugger/view/stepper.rkt | 139 ++++--- collects/macro-debugger/view/term-record.rkt | 107 +++-- collects/macro-debugger/view/view.rkt | 33 +- 54 files changed, 611 insertions(+), 1044 deletions(-) diff --git a/collects/macro-debugger/expand.rkt b/collects/macro-debugger/expand.rkt index 48d4c22..b34cb03 100644 --- a/collects/macro-debugger/expand.rkt +++ b/collects/macro-debugger/expand.rkt @@ -1,8 +1,8 @@ -#lang scheme/base -(require scheme/contract - "model/trace.ss" - "model/reductions-config.ss" - "model/reductions.ss") +#lang racket/base +(require racket/contract + "model/trace.rkt" + "model/reductions-config.rkt" + "model/reductions.rkt") (provide/contract [expand-only diff --git a/collects/macro-debugger/info.rkt b/collects/macro-debugger/info.rkt index 55db6ff..0a5856f 100644 --- a/collects/macro-debugger/info.rkt +++ b/collects/macro-debugger/info.rkt @@ -1,5 +1,5 @@ #lang setup/infotab -(define tools '(["tool.ss"])) +(define tools '(["tool.rkt"])) (define tool-names '("Macro Stepper")) (define scribblings '(("macro-debugger.scrbl" () (tool-library)))) diff --git a/collects/macro-debugger/model/context.rkt b/collects/macro-debugger/model/context.rkt index c385aff..8d6073d 100644 --- a/collects/macro-debugger/model/context.rkt +++ b/collects/macro-debugger/model/context.rkt @@ -1,5 +1,4 @@ -#lang scheme/base - +#lang racket/base (require syntax/stx) (provide (struct-out ref) (struct-out tail) diff --git a/collects/macro-debugger/model/debug.rkt b/collects/macro-debugger/model/debug.rkt index 3ba4ad0..1bb8157 100644 --- a/collects/macro-debugger/model/debug.rkt +++ b/collects/macro-debugger/model/debug.rkt @@ -1,19 +1,18 @@ -#lang scheme/base +#lang racket/base +(require racket/match + "trace.rkt" + "reductions.rkt" + "reductions-config.rkt" + "deriv-util.rkt" + "hiding-policies.rkt" + "deriv.rkt" + "steps.rkt") -(require scheme/match - "trace.ss" - "reductions.ss" - "reductions-config.ss" - "deriv-util.ss" - "hiding-policies.ss" - "deriv.ss" - "steps.ss") - -(provide (all-from-out "trace.ss") - (all-from-out "reductions.ss") - (all-from-out "reductions-config.ss") - (all-from-out "deriv.ss") - (all-from-out "deriv-util.ss") - (all-from-out "hiding-policies.ss") - (all-from-out "steps.ss") - (all-from-out scheme/match)) +(provide (all-from-out "trace.rkt") + (all-from-out "reductions.rkt") + (all-from-out "reductions-config.rkt") + (all-from-out "deriv.rkt") + (all-from-out "deriv-util.rkt") + (all-from-out "hiding-policies.rkt") + (all-from-out "steps.rkt") + (all-from-out racket/match)) diff --git a/collects/macro-debugger/model/deriv-c.rkt b/collects/macro-debugger/model/deriv-c.rkt index 9221dfc..2ab5dc6 100644 --- a/collects/macro-debugger/model/deriv-c.rkt +++ b/collects/macro-debugger/model/deriv-c.rkt @@ -1,5 +1,4 @@ - -#lang scheme/base +#lang racket/base (provide (all-defined-out)) ;; A Node(a) is: diff --git a/collects/macro-debugger/model/deriv-parser.rkt b/collects/macro-debugger/model/deriv-parser.rkt index f4f8ca0..c24e0d2 100644 --- a/collects/macro-debugger/model/deriv-parser.rkt +++ b/collects/macro-debugger/model/deriv-parser.rkt @@ -1,12 +1,11 @@ - -#lang scheme/base -(require (for-syntax scheme/base) +#lang racket/base +(require (for-syntax racket/base) syntax/stx - "yacc-ext.ss" - "yacc-interrupted.ss" - "deriv.ss" - "deriv-util.ss" - "deriv-tokens.ss") + "yacc-ext.rkt" + "yacc-interrupted.rkt" + "deriv.rkt" + "deriv-util.rkt" + "deriv-tokens.rkt") (provide parse-derivation) (define (deriv-error ok? name value start end) diff --git a/collects/macro-debugger/model/deriv-tokens.rkt b/collects/macro-debugger/model/deriv-tokens.rkt index 6448e7a..d33e3c2 100644 --- a/collects/macro-debugger/model/deriv-tokens.rkt +++ b/collects/macro-debugger/model/deriv-tokens.rkt @@ -1,7 +1,6 @@ - -#lang scheme/base +#lang racket/base (require parser-tools/lex - "deriv.ss") + "deriv.rkt") (provide (all-defined-out)) (define-tokens basic-tokens diff --git a/collects/macro-debugger/model/deriv-util.rkt b/collects/macro-debugger/model/deriv-util.rkt index 0a3c2a3..8987afb 100644 --- a/collects/macro-debugger/model/deriv-util.rkt +++ b/collects/macro-debugger/model/deriv-util.rkt @@ -1,11 +1,10 @@ - -#lang scheme/base -(require (for-syntax scheme/base) +#lang racket/base +(require (for-syntax racket/base) (for-syntax racket/private/struct-info) - scheme/list - scheme/match + racket/list + racket/match unstable/struct - "deriv.ss") + "deriv.rkt") (provide make diff --git a/collects/macro-debugger/model/deriv.rkt b/collects/macro-debugger/model/deriv.rkt index a7be9bd..420d6ca 100644 --- a/collects/macro-debugger/model/deriv.rkt +++ b/collects/macro-debugger/model/deriv.rkt @@ -1,368 +1,5 @@ - -#lang scheme/base -(require scheme/contract +#lang racket/base +(require racket/contract syntax/stx - "deriv-c.ss") - -(provide (all-from-out "deriv-c.ss")) - -#| - -(define (?? c) (or/c c false/c)) - -(define (stx? x) - (or (syntax? x) - (and (pair? x) (stx? (car x)) (stx? (cdr x))) - (null? x))) - -(define (stx-list-like? x) - (let ([x (stx->list x)]) - (and x (andmap syntax? x)))) - -(define syntax/f (?? syntax?)) -(define syntaxes/c stx-list-like?) -(define syntaxes/f (?? syntaxes/c)) -(define resolves/c (listof identifier?)) - -(define localaction/c - (or/c local-expansion? local-expansion/expr? local-lift? - local-lift-end? local-bind?)) - -(provide/contract - (struct node - ([z1 any/c] - [z2 any/c])) - (struct (deriv node) - ([z1 syntax?] - [z2 syntax/f])) - (struct (lift-deriv deriv) - ([z1 syntax?] - [z2 syntax/f] - [first deriv?] - [lift-stx syntax?] - [second deriv?])) - (struct (mrule deriv) - ([z1 syntax?] - [z2 syntax/f] - [transformation transformation?] - [next (?? deriv?)])) - (struct (lift/let-deriv deriv) - ([z1 syntax?] - [z2 syntax/f] - [first deriv?] - [lift-stx syntax?] - [second deriv?])) - (struct (transformation node) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [me1 (?? syntax?)] - [locals (?? (listof localaction/c))] - [me2 (?? syntax?)] - [?2 (?? exn?)] - [seq number?])) - (struct (local-expansion node) - ([z1 syntax?] - [z2 syntax/f] - [me1 syntax?] - [me2 syntax/f] - [for-stx? boolean?] - [inner deriv?])) - (struct (local-expansion/expr node) - ([z1 syntax?] - [z2 syntax/f] - [me1 syntax?] - [me2 syntax/f] - [for-stx? boolean?] - [opaque any/c] - [inner deriv?])) - (struct local-lift - ([expr syntax?] - [id identifier?])) - (struct local-lift-end - ([decl syntax?])) - (struct local-bind - ([bindrhs bind-syntaxes?])) - (struct (base deriv) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)])) - (struct (prule base) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)])) - (struct (p:variable prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)])) - (struct (p:module prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [one-body-form? boolean?] - [mb (?? deriv?)] - [?2 (?? exn?)] - [body (?? deriv?)])) - (struct (p:#%module-begin prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [pass1 (?? (listof modrule?))] - [pass2 (?? (listof modrule?))] - [?2 (?? exn?)])) - (struct (p:define-syntaxes prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [rhs (?? deriv?)] - [?2 (?? exn?)])) - (struct (p:define-values prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [rhs (?? deriv?)])) - (struct (p:#%expression prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [inner (?? deriv?)])) - (struct (p:if prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [full? boolean?] - [test (?? deriv?)] - [then (?? deriv?)] - [else (?? deriv?)])) - (struct (p:wcm prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [key (?? deriv?)] - [mark (?? deriv?)] - [body (?? deriv?)])) - (struct (p:set! prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [id-resolves (?? resolves/c)] - [rhs (?? deriv?)])) - (struct (p:set!-macro prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [deriv (?? deriv?)])) - (struct (p:#%app prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [tagged-stx syntax/f] - [lderiv (?? lderiv?)])) - (struct (p:begin prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [lderiv (?? lderiv?)])) - (struct (p:begin0 prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [first (?? deriv?)] - [lderiv (?? lderiv?)])) - (struct (p:lambda prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [renames any/c] ;; fixme - [body (?? bderiv?)])) - (struct (p:case-lambda prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [renames+bodies (listof clc?)])) - (struct (p:let-values prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [renames any/c] ;; fixme - [rhss (?? (listof deriv?))] - [body (?? bderiv?)])) - (struct (p:letrec-values prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [renames any/c] ;; fixme - [rhss (?? (listof deriv?))] - [body (?? bderiv?)])) - (struct (p:letrec-syntaxes+values prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [srenames any/c] ;; fixme - [sbindrhss (?? (listof bind-syntaxes?))] - [vrenames any/c] ;; fixme - [vrhss (?? (listof deriv?))] - [body (?? bderiv?)])) - (struct (p::STOP prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)])) - (struct (p:stop p::STOP) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)])) - (struct (p:unknown p::STOP) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)])) - (struct (p:#%top p::STOP) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [tagged-stx syntax/f])) - (struct (p:#%datum p::STOP) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [tagged-stx syntax/f])) - (struct (p:quote p::STOP) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)])) - (struct (p:quote-syntax p::STOP) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)])) - (struct (p:require p::STOP) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)])) - (struct (p:require-for-syntax p::STOP) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)])) - (struct (p:require-for-template p::STOP) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)])) - (struct (p:provide p::STOP) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)])) - (struct (p:rename prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [renames any/c] - [inner (?? deriv?)])) - (struct (p:synth prule) - ([z1 syntax?] - [z2 syntax/f] - [resolves resolves/c] - [?1 (?? exn?)] - [subterms (?? (listof subitem?))] - [?2 (?? exn?)])) - - (struct (lderiv node) - ([z1 stx?] - [z2 syntaxes/f] - [?1 (?? exn?)] - [derivs (?? (listof deriv?))])) - (struct (bderiv node) - ([z1 stx?] - [z2 syntaxes/f] - [pass1 (?? (listof (or/c b:error? brule?)))] - [trans (symbols 'list 'letrec)] - [pass2 (?? lderiv?)])) - - (struct b:error - ([?1 exn?])) - (struct brule - ([renames any/c])) - (struct (b:expr brule) - ([renames any/c] - [head deriv?])) - (struct (b:splice brule) - ([renames any/c] - [head deriv?] - [?1 (?? exn?)] - [tail (?? stx?)] - [?2 (?? exn?)])) - (struct (b:defvals brule) - ([renames any/c] - [head deriv?] - [?1 (?? exn?)])) - (struct (b:defstx brule) - ([renames any/c] - [head deriv?] - [?1 (?? exn?)] - [bindrhs (?? bind-syntaxes?)])) - - (struct bind-syntaxes - ([rhs deriv?] - [?1 (?? exn?)])) - - (struct clc - ([?1 (?? exn?)] - [renames any/c] - [body (?? bderiv?)])) - - (struct modrule ()) - (struct (mod:cons modrule) - ([head deriv?])) - (struct (mod:prim modrule) - ([head deriv?] - [prim (?? deriv?)])) - (struct (mod:skip modrule) ()) - (struct (mod:splice modrule) - ([head deriv?] - [?1 (?? exn?)] - [tail (?? stx?)])) - (struct (mod:lift modrule) - ([head deriv?] - [tail syntaxes/c])) - (struct (mod:lift-end modrule) - ([tail syntaxes/c])) - - (struct subitem ()) - (struct (s:subterm subitem) - ([path any/c] - [deriv deriv?])) - (struct (s:rename subitem) - ([path any/c] - [before syntax?] - [after syntax?]))) -|# + "deriv-c.rkt") +(provide (all-from-out "deriv-c.rkt")) diff --git a/collects/macro-debugger/model/hiding-policies.rkt b/collects/macro-debugger/model/hiding-policies.rkt index 51c1027..0be2f56 100644 --- a/collects/macro-debugger/model/hiding-policies.rkt +++ b/collects/macro-debugger/model/hiding-policies.rkt @@ -1,10 +1,8 @@ - -#lang scheme/base -(require (for-syntax scheme/base) - scheme/match - syntax/boundmap - "reductions-config.ss" - "../util/mpi.ss") +#lang racket/base +(require (for-syntax racket/base) + racket/match + "reductions-config.rkt" + "../util/mpi.rkt") (provide policy->predicate) ;; A Policy is one of diff --git a/collects/macro-debugger/model/reductions-config.rkt b/collects/macro-debugger/model/reductions-config.rkt index 160255c..f3c82aa 100644 --- a/collects/macro-debugger/model/reductions-config.rkt +++ b/collects/macro-debugger/model/reductions-config.rkt @@ -1,14 +1,13 @@ -#lang scheme/base - -(require (for-syntax scheme/base) - scheme/list - scheme/contract - scheme/match - "deriv.ss" - "deriv-util.ss" - "stx-util.ss" - "context.ss" - "steps.ss") +#lang racket/base +(require (for-syntax racket/base) + racket/list + racket/contract + racket/match + "deriv.rkt" + "deriv-util.rkt" + "stx-util.rkt" + "context.rkt" + "steps.rkt") (define-syntax-rule (STRICT-CHECKS form ...) (when #f diff --git a/collects/macro-debugger/model/reductions-engine.rkt b/collects/macro-debugger/model/reductions-engine.rkt index 9c89829..80e5e31 100644 --- a/collects/macro-debugger/model/reductions-engine.rkt +++ b/collects/macro-debugger/model/reductions-engine.rkt @@ -1,16 +1,16 @@ -#lang scheme/base -(require (for-syntax scheme/base) - (for-syntax syntax/parse) - scheme/list - scheme/contract - "deriv.ss" - "deriv-util.ss" - "stx-util.ss" - "context.ss" - "steps.ss" - "reductions-config.ss") -(provide (all-from-out "steps.ss") - (all-from-out "reductions-config.ss") +#lang racket/base +(require (for-syntax racket/base + syntax/parse) + racket/list + racket/contract + "deriv.rkt" + "deriv-util.rkt" + "stx-util.rkt" + "context.rkt" + "steps.rkt" + "reductions-config.rkt") +(provide (all-from-out "steps.rkt") + (all-from-out "reductions-config.rkt") DEBUG R !) diff --git a/collects/macro-debugger/model/reductions.rkt b/collects/macro-debugger/model/reductions.rkt index 82943aa..3f60cf6 100644 --- a/collects/macro-debugger/model/reductions.rkt +++ b/collects/macro-debugger/model/reductions.rkt @@ -1,10 +1,9 @@ - -#lang scheme/base -(require scheme/match - "stx-util.ss" - "deriv-util.ss" - "deriv.ss" - "reductions-engine.ss") +#lang racket/base +(require racket/match + "stx-util.rkt" + "deriv-util.rkt" + "deriv.rkt" + "reductions-engine.rkt") (provide reductions reductions+) diff --git a/collects/macro-debugger/model/steps.rkt b/collects/macro-debugger/model/steps.rkt index 4412186..bb4feed 100644 --- a/collects/macro-debugger/model/steps.rkt +++ b/collects/macro-debugger/model/steps.rkt @@ -1,6 +1,6 @@ -#lang scheme/base -(require "deriv.ss" - "deriv-util.ss") +#lang racket/base +(require "deriv.rkt" + "deriv-util.rkt") (provide (struct-out protostep) (struct-out step) (struct-out misstep) diff --git a/collects/macro-debugger/model/stx-util.rkt b/collects/macro-debugger/model/stx-util.rkt index 1073298..def760a 100644 --- a/collects/macro-debugger/model/stx-util.rkt +++ b/collects/macro-debugger/model/stx-util.rkt @@ -1,6 +1,5 @@ - -#lang scheme/base -(require (for-syntax scheme/base) +#lang racket/base +(require (for-syntax racket/base) syntax/stx) (provide (all-defined-out) diff --git a/collects/macro-debugger/model/trace-raw.rkt b/collects/macro-debugger/model/trace-raw.rkt index 5fc8702..40615d6 100644 --- a/collects/macro-debugger/model/trace-raw.rkt +++ b/collects/macro-debugger/model/trace-raw.rkt @@ -1,10 +1,9 @@ - -#lang scheme/base -(require scheme/class +#lang racket/base +(require racket/class parser-tools/lex - "deriv-tokens.ss" - "deriv-parser.ss" - "../syntax-browser.ss") + "deriv-tokens.rkt" + "deriv-parser.rkt" + "../syntax-browser.rkt") (provide (all-defined-out)) (define current-expand-observe diff --git a/collects/macro-debugger/model/trace.rkt b/collects/macro-debugger/model/trace.rkt index 12e08c5..5f509e5 100644 --- a/collects/macro-debugger/model/trace.rkt +++ b/collects/macro-debugger/model/trace.rkt @@ -1,10 +1,9 @@ - -#lang scheme/base -(require scheme/promise +#lang racket/base +(require racket/promise parser-tools/lex - "deriv.ss" - "deriv-parser.ss" - "deriv-tokens.ss") + "deriv.rkt" + "deriv-parser.rkt" + "deriv-tokens.rkt") (provide trace trace* diff --git a/collects/macro-debugger/model/yacc-ext.rkt b/collects/macro-debugger/model/yacc-ext.rkt index 85ef44b..a8d262a 100644 --- a/collects/macro-debugger/model/yacc-ext.rkt +++ b/collects/macro-debugger/model/yacc-ext.rkt @@ -1,7 +1,6 @@ - -#lang scheme/base -(require (prefix-in yacc: parser-tools/yacc) - (for-syntax scheme/base)) +#lang racket/base +(require (for-syntax racket/base) + (prefix-in yacc: parser-tools/yacc)) (provide parser options productions diff --git a/collects/macro-debugger/model/yacc-interrupted.rkt b/collects/macro-debugger/model/yacc-interrupted.rkt index 7d7c491..9e8d2a5 100644 --- a/collects/macro-debugger/model/yacc-interrupted.rkt +++ b/collects/macro-debugger/model/yacc-interrupted.rkt @@ -1,9 +1,7 @@ - -#lang scheme/base -(require (for-syntax scheme/base - mzlib/etc +#lang racket/base +(require (for-syntax racket/base unstable/syntax) - "yacc-ext.ss") + "yacc-ext.rkt") (provide ! ? !! define-production-splitter skipped-token-values diff --git a/collects/macro-debugger/stepper-text.rkt b/collects/macro-debugger/stepper-text.rkt index 327b52a..15df8ef 100644 --- a/collects/macro-debugger/stepper-text.rkt +++ b/collects/macro-debugger/stepper-text.rkt @@ -1,13 +1,12 @@ - -#lang scheme/base -(require scheme/list - scheme/pretty - "model/trace.ss" - "model/reductions.ss" - "model/reductions-config.ss" - "model/steps.ss" - "syntax-browser/partition.ss" - "syntax-browser/pretty-helper.ss") +#lang racket/base +(require racket/list + racket/pretty + "model/trace.rkt" + "model/reductions.rkt" + "model/reductions-config.rkt" + "model/steps.rkt" + "syntax-browser/partition.rkt" + "syntax-browser/pretty-helper.rkt") (provide expand/step-text stepper-text) diff --git a/collects/macro-debugger/stepper.rkt b/collects/macro-debugger/stepper.rkt index 30fec39..07e782b 100644 --- a/collects/macro-debugger/stepper.rkt +++ b/collects/macro-debugger/stepper.rkt @@ -1,6 +1,5 @@ - -#lang scheme/base -(require "view/view.ss") +#lang racket/base +(require "view/view.rkt") (provide expand/step) (define (expand/step stx) diff --git a/collects/macro-debugger/syntax-browser.rkt b/collects/macro-debugger/syntax-browser.rkt index ce23cef..155ef03 100644 --- a/collects/macro-debugger/syntax-browser.rkt +++ b/collects/macro-debugger/syntax-browser.rkt @@ -1,6 +1,5 @@ - -#lang scheme/base -(require "syntax-browser/frame.ss") +#lang racket/base +(require "syntax-browser/frame.rkt") (provide browse-syntax browse-syntaxes make-syntax-browser) diff --git a/collects/macro-debugger/syntax-browser/controller.rkt b/collects/macro-debugger/syntax-browser/controller.rkt index 897a9c8..82a2d06 100644 --- a/collects/macro-debugger/syntax-browser/controller.rkt +++ b/collects/macro-debugger/syntax-browser/controller.rkt @@ -1,10 +1,8 @@ -#lang scheme/base -(require scheme/class - (rename-in unstable/class-iop - [send/i send:] - [init-field/i init-field:]) - "interfaces.ss" - "partition.ss" +#lang racket/base +(require racket/class + unstable/class-iop + "interfaces.rkt" + "partition.rkt" unstable/gui/notify) (provide controller%) @@ -33,13 +31,13 @@ (super-new) (listen-selected-syntax (lambda (new-value) - (for-each (lambda (display) (send: display display<%> refresh)) + (for-each (lambda (display) (send/i display display<%> refresh)) displays))))) ;; mark-manager-mixin (define mark-manager-mixin (mixin () (mark-manager<%>) - (init-field: [primary-partition partition<%> (new-bound-partition)]) + (init-field/i [primary-partition partition<%> (new-bound-partition)]) (super-new) ;; get-primary-partition : -> partition @@ -65,7 +63,7 @@ (listen-secondary-partition (lambda (p) (for ([d displays]) - (send: d display<%> refresh)))) + (send/i d display<%> refresh)))) (super-new))) (define controller% diff --git a/collects/macro-debugger/syntax-browser/display.rkt b/collects/macro-debugger/syntax-browser/display.rkt index 2ca32ef..e0a7da0 100644 --- a/collects/macro-debugger/syntax-browser/display.rkt +++ b/collects/macro-debugger/syntax-browser/display.rkt @@ -1,16 +1,14 @@ -#lang scheme/base -(require scheme/class - scheme/gui - scheme/list +#lang racket/base +(require racket/class + racket/gui + racket/list + racket/block framework - (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" - "prefs.ss" - "util.ss") + unstable/class-iop + "pretty-printer.rkt" + "interfaces.rkt" + "prefs.rkt" + "util.rkt") (provide print-syntax-to-editor code-style) @@ -27,13 +25,13 @@ ;; -> display<%> (define (print-syntax-to-editor stx text controller config columns [insertion-point (send text last-position)]) - (begin-with-definitions + (block (define output-port (open-output-string/count-lines)) (define range (pretty-print-syntax stx output-port - (send: controller controller<%> get-primary-partition) - (length (send: config config<%> get-colors)) - (send: config config<%> get-suffix-option) + (send/i controller controller<%> get-primary-partition) + (length (send/i config config<%> get-colors)) + (send/i config config<%> get-suffix-option) (send config get-pretty-styles) columns)) (define output-string (get-output-string output-port)) @@ -56,15 +54,15 @@ ;; display% (define display% (class* object% (display<%>) - (init-field: [controller controller<%>] - [config config<%>] - [range range<%>]) + (init-field/i [controller controller<%>] + [config config<%>] + [range range<%>]) (init-field text start-position end-position) (define base-style - (code-style text (send: config config<%> get-syntax-font-size))) + (code-style text (send/i config config<%> get-syntax-font-size))) (define extra-styles (make-hasheq)) @@ -78,10 +76,10 @@ ;; add-clickbacks : -> void (define/private (add-clickbacks) (define (the-clickback editor start end) - (send: controller selection-manager<%> set-selected-syntax + (send/i controller selection-manager<%> set-selected-syntax (clickback->stx (- start start-position) (- end start-position)))) - (for ([range (send: range range<%> all-ranges)]) + (for ([range (send/i range range<%> all-ranges)]) (let ([stx (range-obj range)] [start (range-start range)] [end (range-end range)]) @@ -91,7 +89,7 @@ ;; clickback->stx : num num -> syntax ;; FIXME: use vectors for treerange-subs and do binary search to narrow? (define/private (clickback->stx start end) - (let ([treeranges (send: range range<%> get-treeranges)]) + (let ([treeranges (send/i range range<%> get-treeranges)]) (let loop* ([treeranges treeranges]) (for/or ([tr treeranges]) (cond [(and (= (treerange-start tr) start) @@ -111,7 +109,7 @@ (change-style (unhighlight-d) start-position end-position)) (apply-extra-styles) (let ([selected-syntax - (send: controller selection-manager<%> + (send/i controller selection-manager<%> get-selected-syntax)]) (apply-secondary-partition-styles selected-syntax) (apply-selection-styles selected-syntax)) @@ -162,13 +160,13 @@ (list->vector (map color-style (map translate-color - (send: config config<%> get-colors))))) + (send/i config config<%> get-colors))))) (define overflow-style (color-style (translate-color "darkgray"))) (define color-partition - (send: controller mark-manager<%> get-primary-partition)) + (send/i controller mark-manager<%> get-primary-partition)) (define offset start-position) ;; Optimization: don't call change-style when new style = old style - (let tr*loop ([trs (send: range range<%> get-treeranges)] [old-style #f]) + (let tr*loop ([trs (send/i range range<%> get-treeranges)] [old-style #f]) (for ([tr trs]) (define stx (treerange-obj tr)) (define start (treerange-start tr)) @@ -184,7 +182,7 @@ ;; primary-style : syntax partition (vector-of style-delta%) style-delta% ;; -> style-delta% (define/private (primary-style stx partition color-vector overflow) - (let ([n (send: partition partition<%> get-partition stx)]) + (let ([n (send/i partition partition<%> get-partition stx)]) (cond [(< n (vector-length color-vector)) (vector-ref color-vector n)] [else @@ -197,7 +195,7 @@ ;; Applies externally-added styles (such as highlighting) (define/private (apply-extra-styles) (for ([(stx style-deltas) extra-styles]) - (for ([r (send: range range<%> get-ranges stx)]) + (for ([r (send/i range range<%> get-ranges stx)]) (for ([style-delta style-deltas]) (restyle-range r style-delta))))) @@ -207,23 +205,23 @@ (define/private (apply-secondary-partition-styles selected-syntax) (when (identifier? selected-syntax) (let ([partition - (send: controller secondary-partition<%> + (send/i controller secondary-partition<%> get-secondary-partition)]) (when partition - (for ([id (send: range range<%> get-identifier-list)]) - (when (send: partition partition<%> + (for ([id (send/i range range<%> get-identifier-list)]) + (when (send/i partition partition<%> same-partition? selected-syntax id) (draw-secondary-connection id))))))) ;; apply-selection-styles : syntax -> void ;; Styles subterms eq to the selected syntax (define/private (apply-selection-styles selected-syntax) - (for ([r (send: range range<%> get-ranges selected-syntax)]) + (for ([r (send/i range range<%> get-ranges selected-syntax)]) (restyle-range r (select-highlight-d)))) ;; draw-secondary-connection : syntax -> void (define/private (draw-secondary-connection stx2) - (for ([r (send: range range<%> get-ranges stx2)]) + (for ([r (send/i range range<%> get-ranges stx2)]) (restyle-range r (select-sub-highlight-d)))) ;; restyle-range : (cons num num) style-delta% -> void @@ -238,11 +236,11 @@ ;; Initialize (super-new) - (send: controller controller<%> add-syntax-display this))) + (send/i controller controller<%> add-syntax-display this))) ;; fixup-parentheses : string range -> void (define (fixup-parentheses string range) - (for ([r (send: range range<%> all-ranges)]) + (for ([r (send/i range range<%> all-ranges)]) (let ([stx (range-obj r)] [start (range-start r)] [end (range-end r)]) diff --git a/collects/macro-debugger/syntax-browser/embed.rkt b/collects/macro-debugger/syntax-browser/embed.rkt index 2edc5e6..b3cb5d3 100644 --- a/collects/macro-debugger/syntax-browser/embed.rkt +++ b/collects/macro-debugger/syntax-browser/embed.rkt @@ -1,11 +1,10 @@ +#lang racket/base +(require "interfaces.rkt" + "widget.rkt" + "keymap.rkt" + "partition.rkt") -#lang scheme/base -(require "interfaces.ss" - "widget.ss" - "keymap.ss" - "partition.ss") - -(provide (all-from-out "interfaces.ss") - (all-from-out "widget.ss") - (all-from-out "keymap.ss") +(provide (all-from-out "interfaces.rkt") + (all-from-out "widget.rkt") + (all-from-out "keymap.rkt") identifier=-choices) diff --git a/collects/macro-debugger/syntax-browser/frame.rkt b/collects/macro-debugger/syntax-browser/frame.rkt index 7b4a3ff..d59f2eb 100644 --- a/collects/macro-debugger/syntax-browser/frame.rkt +++ b/collects/macro-debugger/syntax-browser/frame.rkt @@ -1,17 +1,13 @@ -#lang scheme/base -(require scheme/class - (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 - "interfaces.ss" - "partition.ss" - "prefs.ss" - "widget.ss") +#lang racket/base +(require racket/class + racket/gui + racket/list + framework + unstable/class-iop + "interfaces.rkt" + "partition.rkt" + "prefs.rkt" + "widget.rkt") (provide browse-syntax browse-syntaxes make-syntax-browser @@ -26,7 +22,7 @@ (define (browse-syntaxes stxs) (let ((w (make-syntax-browser))) (for ([stx stxs]) - (send*: w syntax-browser<%> + (send*/i w syntax-browser<%> (add-syntax stx) (add-separator))))) @@ -41,17 +37,17 @@ (class* frame% () (inherit get-width get-height) - (init-field: [config config<%> (new syntax-prefs%)]) + (init-field/i [config config<%> (new syntax-prefs%)]) (super-new (label "Syntax Browser") - (width (send: config config<%> get-width)) - (height (send: config config<%> get-height))) - (define: widget syntax-browser<%> + (width (send/i config config<%> get-width)) + (height (send/i config config<%> get-height))) + (define/i widget syntax-browser<%> (new syntax-widget/controls% (parent this) (config config))) (define/public (get-widget) widget) (define/augment (on-close) - (send*: config config<%> + (send*/i config config<%> (set-width (get-width)) (set-height (get-height))) (send widget shutdown) @@ -81,22 +77,22 @@ (choices (map car -identifier=-choices)) (callback (lambda (c e) - (send: (get-controller) controller<%> set-identifier=? + (send/i (get-controller) controller<%> set-identifier=? (assoc (send c get-string-selection) -identifier=-choices)))))) (new button% (label "Clear") (parent -control-panel) - (callback (lambda _ (send: (get-controller) controller<%> set-selected-syntax #f)))) + (callback (lambda _ (send/i (get-controller) controller<%> set-selected-syntax #f)))) (new button% (label "Properties") (parent -control-panel) (callback (lambda _ - (send: config config<%> set-props-shown? - (not (send: config config<%> get-props-shown?)))))) + (send/i config config<%> set-props-shown? + (not (send/i config config<%> get-props-shown?)))))) - (send: (get-controller) controller<%> listen-identifier=? + (send/i (get-controller) controller<%> listen-identifier=? (lambda (name+func) (send -choice set-selection (or (send -choice find-string (car name+func)) 0)))) diff --git a/collects/macro-debugger/syntax-browser/hrule-snip.rkt b/collects/macro-debugger/syntax-browser/hrule-snip.rkt index 148d3f2..c7bb859 100644 --- a/collects/macro-debugger/syntax-browser/hrule-snip.rkt +++ b/collects/macro-debugger/syntax-browser/hrule-snip.rkt @@ -1,8 +1,6 @@ - -#lang scheme/base - -(require scheme/class - scheme/gui) +#lang racket/base +(require racket/class + racket/gui) (provide hrule-snip%) ;; hrule-snip% @@ -53,5 +51,5 @@ (define snip-class (new hrule-snipclass%)) (send snip-class set-version 1) (send snip-class set-classname - (format "~s" '(lib "hrule-snip.ss" "macro-debugger" "syntax-browser"))) + (format "~s" '(lib "hrule-snip.rkt" "macro-debugger" "syntax-browser"))) (send (get-the-snip-class-list) add snip-class) diff --git a/collects/macro-debugger/syntax-browser/image.rkt b/collects/macro-debugger/syntax-browser/image.rkt index 7e5774a..23fa15c 100644 --- a/collects/macro-debugger/syntax-browser/image.rkt +++ b/collects/macro-debugger/syntax-browser/image.rkt @@ -1,11 +1,11 @@ -#lang scheme/base -(require scheme/contract - scheme/class - scheme/gui +#lang racket/base +(require racket/contract + racket/class + racket/gui framework - "prefs.ss" - "controller.ss" - "display.ss") + "prefs.rkt" + "controller.rkt" + "display.rkt") #| diff --git a/collects/macro-debugger/syntax-browser/interfaces.rkt b/collects/macro-debugger/syntax-browser/interfaces.rkt index 411f922..5f057ba 100644 --- a/collects/macro-debugger/syntax-browser/interfaces.rkt +++ b/collects/macro-debugger/syntax-browser/interfaces.rkt @@ -1,7 +1,7 @@ -#lang scheme/base -(require scheme/class +#lang racket/base +(require racket/class unstable/class-iop - (for-syntax scheme/base)) + (for-syntax racket/base)) (provide (all-defined-out)) ;; Helpers @@ -14,7 +14,7 @@ [else (error '->string)])) (string->symbol (apply string-append (map ->string args)))) -;; not in notify.ss because notify depends on scheme/gui +;; not in notify.rkt because notify depends on gui (define-interface-expander methods:notify (lambda (stx) (syntax-case stx () diff --git a/collects/macro-debugger/syntax-browser/keymap.rkt b/collects/macro-debugger/syntax-browser/keymap.rkt index 7da1a99..afc3fc2 100644 --- a/collects/macro-debugger/syntax-browser/keymap.rkt +++ b/collects/macro-debugger/syntax-browser/keymap.rkt @@ -1,10 +1,10 @@ -#lang scheme/base -(require scheme/class - scheme/gui - scheme/pretty +#lang racket/base +(require racket/class + racket/gui + racket/pretty unstable/gui/notify - "interfaces.ss" - "partition.ss") + "interfaces.rkt" + "partition.rkt") (provide syntax-keymap%) (define keymap/popup% diff --git a/collects/macro-debugger/syntax-browser/partition.rkt b/collects/macro-debugger/syntax-browser/partition.rkt index f9600c0..b99cec0 100644 --- a/collects/macro-debugger/syntax-browser/partition.rkt +++ b/collects/macro-debugger/syntax-browser/partition.rkt @@ -1,6 +1,5 @@ -#lang scheme/base -(require scheme/class - syntax/boundmap +#lang racket/base +(require racket/class syntax/stx "interfaces.rkt" "../util/stxobj.rkt") diff --git a/collects/macro-debugger/syntax-browser/prefs.rkt b/collects/macro-debugger/syntax-browser/prefs.rkt index 63e245b..ec9c0ad 100644 --- a/collects/macro-debugger/syntax-browser/prefs.rkt +++ b/collects/macro-debugger/syntax-browser/prefs.rkt @@ -1,7 +1,7 @@ -#lang scheme/base -(require scheme/class - framework/framework - "interfaces.ss" +#lang racket/base +(require racket/class + framework + "interfaces.rkt" unstable/gui/notify unstable/gui/prefs) (provide prefs-base% diff --git a/collects/macro-debugger/syntax-browser/pretty-helper.rkt b/collects/macro-debugger/syntax-browser/pretty-helper.rkt index af67d15..7a4ae10 100644 --- a/collects/macro-debugger/syntax-browser/pretty-helper.rkt +++ b/collects/macro-debugger/syntax-browser/pretty-helper.rkt @@ -1,11 +1,10 @@ -#lang scheme/base -(require scheme/class - scheme/pretty - (rename-in unstable/class-iop - [send/i send:]) +#lang racket/base +(require racket/class + racket/pretty + unstable/class-iop syntax/stx unstable/struct - "interfaces.ss") + "interfaces.rkt") (provide (all-defined-out)) ;; Problem: If stx1 and stx2 are two distinguishable syntax objects, it @@ -64,12 +63,12 @@ ((never) (make-id-syntax-dummy sym sym)) ((always) - (let ([n (send: partition partition<%> get-partition id)]) + (let ([n (send/i partition partition<%> get-partition id)]) (if (zero? n) (make-id-syntax-dummy sym sym) (make-id-syntax-dummy (suffix sym n) sym)))) ((over-limit) - (let ([n (send: partition partition<%> get-partition id)]) + (let ([n (send/i partition partition<%> get-partition id)]) (if (<= n limit) (make-id-syntax-dummy sym sym) (make-id-syntax-dummy (suffix sym n) sym)))))) @@ -82,7 +81,7 @@ => (lambda (datum) datum)] [(and partition (identifier? obj)) (when (and (eq? suffixopt 'all-if-over-limit) - (> (send: partition partition<%> count) limit)) + (> (send/i partition partition<%> count) limit)) (call-with-values (lambda () (table stx partition #f 'always)) escape)) (let ([lp-datum (make-identifier-proxy obj)]) @@ -91,7 +90,7 @@ lp-datum)] [(and (syntax? obj) (check+convert-special-expression obj)) => (lambda (newobj) - (when partition (send: partition partition<%> get-partition obj)) + (when partition (send/i partition partition<%> get-partition obj)) (let* ([inner (cadr newobj)] [lp-inner-datum (loop inner)] [lp-datum (list (car newobj) lp-inner-datum)]) @@ -101,7 +100,7 @@ (hash-set! stx=>flat obj lp-datum) lp-datum))] [(syntax? obj) - (when partition (send: partition partition<%> get-partition obj)) + (when partition (send/i partition partition<%> get-partition obj)) (let ([lp-datum (loop (syntax-e obj))]) (hash-set! flat=>stx lp-datum obj) (hash-set! stx=>flat obj lp-datum) diff --git a/collects/macro-debugger/syntax-browser/pretty-printer.rkt b/collects/macro-debugger/syntax-browser/pretty-printer.rkt index 4787e83..442115c 100644 --- a/collects/macro-debugger/syntax-browser/pretty-printer.rkt +++ b/collects/macro-debugger/syntax-browser/pretty-printer.rkt @@ -1,10 +1,10 @@ -#lang scheme/base -(require scheme/list - scheme/class - scheme/pretty - scheme/gui - "pretty-helper.ss" - "interfaces.ss") +#lang racket/base +(require racket/list + racket/class + racket/pretty + racket/gui + "pretty-helper.rkt" + "interfaces.rkt") (provide pretty-print-syntax) ;; FIXME: Need to disable printing of structs with custom-write property diff --git a/collects/macro-debugger/syntax-browser/properties.rkt b/collects/macro-debugger/syntax-browser/properties.rkt index e46a0e9..2d0a482 100644 --- a/collects/macro-debugger/syntax-browser/properties.rkt +++ b/collects/macro-debugger/syntax-browser/properties.rkt @@ -1,12 +1,11 @@ -#lang scheme/base -(require scheme/class - scheme/gui +#lang racket/base +(require racket/class + racket/gui framework - (rename-in unstable/class-iop - [send/i send:]) - "interfaces.ss" - "util.ss" - "../util/mpi.ss" + unstable/class-iop + "interfaces.rkt" + "util.rkt" + "../util/mpi.rkt" "../util/stxobj.rkt") (provide properties-view% properties-snip%) @@ -44,10 +43,10 @@ (field (text (new color-text%))) (field (pdisplayer (new properties-displayer% (text text)))) - (send: controller selection-manager<%> listen-selected-syntax - (lambda (stx) - (set! selected-syntax stx) - (refresh))) + (send/i controller selection-manager<%> listen-selected-syntax + (lambda (stx) + (set! selected-syntax stx) + (refresh))) (super-new) ;; get-mode : -> symbol diff --git a/collects/macro-debugger/syntax-browser/snip-decorated.rkt b/collects/macro-debugger/syntax-browser/snip-decorated.rkt index 55f0574..c408255 100644 --- a/collects/macro-debugger/syntax-browser/snip-decorated.rkt +++ b/collects/macro-debugger/syntax-browser/snip-decorated.rkt @@ -1,14 +1,13 @@ -#lang scheme/base -(require scheme/class - (rename-in unstable/class-iop - [send/i send:]) - mzlib/string - mred - "interfaces.ss" - "controller.ss" - "properties.ss" - "prefs.ss" - (except-in "snip.ss" +#lang racket/base +(require racket/class + racket/gui + (only-in mzlib/string read-from-string) + unstable/class-iop + "interfaces.rkt" + "controller.rkt" + "properties.rkt" + "prefs.rkt" + (except-in "snip.rkt" snip-class)) (provide decorated-syntax-snip% @@ -145,8 +144,8 @@ (define/public (read-special src line col pos) (send the-syntax-snip read-special src line col pos)) - (send: config config<%> listen-props-shown? - (lambda (?) (refresh-contents))) + (send/i config config<%> listen-props-shown? + (lambda (?) (refresh-contents))) (super-new) (set-snipclass snip-class) @@ -198,7 +197,7 @@ ;; SNIPCLASS -;; COPIED AND MODIFIED from mrlib/syntax-browser.ss +;; COPIED AND MODIFIED from mrlib/syntax-browser.rkt (define decorated-syntax-snipclass% (class snip-class% (define/override (read stream) @@ -210,4 +209,4 @@ (define snip-class (make-object decorated-syntax-snipclass%)) (send snip-class set-version 2) (send snip-class set-classname - (format "~s" '(lib "macro-debugger/syntax-browser/snip-decorated.ss"))) + (format "~s" '(lib "macro-debugger/syntax-browser/snip-decorated.rkt"))) diff --git a/collects/macro-debugger/syntax-browser/snip.rkt b/collects/macro-debugger/syntax-browser/snip.rkt index 7116afc..545b213 100644 --- a/collects/macro-debugger/syntax-browser/snip.rkt +++ b/collects/macro-debugger/syntax-browser/snip.rkt @@ -1,16 +1,14 @@ -#lang scheme/base -(require scheme/class - (rename-in unstable/class-iop - [send/i send:]) - scheme/match - mzlib/string - mred +#lang racket/base +(require racket/class + racket/gui + racket/match + (only-in mzlib/string read-from-string) framework - "interfaces.ss" - "display.ss" - "controller.ss" - "keymap.ss" - "prefs.ss") + "interfaces.rkt" + "display.rkt" + "controller.rkt" + "keymap.rkt" + "prefs.rkt") (provide syntax-snip% marshall-syntax @@ -167,7 +165,7 @@ ;; SNIPCLASS -;; COPIED AND MODIFIED from mrlib/syntax-browser.ss +;; COPIED AND MODIFIED from mrlib/syntax-browser.rkt (define syntax-snipclass% (class snip-class% (define/override (read stream) @@ -178,4 +176,4 @@ (define snip-class (new syntax-snipclass%)) (send snip-class set-version 2) (send snip-class set-classname - (format "~s" '(lib "macro-debugger/syntax-browser/snip.ss"))) + (format "~s" '(lib "macro-debugger/syntax-browser/snip.rkt"))) diff --git a/collects/macro-debugger/syntax-browser/text.rkt b/collects/macro-debugger/syntax-browser/text.rkt index 6af632a..839123c 100644 --- a/collects/macro-debugger/syntax-browser/text.rkt +++ b/collects/macro-debugger/syntax-browser/text.rkt @@ -1,12 +1,12 @@ -#lang scheme/base -(require scheme/list - scheme/class - scheme/gui +#lang racket/base +(require racket/list + racket/class + racket/gui drracket/arrow framework/framework unstable/interval-map unstable/gui/notify - "interfaces.ss") + "interfaces.rkt") (provide text:hover<%> text:hover-drawings<%> diff --git a/collects/macro-debugger/syntax-browser/util.rkt b/collects/macro-debugger/syntax-browser/util.rkt index c74553a..1c3ad52 100644 --- a/collects/macro-debugger/syntax-browser/util.rkt +++ b/collects/macro-debugger/syntax-browser/util.rkt @@ -1,6 +1,5 @@ - -#lang scheme/base -(require scheme/class) +#lang racket/base +(require racket/class) (provide with-unlock make-text-port) diff --git a/collects/macro-debugger/syntax-browser/widget.rkt b/collects/macro-debugger/syntax-browser/widget.rkt index 598d3b6..5aaccbc 100644 --- a/collects/macro-debugger/syntax-browser/widget.rkt +++ b/collects/macro-debugger/syntax-browser/widget.rkt @@ -1,21 +1,20 @@ -#lang scheme/base -(require scheme/class - mred - framework/framework - scheme/list - scheme/match +#lang racket/base +(require racket/class + racket/gui + racket/list + racket/match + framework syntax/id-table - (rename-in unstable/class-iop - [send/i send:]) - "interfaces.ss" - "controller.ss" - "display.ss" - "keymap.ss" - "hrule-snip.ss" - "properties.ss" - "text.ss" - "util.ss" - "../util/mpi.ss") + unstable/class-iop + "interfaces.rkt" + "controller.rkt" + "display.rkt" + "keymap.rkt" + "hrule-snip.rkt" + "properties.rkt" + "text.rkt" + "util.rkt" + "../util/mpi.rkt") (provide widget%) ;; widget% @@ -55,7 +54,7 @@ (define/private (internal-show-props show?) (if show? (unless (send -props-panel is-shown?) - (let ([p (send: config config<%> get-props-percentage)]) + (let ([p (send/i config config<%> get-props-percentage)]) (send -split-panel add-child -props-panel) (update-props-percentage p)) (send -props-panel show #t)) @@ -82,7 +81,7 @@ (define/public (shutdown) (when (props-panel-shown?) - (send: config config<%> set-props-percentage + (send/i config config<%> set-props-percentage (cadr (send -split-panel get-percentages))))) ;; syntax-browser<%> Methods @@ -115,29 +114,29 @@ #:substitutions [substitutions null]) (let ([display (internal-add-syntax stx)] [definite-table (make-hasheq)]) - (let ([range (send: display display<%> get-range)] - [offset (send: display display<%> get-start-position)]) + (let ([range (send/i display display<%> get-range)] + [offset (send/i display display<%> get-start-position)]) (for ([subst substitutions]) - (for ([r (send: range range<%> get-ranges (car subst))]) + (for ([r (send/i range range<%> get-ranges (car subst))]) (with-unlock -text (send -text insert (cdr subst) (+ offset (car r)) (+ offset (cdr r)) #f) (send -text change-style - (code-style -text (send: config config<%> get-syntax-font-size)) + (code-style -text (send/i config config<%> get-syntax-font-size)) (+ offset (car r)) (+ offset (cdr r))))))) (for ([hi-stxs hi-stxss] [hi-color hi-colors]) - (send: display display<%> highlight-syntaxes hi-stxs hi-color)) + (send/i display display<%> highlight-syntaxes hi-stxs hi-color)) (for ([definite definites]) (hash-set! definite-table definite #t) (when shift-table (for ([shifted-definite (hash-ref shift-table definite null)]) (hash-set! definite-table shifted-definite #t)))) (let ([binder-table (make-free-id-table)]) - (define range (send: display display<%> get-range)) - (define start (send: display display<%> get-start-position)) + (define range (send/i display display<%> get-range)) + (define start (send/i display display<%> get-start-position)) (define (get-binders id) (let ([binder (free-id-table-ref binder-table id #f)]) (cond [(not binder) null] @@ -149,17 +148,17 @@ (for ([binder binders]) (free-id-table-set! binder-table binder binder)) ;; Underline binders (and shifted binders) - (send: display display<%> underline-syntaxes + (send/i display display<%> underline-syntaxes (append (apply append (map get-shifted binders)) binders)) ;; Make arrows (& billboards, when enabled) - (for ([id (send: range range<%> get-identifier-list)]) + (for ([id (send/i range range<%> get-identifier-list)]) (define definite? (hash-ref definite-table id #f)) (when #f ;; DISABLED (add-binding-billboard start range id definite?)) (for ([binder (get-binders id)]) - (for ([binder-r (send: range range<%> get-ranges binder)]) - (for ([id-r (send: range range<%> get-ranges id)]) + (for ([binder-r (send/i range range<%> get-ranges binder)]) + (for ([id-r (send/i range range<%> get-ranges id)]) (add-binding-arrow start binder-r id-r definite?)))))) (void))) @@ -187,7 +186,7 @@ (+ start (cdr id-r)) (string-append "from " (mpi->string src-mod)) (if definite? "blue" "purple"))) - (send: range range<%> get-ranges id))] + (send/i range range<%> get-ranges id))] [_ (void)])) (define/public (add-separator) @@ -200,7 +199,7 @@ (with-unlock -text (send -text erase) (send -text delete-all-drawings)) - (send: controller displays-manager<%> remove-all-syntax-displays)) + (send/i controller displays-manager<%> remove-all-syntax-displays)) (define/public (get-text) -text) @@ -218,7 +217,7 @@ display))) (define/private (calculate-columns) - (define style (code-style -text (send: config config<%> get-syntax-font-size))) + (define style (code-style -text (send/i config config<%> get-syntax-font-size))) (define char-width (send style get-text-width (send -ecanvas get-dc))) (define-values (canvas-w canvas-h) (send -ecanvas get-client-size)) (sub1 (inexact->exact (floor (/ canvas-w char-width))))) @@ -227,13 +226,13 @@ (super-new) (setup-keymap) - (send: config config<%> listen-props-shown? + (send/i config config<%> listen-props-shown? (lambda (show?) (show-props show?))) - (send: config config<%> listen-props-percentage + (send/i config config<%> listen-props-percentage (lambda (p) (update-props-percentage p))) - (internal-show-props (send: config config<%> get-props-shown?)))) + (internal-show-props (send/i config config<%> get-props-shown?)))) (define clickback-style diff --git a/collects/macro-debugger/util/mpi.rkt b/collects/macro-debugger/util/mpi.rkt index c4f832c..5713951 100644 --- a/collects/macro-debugger/util/mpi.rkt +++ b/collects/macro-debugger/util/mpi.rkt @@ -1,6 +1,6 @@ -#lang scheme/base -(require scheme/match - scheme/string) +#lang racket/base +(require racket/match + racket/string) (provide mpi->list mpi->string @@ -176,7 +176,7 @@ [package (string-append (caddr m) ".plt")] [version (and (cadddr m) (parse-version (cadddr m)))] [path (list-ref m 4)]) - `(planet ,(string-append (or path "main") ".ss") + `(planet ,(string-append (or path "main") ".rkt") (,owner ,package . ,version))))) (define (parse-version str) @@ -186,7 +186,7 @@ (define (split-mods* path) (let ([mods (split-mods path)]) (if (and (pair? mods) (null? (cdr mods))) - (append mods (list "main.ss")) + (append mods (list "main.rkt")) mods))) (define (split-mods path [more null]) diff --git a/collects/macro-debugger/util/stxobj.rkt b/collects/macro-debugger/util/stxobj.rkt index dcbd429..58d30f2 100644 --- a/collects/macro-debugger/util/stxobj.rkt +++ b/collects/macro-debugger/util/stxobj.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require (rename-in racket/contract [-> c:->]) ffi/unsafe) diff --git a/collects/macro-debugger/view/cursor.rkt b/collects/macro-debugger/view/cursor.rkt index 981d4d5..080c1ec 100644 --- a/collects/macro-debugger/view/cursor.rkt +++ b/collects/macro-debugger/view/cursor.rkt @@ -1,6 +1,4 @@ - -#lang scheme/base -(require scheme/promise) +#lang racket/base (provide cursor? cursor-position cursor:new diff --git a/collects/macro-debugger/view/debug-format.rkt b/collects/macro-debugger/view/debug-format.rkt index 87cdc04..6527397 100644 --- a/collects/macro-debugger/view/debug-format.rkt +++ b/collects/macro-debugger/view/debug-format.rkt @@ -1,6 +1,5 @@ - -#lang scheme/base -(require scheme/pretty) +#lang racket/base +(require racket/pretty) (provide write-debug-file load-debug-file) diff --git a/collects/macro-debugger/view/debug.rkt b/collects/macro-debugger/view/debug.rkt index dff2ec1..8ebc9da 100644 --- a/collects/macro-debugger/view/debug.rkt +++ b/collects/macro-debugger/view/debug.rkt @@ -1,12 +1,11 @@ -#lang scheme/base -(require scheme/pretty - scheme/class - (rename-in unstable/class-iop - [send/i send:]) - "interfaces.ss" - "debug-format.ss" - "prefs.ss" - "view.ss") +#lang racket/base +(require racket/pretty + racket/class + unstable/class-iop + "interfaces.rkt" + "debug-format.rkt" + "prefs.rkt" + "view.rkt") (provide debug-file) (define (widget-mixin %) @@ -30,5 +29,5 @@ (pretty-print msg) (pretty-print ctx) (let* ([w (make-stepper)]) - (send: w widget<%> add-trace events) + (send/i w widget<%> add-trace events) w))) diff --git a/collects/macro-debugger/view/extensions.rkt b/collects/macro-debugger/view/extensions.rkt index 88cd113..61425dc 100644 --- a/collects/macro-debugger/view/extensions.rkt +++ b/collects/macro-debugger/view/extensions.rkt @@ -1,27 +1,22 @@ -#lang scheme/base -(require scheme/class - (rename-in unstable/class-iop - [send/i send:] - [send*/i send*:] - [init-field/i init-field:]) - scheme/unit - scheme/list - scheme/match - scheme/gui - framework/framework - syntax/boundmap - "interfaces.ss" - "prefs.ss" - "warning.ss" - "hiding-panel.ss" - (prefix-in s: "../syntax-browser/widget.ss") - (prefix-in s: "../syntax-browser/keymap.ss") - (prefix-in s: "../syntax-browser/interfaces.ss") - "../model/deriv.ss" - "../model/deriv-util.ss" - "../model/trace.ss" - "../model/steps.ss" - "cursor.ss" +#lang racket/base +(require racket/class + racket/unit + racket/list + racket/match + racket/gui + framework + unstable/class-iop + "interfaces.rkt" + "prefs.rkt" + "hiding-panel.rkt" + (prefix-in s: "../syntax-browser/widget.rkt") + (prefix-in s: "../syntax-browser/keymap.rkt") + (prefix-in s: "../syntax-browser/interfaces.rkt") + "../model/deriv.rkt" + "../model/deriv-util.rkt" + "../model/trace.rkt" + "../model/steps.rkt" + "cursor.rkt" unstable/gui/notify) (provide stepper-keymap% stepper-syntax-widget%) @@ -30,7 +25,7 @@ (define stepper-keymap% (class s:syntax-keymap% - (init-field: (macro-stepper widget<%>)) + (init-field/i (macro-stepper widget<%>)) (inherit-field config controller) (inherit add-function @@ -42,17 +37,17 @@ (super-new) (define/public (get-hiding-panel) - (send: macro-stepper widget<%> get-macro-hiding-prefs)) + (send/i macro-stepper widget<%> get-macro-hiding-prefs)) (add-function "hiding:show-macro" (lambda (i e) - (send*: (get-hiding-panel) hiding-prefs<%> + (send*/i (get-hiding-panel) hiding-prefs<%> (add-show-identifier) (refresh)))) (add-function "hiding:hide-macro" (lambda (i e) - (send*: (get-hiding-panel) hiding-prefs<%> + (send*/i (get-hiding-panel) hiding-prefs<%> (add-hide-identifier) (refresh)))) @@ -78,21 +73,21 @@ (define stepper-syntax-widget% (class s:widget% - (init-field: (macro-stepper widget<%>)) + (init-field/i (macro-stepper widget<%>)) (inherit get-text) (inherit-field controller) (define/override (setup-keymap) (new stepper-keymap% (editor (get-text)) - (config (send: macro-stepper widget<%> get-config)) + (config (send/i macro-stepper widget<%> get-config)) (controller controller) (macro-stepper macro-stepper))) (define/override (show-props show?) (super show-props show?) - (send: macro-stepper widget<%> update/preserve-view)) + (send/i macro-stepper widget<%> update/preserve-view)) (super-new - (config (send: macro-stepper widget<%> get-config))))) + (config (send/i macro-stepper widget<%> get-config))))) diff --git a/collects/macro-debugger/view/frame.rkt b/collects/macro-debugger/view/frame.rkt index f86ac94..3d02a47 100644 --- a/collects/macro-debugger/view/frame.rkt +++ b/collects/macro-debugger/view/frame.rkt @@ -1,27 +1,23 @@ -#lang scheme/base -(require scheme/class - (rename-in unstable/class-iop - [define/i define:] - [send/i send:]) - scheme/unit - scheme/list - scheme/file - scheme/match - scheme/gui - framework/framework - syntax/boundmap - "interfaces.ss" - "stepper.ss" - "prefs.ss" - "warning.ss" - "hiding-panel.ss" - (prefix-in sb: "../syntax-browser/embed.ss") - (prefix-in sb: "../syntax-browser/interfaces.ss") - "../model/deriv.ss" - "../model/deriv-util.ss" - "../model/trace.ss" - "../model/steps.ss" - "cursor.ss" +#lang racket/base +(require racket/class + racket/unit + racket/list + racket/file + racket/match + racket/gui + framework + unstable/class-iop + "interfaces.rkt" + "stepper.rkt" + "prefs.rkt" + "hiding-panel.rkt" + (prefix-in sb: "../syntax-browser/embed.rkt") + (prefix-in sb: "../syntax-browser/interfaces.rkt") + "../model/deriv.rkt" + "../model/deriv-util.rkt" + "../model/trace.rkt" + "../model/steps.rkt" + "cursor.rkt" unstable/gui/notify) (provide macro-stepper-frame-mixin) @@ -49,8 +45,8 @@ get-help-menu) (super-new (label (make-label)) - (width (send: config config<%> get-width)) - (height (send: config config<%> get-height))) + (width (send/i config config<%> get-width)) + (height (send/i config config<%> get-height))) (define/private (make-label) (if filename @@ -65,10 +61,10 @@ ;; to doing something. Avoid unnecessary updates. (define-values (w0 h0) (get-size)) (define/override (on-size w h) - (send: config config<%> set-width w) - (send: config config<%> set-height h) + (send/i config config<%> set-width w) + (send/i config config<%> set-height h) (unless (and (= w0 w) (= h0 h)) - (send: widget widget<%> update/preserve-view)) + (send/i widget widget<%> update/preserve-view)) (set!-values (w0 h0) (values w h))) (define warning-panel @@ -80,13 +76,13 @@ (define/public (get-macro-stepper-widget%) macro-stepper-widget%) - (define: widget widget<%> + (define/i widget widget<%> (new (get-macro-stepper-widget%) (parent (get-area-container)) (director director) (config config))) - (define: controller sb:controller<%> - (send: widget widget<%> get-controller)) + (define/i controller sb:controller<%> + (send/i widget widget<%> get-controller)) (define/public (get-widget) widget) (define/public (get-controller) controller) @@ -128,11 +124,11 @@ (new (get-menu-item%) (label "Duplicate stepper") (parent file-menu) - (callback (lambda _ (send: widget widget<%> duplicate-stepper)))) + (callback (lambda _ (send/i widget widget<%> duplicate-stepper)))) (new (get-menu-item%) (label "Duplicate stepper (current term only)") (parent file-menu) - (callback (lambda _ (send: widget widget<%> show-in-new-frame))))) + (callback (lambda _ (send/i widget widget<%> show-in-new-frame))))) (menu-option/notify-box stepper-menu "View syntax properties" @@ -149,23 +145,23 @@ (parent id-menu) (callback (lambda _ - (send: controller sb:controller<%> set-identifier=? p))))]) - (send: controller sb:controller<%> listen-identifier=? + (send/i controller sb:controller<%> set-identifier=? p))))]) + (send/i controller sb:controller<%> listen-identifier=? (lambda (name+func) (send this-choice check (eq? (car name+func) (car p))))))) (sb:identifier=-choices))) - (let ([identifier=? (send: config config<%> get-identifier=?)]) + (let ([identifier=? (send/i config config<%> get-identifier=?)]) (when identifier=? (let ([p (assoc identifier=? (sb:identifier=-choices))]) - (send: controller sb:controller<%> set-identifier=? p)))) + (send/i controller sb:controller<%> set-identifier=? p)))) (new (get-menu-item%) (label "Clear selection") (parent stepper-menu) (callback - (lambda _ (send: controller sb:controller<%> + (lambda _ (send/i controller sb:controller<%> set-selected-syntax #f)))) (new separator-menu-item% (parent stepper-menu)) @@ -177,11 +173,11 @@ (new (get-menu-item%) (label "Remove selected term") (parent stepper-menu) - (callback (lambda _ (send: widget widget<%> remove-current-term)))) + (callback (lambda _ (send/i widget widget<%> remove-current-term)))) (new (get-menu-item%) (label "Reset mark numbering") (parent stepper-menu) - (callback (lambda _ (send: widget widget<%> reset-primary-partition)))) + (callback (lambda _ (send/i widget widget<%> reset-primary-partition)))) (let ([extras-menu (new (get-menu%) (label "Extra options") @@ -191,11 +187,11 @@ (parent extras-menu) (callback (lambda (i e) - (send: config config<%> set-suffix-option + (send/i config config<%> set-suffix-option (if (send i is-checked?) 'always 'over-limit)) - (send: widget widget<%> update/preserve-view)))) + (send/i widget widget<%> update/preserve-view)))) (menu-option/notify-box extras-menu "Factor out common context?" (get-field split-context? config)) diff --git a/collects/macro-debugger/view/hiding-panel.rkt b/collects/macro-debugger/view/hiding-panel.rkt index 0b1d692..f8bc2f1 100644 --- a/collects/macro-debugger/view/hiding-panel.rkt +++ b/collects/macro-debugger/view/hiding-panel.rkt @@ -1,14 +1,11 @@ -#lang scheme/base -(require scheme/class - (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" +#lang racket/base +(require racket/class + racket/gui + racket/list + unstable/class-iop + "interfaces.rkt" + "../model/hiding-policies.rkt" + "../util/mpi.rkt" unstable/gui/notify) (provide macro-hiding-prefs-widget%) @@ -30,7 +27,7 @@ TODO (define macro-hiding-prefs-widget% (class* object% (hiding-prefs<%>) (init parent) - (init-field: (stepper widget<%>)) + (init-field/i (stepper widget<%>)) (init-field config) (define/public (get-policy) @@ -89,7 +86,7 @@ TODO (style '(deleted)))) (define/private (get-mode) - (send: config config<%> get-macro-hiding-mode)) + (send/i config config<%> get-macro-hiding-mode)) (define/private (macro-hiding-enabled?) (let ([mode (get-mode)]) @@ -99,7 +96,7 @@ TODO (define/private (ensure-custom-mode) (unless (equal? (get-mode) mode:custom) - (send: config config<%> set-macro-hiding-mode mode:custom))) + (send/i config config<%> set-macro-hiding-mode mode:custom))) (define/private (update-visibility) (let ([customizing (equal? (get-mode) mode:custom)]) @@ -114,10 +111,10 @@ TODO (list customize-panel) null)))))) - (send: config config<%> listen-macro-hiding-mode - (lambda (value) - (update-visibility) - (force-refresh))) + (send/i config config<%> listen-macro-hiding-mode + (lambda (value) + (update-visibility) + (force-refresh))) (define box:hiding (new check-box% @@ -185,11 +182,11 @@ TODO ;; refresh : -> void (define/public (refresh) (when (macro-hiding-enabled?) - (send: stepper widget<%> refresh/resynth))) + (send/i stepper widget<%> refresh/resynth))) ;; force-refresh : -> void (define/private (force-refresh) - (send: stepper widget<%> refresh/resynth)) + (send/i stepper widget<%> refresh/resynth)) ;; set-syntax : syntax/#f -> void (define/public (set-syntax lstx) diff --git a/collects/macro-debugger/view/interfaces.rkt b/collects/macro-debugger/view/interfaces.rkt index 54f8088..e038725 100644 --- a/collects/macro-debugger/view/interfaces.rkt +++ b/collects/macro-debugger/view/interfaces.rkt @@ -1,6 +1,6 @@ -#lang scheme/base +#lang racket/base (require unstable/class-iop - (prefix-in sb: "../syntax-browser/interfaces.ss")) + (prefix-in sb: "../syntax-browser/interfaces.rkt")) (provide (all-defined-out)) (define-interface config<%> (sb:config<%>) diff --git a/collects/macro-debugger/view/prefs.rkt b/collects/macro-debugger/view/prefs.rkt index 39100ed..237d86a 100644 --- a/collects/macro-debugger/view/prefs.rkt +++ b/collects/macro-debugger/view/prefs.rkt @@ -1,8 +1,8 @@ -#lang scheme/base -(require scheme/class - framework/framework - "interfaces.ss" - "../syntax-browser/prefs.ss" +#lang racket/base +(require racket/class + framework + "interfaces.rkt" + "../syntax-browser/prefs.rkt" unstable/gui/notify unstable/gui/prefs) (provide pref:macro-step-limit diff --git a/collects/macro-debugger/view/step-display.rkt b/collects/macro-debugger/view/step-display.rkt index f33eb92..0e01ccf 100644 --- a/collects/macro-debugger/view/step-display.rkt +++ b/collects/macro-debugger/view/step-display.rkt @@ -1,31 +1,26 @@ -#lang scheme/base -(require scheme/class - (rename-in unstable/class-iop - [send/i send:] - [send*/i send*:] - [init-field/i init-field:]) - scheme/unit - scheme/list - scheme/match - scheme/gui - framework/framework - syntax/boundmap - "interfaces.ss" - "prefs.ss" - "extensions.ss" - "warning.ss" - "hiding-panel.ss" - "../model/deriv.ss" - "../model/deriv-util.ss" - "../model/deriv-parser.ss" - "../model/trace.ss" - "../model/reductions-config.ss" - "../model/reductions.ss" - "../model/steps.ss" +#lang racket/base +(require racket/class + racket/unit + racket/list + racket/match + racket/gui + framework + unstable/class-iop + "interfaces.rkt" + "prefs.rkt" + "extensions.rkt" + "hiding-panel.rkt" + "../model/deriv.rkt" + "../model/deriv-util.rkt" + "../model/deriv-parser.rkt" + "../model/trace.rkt" + "../model/reductions-config.rkt" + "../model/reductions.rkt" + "../model/steps.rkt" unstable/gui/notify - (prefix-in sb: "../syntax-browser/interfaces.ss") - "cursor.ss" - "debug-format.ss") + (prefix-in sb: "../syntax-browser/interfaces.rkt") + "cursor.rkt" + "debug-format.rkt") #; (provide step-display% @@ -42,23 +37,23 @@ (define step-display% (class* object% (step-display<%>) - (init-field: (config config<%>)) + (init-field/i (config config<%>)) (init-field ((sbview syntax-widget))) (super-new) (define/public (add-internal-error part exn stx events) - (send: sbview sb:syntax-browser<%> add-text - (if part - (format "Macro stepper error (~a)" part) - "Macro stepper error")) + (send/i sbview sb:syntax-browser<%> add-text + (if part + (format "Macro stepper error (~a)" part) + "Macro stepper error")) (when (exn? exn) - (send: sbview sb:syntax-browser<%> add-text " ") - (send: sbview sb:syntax-browser<%> add-clickback "[details]" - (lambda _ (show-internal-error-details exn events)))) - (send: sbview sb:syntax-browser<%> add-text ". ") - (when stx (send: sbview sb:syntax-browser<%> add-text "Original syntax:")) - (send: sbview sb:syntax-browser<%> add-text "\n") - (when stx (send: sbview sb:syntax-browser<%> add-syntax stx))) + (send/i sbview sb:syntax-browser<%> add-text " ") + (send/i sbview sb:syntax-browser<%> add-clickback "[details]" + (lambda _ (show-internal-error-details exn events)))) + (send/i sbview sb:syntax-browser<%> add-text ". ") + (when stx (send/i sbview sb:syntax-browser<%> add-text "Original syntax:")) + (send/i sbview sb:syntax-browser<%> add-text "\n") + (when stx (send/i sbview sb:syntax-browser<%> add-syntax stx))) (define/private (show-internal-error-details exn events) (case (message-box/custom "Macro stepper internal error" @@ -77,7 +72,7 @@ ((3 #f) (void)))) (define/public (add-error exn) - (send*: sbview sb:syntax-browser<%> + (send*/i sbview sb:syntax-browser<%> (add-error-text (exn-message exn)) (add-text "\n"))) @@ -98,17 +93,17 @@ #:binders [binders null] #:definites [definites null] #:shift-table [shift-table #f]) - (send: sbview sb:syntax-browser<%> add-syntax stx - #:binders binders - #:definites definites - #:shift-table shift-table)) + (send/i sbview sb:syntax-browser<%> add-syntax stx + #:binders binders + #:definites definites + #:shift-table shift-table)) (define/public (add-final stx error #:binders binders #:definites definites #:shift-table [shift-table #f]) (when stx - (send*: sbview sb:syntax-browser<%> + (send*/i sbview sb:syntax-browser<%> (add-text "Expansion finished\n") (add-syntax stx #:binders binders @@ -122,8 +117,8 @@ (define state (protostep-s1 step)) (define lctx (state-lctx state)) (for ([bf lctx]) - (send: sbview sb:syntax-browser<%> add-text - "\nwhile executing macro transformer in:\n") + (send/i sbview sb:syntax-browser<%> add-text + "\nwhile executing macro transformer in:\n") (insert-syntax/redex (bigframe-term bf) (bigframe-foci bf) (state-binders state) @@ -152,7 +147,7 @@ (show-lctx step shift-table))) (define/private (factor-common-context state1 state2) - (if (send: config config<%> get-split-context?) + (if (send/i config config<%> get-split-context?) (factor-common-context* state1 state2) (values null state1 state2))) @@ -179,7 +174,7 @@ (when (pair? ctx) (let* ([hole-stx #'~~HOLE~~] [the-syntax (context-fill ctx hole-stx)]) - (send*: sbview sb:syntax-browser<%> + (send*/i sbview sb:syntax-browser<%> (add-text "\nin context:\n") (add-syntax the-syntax #:definites uses1 @@ -220,26 +215,26 @@ (define state (protostep-s1 step)) (show-state/redex state shift-table) (separator step) - (send*: sbview sb:syntax-browser<%> + (send*/i sbview sb:syntax-browser<%> (add-error-text (exn-message (misstep-exn step))) (add-text "\n")) (when (exn:fail:syntax? (misstep-exn step)) (for ([e (exn:fail:syntax-exprs (misstep-exn step))]) - (send: sbview sb:syntax-browser<%> add-syntax e - #:binders (or (state-binders state) null) - #:definites (or (state-uses state) null) - #:shift-table shift-table))) + (send/i sbview sb:syntax-browser<%> add-syntax e + #:binders (or (state-binders state) null) + #:definites (or (state-uses state) null) + #:shift-table shift-table))) (show-lctx step shift-table)) (define/private (show-remarkstep step shift-table) (define state (protostep-s1 step)) (for ([content (in-list (remarkstep-contents step))]) (cond [(string? content) - (send*: sbview sb:syntax-browser<%> + (send*/i sbview sb:syntax-browser<%> (add-text content) (add-text "\n"))] [(syntax? content) - (send*: sbview sb:syntax-browser<%> + (send*/i sbview sb:syntax-browser<%> (add-syntax content #:binders (or (state-binders state) null) #:definites (or (state-uses state) null) @@ -250,16 +245,16 @@ ;; insert-syntax/color (define/private (insert-syntax/color stx foci binders shift-table definites frontier hi-color) - (define highlight-foci? (send: config config<%> get-highlight-foci?)) - (define highlight-frontier? (send: config config<%> get-highlight-frontier?)) - (send: sbview sb:syntax-browser<%> add-syntax stx - #:definites (or definites null) - #:binders binders - #:shift-table shift-table - #:hi-colors (list hi-color - "WhiteSmoke") - #:hi-stxss (list (if highlight-foci? foci null) - (if highlight-frontier? frontier null)))) + (define highlight-foci? (send/i config config<%> get-highlight-foci?)) + (define highlight-frontier? (send/i config config<%> get-highlight-frontier?)) + (send/i sbview sb:syntax-browser<%> add-syntax stx + #:definites (or definites null) + #:binders binders + #:shift-table shift-table + #:hi-colors (list hi-color + "WhiteSmoke") + #:hi-stxss (list (if highlight-foci? foci null) + (if highlight-frontier? frontier null)))) ;; insert-syntax/redex (define/private (insert-syntax/redex stx foci binders shift-table @@ -275,7 +270,7 @@ ;; insert-step-separator : string -> void (define/private (insert-step-separator text) - (send*: sbview sb:syntax-browser<%> + (send*/i sbview sb:syntax-browser<%> (add-text "\n ") (add-text (make-object image-snip% @@ -287,14 +282,14 @@ ;; insert-as-separator : string -> void (define/private (insert-as-separator text) - (send*: sbview sb:syntax-browser<%> + (send*/i sbview sb:syntax-browser<%> (add-text "\n ") (add-text text) (add-text "\n\n"))) ;; insert-step-separator/small : string -> void (define/private (insert-step-separator/small text) - (send*: sbview sb:syntax-browser<%> + (send*/i sbview sb:syntax-browser<%> (add-text " ") (add-text (make-object image-snip% diff --git a/collects/macro-debugger/view/stepper.rkt b/collects/macro-debugger/view/stepper.rkt index ec1edfb..bba35c7 100644 --- a/collects/macro-debugger/view/stepper.rkt +++ b/collects/macro-debugger/view/stepper.rkt @@ -1,29 +1,24 @@ -#lang scheme/base -(require scheme/class - (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 - scheme/gui - framework/framework - syntax/boundmap - "interfaces.ss" - "prefs.ss" - "extensions.ss" - "hiding-panel.ss" - "term-record.ss" - "step-display.ss" - (prefix-in sb: "../syntax-browser/interfaces.ss") - "../model/deriv.ss" - "../model/deriv-util.ss" - "../model/trace.ss" - "../model/reductions.ss" - "../model/steps.ss" - "cursor.ss" +#lang racket/base +(require racket/class + racket/unit + racket/list + racket/match + racket/gui + framework + unstable/class-iop + "interfaces.rkt" + "prefs.rkt" + "extensions.rkt" + "hiding-panel.rkt" + "term-record.rkt" + "step-display.rkt" + (prefix-in sb: "../syntax-browser/interfaces.rkt") + "../model/deriv.rkt" + "../model/deriv-util.rkt" + "../model/trace.rkt" + "../model/reductions.rkt" + "../model/steps.rkt" + "cursor.rkt" unstable/gui/notify (only-in mzscheme [#%top-interaction mz-top-interaction])) (provide macro-stepper-widget% @@ -36,7 +31,7 @@ (class* object% (widget<%>) (init-field parent) (init-field config) - (init-field: (director director<%>)) + (init-field/i (director director<%>)) ;; Terms @@ -69,7 +64,7 @@ (define/public (add trec) (set! all-terms (cons trec all-terms)) (let ([display-new-term? (cursor:at-end? terms)] - [invisible? (send: trec term-record<%> get-deriv-hidden?)]) + [invisible? (send/i trec term-record<%> get-deriv-hidden?)]) (unless invisible? (cursor:add-to-end! terms (list trec)) (trim-navigator) @@ -87,16 +82,16 @@ (define/public (show-in-new-frame) (let ([term (focused-term)]) (when term - (let ([new-stepper (send: director director<%> new-stepper '(no-new-traces))]) - (send: new-stepper widget<%> add-deriv (send: term term-record<%> get-raw-deriv)) + (let ([new-stepper (send/i director director<%> new-stepper '(no-new-traces))]) + (send/i new-stepper widget<%> add-deriv (send/i term term-record<%> get-raw-deriv)) (void))))) ;; duplicate-stepper : -> void (define/public (duplicate-stepper) - (let ([new-stepper (send: director director<%> new-stepper)]) + (let ([new-stepper (send/i director director<%> new-stepper)]) (for ([term (cursor->list terms)]) - (send: new-stepper widget<%> add-deriv - (send: term term-record<%> get-raw-deriv))))) + (send/i new-stepper widget<%> add-deriv + (send/i term term-record<%> get-raw-deriv))))) (define/public (get-config) config) (define/public (get-controller) sbc) @@ -105,7 +100,7 @@ (define/public (get-macro-hiding-prefs) macro-hiding-prefs) (define/public (reset-primary-partition) - (send: sbc sb:controller<%> reset-primary-partition) + (send/i sbc sb:controller<%> reset-primary-partition) (update/preserve-view)) (define area (new vertical-panel% (parent parent))) @@ -128,28 +123,28 @@ (alignment '(left center)) (style '(deleted)))) - (define: sbview sb:syntax-browser<%> + (define/i sbview sb:syntax-browser<%> (new stepper-syntax-widget% (parent area) (macro-stepper this))) - (define: step-displayer step-display<%> + (define/i step-displayer step-display<%> (new step-display% (config config) (syntax-widget sbview))) - (define: sbc sb:controller<%> - (send: sbview sb:syntax-browser<%> get-controller)) + (define/i sbc sb:controller<%> + (send/i sbview sb:syntax-browser<%> get-controller)) (define control-pane (new vertical-panel% (parent area) (stretchable-height #f))) - (define: macro-hiding-prefs hiding-prefs<%> + (define/i macro-hiding-prefs hiding-prefs<%> (new macro-hiding-prefs-widget% (parent control-pane) (stepper this) (config config))) - (send: sbc sb:controller<%> + (send/i sbc sb:controller<%> listen-selected-syntax - (lambda (stx) (send: macro-hiding-prefs hiding-prefs<%> set-syntax stx))) - (send*: config config<%> + (lambda (stx) (send/i macro-hiding-prefs hiding-prefs<%> set-syntax stx))) + (send*/i config config<%> (listen-show-hiding-panel? (lambda (show?) (show-macro-hiding-panel show?))) (listen-split-context? @@ -251,34 +246,34 @@ ;; Navigation #| (define/public-final (at-start?) - (send: (focused-term) term-record<%> at-start?)) + (send/i (focused-term) term-record<%> at-start?)) (define/public-final (at-end?) - (send: (focused-term) term-record<%> at-end?)) + (send/i (focused-term) term-record<%> at-end?)) |# (define/public-final (navigate-to-start) - (send: (focused-term) term-record<%> navigate-to-start) + (send/i (focused-term) term-record<%> navigate-to-start) (update/save-position)) (define/public-final (navigate-to-end) - (send: (focused-term) term-record<%> navigate-to-end) + (send/i (focused-term) term-record<%> navigate-to-end) (update/save-position)) (define/public-final (navigate-previous) - (send: (focused-term) term-record<%> navigate-previous) + (send/i (focused-term) term-record<%> navigate-previous) (update/save-position)) (define/public-final (navigate-next) - (send: (focused-term) term-record<%> navigate-next) + (send/i (focused-term) term-record<%> navigate-next) (update/save-position)) (define/public-final (navigate-to n) - (send: (focused-term) term-record<%> navigate-to n) + (send/i (focused-term) term-record<%> navigate-to n) (update/save-position)) (define/public-final (navigate-up) (when (focused-term) - (send: (focused-term) term-record<%> on-lose-focus)) + (send/i (focused-term) term-record<%> on-lose-focus)) (cursor:move-prev terms) (refresh/move)) (define/public-final (navigate-down) (when (focused-term) - (send: (focused-term) term-record<%> on-lose-focus)) + (send/i (focused-term) term-record<%> on-lose-focus)) (cursor:move-next terms) (refresh/move)) @@ -290,7 +285,7 @@ ;; update/preserve-lines-view : -> void (define/public (update/preserve-lines-view) - (define text (send: sbview sb:syntax-browser<%> get-text)) + (define text (send/i sbview sb:syntax-browser<%> get-text)) (define start-box (box 0)) (define end-box (box 0)) (send text get-visible-line-range start-box end-box) @@ -303,7 +298,7 @@ ;; update/preserve-view : -> void (define/public (update/preserve-view) - (define text (send: sbview sb:syntax-browser<%> get-text)) + (define text (send/i sbview sb:syntax-browser<%> get-text)) (define start-box (box 0)) (define end-box (box 0)) (send text get-visible-position-range start-box end-box) @@ -313,17 +308,17 @@ ;; update : -> void ;; Updates the terms in the syntax browser to the current step (define/private (update) - (define text (send: sbview sb:syntax-browser<%> get-text)) + (define text (send/i sbview sb:syntax-browser<%> get-text)) (define position-of-interest 0) (define multiple-terms? (> (length (cursor->list terms)) 1)) (send text begin-edit-sequence #f) - (send: sbview sb:syntax-browser<%> erase-all) + (send/i sbview sb:syntax-browser<%> erase-all) (update:show-prefix) - (when multiple-terms? (send: sbview sb:syntax-browser<%> add-separator)) + (when multiple-terms? (send/i sbview sb:syntax-browser<%> add-separator)) (set! position-of-interest (send text last-position)) (update:show-current-step) - (when multiple-terms? (send: sbview sb:syntax-browser<%> add-separator)) + (when multiple-terms? (send/i sbview sb:syntax-browser<%> add-separator)) (update:show-suffix) (send text end-edit-sequence) (send text scroll-to-position @@ -337,35 +332,35 @@ ;; update:show-prefix : -> void (define/private (update:show-prefix) ;; Show the final terms from the cached synth'd derivs - (for-each (lambda (trec) (send: trec term-record<%> display-final-term)) + (for-each (lambda (trec) (send/i trec term-record<%> display-final-term)) (cursor:prefix->list terms))) ;; update:show-current-step : -> void (define/private (update:show-current-step) (when (focused-term) - (send: (focused-term) term-record<%> display-step))) + (send/i (focused-term) term-record<%> display-step))) ;; update:show-suffix : -> void (define/private (update:show-suffix) (let ([suffix0 (cursor:suffix->list terms)]) (when (pair? suffix0) (for-each (lambda (trec) - (send: trec term-record<%> display-initial-term)) + (send/i trec term-record<%> display-initial-term)) (cdr suffix0))))) ;; update-nav-index : -> void (define/private (update-nav-index) (define term (focused-term)) (set-current-step-index - (and term (send: term term-record<%> get-step-index)))) + (and term (send/i term term-record<%> get-step-index)))) ;; enable/disable-buttons : -> void (define/private (enable/disable-buttons) (define term (focused-term)) - (send nav:start enable (and term (send: term term-record<%> has-prev?))) - (send nav:previous enable (and term (send: term term-record<%> has-prev?))) - (send nav:next enable (and term (send: term term-record<%> has-next?))) - (send nav:end enable (and term (send: term term-record<%> has-next?))) + (send nav:start enable (and term (send/i term term-record<%> has-prev?))) + (send nav:previous enable (and term (send/i term term-record<%> has-prev?))) + (send nav:next enable (and term (send/i term term-record<%> has-next?))) + (send nav:end enable (and term (send/i term term-record<%> has-next?))) (send nav:text enable (and term #t)) (send nav:up enable (cursor:has-prev? terms)) (send nav:down enable (cursor:has-next? terms))) @@ -375,14 +370,14 @@ ;; refresh/resynth : -> void ;; Macro hiding policy has changed; invalidate cached parts of trec (define/public (refresh/resynth) - (for-each (lambda (trec) (send: trec term-record<%> invalidate-synth!)) + (for-each (lambda (trec) (send/i trec term-record<%> invalidate-synth!)) (cursor->list terms)) (refresh)) ;; refresh/re-reduce : -> void ;; Reduction config has changed; invalidate cached parts of trec (define/private (refresh/re-reduce) - (for-each (lambda (trec) (send: trec term-record<%> invalidate-steps!)) + (for-each (lambda (trec) (send/i trec term-record<%> invalidate-steps!)) (cursor->list terms)) (refresh)) @@ -394,11 +389,11 @@ ;; refresh : -> void (define/public (refresh) (when (focused-term) - (send: (focused-term) term-record<%> on-get-focus)) + (send/i (focused-term) term-record<%> on-get-focus)) (send nav:step-count set-label "") (let ([term (focused-term)]) (when term - (let ([step-count (send: term term-record<%> get-step-count)]) + (let ([step-count (send/i term term-record<%> get-step-count)]) (when step-count ;; +1 for end of expansion "step" (send nav:step-count set-label (format "of ~s" (add1 step-count))))))) @@ -409,7 +404,7 @@ ;; Hiding policy (define/public (get-show-macro?) - (send: macro-hiding-prefs hiding-prefs<%> get-policy)) + (send/i macro-hiding-prefs hiding-prefs<%> get-policy)) ;; Derivation pre-processing @@ -418,8 +413,8 @@ ;; Initialization (super-new) - (show-macro-hiding-panel (send: config config<%> get-show-hiding-panel?)) - (show-extra-navigation (send: config config<%> get-extra-navigation?)) + (show-macro-hiding-panel (send/i config config<%> get-show-hiding-panel?)) + (show-extra-navigation (send/i config config<%> get-extra-navigation?)) (refresh/move) )) diff --git a/collects/macro-debugger/view/term-record.rkt b/collects/macro-debugger/view/term-record.rkt index de47697..44d7a9c 100644 --- a/collects/macro-debugger/view/term-record.rkt +++ b/collects/macro-debugger/view/term-record.rkt @@ -1,33 +1,28 @@ -#lang scheme/base -(require scheme/class - (rename-in unstable/class-iop - [define/i define:] - [send/i send:] - [init-field/i init-field:]) - scheme/unit - scheme/list - scheme/match - scheme/gui - framework/framework - syntax/boundmap +#lang racket/base +(require racket/class + racket/unit + racket/list + racket/match + racket/gui + framework syntax/stx unstable/find - "interfaces.ss" - "prefs.ss" - "extensions.ss" - "warning.ss" - "hiding-panel.ss" - "step-display.ss" - "../model/deriv.ss" - "../model/deriv-util.ss" - "../model/deriv-parser.ss" - "../model/trace.ss" - "../model/reductions-config.ss" - "../model/reductions.ss" - "../model/steps.ss" + unstable/class-iop + "interfaces.rkt" + "prefs.rkt" + "extensions.rkt" + "hiding-panel.rkt" + "step-display.rkt" + "../model/deriv.rkt" + "../model/deriv-util.rkt" + "../model/deriv-parser.rkt" + "../model/trace.rkt" + "../model/reductions-config.rkt" + "../model/reductions.rkt" + "../model/steps.rkt" unstable/gui/notify - "cursor.ss" - "debug-format.ss") + "cursor.rkt" + "debug-format.rkt") (provide term-record%) @@ -35,12 +30,12 @@ (define term-record% (class* object% (term-record<%>) - (init-field: (stepper widget<%>)) + (init-field/i (stepper widget<%>)) - (define: config config<%> - (send: stepper widget<%> get-config)) - (define: displayer step-display<%> - (send: stepper widget<%> get-step-displayer)) + (define/i config config<%> + (send/i stepper widget<%> get-config)) + (define/i displayer step-display<%> + (send/i stepper widget<%> get-step-displayer)) ;; Data @@ -134,7 +129,7 @@ (unless (or deriv deriv-hidden?) (recache-raw-deriv!) (when raw-deriv - (let ([process (send: stepper widget<%> get-preprocess-deriv)]) + (let ([process (send/i stepper widget<%> get-preprocess-deriv)]) (let ([d (process raw-deriv)]) (when (not d) (set! deriv-hidden? #t)) @@ -151,7 +146,7 @@ (unless (or raw-steps raw-steps-oops) (recache-synth!) (when deriv - (let ([show-macro? (or (send: stepper widget<%> get-show-macro?) + (let ([show-macro? (or (send/i stepper widget<%> get-show-macro?) (lambda (id) #t))]) (with-handlers ([(lambda (e) #t) (lambda (e) @@ -173,12 +168,12 @@ (set! steps (and raw-steps (let* ([filtered-steps - (if (send: config config<%> get-show-rename-steps?) + (if (send/i config config<%> get-show-rename-steps?) raw-steps (filter (lambda (x) (not (rename-step? x))) raw-steps))] [processed-steps - (if (send: config config<%> get-one-by-one?) + (if (send/i config config<%> get-one-by-one?) (reduce:one-by-one filtered-steps) filtered-steps)]) (cursor:new processed-steps)))) @@ -280,21 +275,21 @@ ;; display-initial-term : -> void (define/public (display-initial-term) (cond [raw-deriv-oops - (send: displayer step-display<%> add-internal-error - "derivation" raw-deriv-oops #f events)] + (send/i displayer step-display<%> add-internal-error + "derivation" raw-deriv-oops #f events)] [else - (send: displayer step-display<%> add-syntax (wderiv-e1 deriv))])) + (send/i displayer step-display<%> add-syntax (wderiv-e1 deriv))])) ;; display-final-term : -> void (define/public (display-final-term) (recache-steps!) (cond [(syntax? raw-steps-estx) - (send: displayer step-display<%> add-syntax raw-steps-estx - #:binders raw-steps-binders - #:shift-table shift-table - #:definites raw-steps-definites)] + (send/i displayer step-display<%> add-syntax raw-steps-estx + #:binders raw-steps-binders + #:shift-table shift-table + #:definites raw-steps-definites)] [(exn? raw-steps-exn) - (send: displayer step-display<%> add-error raw-steps-exn)] + (send/i displayer step-display<%> add-error raw-steps-exn)] [else (display-oops #f)])) ;; display-step : -> void @@ -303,24 +298,24 @@ (cond [steps (let ([step (cursor:next steps)]) (if step - (send: displayer step-display<%> add-step step - #:shift-table shift-table) - (send: displayer step-display<%> add-final raw-steps-estx raw-steps-exn - #:binders raw-steps-binders - #:shift-table shift-table - #:definites raw-steps-definites)))] + (send/i displayer step-display<%> add-step step + #:shift-table shift-table) + (send/i displayer step-display<%> add-final raw-steps-estx raw-steps-exn + #:binders raw-steps-binders + #:shift-table shift-table + #:definites raw-steps-definites)))] [else (display-oops #t)])) ;; display-oops : boolean -> void (define/private (display-oops show-syntax?) (cond [raw-steps-oops - (send: displayer step-display<%> add-internal-error - "steps" raw-steps-oops - (and show-syntax? (wderiv-e1 deriv)) - events)] + (send/i displayer step-display<%> add-internal-error + "steps" raw-steps-oops + (and show-syntax? (wderiv-e1 deriv)) + events)] [raw-deriv-oops - (send: displayer step-display<%> add-internal-error - "derivation" raw-deriv-oops #f events)] + (send/i displayer step-display<%> add-internal-error + "derivation" raw-deriv-oops #f events)] [else (error 'term-record::display-oops "internal error")])) )) diff --git a/collects/macro-debugger/view/view.rkt b/collects/macro-debugger/view/view.rkt index 7162a98..4552b48 100644 --- a/collects/macro-debugger/view/view.rkt +++ b/collects/macro-debugger/view/view.rkt @@ -1,14 +1,13 @@ -#lang scheme/base -(require scheme/class - (rename-in unstable/class-iop - [send/i send:]) - scheme/pretty - scheme/gui - framework/framework - "interfaces.ss" - "frame.ss" - "prefs.ss" - "../model/trace.ss") +#lang racket/base +(require racket/class + racket/pretty + racket/gui + framework + unstable/class-iop + "interfaces.rkt" + "frame.rkt" + "prefs.rkt" + "../model/trace.rkt") (provide macro-stepper-director% macro-stepper-frame% go) @@ -28,23 +27,23 @@ (hash-for-each stepper-frames (lambda (stepper-frame flags) (unless (memq 'no-obsolete flags) - (send: stepper-frame stepper-frame<%> add-obsoleted-warning))))) + (send/i stepper-frame stepper-frame<%> add-obsoleted-warning))))) (define/public (add-trace events) (hash-for-each stepper-frames (lambda (stepper-frame flags) (unless (memq 'no-new-traces flags) - (send: (send: stepper-frame stepper-frame<%> get-widget) widget<%> + (send/i (send/i stepper-frame stepper-frame<%> get-widget) widget<%> add-trace events))))) (define/public (add-deriv deriv) (hash-for-each stepper-frames (lambda (stepper-frame flags) (unless (memq 'no-new-traces flags) - (send: (send: stepper-frame stepper-frame<%> get-widget) widget<%> + (send/i (send/i stepper-frame stepper-frame<%> get-widget) widget<%> add-deriv deriv))))) (define/public (new-stepper [flags '()]) (define stepper-frame (new-stepper-frame)) - (define stepper (send: stepper-frame stepper-frame<%> get-widget)) + (define stepper (send/i stepper-frame stepper-frame<%> get-widget)) (send stepper-frame show #t) (add-stepper! stepper-frame flags) stepper) @@ -65,6 +64,6 @@ (define (go stx) (define director (new macro-stepper-director%)) - (define stepper (send: director director<%> new-stepper)) - (send: director director<%> add-deriv (trace stx)) + (define stepper (send/i director director<%> new-stepper)) + (send/i director director<%> add-deriv (trace stx)) (void))