changed macro-debugger to use v4 syntax (mostly)

svn: r8544

original commit: 13a3c31ad5f63115427cfd34df285c0e981a8107

collects/macro-debugger/expand.ss

@@ -1,5 +1,4 @@
-
+#lang scheme/base
-(module expand mzscheme
 (require "model/trace.ss"
          "model/hide.ss")
 (provide expand-only
@@ -7,13 +6,13 @@
 
 (define (expand-only stx show-list)
   (define (show? id)
-      (ormap (lambda (x) (module-identifier=? id x))
+    (ormap (lambda (x) (free-identifier=? id x))
            show-list))
   (expand/hiding stx show?))
 
 (define (expand/hide stx hide-list)
   (define (show? id)
-      (andmap (lambda (x) (not (module-identifier=? id x)))
+    (andmap (lambda (x) (not (free-identifier=? id x)))
             hide-list))
   (expand/hiding stx show?))
 
@@ -23,5 +22,3 @@
       (raise result))
     (let-values ([(_d estx) (hide/policy deriv show?)])
       estx)))
-  
-  )

collects/macro-debugger/model/context.ss

@@ -1,8 +1,8 @@
+#lang scheme/base
 
-(module context mzscheme
+(require syntax/stx)
-  (require (lib "stx.ss" "syntax"))
+(provide (struct-out ref)
-  (provide (struct ref (n))
+         (struct-out tail)
-           (struct tail (n))
          path-get
          pathseg-get
          path-replace
@@ -17,9 +17,9 @@
 ;;   - (make-ref number)
 ;;   - (make-tail number)
 
-  (define-struct pathseg () #f)
+(define-struct pathseg () #:transparent)
-  (define-struct (ref pathseg) (n) #f)
+(define-struct (ref pathseg) (n) #:transparent)
-  (define-struct (tail pathseg) (n) #f)
+(define-struct (tail pathseg) (n) #:transparent)
 
 ;; path:ref->splicing-tail : PathSeg -> ???
 ;; ????
@@ -48,7 +48,7 @@
     (unless (stx-pair? stx)
       (error 'pathseg-get "ref path out of bounds for syntax: ~s, ~s" 
              n0
-               (syntax-object->datum stx0)))
+             (syntax->datum stx0)))
     (if (zero? n)
         (stx-car stx)
         (loop (sub1 n) (stx-cdr stx)))))
@@ -104,7 +104,7 @@
   (cond [(pair? stx)
          (cons x (cdr stx))]
         [(syntax? stx)
-	   (datum->syntax-object stx (cons x (cdr (syntax-e stx))) stx stx)]
+         (datum->syntax stx (cons x (cdr (syntax-e stx))) stx stx)]
         [else (raise-type-error 'stx-replcar "stx-pair" stx)]))
 
 ;; stx-replcdr : syntax syntax -> syntax
@@ -112,11 +112,11 @@
   (cond [(pair? stx)
          (cons (car stx) x)]
         [(and (syntax? stx) (pair? (syntax-e stx)))
-	   (datum->syntax-object stx (cons (car (syntax-e stx)) x) stx stx)]
+         (datum->syntax stx (cons (car (syntax-e stx)) x) stx stx)]
         [else (raise-type-error 'stx-replcdr "stx-pair" stx)]))
 
 (define (sd x)
-    (syntax-object->datum (datum->syntax-object #f x)))
+  (syntax->datum (datum->syntax #f x)))
 
 ;;=======
 
@@ -139,4 +139,3 @@
                         (outer-loop term)))))]
           ;; FIXME: more structured cases here: box, vector, ...
           [else null])))
-  )

collects/macro-debugger/model/debug.ss

@@ -1,7 +1,8 @@
 
-(module debug mzscheme
+#lang scheme/base
-  (require (lib "plt-match.ss"))
+
-  (require "trace.ss"
+(require scheme/match
+         "trace.ss"
          "reductions.ss"
          "deriv-util.ss"
          "deriv-find.ss"
@@ -10,13 +11,12 @@
          "deriv.ss"
          "steps.ss")
 
-  (provide (all-from "trace.ss")
+(provide (all-from-out "trace.ss")
-           (all-from "reductions.ss")
+         (all-from-out "reductions.ss")
-           (all-from "deriv.ss")
+         (all-from-out "deriv.ss")
-           (all-from "deriv-util.ss")
+         (all-from-out "deriv-util.ss")
-           (all-from "deriv-find.ss")
+         (all-from-out "deriv-find.ss")
-           (all-from "hiding-policies.ss")
+         (all-from-out "hiding-policies.ss")
-           (all-from "hide.ss")
+         (all-from-out "hide.ss")
-           (all-from "steps.ss")
+         (all-from-out "steps.ss")
-           (all-from (lib "plt-match.ss")))
+         (all-from-out scheme/match))
-  )

collects/macro-debugger/model/deriv-c.ss

@@ -1,10 +1,10 @@
 
-(module deriv-c mzscheme
+#lang scheme/base
-  (provide (all-defined))
+(provide (all-defined-out))
 
 ;; A Node(a) is:
 ;;   (make-node a ?a)
-  (define-struct node (z1 z2) #f)
+(define-struct node (z1 z2) #:transparent)
 
 ;; A TopDeriv is one of
 ;;   (make-lift-deriv <Node(Stx)> Deriv Stxs TopDeriv)
@@ -13,18 +13,18 @@
 ;; A Deriv is one of
 ;;   (make-mrule <Node(Stx)> Transformation Deriv)
 ;;   PrimDeriv
-  (define-struct (deriv node) () #f)
+(define-struct (deriv node) () #:transparent)
-  (define-struct (lift-deriv deriv) (first lift-stx second) #f)
+(define-struct (lift-deriv deriv) (first lift-stx second) #:transparent)
-  (define-struct (mrule deriv) (transformation next) #f)
+(define-struct (mrule deriv) (transformation next) #:transparent)
 
 ;; A DerivLL is one of
 ;;   (make-lift/let-deriv <Node(Stx)> Deriv Stx Deriv)
 ;;   Deriv
-  (define-struct (lift/let-deriv deriv) (first lift-stx second) #f)
+(define-struct (lift/let-deriv deriv) (first lift-stx second) #:transparent)
 
 ;; A Transformation is
 ;;   (make-transformation <Node(Stx)> Rs ?exn ?Stx (list-of LocalAction) ?exn ?Stx Number)
-  (define-struct (transformation node) (resolves ?1 me1 locals ?2 me2 seq) #f)
+(define-struct (transformation node) (resolves ?1 me1 locals ?2 me2 seq) #:transparent)
 
 ;; A LocalAction is one of
 ;;   (make-local-expansion <Node(Stx)> Stx ?Stx Boolean Deriv)
@@ -32,57 +32,57 @@
 ;;   (make-local-lift Stx Identifier)
 ;;   (make-local-lift-end Stx)
 ;;   (make-local-bind BindSyntaxes)
-  (define-struct (local-expansion node) (me1 me2 for-stx? inner) #f)
+(define-struct (local-expansion node) (me1 me2 for-stx? inner) #:transparent)
-  (define-struct (local-expansion/expr node) (me1 me2 for-stx? opaque inner) #f)
+(define-struct (local-expansion/expr node) (me1 me2 for-stx? opaque inner) #:transparent)
-  (define-struct local-lift (expr id) #f)
+(define-struct local-lift (expr id) #:transparent)
-  (define-struct local-lift-end (decl) #f)
+(define-struct local-lift-end (decl) #:transparent)
-  (define-struct local-bind (bindrhs) #f)
+(define-struct local-bind (bindrhs) #:transparent)
 
 ;; Base = << Node(Stx) Rs ?exn >>
-  (define-struct (base deriv) (resolves ?1) #f)
+(define-struct (base deriv) (resolves ?1) #:transparent)
 
 ;; A PrimDeriv is one of
-  (define-struct (prule base) () #f)
+(define-struct (prule base) () #:transparent)
-  (define-struct (p:variable prule) () #f)
+(define-struct (p:variable prule) () #:transparent)
 
 ;;   (make-p:module <Base> Boolean ?Deriv ?exn Deriv)
 ;;   (make-p:#%module-begin <Base> ModulePass1 ModulePass2 ?exn)
-  (define-struct (p:module prule) (one-body-form? mb ?2 body) #f)
+(define-struct (p:module prule) (one-body-form? mb ?2 body) #:transparent)
-  (define-struct (p:#%module-begin prule) (pass1 pass2 ?2) #f)
+(define-struct (p:#%module-begin prule) (pass1 pass2 ?2) #:transparent)
 
 ;;   (make-p:define-syntaxes <Base> DerivLL)
 ;;   (make-p:define-values <Base> Deriv)
-  (define-struct (p:define-syntaxes prule) (rhs ?2) #f)
+(define-struct (p:define-syntaxes prule) (rhs ?2) #:transparent)
-  (define-struct (p:define-values prule) (rhs) #f)
+(define-struct (p:define-values prule) (rhs) #:transparent)
 
 ;;   (make-p:#%expression <Base> Deriv)
 ;;   (make-p:if <Base> Boolean Deriv Deriv Deriv)
 ;;   (make-p:wcm <Base> Deriv Deriv Deriv)
 ;;   (make-p:set! <Base> Rs Deriv)
 ;;   (make-p:set!-macro <Base> Rs Deriv)
-  (define-struct (p:#%expression prule) (inner) #f)
+(define-struct (p:#%expression prule) (inner) #:transparent)
-  (define-struct (p:if prule) (full? test then else) #f)
+(define-struct (p:if prule) (full? test then else) #:transparent)
-  (define-struct (p:wcm prule) (key mark body) #f)
+(define-struct (p:wcm prule) (key mark body) #:transparent)
-  (define-struct (p:set! prule) (id-resolves rhs) #f)
+(define-struct (p:set! prule) (id-resolves rhs) #:transparent)
-  (define-struct (p:set!-macro prule) (deriv) #f)
+(define-struct (p:set!-macro prule) (deriv) #:transparent)
 
 ;;   (make-p:#%app <Base> Stx LDeriv)
 ;;   (make-p:begin <Base> LDeriv)
 ;;   (make-p:begin0 <Base> Deriv LDeriv)
-  (define-struct (p:#%app prule) (tagged-stx lderiv) #f)
+(define-struct (p:#%app prule) (tagged-stx lderiv) #:transparent)
-  (define-struct (p:begin prule) (lderiv) #f)
+(define-struct (p:begin prule) (lderiv) #:transparent)
-  (define-struct (p:begin0 prule) (first lderiv) #f)
+(define-struct (p:begin0 prule) (first lderiv) #:transparent)
 
 ;;   (make-p:lambda <Base> LambdaRenames BDeriv)
 ;;   (make-p:case-lambda <Base> (list-of CaseLambdaClause))
 ;;   (make-p:let-values <Base> LetRenames (list-of Deriv) BDeriv)
 ;;   (make-p:letrec-values <Base> LetRenames (list-of Deriv) BDeriv)
 ;;   (make-p:letrec-syntaxes+values <Base> LSVRenames (list-of BindSyntaxes) (list-of Deriv) BDeriv)
-  (define-struct (p:lambda prule) (renames body) #f)
+(define-struct (p:lambda prule) (renames body) #:transparent)
-  (define-struct (p:case-lambda prule) (renames+bodies) #f)
+(define-struct (p:case-lambda prule) (renames+bodies) #:transparent)
-  (define-struct (p:let-values prule) (renames rhss body) #f)
+(define-struct (p:let-values prule) (renames rhss body) #:transparent)
-  (define-struct (p:letrec-values prule) (renames rhss body) #f)
+(define-struct (p:letrec-values prule) (renames rhss body) #:transparent)
-  (define-struct (p:letrec-syntaxes+values prule) (srenames sbindrhss vrenames vrhss body) #f)
+(define-struct (p:letrec-syntaxes+values prule) (srenames sbindrhss vrenames vrhss body) #:transparent)
 
 ;;   (make-p:stop <Base>)
 ;;   (make-p:unknown <Base>)
@@ -94,32 +94,32 @@
 ;;   (make-p:require-for-syntax <Base>)
 ;;   (make-p:require-for-template <Base>)
 ;;   (make-p:provide <Base>)
-  (define-struct (p::STOP prule) () #f)
+(define-struct (p::STOP prule) () #:transparent)
-  (define-struct (p:stop p::STOP) () #f)
+(define-struct (p:stop p::STOP) () #:transparent)
-  (define-struct (p:unknown p::STOP) () #f)
+(define-struct (p:unknown p::STOP) () #:transparent)
-  (define-struct (p:#%top p::STOP) (tagged-stx) #f)
+(define-struct (p:#%top p::STOP) (tagged-stx) #:transparent)
-  (define-struct (p:#%datum p::STOP) (tagged-stx) #f)
+(define-struct (p:#%datum p::STOP) (tagged-stx) #:transparent)
-  (define-struct (p:quote p::STOP) () #f)
+(define-struct (p:quote p::STOP) () #:transparent)
-  (define-struct (p:quote-syntax p::STOP) () #f)
+(define-struct (p:quote-syntax p::STOP) () #:transparent)
-  (define-struct (p:require p::STOP) () #f)
+(define-struct (p:require p::STOP) () #:transparent)
-  (define-struct (p:require-for-syntax p::STOP) () #f)
+(define-struct (p:require-for-syntax p::STOP) () #:transparent)
-  (define-struct (p:require-for-template p::STOP) () #f)
+(define-struct (p:require-for-template p::STOP) () #:transparent)
-  (define-struct (p:provide p::STOP) () #f)
+(define-struct (p:provide p::STOP) () #:transparent)
 
 ;;+  (make-p:rename <Base> Renames Deriv)
 ;;+  (make-p:synth <Base> (list-of SynthItem) ?exn)
-  (define-struct (p:rename prule) (renames inner) #f)
+(define-struct (p:rename prule) (renames inner) #:transparent)
-  (define-struct (p:synth prule) (subterms ?2) #f)
+(define-struct (p:synth prule) (subterms ?2) #:transparent)
 
 
 
 ;; A LDeriv is
 ;;   (make-lderiv <Node(Stxs)> ?exn (list-of Deriv))
-  (define-struct (lderiv node) (?1 derivs) #f)
+(define-struct (lderiv node) (?1 derivs) #:transparent)
 
 ;; A BDeriv is
 ;;   (make-bderiv <Node(Stxs)> (list-of BRule) (U 'list 'letrec) LDeriv)
-  (define-struct (bderiv node) (pass1 trans pass2) #f)
+(define-struct (bderiv node) (pass1 trans pass2) #:transparent)
 
 ;; A BRule is one of
 ;;   (make-b:error exn)
@@ -128,22 +128,22 @@
 ;;   (make-b:defvals BlockRenames Deriv ?exn)
 ;;   (make-b:defstx BlockRenames Deriv ?exn BindSyntaxes)
 ;;i  (make-b:begin BlockRenames Deriv (list-of Deriv))
-  (define-struct b:error (?1) #f)
+(define-struct b:error (?1) #:transparent)
-  (define-struct brule (renames) #f)
+(define-struct brule (renames) #:transparent)
-  (define-struct (b:expr brule) (head) #f)
+(define-struct (b:expr brule) (head) #:transparent)
-  (define-struct (b:splice brule) (head ?1 tail ?2) #f)
+(define-struct (b:splice brule) (head ?1 tail ?2) #:transparent)
-  (define-struct (b:defvals brule) (head ?1) #f)
+(define-struct (b:defvals brule) (head ?1) #:transparent)
-  (define-struct (b:defstx brule) (head ?1 bindrhs) #f)
+(define-struct (b:defstx brule) (head ?1 bindrhs) #:transparent)
-;;(define-struct (b:begin brule) (head inner) #f)
+;;(define-struct (b:begin brule) (head inner) #:transparent)
 
 ;; A BindSyntaxes is
 ;;   (make-bind-syntaxes DerivLL ?exn)
-  (define-struct bind-syntaxes (rhs ?1) #f)
+(define-struct bind-syntaxes (rhs ?1) #:transparent)
 
 
 ;; A CaseLambdaClause is
 ;;   (make-clc ?exn CaseLambdaRename BDeriv)
-  (define-struct clc (?1 renames body) #f)
+(define-struct clc (?1 renames body) #:transparent)
 
 ;; A BlockRename is (cons Stx Stx)
 
@@ -159,16 +159,16 @@
 ;;   (make-mod:skip)
 ;;   (make-mod:cons Deriv)
 ;;   (make-mod:lift Deriv Stxs)
-  (define-struct modrule () #f)
+(define-struct modrule () #:transparent)
-  (define-struct (mod:cons modrule) (head) #f)
+(define-struct (mod:cons modrule) (head) #:transparent)
-  (define-struct (mod:prim modrule) (head prim) #f)
+(define-struct (mod:prim modrule) (head prim) #:transparent)
-  (define-struct (mod:skip modrule) () #f)
+(define-struct (mod:skip modrule) () #:transparent)
-  (define-struct (mod:splice modrule) (head ?1 tail) #f)
+(define-struct (mod:splice modrule) (head ?1 tail) #:transparent)
-  (define-struct (mod:lift modrule) (head tail) #f)
+(define-struct (mod:lift modrule) (head tail) #:transparent)
-  (define-struct (mod:lift-end modrule) (tail) #f)
+(define-struct (mod:lift-end modrule) (tail) #:transparent)
 
 ;; A ModPrim is a PRule in:
-  ;;   (make-p:define-values <Base> #f)
+;;   (make-p:define-values <Base> #:transparent)
 ;;   (make-p:define-syntaxes <Base> Deriv)
 ;;   (make-p:require <Base>)
 ;;   (make-p:require-for-syntax <Base>)
@@ -179,9 +179,6 @@
 ;; A SynthItem is one of
 ;;   - (make-s:subterm Path Deriv)
 ;;   - (make-s:rename Path Stx Stx)
-  (define-struct subitem () #f)
+(define-struct subitem () #:transparent)
-  (define-struct (s:subterm subitem) (path deriv) #f)
+(define-struct (s:subterm subitem) (path deriv) #:transparent)
-  (define-struct (s:rename subitem) (path before after) #f)
+(define-struct (s:rename subitem) (path before after) #:transparent)
-
-
-  )

collects/macro-debugger/model/deriv-parser.ss

@@ -1,6 +1,7 @@
 
-(module deriv-parser mzscheme
+#lang scheme/base
-  (require "yacc-ext.ss"
+(require (for-syntax scheme/base)
+         "yacc-ext.ss"
          "yacc-interrupted.ss"
          "deriv.ss"
          "deriv-util.ss"
@@ -576,5 +577,3 @@
      [(next (? EE) (? EL*)) (cons $2 $3)])
 
     )))
-
-  )

collects/macro-debugger/model/deriv-tokens.ss

@@ -1,8 +1,8 @@
 
-(module deriv-tokens mzscheme
+#lang scheme/base
-  (require (lib "lex.ss" "parser-tools")
+(require parser-tools/lex
          "deriv.ss")
-  (provide (all-defined))
+(provide (all-defined-out))
 
 (define-tokens basic-tokens
   (start                ; .
@@ -156,5 +156,3 @@
 
 (define (signal->symbol sig-n)
   (cdr (assv sig-n signal-mapping)))
-
-  )

collects/macro-debugger/model/deriv-util.ss

@@ -1,9 +1,10 @@
 
-(module deriv-util mzscheme
+#lang scheme/base
-  (require "deriv.ss"
+(require (for-syntax scheme/base)
-           (lib "list.ss")
+         (for-syntax scheme/private/struct-info)
-           (lib "plt-match.ss"))
+         scheme/list
-  (require-for-syntax (lib "scheme/private/struct-info.ss"))
+         scheme/match
+         "deriv.ss")
 
 (provide make
 
@@ -97,4 +98,3 @@
             stx)))
        (with-syntax ([constructor constructor])
          #'(constructor expr ...)))]))
-  )

collects/macro-debugger/model/deriv.ss

@@ -1,14 +1,12 @@
 
-(module deriv mzscheme
+#lang scheme/base
-  (require (lib "contract.ss")
+(require scheme/contract
-           (lib "stx.ss" "syntax")
+         syntax/stx
          "deriv-c.ss")
 
-  ;; NO CONTRACTS
+(provide (all-from-out "deriv-c.ss"))
 
-  #;(provide (all-from "deriv-c.ss"))
+#|
-
-  ;; CONTRACTS
 
 (define (?? c) (or/c c false/c))
 
@@ -366,5 +364,5 @@
  (struct (s:rename subitem)
          ([path any/c]
           [before syntax?]
-            [after syntax?]))
+          [after syntax?])))
-   ))
+|#

collects/macro-debugger/model/hiding-policies.ss

@@ -1,11 +1,13 @@
 
-(module hiding-policies mzscheme
+#lang scheme/base
-  (require (lib "plt-match.ss")
+(require (for-syntax scheme/base)
-           (lib "boundmap.ss" "syntax"))
+         scheme/match
-  (provide (all-defined))
+         syntax/boundmap)
+(provide (all-defined-out))
 
 (define-struct hiding-policy
-    (opaque-modules opaque-ids opaque-kernel opaque-libs transparent-ids))
+  (opaque-modules opaque-ids opaque-kernel opaque-libs transparent-ids)
+  #:mutable)
 
 (define (policy-hide-module p m)
   (hash-table-put! (hiding-policy-opaque-modules p) m #t))
@@ -97,4 +99,3 @@
          (cond [(pair? path) (memq (car path) '(lib planet))]
                [(string? path) (lib-module? rel)]
                [else #f]))))
-  )

collects/macro-debugger/model/reductions-engine.ss

@@ -1,16 +1,14 @@
 
-;; FIXME: Steps are pairs of Configurations
+#lang scheme/base
-;; Configurations contain contexts, definites, etc.
 
-(module reductions-engine mzscheme
+(require (for-syntax scheme/base)
-  (require (lib "list.ss")
+         scheme/list
+         scheme/contract
          "deriv.ss"
          "stx-util.ss"
          "steps.ss")
-  (require (lib "contract.ss"))
+(provide (all-from-out "steps.ss")
-  (provide (all-from "steps.ss"))
+         context
-
-  (provide context
          big-context
          current-derivation
          current-definites
@@ -33,13 +31,17 @@
 
          CC
          R
-           revappend)
+         revappend
-  (provide walk
+
+         walk
          walk/foci
          walk/mono
          stumble
          stumble/E)
 
+;; FIXME: Steps are pairs of Configurations
+;; Configurations contain contexts, definites, etc.
+
 ;; context: parameter of Context
 (define context (make-parameter null))
 
@@ -313,7 +315,7 @@
     ;; Implementation of subterm handling for (hole ...) sequences
     [(Run* f form-var pattern (hole :::) fills k)
      (and (identifier? #':::)
-            (module-identifier=? #'::: (quote-syntax ...)))
+          (free-identifier=? #'::: (quote-syntax ...)))
      #'(let ([ctx (CC (hole :::) form-var pattern)])
          (let ([e1s (with-syntax ([pattern form-var]) (syntax->list #'(hole :::)))])
            (run-multiple f ctx fills e1s k)))]
@@ -367,9 +369,9 @@
           [(pair? from)
            #;(unless (pair? to)
              (fprintf (current-error-port)
-                        "from:\n~s\n\n" (syntax-object->datum from0))
+                      "from:\n~s\n\n" (syntax->datum from0))
              (fprintf (current-error-port)
-                        "to:\n~s\n\n" (syntax-object->datum to0))
+                      "to:\n~s\n\n" (syntax->datum to0))
              (error 'frontier-renaming))
            (loop (car from) (car to))
            (loop (cdr from) (cdr to))]
@@ -441,4 +443,3 @@
   (if (list? x)
       x
       (list x)))
-  )

collects/macro-debugger/model/reductions.ss

@@ -1,6 +1,6 @@
 
-(module reductions mzscheme
+#lang scheme/base
-  (require (lib "plt-match.ss")
+(require scheme/match
          "stx-util.ss"
          "deriv-util.ss"
          "context.ss"
@@ -560,5 +560,3 @@
                            stxs
                            'splice-module-lifts]]
         [(ModulePass #'?forms) ?forms rest])]))
-  
-  )

collects/macro-debugger/model/steps.ss

@@ -1,9 +1,9 @@
 
-(module steps mzscheme
+#lang scheme/base
 (require "deriv.ss"
          "deriv-util.ss"
          "deriv-find.ss")
-  (provide (all-defined))
+(provide (all-defined-out))
 
 ;; A ReductionSequence is a (list-of Reduction)
 
@@ -27,11 +27,11 @@
 ;;   - (make-mono ... Syntaxes Syntax)
 ;;   - (make-misstep ... Syntax Syntax Exception)
 
-  (define-struct protostep (deriv lctx type ctx definites frontier) #f)
+(define-struct protostep (deriv lctx type ctx definites frontier) #:transparent)
 
-  (define-struct (step protostep) (foci1 foci2 e1 e2) #f)
+(define-struct (step protostep) (foci1 foci2 e1 e2) #:transparent)
-  (define-struct (mono protostep) (foci1 e1) #f)
+(define-struct (mono protostep) (foci1 e1) #:transparent)
-  (define-struct (misstep protostep) (foci1 e1 exn) #f)
+(define-struct (misstep protostep) (foci1 e1 exn) #:transparent)
 
 ;; context-fill : Context Syntax -> Syntax
 (define (context-fill ctx stx)
@@ -113,4 +113,3 @@
 
 (define (rewrite-step? x)
   (and (step? x) (not (rename-step? x))))
-)

collects/macro-debugger/model/stx-util.ss

@@ -1,13 +1,14 @@
 
-(module stx-util mzscheme
+#lang scheme/base
-  (require (lib "stx.ss" "syntax"))
+(require (for-syntax scheme/base)
+         syntax/stx)
 
-  (provide (all-defined)
+(provide (all-defined-out)
-           (all-from (lib "stx.ss" "syntax")))
+         (all-from-out syntax/stx))
 
 (define (d->so template datum)
   (if (syntax? template)
-        (datum->syntax-object template datum template template)
+      (datum->syntax template datum template template)
       datum))
 
 (define-syntax (syntax-copier stx)
@@ -34,9 +35,9 @@
          ;; FIXME 
          (unless (= (length new-parts) (length old-parts))
            (printf "** syntax/restamp~n~s~n" (quote-syntax #,stx))
-             (printf "pattern : ~s~n" (syntax-object->datum #'(pa (... ...))))
+           (printf "pattern : ~s~n" (syntax->datum #'(pa (... ...))))
-             (printf "old parts: ~s~n" (map syntax-object->datum old-parts))
+           (printf "old parts: ~s~n" (map syntax->datum old-parts))
-             (printf "new parts: ~s~n" (map syntax-object->datum new-parts)))
+           (printf "new parts: ~s~n" (map syntax->datum new-parts)))
          (d->so
           old-expr
           (map (lambda (new old) (syntax/restamp pa new old))
@@ -47,7 +48,7 @@
      #'(begin
          (unless (and (stx-pair? new-expr) (stx-pair? old-expr))
            (printf "** syntax/restamp~n~s~n" (quote-syntax #,stx))
-             (printf "pattern : ~s~n" (syntax-object->datum (quote-syntax (pa . pb))))
+           (printf "pattern : ~s~n" (syntax->datum (quote-syntax (pa . pb))))
            (printf "old parts: ~s~n" old-expr)
            (printf "new parts: ~s~n" new-expr))
          (let ([na (stx-car new-expr)]
@@ -96,5 +97,3 @@
                (cons (car x) (stx->list* (cdr x)))
                (list stx)))]
         [else null]))
-
-)

collects/macro-debugger/model/trace-raw.ss

@@ -1,11 +1,11 @@
 
-(module trace-raw mzscheme
+#lang scheme/base
-  (require "../syntax-browser.ss"
+(require scheme/class
-           (lib "class.ss")
+         parser-tools/lex
-           (lib "lex.ss" "parser-tools")
          "deriv-tokens.ss"
-           "deriv-parser.ss")
+         "deriv-parser.ss"
-  (provide (all-defined))
+         "../syntax-browser.ss")
+(provide (all-defined-out))
 
 (define current-expand-observe
   (dynamic-require ''#%expobs 'current-expand-observe))
@@ -24,7 +24,7 @@
                   (token-name (position-token-token t))))
     (when val
           (send browser add-syntax
-                  (datum->syntax-object #f val)))
+                (datum->syntax #f val)))
     (set! pos (add1 pos)))
   (parameterize ((current-expand-observe
                   (lambda (sig val)
@@ -34,4 +34,3 @@
     (expand sexpr)
     (for-each show (reverse events))))
 
-  )

collects/macro-debugger/model/trace.ss

@@ -1,7 +1,8 @@
 
-(module trace mzscheme
+#lang scheme/base
-  (require (lib "lex.ss" "parser-tools"))
+(require scheme/promise
-  (require "deriv.ss"
+         parser-tools/lex
+         "deriv.ss"
          "deriv-parser.ss"
          "deriv-tokens.ss")
 
@@ -70,4 +71,3 @@
         (add! (cons 'EOF #f))
         (values result
                 (reverse events))))))
-  )

collects/macro-debugger/model/yacc-ext.ss

@@ -1,7 +1,7 @@
 
-(module yacc-ext mzscheme
+#lang scheme/base
-  
+(require (prefix-in yacc: parser-tools/yacc)
-  (require (prefix yacc: (lib "yacc.ss" "parser-tools")))
+         (for-syntax scheme/base))
 (provide parser
          options
          productions
@@ -47,4 +47,3 @@
          #'(let ()
              def ...
              (#%expression (yacc:parser opt ... (grammar prod ...))))))]))
-  )

collects/macro-debugger/model/yacc-interrupted.ss

@@ -1,7 +1,8 @@
 
-(module yacc-interrupted mzscheme
+#lang scheme/base
-  (require-for-syntax (lib "etc.ss"))
+(require (for-syntax scheme/base)
-  (require "yacc-ext.ss")
+         (for-syntax mzlib/etc)
+         "yacc-ext.ss")
 (provide ! ? !!
          define-production-splitter
          skipped-token-values
@@ -33,13 +34,13 @@
     (if (pair? forms)
         (syntax-case (car forms) ()
           [(#:args . args)
-             (loop (cdr forms) (cons (cons #:args #'args) options) alts)]
+           (loop (cdr forms) (cons (cons '#:args #'args) options) alts)]
           [(#:skipped expr)
-             (loop (cdr forms) (cons (cons #:skipped #'expr) options) alts)]
+           (loop (cdr forms) (cons (cons '#:skipped #'expr) options) alts)]
           [(#:wrap)
-             (loop (cdr forms) (cons (cons #:wrap #t) options) alts)]
+           (loop (cdr forms) (cons (cons '#:wrap #t) options) alts)]
           [(#:no-wrap)
-             (loop (cdr forms) (cons (cons #:no-wrap #t) options) alts)]
+           (loop (cdr forms) (cons (cons '#:no-wrap #t) options) alts)]
           [(kw . args)
            (keyword? (syntax-e #'kw))
            (raise-syntax-error 'split "bad keyword" (car forms))]
@@ -59,7 +60,7 @@
 
 (define-for-syntax (I symbol)
   (syntax-local-introduce
-     (syntax-local-get-shadower (datum->syntax-object #f symbol))))
+   (syntax-local-get-shadower (datum->syntax #f symbol))))
 
 (define-for-syntax ($name n)
   (I (symbol+ '$ n)))
@@ -112,7 +113,7 @@
          (loop #'parts-rest (cons #'NT rpattern)
                (add1 position) (cons ($name position) args))])))
   (map (lambda (new-pattern)
-           (cons (datum->syntax-object #f new-pattern pattern)
+         (cons (datum->syntax #f new-pattern pattern)
                #`(#,action-function #,(if wrap? okW #'values) #,@arguments)))
        new-patterns))
 
@@ -162,7 +163,7 @@
 
 (define-for-syntax (generate-action-name nt pos)
   (syntax-local-get-shadower
-     (datum->syntax-object #f (symbol+ 'action-for- nt '/ pos))))
+   (datum->syntax #f (symbol+ 'action-for- nt '/ pos))))
 
 (define-for-syntax ((make-rewrite-alt+def nt args-spec) alt pos)
   (define pattern (car alt))
@@ -231,15 +232,15 @@
        (define-values (options alternates0)
          (partition-options/alternates (syntax->list #'(form ...))))
        (define wrap?
-           (let ([wrap? (assq #:wrap options)]
+         (let ([wrap? (assq '#:wrap options)]
-                 [no-wrap? (assq #:no-wrap options)])
+               [no-wrap? (assq '#:no-wrap options)])
            (unless (and (or wrap? no-wrap?) (not (and wrap? no-wrap?)))
              (raise-syntax-error 'split
                                  "must specify exactly one of #:wrap, #:no-wrap"
                                  stx))
            (and wrap? #t)))
        (define args-spec
-           (let ([p (assq #:args options)]) (and p (cdr p))))
+         (let ([p (assq '#:args options)]) (and p (cdr p))))
        (define rewrite-alt+def (make-rewrite-alt+def #'name args-spec))
        (define alternates+definitions
          (map rewrite-alt+def alternates0 (build-list (length alternates0) add1)))
@@ -257,8 +258,8 @@
                       successful-alternates]
                      [((interrupted-pattern . interrupted-action) ...)
                       interrupted-alternates]
-                       [skip-spec (assq #:skipped options)]
+                     [skip-spec (assq '#:skipped options)]
-                       [args-spec (assq #:args options)]
+                     [args-spec (assq '#:args options)]
                      [name/Skipped (I (symbol+ #'name '/Skipped))]
                      [name/Interrupted (I (symbol+ #'name '/Interrupted))]
                      [%action ((syntax-local-certifier) #'%action)])
@@ -299,4 +300,3 @@
      #'(lambda args action)]
     [(%action #f action)
      #'action]))
-  )

collects/macro-debugger/stepper-text.ss

@@ -1,7 +1,7 @@
 
-(module stepper-text mzscheme 
+#lang scheme/base
-  (require (lib "list.ss")
+(require scheme/list
-           (lib "pretty.ss")
+         scheme/pretty
          "model/trace.ss"
          "model/reductions.ss"
          "model/steps.ss"
@@ -123,7 +123,7 @@
          show]
         [(list? show)
          (lambda (id)
-             (ormap (lambda (x) (module-identifier=? x id))
+           (ormap (lambda (x) (free-identifier=? x id))
                   show))]
         [(hiding-policy? show)
          (lambda (x) (policy-show-macro? show x))]
@@ -137,4 +137,3 @@
 (define extended-style-list
   '((define-values          . define)
     (define-syntaxes        . define-syntax)))
-  )

collects/macro-debugger/stepper.ss

@@ -1,8 +1,7 @@
 
-(module stepper mzscheme
+#lang scheme/base
 (require "view/view.ss")
 (provide expand/step)
 
 (define (expand/step stx)
   (go stx))
-  )

collects/macro-debugger/syntax-browser.ss

@@ -1,7 +1,6 @@
 
-(module syntax-browser mzscheme
+#lang scheme/base
 (require "syntax-browser/frame.ss")
 (provide browse-syntax
          browse-syntaxes
          make-syntax-browser)
-  )

collects/macro-debugger/syntax-browser/controller.ss

@@ -1,6 +1,6 @@
 
-(module controller mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
          "interfaces.ss"
          "partition.ss"
          "../util/notify.ss")
@@ -73,4 +73,3 @@
             (displays-manager-mixin
              object%))))
     (super-new)))
-  )

collects/macro-debugger/syntax-browser/display.ss

@@ -1,8 +1,8 @@
 
-(module display mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "mred.ss" "mred")
+         scheme/gui
-           (lib "plt-match.ss")
+         scheme/match
          "params.ss"
          "pretty-printer.ss"
          "interfaces.ss"
@@ -248,4 +248,3 @@
 
 (define unhighlight-d (highlight-style-delta "white" #f))
 
-  )

collects/macro-debugger/syntax-browser/embed.ss

@@ -1,13 +1,13 @@
 
-(module embed mzscheme
+#lang scheme/base
 (require "interfaces.ss"
          "widget.ss"
          "keymap.ss"
          "params.ss"
          "partition.ss")
 
-  (provide (all-from "interfaces.ss")
+(provide (all-from-out "interfaces.ss")
-           (all-from "widget.ss")
+         (all-from-out "widget.ss")
-           (all-from "keymap.ss")
+         (all-from-out "keymap.ss")
-           (all-from "params.ss")
+         (all-from-out "params.ss")
-           identifier=-choices))
+         identifier=-choices)

collects/macro-debugger/syntax-browser/frame.ss

@@ -1,9 +1,9 @@
 
-(module frame mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "mred.ss" "mred")
+         scheme/gui
-           (lib "framework.ss" "framework")
+         framework/framework
-           (lib "list.ss")
+         scheme/list
          "partition.ss"
          "prefs.ss"
          "widget.ss")
@@ -92,5 +92,3 @@
             (send -choice set-selection
                   (or (send -choice find-string (car name+func)) 0))))
     ))
-
-  )

collects/macro-debugger/syntax-browser/hrule-snip.ss

@@ -1,7 +1,8 @@
 
-(module hrule-snip mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+
-           (lib "mred.ss" "mred"))
+(require scheme/class
+         scheme/gui)
 (provide hrule-snip%)
 
 ;; hrule-snip%
@@ -54,4 +55,3 @@
 (send snip-class set-classname
       (format "~s" '(lib "hrule-snip.ss" "macro-debugger" "syntax-browser")))
 (send (get-the-snip-class-list) add snip-class)
-  )

collects/macro-debugger/syntax-browser/interfaces.ss

@@ -1,7 +1,7 @@
 
-(module interfaces mzscheme
+#lang scheme/base
-  (require (lib "class.ss"))
+(require scheme/class)
-  (provide (all-defined))
+(provide (all-defined-out))
 
 ;; displays-manager<%>
 (define displays-manager<%>
@@ -163,5 +163,3 @@
 
     ;; count : -> number
     count))
-
-  )

collects/macro-debugger/syntax-browser/keymap.ss

@@ -1,7 +1,7 @@
 
-(module keymap mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "mred.ss" "mred")
+         scheme/gui
          "interfaces.ss"
          "partition.ss")
 (provide syntax-keymap%
@@ -38,7 +38,7 @@
                     (define stx (send controller get-selected-syntax))
                     (send the-clipboard set-clipboard-string
                           (if stx 
-                                (format "~s" (syntax-object->datum stx))
+                              (format "~s" (syntax->datum stx))
                               "")
                           (send event get-time-stamp))))
 
@@ -148,5 +148,3 @@
     (add-partition-items)
     (after-partition-items)
     ))
-
-  )

collects/macro-debugger/syntax-browser/partition.ss

@@ -1,8 +1,8 @@
 
-(module partition mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "boundmap.ss" "syntax")
+         syntax/boundmap
-           (lib "stx.ss" "syntax")
+         syntax/stx
          "interfaces.ss")
 (provide new-bound-partition
          partition%
@@ -22,7 +22,7 @@
 ;; Has no marks---used to initialize bound partition so that 
 ;; unmarked syntax always gets colored "black"
 (define unmarked-syntax
-    (datum->syntax-object #f representative-symbol))
+  (datum->syntax #f representative-symbol))
 
 (define partition%
   (class* object% (partition<%>)
@@ -89,7 +89,7 @@
         (or n
             (begin0 next-number
               (bound-identifier-mapping-put! numbers r next-number)
-                #;(printf "primary partition new stx:~n~s~n~s~n" stx (syntax-object->datum stx))
+              #;(printf "primary partition new stx:~n~s~n~s~n" stx (syntax->datum stx))
               (set! next-number (add1 next-number))))))
     
     (define/public (same-partition? a b)
@@ -99,7 +99,7 @@
       next-number)
     
     (define/private (representative stx)
-        (datum->syntax-object stx representative-symbol))
+      (datum->syntax stx representative-symbol))
 
     (get-partition unmarked-syntax)
     (super-new)))
@@ -108,8 +108,8 @@
 
 (define (lift/rep id=?)
   (lambda (A B)
-      (let ([ra (datum->syntax-object A representative-symbol)]
+    (let ([ra (datum->syntax A representative-symbol)]
-            [rb (datum->syntax-object B representative-symbol)])
+          [rb (datum->syntax B representative-symbol)])
       (id=? ra rb))))
 
 (define (lift id=?)
@@ -127,7 +127,7 @@
   (let ([ba (identifier-binding a)]
         [bb (identifier-binding b)])
     (cond [(or (eq? 'lexical ba) (eq? 'lexical bb))
-             (module-identifier=? a b)]
+           (free-identifier=? a b)]
           [(and (not ba) (not bb))
            #t]
           [(or (not ba) (not bb))
@@ -138,7 +138,7 @@
   (let ([ba (identifier-binding A)]
         [bb (identifier-binding B)])
     (cond [(or (eq? 'lexical ba) (eq? 'lexical bb))
-             (module-identifier=? A B)]
+           (free-identifier=? A B)]
           [(or (not ba) (not bb))
            (and (not ba) (not bb))]
           [else (eq? (caddr ba) (caddr bb))])))
@@ -150,10 +150,8 @@
   (make-parameter
    `(("<nothing>" . #f)
      ("bound-identifier=?"  . ,bound-identifier=?)
-       ("module-identifier=?" . ,module-identifier=?)
+     ("free-identifier=?" . ,free-identifier=?)
      ("module-or-top-identifier=?" . ,module-or-top-identifier=?)
      ("symbolic-identifier=?" . ,symbolic-identifier=?)
      ("same source module" . ,id:source-module=?)
      ("same nominal module" . ,id:nominal-module=?))))
-  
-  )

collects/macro-debugger/syntax-browser/prefs.ss

@@ -1,7 +1,7 @@
 
-(module prefs mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "framework.ss" "framework")
+         framework/framework
          "interfaces.ss"
          "../util/misc.ss")
 (provide syntax-prefs%
@@ -29,4 +29,3 @@
     (pref:props-shown? pref:props-shown?)))
 
 (define syntax-prefs% (syntax-prefs-mixin object%))
-  )

collects/macro-debugger/syntax-browser/pretty-helper.ss

@@ -1,9 +1,9 @@
 
-(module pretty-helper mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "stx.ss" "syntax")
+         syntax/stx
          "partition.ss")
-  (provide (all-defined))
+(provide (all-defined-out))
 
 ;; Problem: If stx1 and stx2 are two distinguishable syntax objects, it
 ;; still may be the case that (syntax-e stx1) and (syntax-e stx2) are 
@@ -126,7 +126,7 @@
              [expr (cadr stx-list)])
          (and (identifier? kw)
               (memq (syntax-e kw) special-expression-keywords)
-                (bound-identifier=? kw (datum->syntax-object stx (syntax-e kw)))
+              (bound-identifier=? kw (datum->syntax stx (syntax-e kw)))
               (andmap (lambda (f) (equal? (f stx) (f kw)))
                       (list syntax-source
                             syntax-line
@@ -146,5 +146,3 @@
 
 (define (suffix sym n)
   (string->uninterned-symbol (format "~a:~a" sym n)))
-
-  )

collects/macro-debugger/syntax-browser/pretty-printer.ss

@@ -1,11 +1,11 @@
 
 ;; FIXME: Need to disable printing of structs with custom-write property
 
-(module pretty-printer mzscheme
+#lang scheme/base
-  (require (lib "list.ss")
+(require scheme/list
-           (lib "class.ss")
+         scheme/class
-           (lib "pretty.ss")
+         scheme/pretty
-           (lib "mred.ss" "mred")
+         scheme/gui
          "pretty-helper.ss"
          "interfaces.ss"
          "params.ss"
@@ -158,4 +158,3 @@
          (>= (- (range-end x) (range-start x))
              (- (range-end y) (range-start y))))))))
 
-  )

collects/macro-debugger/syntax-browser/properties.ss

@@ -1,11 +1,9 @@
 
-(module properties mzscheme
+#lang scheme/base
-  (require "interfaces.ss"
+(require scheme/class
-           "util.ss"
+         scheme/gui
-           (lib "class.ss")
+         "interfaces.ss"
-           (lib "mred.ss" "mred")
+         "util.ss")
-           #;(lib "framework.ss" "framework")
-           #;(lib "interactive-value-port.ss" "mrlib"))
 (provide properties-view%
          properties-snip%)
 
@@ -151,13 +149,13 @@
       (cond
        [(identifier? stx)
         (display "Binding if used for #%top\n" key-sd)
-          (display-bindings (datum->syntax-object stx '#%top))]
+        (display-bindings (datum->syntax stx '#%top))]
        [(and (syntax? stx) (pair? (syntax-e stx)))
         (display "Binding if used for #%app\n" key-sd)
-          (display-bindings (datum->syntax-object stx '#%app))]
+        (display-bindings (datum->syntax stx '#%app))]
        [else
         (display "Binding if used for #%datum\n" key-sd)
-          (display-bindings (datum->syntax-object stx '#%datum))]))
+        (display-bindings (datum->syntax stx '#%datum))]))
 
     ;; display-bindings : syntax -> void
     (define/private (display-bindings stx)
@@ -181,7 +179,7 @@
              (display-subkv "  as" (list-ref v 1))
              (display-subkv "  imported from" (mpi->string (list-ref v 2)))
              (display-subkv "  as" (list-ref v 3))
-               (if (list-ref v 4)
+             (when (list-ref v 4)
                (display "  via define-for-syntax" sub-key-sd))]))
 
     ;; display-stxobj-info : syntax -> void
@@ -311,4 +309,3 @@
     (send s set-delta 'change-toggle-underline)
     (send s set-delta-foreground "blue")
     s))
-  )

collects/macro-debugger/syntax-browser/text.ss

@@ -1,10 +1,10 @@
 
-(module text mzscheme
+#lang scheme/base
-  (require (lib "list.ss")
+(require scheme/list
-           (lib "class.ss")
+         scheme/class
-           (lib "mred.ss" "mred")
+         scheme/gui
-           (lib "arrow.ss" "drscheme")
+         drscheme/arrow
-           (lib "framework.ss" "framework")
+         framework/framework
          "../util/notify.ss")
 
 (provide text:hover<%>
@@ -29,9 +29,9 @@
 (define white (send the-color-database find-color "white"))
 
 ;; A Drawing is (make-drawing number number (??? -> void) boolean boolean)
-  (define-struct drawing (start end draw visible? tacked?) #f)
+(define-struct drawing (start end draw visible? tacked?) #:mutable)
 
-  (define-struct idloc (start end id) #f)
+(define-struct idloc (start end id))
 
 (define (mean x y)
   (/ (+ x y) 2))
@@ -321,4 +321,3 @@
   (text:arrows-mixin
    (text:tacking-mixin
     text:mouse-drawings%)))
-  )

collects/macro-debugger/syntax-browser/util.ss

@@ -1,6 +1,6 @@
 
-(module util mzscheme
+#lang scheme/base
-  (require (lib "class.ss"))
+(require scheme/class)
 (provide with-unlock
          make-text-port
          mpi->string
@@ -57,4 +57,3 @@
         [(not mpi)
          '()]
         [else (list mpi)]))
-  )

collects/macro-debugger/syntax-browser/widget.ss

@@ -1,12 +1,12 @@
 
-(module widget mzscheme
+#lang mzscheme
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "mred.ss" "mred")
+         mred/mred
-           (lib "framework.ss" "framework")
+         framework/framework
-           (lib "list.ss")
+         scheme/list
-           (lib "plt-match.ss")
+         scheme/match
-           (lib "kw.ss")
+         mzlib/kw
-           (lib "boundmap.ss" "syntax")
+         syntax/boundmap
          "interfaces.ss"
          "params.ss"
          "controller.ss"
@@ -255,4 +255,3 @@
     (define/override (default-style-name) "Basic")
     (super-new (auto-wrap #t))
     (set-autowrap-bitmap #f)))
-  )

collects/macro-debugger/view/cursor.ss

@@ -1,5 +1,6 @@
 
-(module cursor mzscheme
+#lang scheme/base
+(require scheme/promise)
 (provide cursor?
          cursor:new
          cursor:add-to-end!
@@ -57,7 +58,7 @@
 ;; Cursors
 
 ;; A (Cursor-of 'a) is (make-cursor (list-of 'a) (Stream-of 'a))
-  (define-struct cursor (prefix suffixp))
+(define-struct cursor (prefix suffixp) #:mutable)
 
 (define (cursor:new items)
   (make-cursor null items))
@@ -128,5 +129,3 @@
 
 (define (cursor:suffix->list c)
   (stream->list (cursor-suffixp c)))
-  
-  )

collects/macro-debugger/view/debug-format.ss

@@ -1,10 +1,9 @@
 
-(module debug-format mzscheme
+#lang scheme/base
-  (require (lib "pretty.ss"))
+(require scheme/pretty)
 (provide write-debug-file
          load-debug-file)
 
-
 (define (write-debug-file file exn events)
   (with-output-to-file file
     (lambda ()
@@ -25,7 +24,7 @@
         [(pair? d) `(cons ,(serialize-datum (car d)) ,(serialize-datum (cdr d)))]
         [(null? d) '()]
         [(exn? d) `(make-exn ,(exn-message d) (current-continuation-marks))]
-          [(syntax? d) `(datum->syntax-object #f ',(syntax-object->datum d))]
+        [(syntax? d) `(datum->syntax #f ',(syntax->datum d))]
         #;[(syntax? d) `(eval (quote ,(compile `(,#'quote-syntax ,d))))]
         [else (error 'serialize-datum "got ~s" d)]))
 
@@ -52,4 +51,3 @@
                [ctx (read)])
           (let ([events (eval events-expr)])
             (values events exnmsg ctx)))))))
-  )

collects/macro-debugger/view/debug.ss

@@ -1,7 +1,7 @@
 
-(module debug mzscheme
+#lang scheme/base
-  (require (lib "pretty.ss")
+(require scheme/pretty
-           (lib "class.ss")
+         scheme/class
          "debug-format.ss"
          "prefs.ss"
          "view.ss")
@@ -32,4 +32,3 @@
     (let* ([w (make-stepper)])
       (send w add-trace events)
       w)))
-  )

collects/macro-debugger/view/extensions.ss

@@ -1,24 +1,24 @@
 
-(module extensions mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "unit.ss")
+         scheme/unit
-           (lib "list.ss")
+         scheme/list
-           (lib "plt-match.ss")
+         scheme/match
-           (lib "mred.ss" "mred")
+         scheme/gui
-           (lib "framework.ss" "framework")
+         framework/framework
-           (lib "boundmap.ss" "syntax")
+         syntax/boundmap
          "interfaces.ss"
          "prefs.ss"
          "warning.ss"
          "hiding-panel.ss"
-           (prefix s: "../syntax-browser/widget.ss")
+         (prefix-in s: "../syntax-browser/widget.ss")
          "../model/deriv.ss"
          "../model/deriv-util.ss"
          "../model/trace.ss"
          "../model/hide.ss"
          "../model/steps.ss"
          "cursor.ss"
-           "util.ss")
+         "../util/notify.ss")
 (provide stepper-keymap%
          stepper-context-menu%
          stepper-syntax-widget%)
@@ -109,4 +109,3 @@
       (case-lambda [() (send config get-props-percentage)]
                    [(v) (send config set-props-percentage v)]))
     (super-new)))
-  )

collects/macro-debugger/view/frame.ss

@@ -1,27 +1,27 @@
 
-(module frame mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "unit.ss")
+         scheme/unit
-           (lib "list.ss")
+         scheme/list
-           (lib "file.ss")
+         scheme/file
-           (lib "plt-match.ss")
+         scheme/match
-           (lib "mred.ss" "mred")
+         scheme/gui
-           (lib "framework.ss" "framework")
+         framework/framework
-           (lib "boundmap.ss" "syntax")
+         syntax/boundmap
          "interfaces.ss"
          "stepper.ss"
          "prefs.ss"
          "warning.ss"
          "hiding-panel.ss"
-           (prefix sb: "../syntax-browser/embed.ss")
+         (prefix-in sb: "../syntax-browser/embed.ss")
-           (prefix sb: "../syntax-browser/params.ss")
+         (prefix-in sb: "../syntax-browser/params.ss")
          "../model/deriv.ss"
          "../model/deriv-util.ss"
          "../model/trace.ss"
          "../model/hide.ss"
          "../model/steps.ss"
          "cursor.ss"
-           "util.ss")
+         "../util/notify.ss")
 (provide macro-stepper-frame-mixin)
 
 (define (macro-stepper-frame-mixin base-frame%)
@@ -232,5 +232,3 @@
       (min-width (+ 2 (inexact->exact (ceiling tw))))
       (min-height (+ 2 (inexact->exact (ceiling th)))))
     (stretchable-height #f)))
-
-  )

collects/macro-debugger/view/hiding-panel.ss

@@ -1,12 +1,12 @@
 
-(module hiding-panel mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "mred.ss" "mred")
+         scheme/gui
-           (lib "list.ss")
+         scheme/list
-           (lib "boundmap.ss" "syntax")
+         syntax/boundmap
-           "util.ss"
          "../model/synth-engine.ss"
          "../syntax-browser/util.ss"
+         "../util/notify.ss"
          "../util/hiding.ss")
 (provide macro-hiding-prefs-widget%)
 
@@ -241,7 +241,7 @@
                         (return show?)))]
                    [else
                     (lambda (id binding return)
-                        (when (module-identifier=? id key)
+                      (when (free-identifier=? id key)
                         (return show?)))]))
            identifier-policies))
 
@@ -302,7 +302,7 @@
 
 (define (key=? key1 key2)
   (cond [(and (identifier? key1) (identifier? key2))
-           (module-identifier=? key1 key2)]
+         (free-identifier=? key1 key2)]
         [(and (pair? key1) (pair? key2))
          (and (equal? (car key1) (car key2))
               (equal? (cadr key1) (cadr key2)))]
@@ -317,4 +317,3 @@
                    (mpi->string mod)))]
         [else (symbol->string (syntax-e key))]))
 
-  )

collects/macro-debugger/view/interfaces.ss

@@ -1,7 +1,7 @@
 
-(module interfaces mzscheme
+#lang scheme/base
-  (require (lib "unit.ss"))
+(require scheme/unit)
-  (provide (all-defined))
+(provide (all-defined-out))
 
 ;; Signatures
 
@@ -44,5 +44,3 @@
 ;;     show-hiding-panel?
 ;;     show-rename-steps?
 ;;     highlight-foci?
-
-  )

collects/macro-debugger/view/prefs.ss

@@ -1,7 +1,7 @@
 
-(module prefs mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "framework.ss" "framework")
+         framework/framework
          "../util/notify.ss"
          "../util/misc.ss")
 (provide macro-stepper-config-base%
@@ -96,5 +96,3 @@
     (connect-to-pref/readonly debug-catch-errors? pref:debug-catch-errors?)
     (connect-to-pref/readonly force-letrec-transformation? pref:force-letrec-transformation?)
     (super-new)))
-
-  )

collects/macro-debugger/view/stepper.ss

@@ -1,20 +1,20 @@
 
-(module stepper mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "unit.ss")
+         scheme/unit
-           (lib "list.ss")
+         scheme/list
-           (lib "plt-match.ss")
+         scheme/match
-           (lib "mred.ss" "mred")
+         scheme/gui
-           (lib "framework.ss" "framework")
+         framework/framework
-           (lib "boundmap.ss" "syntax")
+         syntax/boundmap
          "interfaces.ss"
          "prefs.ss"
          "extensions.ss"
          "warning.ss"
          "hiding-panel.ss"
          "term-record.ss"
-           (prefix s: "../syntax-browser/widget.ss")
+         (prefix-in s: "../syntax-browser/widget.ss")
-           (prefix s: "../syntax-browser/params.ss")
+         (prefix-in s: "../syntax-browser/params.ss")
          "../model/deriv.ss"
          "../model/deriv-util.ss"
          "../model/deriv-find.ss"
@@ -23,7 +23,7 @@
          "../model/hide.ss"
          "../model/steps.ss"
          "cursor.ss"
-           "util.ss")
+         "../util/notify.ss")
 (provide macro-stepper-widget%
          macro-stepper-widget/process-mixin)
 
@@ -427,7 +427,6 @@
             [else #f])))
 
     (define/public (top-interaction-kw? x)
-        (module-identifier=? x #'#%top-interaction))
+      (free-identifier=? x #'#%top-interaction))
 
     ))
-  )

collects/macro-debugger/view/term-record.ss

@@ -1,19 +1,19 @@
 
-(module term-record mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "unit.ss")
+         scheme/unit
-           (lib "list.ss")
+         scheme/list
-           (lib "plt-match.ss")
+         scheme/match
-           (lib "mred.ss" "mred")
+         scheme/gui
-           (lib "framework.ss" "framework")
+         framework/framework
-           (lib "boundmap.ss" "syntax")
+         syntax/boundmap
          "interfaces.ss"
          "prefs.ss"
          "extensions.ss"
          "warning.ss"
          "hiding-panel.ss"
-           (prefix s: "../syntax-browser/widget.ss")
+         (prefix-in s: "../syntax-browser/widget.ss")
-           (prefix s: "../syntax-browser/params.ss")
+         (prefix-in s: "../syntax-browser/params.ss")
          "../model/deriv.ss"
          "../model/deriv-util.ss"
          "../model/deriv-find.ss"
@@ -24,7 +24,7 @@
          "../model/steps.ss"
          "debug-format.ss"
          "cursor.ss"
-           "util.ss")
+         "../util/notify.ss")
 
 (provide term-record%)
 
@@ -389,15 +389,15 @@
 
     (define/public (add-syntax stx binders definites)
       (send sbview add-syntax stx
-              #:alpha-table binders
+            '#:alpha-table binders
-              #:definites definites))
+            '#:definites definites))
 
     (define/private (add-final stx error binders definites)
       (when stx
         (send sbview add-text "Expansion finished\n")
         (send sbview add-syntax stx
-                #:alpha-table binders
+              '#:alpha-table binders
-                #:definites (or definites null)))
+              '#:definites (or definites null)))
       (when error
         (add-error error)))
 
@@ -484,8 +484,8 @@
       (send sbview add-text "\n")
       (when (exn:fail:syntax? (misstep-exn step))
         (for-each (lambda (e) (send sbview add-syntax e
-                                      #:alpha-table binders
+                                    '#:alpha-table binders
-                                      #:definites (protostep-definites step)))
+                                    '#:definites (protostep-definites step)))
                   (exn:fail:syntax-exprs (misstep-exn step))))
       (show-lctx step binders))
 
@@ -493,12 +493,12 @@
     ;; insert-syntax/color : syntax syntaxes identifiers syntaxes string -> void
     (define/private (insert-syntax/color stx foci binders definites frontier hi-color)
       (send sbview add-syntax stx
-              #:definites definites
+            '#:definites definites
-              #:alpha-table binders
+            '#:alpha-table binders
-              #:hi-color hi-color
+            '#:hi-color hi-color
-              #:hi-stxs (if (send config get-highlight-foci?) foci null)
+            '#:hi-stxs (if (send config get-highlight-foci?) foci null)
-              #:hi2-color "WhiteSmoke"
+            '#:hi2-color "WhiteSmoke"
-              #:hi2-stxs (if (send config get-highlight-frontier?) frontier null)))
+            '#:hi2-stxs (if (send config get-highlight-frontier?) frontier null)))
 
     ;; insert-syntax/redex : syntax syntaxes identifiers syntaxes -> void
     (define/private (insert-syntax/redex stx foci binders definites frontier)
@@ -538,5 +538,3 @@
 
 
     ))
-
-  )

collects/macro-debugger/view/view.ss

@@ -1,14 +1,14 @@
 
-(module view mzscheme
+#lang scheme/base
-  (require (lib "class.ss")
+(require scheme/class
-           (lib "pretty.ss")
+         scheme/pretty
-           (lib "mred.ss" "mred")
+         scheme/gui
-           (lib "framework.ss" "framework")
+         framework/framework
          "interfaces.ss"
          "frame.ss"
          "prefs.ss"
          "../model/trace.ss")
-  (provide (all-defined))
+(provide (all-defined-out))
 
 (define macro-stepper-frame%
   (macro-stepper-frame-mixin
@@ -39,5 +39,3 @@
   (let* ([w (make-macro-stepper)])
     (send w add-trace events)
     w))
-
-  )