[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/racket-mode 3ce25d897a 2/2: Enhance macro expansion steppe
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/racket-mode 3ce25d897a 2/2: Enhance macro expansion stepper hiding; closes #697 |
|
Date: |
Sun, 28 Jan 2024 19:00:27 -0500 (EST) |
branch: elpa/racket-mode
commit 3ce25d897a5857d798293db21bb044e1ede50e46
Author: Greg Hendershott <git@greghendershott.com>
Commit: Greg Hendershott <git@greghendershott.com>
Enhance macro expansion stepper hiding; closes #697
- Add customization variable racket-expand-hiding, which is an Emacs
Lisp equivalent of macro-debugger/model/hiding-policies. Allows the
same level of macro hiding customization as in DrRacket.
- Use macro-debugger stepper for expressions, too:
- Simplifies back end implementation.
- Allows racket-expand-hiding policy to affect expression expansion,
too.
- Unless overridden by a command prefix, show the racket-expand-hiding
name and value in the buffer, and button-ize the former to be
customize-variable.
- Add a racket-stepper-refresh command, so after someone customizes
the hiding policy they can just hit "g" to use the new value.
---
doc/generate.el | 1 +
doc/racket-mode.texi | 22 ++++++-
racket-custom.el | 39 ++++++++++++
racket-stepper.el | 136 +++++++++++++++++++++++++----------------
racket/command-server.rkt | 2 +-
racket/commands/macro.rkt | 145 ++++++++++++++++++++------------------------
test/racket-tests.el | 150 +++++++++++++++++++++++++---------------------
7 files changed, 289 insertions(+), 206 deletions(-)
diff --git a/doc/generate.el b/doc/generate.el
index fc86e26f27..cafbd47346 100644
--- a/doc/generate.el
+++ b/doc/generate.el
@@ -190,6 +190,7 @@
racket-xp-highlight-unused-regexp
racket-xp-add-binding-faces
racket-documentation-search-location
+ racket-expand-hiding
"Hash lang variables"
racket-hash-lang-token-face-alist
racket-hash-lang-pairs
diff --git a/doc/racket-mode.texi b/doc/racket-mode.texi
index 48ed337cec..780fc8e8fe 100644
--- a/doc/racket-mode.texi
+++ b/doc/racket-mode.texi
@@ -208,6 +208,7 @@ General variables
* racket-xp-highlight-unused-regexp::
* racket-xp-add-binding-faces::
* racket-documentation-search-location::
+* racket-expand-hiding::
Hash lang variables
@@ -2781,6 +2782,8 @@ Used by the commands @ref{racket-expand-file},
@multitable {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
{aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
@item Key
@tab Binding
+@item @kbd{g}
+@tab @code{racket-stepper-refresh}
@item @kbd{k}
@tab @code{racket-stepper-previous-item}
@item @kbd{p}
@@ -2816,8 +2819,8 @@ If the file is non-trivial and/or is not compiled to a .zo
bytecode file, then it might take many seconds before the
original form is displayed and you can start stepping.
-With @kbd{C-u} also expands syntax from racket/base
--- which can result in very many expansion steps.
+With @kbd{C-u} behaves as if @ref{racket-expand-hiding}
+were 'disabled.
@node racket-expand-region
@subsection racket-expand-region
@@ -2829,6 +2832,9 @@ Expand the active region using @ref{racket-stepper-mode}.
Uses Racket's @code{expand-once} in the namespace from the most recent
@ref{racket-run}.
+With @kbd{C-u} behaves as if @ref{racket-expand-hiding}
+were 'disabled.
+
@node racket-expand-definition
@subsection racket-expand-definition
@@ -2839,6 +2845,9 @@ Expand the definition around point using
@ref{racket-stepper-mode}.
Uses Racket's @code{expand-once} in the namespace from the most recent
@ref{racket-run}.
+With @kbd{C-u} behaves as if @ref{racket-expand-hiding}
+were 'disabled.
+
@node racket-expand-last-sexp
@subsection racket-expand-last-sexp
@@ -2849,6 +2858,9 @@ Expand the sexp before point using
@ref{racket-stepper-mode}.
Uses Racket's @code{expand-once} in the namespace from the most recent
@ref{racket-run}.
+With @kbd{C-u} behaves as if @ref{racket-expand-hiding}
+were 'disabled.
+
@node Other
@section Other
@@ -2982,6 +2994,7 @@ Delete the ``compiled'' directories made by
@ref{racket-mode-start-faster}.
* racket-xp-highlight-unused-regexp::
* racket-xp-add-binding-faces::
* racket-documentation-search-location::
+* racket-expand-hiding::
@end menu
@node racket-program
@@ -3140,6 +3153,11 @@ after applying @code{url-hexify-string}. Apart from
``%s'', the
string should be a properly encoded URL@.
@end itemize
+@node racket-expand-hiding
+@subsection racket-expand-hiding
+
+The macro hiding policy for commands like @ref{racket-expand-file}.
+
@node Hash lang variables
@section Hash lang variables
diff --git a/racket-custom.el b/racket-custom.el
index 7636e4ea1a..c5e826386c 100644
--- a/racket-custom.el
+++ b/racket-custom.el
@@ -572,6 +572,45 @@ ignore POS. Examples: `racket-show-echo-area' and
:risky t
:group 'racket-other)
+(defcustom racket-expand-hiding 'standard
+ "The macro hiding policy for commands like `racket-expand-file'."
+ :tag "Racket Expand Hiding"
+ :type '(choice
+ (const :tag "Disable" disable)
+ (const :tag "Standard" standard)
+ (list :tag "Custom" :value (t t t t nil)
+ (boolean :tag "Hide racket syntax")
+ (boolean :tag "Hide library syntax")
+ (boolean :tag "Hide contracts")
+ (boolean :tag "Hide phase>0")
+ (repeat
+ :tag "More rules (see macro-debugger/model/hiding-policies
\"Entry\" and \"Condition\")"
+ (list (choice (const :tag "show-if" show-if)
+ (const :tag "hide-if" hide-if))
+ (choice (const :tag "lexical" (lexical))
+ (const :tag "unbound" (unbound))
+ (const :tag "from-kernel-module"
(from-kernel-module))
+ (list :tag "from-def-module"
+ (const from-def-module)
+ (choice :tag "module path" string symbol))
+ (list :tag "from-nom-module"
+ (const from-nom-module)
+ (choice :tag "module path" string symbol))
+ (list :tag "from-collection"
+ (const from-collection)
+ (repeat :tag "collection-string" string))
+ (list :tag "symbol=?"
+ (const symbol=?)
+ (symbol))
+ (list :tag "symbol-like"
+ (const symbol-like)
+ (string :tag "racket regexp"))
+ (list :tag "phase>=?"
+ (const phase>=?)
+ (natnum :tag "natural number"))
+ (sexp :tag "sexp"))))))
+ :group 'racket-other)
+
;;; Faces
(defgroup racket-faces nil
diff --git a/racket-stepper.el b/racket-stepper.el
index 25dd4d7c82..7009d98b5d 100644
--- a/racket-stepper.el
+++ b/racket-stepper.el
@@ -19,16 +19,18 @@
;; Need to define this before racket-stepper-mode
(defvar racket-stepper-mode-map
(racket--easy-keymap-define
- '((("C-m") racket-stepper-step)
- (("n" "j") racket-stepper-next-item)
- (("p" "k") racket-stepper-previous-item))))
+ `((("C-m") ,#'racket-stepper-step)
+ (("n" "j") ,#'racket-stepper-next-item)
+ (("p" "k") ,#'racket-stepper-previous-item)
+ ("g" ,#'racket-stepper-refresh))))
(easy-menu-define racket-stepper-mode-menu racket-stepper-mode-map
"Menu for Racket stepper mode."
- '("Racket"
- ["Step" racket-stepper-step]
- ["Next" racket-stepper-next-item]
- ["Previous" racket-stepper-previous-item]))
+ `("Racket"
+ ["Step" ,#'racket-stepper-step]
+ ["Next" ,#'racket-stepper-next-item]
+ ["Previous" ,#'racket-stepper-previous-item]
+ ["Refresh" ,#'racket-stepper-refresh]))
(defconst racket-stepper-font-lock-keywords
(eval-when-compile
@@ -59,7 +61,7 @@ Used by the commands `racket-expand-file',
;;; commands
-(defun racket-expand-file (&optional into-base)
+(defun racket-expand-file (&optional no-hiding)
"Expand the `racket-mode' buffer's file in `racket-stepper-mode'.
Uses the `macro-debugger` package to do the expansion.
@@ -71,75 +73,87 @@ If the file is non-trivial and/or is not compiled to a .zo
bytecode file, then it might take many seconds before the
original form is displayed and you can start stepping.
-With \\[universal-argument] also expands syntax from racket/base
--- which can result in very many expansion steps."
+With \\[universal-argument] behaves as if `racket-expand-hiding'
+were \\='disabled."
(interactive "P")
(racket--assert-edit-mode)
(racket--save-if-changed)
- (racket-stepper--start 'file (racket--buffer-file-name) into-base))
+ (racket-stepper--start nil no-hiding))
-(defun racket-expand-region (start end &optional into-base)
+(defun racket-expand-region (&optional no-hiding)
"Expand the active region using `racket-stepper-mode'.
Uses Racket's `expand-once` in the namespace from the most recent
-`racket-run'."
- (interactive "rP")
+`racket-run'.
+
+With \\[universal-argument] behaves as if `racket-expand-hiding'
+were \\='disabled."
+ (interactive "P")
(unless (region-active-p)
(user-error "No region"))
- (racket--assert-sexp-edit-mode)
- (racket-stepper--expand-text into-base
+ (racket--assert-edit-mode)
+ (racket-stepper--expand-text no-hiding
(lambda ()
- (cons start end))))
+ (cons (region-beginning)
+ (region-end)))))
-(defun racket-expand-definition (&optional into-base)
+(defun racket-expand-definition (&optional no-hiding)
"Expand the definition around point using `racket-stepper-mode'.
Uses Racket's `expand-once` in the namespace from the most recent
-`racket-run'."
+`racket-run'.
+
+With \\[universal-argument] behaves as if `racket-expand-hiding'
+were \\='disabled."
(interactive "P")
(racket--assert-sexp-edit-mode)
- (racket-stepper--expand-text into-base
+ (racket-stepper--expand-text no-hiding
(lambda ()
(save-excursion
(cons (progn (beginning-of-defun) (point))
(progn (end-of-defun)
(point)))))))
-(defun racket-expand-last-sexp (&optional into-base)
+(defun racket-expand-last-sexp (&optional no-hiding)
"Expand the sexp before point using `racket-stepper-mode'.
Uses Racket's `expand-once` in the namespace from the most recent
-`racket-run'."
+`racket-run'.
+
+With \\[universal-argument] behaves as if `racket-expand-hiding'
+were \\='disabled."
(interactive "P")
(racket--assert-sexp-edit-mode)
- (racket-stepper--expand-text into-base
+ (racket-stepper--expand-text no-hiding
(lambda ()
(save-excursion
(cons (progn (backward-sexp) (point))
(progn (forward-sexp) (point)))))))
-(defun racket-stepper--expand-text (prefix get-region)
+(defun racket-stepper--expand-text (no-hiding get-region)
(pcase (funcall get-region)
(`(,beg . ,end)
- (racket-stepper--start 'expr
- (buffer-substring-no-properties beg end)
- prefix))))
-
-(defvar racket--stepper-repl-session-id nil
- "The REPL session used when stepping.
+ (racket-stepper--start (buffer-substring-no-properties beg end)
+ no-hiding))))
-May be nil for \"file\" stepping, but must be valid for \"expr\"
-stepping.")
+;; When starting, save the essential parameters in these vars, to
+;; support a refresh command.
+(defvar racket--stepper-repl-session-id nil)
+(defvar racket--stepper-path nil)
+(defvar racket--stepper-expr nil)
+(defvar racket--stepper-no-hiding nil)
-(defun racket-stepper--start (which str into-base)
+(defun racket-stepper--start (expression-str no-hiding)
"Ensure buffer and issue initial command.
-WHICH should be \"expr\" or \"file\".
-STR should be the expression or pathname.
-INTO-BASE is treated as a raw command prefix arg and converted to boolp."
+
+STR should be the expression or nil for file expansion."
(racket--assert-edit-mode)
(setq racket--stepper-repl-session-id (racket--repl-session-id))
- (unless (or racket--stepper-repl-session-id
- (eq which 'file))
- (error "Only works when the edit buffer has a REPL buffer, and, you should
racket-run first"))
+ (unless (or (not expression-str)
+ racket--stepper-repl-session-id)
+ (error "Expression expansion only works when the edit buffer has a REPL
buffer, and, you already did a racket-run"))
+ (setq racket--stepper-path (racket-file-name-front-to-back
(racket--buffer-file-name)))
+ (setq racket--stepper-expr expression-str)
+ (setq racket--stepper-no-hiding no-hiding)
;; Create buffer if necessary
(let ((name (racket--stepper-buffer-name)))
(unless (get-buffer name)
@@ -148,28 +162,41 @@ INTO-BASE is treated as a raw command prefix arg and
converted to boolp."
;; Give it a window if necessary
(unless (get-buffer-window name)
(pop-to-buffer (get-buffer name)))
- ;; Select the stepper window and insert
+ ;; Select the stepper window and start.
(select-window (get-buffer-window name))
- (let ((inhibit-read-only t))
- (delete-region (point-min) (point-max))
- (insert "Starting macro expansion stepper... please wait...\n"))
- (racket--cmd/async racket--stepper-repl-session-id
- `(macro-stepper (,which . ,(if (eq which 'file)
-
(racket-file-name-front-to-back str)
- str))
- ,(and into-base t))
- #'racket-stepper--insert)))
-
-(defun racket-stepper--insert (nothing-or-steps)
- (if (eq nothing-or-steps 'nothing)
+ (racket-stepper-refresh)))
+
+(defun racket-stepper-refresh ()
+ (interactive)
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max))
+ (insert "Starting macro expansion stepper... please wait...\n"))
+ (racket--cmd/async racket--stepper-repl-session-id
+ `(macro-stepper ,racket--stepper-path
+ ,racket--stepper-expr
+ ,(if racket--stepper-no-hiding
+ 'disable
+ racket-expand-hiding))
+ #'racket-stepper--insert))
+
+(defun racket-stepper--insert (steps)
+ (if (null steps)
(message "Nothing to expand")
(with-current-buffer (racket--stepper-buffer-name)
(let ((inhibit-read-only t))
(goto-char (point-max))
- (dolist (step nothing-or-steps)
+ (dolist (step steps)
(pcase step
(`(original . ,text)
(delete-region (point-min) (point-max))
+ (if racket--stepper-no-hiding
+ (insert "macro hiding disabled by command prefix")
+ (insert-text-button "racket-expand-hiding"
+ 'action #'racket-stepper-customize-hiding)
+ (insert ": ")
+ (princ (if racket--stepper-no-hiding 'disable
racket-expand-hiding)
+ (current-buffer)))
+ (insert "\n\n")
(insert "Original\n" text "\n" "\n"))
(`(final . ,text) (insert "Final\n" text "\n"))
(`(,label . ,diff) (insert label "\n" diff "\n"))))
@@ -177,6 +204,9 @@ INTO-BASE is treated as a raw command prefix arg and
converted to boolp."
(when (equal (selected-window) (get-buffer-window (current-buffer)))
(recenter))))))
+(defun racket-stepper-customize-hiding (_btn)
+ (customize-variable 'racket-expand-hiding))
+
(defun racket-stepper-step (prefix)
(interactive "P")
(racket--cmd/async racket--stepper-repl-session-id
diff --git a/racket/command-server.rkt b/racket/command-server.rkt
index dce5dc0eb8..76e9a22291 100644
--- a/racket/command-server.rkt
+++ b/racket/command-server.rkt
@@ -136,7 +136,7 @@
[`(no-op) #t]
[`(logger ,v) (channel-put logger-command-channel v)]
[`(check-syntax ,path-str ,code) (check-syntax path-str code)]
- [`(macro-stepper ,str ,into-base?) (macro-stepper str into-base?)]
+ [`(macro-stepper ,path ,str ,pol) (macro-stepper path str pol)]
[`(macro-stepper/next ,what) (macro-stepper/next what)]
[`(module-names) (module-names)]
[`(requires/tidy ,reqs) (requires/tidy reqs)]
diff --git a/racket/commands/macro.rkt b/racket/commands/macro.rkt
index 8de37d196b..03e17a06b3 100644
--- a/racket/commands/macro.rkt
+++ b/racket/commands/macro.rkt
@@ -5,6 +5,8 @@
(require (only-in macro-debugger/stepper-text
stepper-text)
+ (only-in macro-debugger/model/hiding-policies
+ policy->predicate)
racket/contract
racket/file
racket/format
@@ -22,61 +24,49 @@
macro-stepper/next)
(define step/c (cons/c (or/c 'original string? 'final) string?))
-(define step-proc/c (-> (or/c 'next 'all)
- (or/c 'nothing (listof step/c))))
-(define step-proc #f)
-(define (nothing-step-proc _) 'nothing)
+(define step-proc/c (-> (or/c 'next 'all) (listof step/c)))
-(define/contract (make-expr-stepper str)
- (-> string? step-proc/c)
- (unless (current-session-id)
- (error 'make-expr-stepper "Does not work without a running REPL"))
- (define step-num #f)
- (define last-stx (string->namespace-syntax str))
- (define/contract (step what) step-proc/c
- (cond [(not step-num)
- (set! step-num 0)
- (list (cons 'original
- (pretty-format-syntax last-stx)))]
- [else
- (define result
- (let loop ()
- (define this-stx (expand-once last-stx))
- (cond [(equal? (syntax->datum last-stx)
- (syntax->datum this-stx))
- (cond [(eq? what 'all)
- (list (cons 'final
- (pretty-format-syntax this-stx)))]
- [else (list)])]
- [else
- (set! step-num (add1 step-num))
- (define step
- (cons (~a step-num ": expand-once")
- (diff-text (pretty-format-syntax last-stx)
- (pretty-format-syntax this-stx)
- #:unified 3)))
- (set! last-stx this-stx)
- (cond [(eq? what 'all) (cons step (loop))]
- [else (list step)])])))
- (match result
- [(list) (list (cons 'final
- (pretty-format-syntax last-stx)))]
- [v v])]))
- step)
+(define (nothing-step-proc _) null)
+
+(define step-proc nothing-step-proc)
-(define/contract (make-file-stepper path into-base?)
- (-> (and/c path-string? absolute-path?) boolean? step-proc/c)
- (assert-file-stepper-works)
- (define stx (file->syntax path))
+(define/contract (macro-stepper path expression-str hiding-policy)
+ (-> (and/c path-string? complete-path?) any/c any/c
+ (list/c step/c))
+ (assert-macro-debugger-stepper-works)
+ (define-values (stx ns)
+ (cond
+ [(string? expression-str)
+ (unless (current-session-id)
+ (error 'macro-stepper "Does not work without a running REPL"))
+ (values (string->namespace-syntax expression-str)
+ (current-namespace))]
+ [else
+ (values (file->syntax path)
+ (make-base-namespace))]))
+ (set! step-proc
+ (make-stepper path stx ns hiding-policy))
+ (macro-stepper/next 'next))
+
+(define/contract (macro-stepper/next what) step-proc/c
+ (define v (step-proc what))
+ (match v
+ [(list (cons 'final _)) (set! step-proc nothing-step-proc)]
+ [_ (void)])
+ v)
+
+(define/contract (make-stepper path stx ns elisp-hiding-policy)
+ (-> (and/c path-string? complete-path?) syntax? namespace? any/c
+ step-proc/c)
(define dir (path-only path))
- (define ns (make-base-namespace))
+ (define policy (elisp-policy->policy elisp-hiding-policy))
+ (define predicate (policy->predicate policy))
(define raw-step (parameterize ([current-load-relative-directory dir]
[current-namespace ns])
- (stepper-text stx
- (if into-base? (λ _ #t) (not-in-base)))))
+ (stepper-text stx predicate)))
(define step-num #f)
(define step-last-after (pretty-format-syntax stx))
- (log-racket-mode-debug "~v ~v ~v" path into-base? raw-step)
+ (log-racket-mode-debug "~v ~v ~v" path policy raw-step)
(define/contract (step what) step-proc/c
(cond [(not step-num)
(set! step-num 0)
@@ -105,6 +95,26 @@
(list (cons 'final step-last-after))])]))
step)
+(define (elisp-policy->policy e)
+ ;; See macro-debugger/model/hiding-policies.rkt):
+ ;;
+ ;; A Policy is one of
+ ;; 'disable
+ ;; 'standard
+ ;; (list 'custom boolean boolean boolean boolean (listof Entry))
+ ;;
+ ;; Of the Entry rules, although the free=? one can't work because it
+ ;; needs a live syntax object identifier, I think most of the rest
+ ;; should be fine.
+ (match e
+ [(or 'disable 'standard) e]
+ [(list (app as-racket-bool hide-racket?)
+ (app as-racket-bool hide-libs?)
+ (app as-racket-bool hide-contracts?)
+ (app as-racket-bool hide-phase1?)
+ rules)
+ (list 'custom hide-racket? hide-libs? hide-contracts? hide-phase1?
rules)]))
+
(define (read-step)
(define title (read-line))
(define before (read))
@@ -117,39 +127,6 @@
(pretty-format #:mode 'write before)
(pretty-format #:mode 'write after))]))
-(define (assert-file-stepper-works)
- (define step (stepper-text #'(module example racket/base 42)))
- (unless (step 'next)
- (error 'macro-debugger/stepper-text
- "does not work in your version of Racket.\nPlease try an older or
newer version.")))
-
-(define/contract (macro-stepper what into-base?)
- (-> (or/c (cons/c 'expr string?) (cons/c 'file path-string?)) elisp-bool/c
- (list/c step/c))
- (set! step-proc
- (match what
- [(cons 'expr str) (make-expr-stepper str)]
- [(cons 'file path) (make-file-stepper path (as-racket-bool
into-base?))]))
- (macro-stepper/next 'next))
-
-(define/contract (macro-stepper/next what) step-proc/c
- (define v (step-proc what))
- (match v
- [(list (cons 'final _)) (set! step-proc nothing-step-proc)]
- [_ (void)])
- v)
-
-;; Borrowed from xrepl.
-(define not-in-base
- (λ () (let ([base-stxs #f])
- (unless base-stxs
- (set! base-stxs ; all ids that are bound to a syntax in racket/base
- (parameterize ([current-namespace (make-base-namespace)])
- (let-values ([(vals stxs) (module->exports 'racket/base)])
- (map (λ (s) (namespace-symbol->identifier (car s)))
- (cdr (assq 0 stxs)))))))
- (λ (id) (not (ormap (λ (s) (free-identifier=? id s)) base-stxs))))))
-
(define (diff-text before-text after-text #:unified [-U 3])
(define template "racket-mode-syntax-diff-~a")
(define (make-temporary-file-with-text str)
@@ -176,3 +153,9 @@
(define (pretty-format-syntax stx)
(pretty-format #:mode 'write (syntax->datum stx)))
+
+(define (assert-macro-debugger-stepper-works)
+ (define step (stepper-text #'(module example racket/base 42)))
+ (unless (step 'next)
+ (error 'macro-debugger/stepper-text
+ "does not work in your version of Racket.\nPlease try an older or
newer version.")))
diff --git a/test/racket-tests.el b/test/racket-tests.el
index f302bc16e9..f55f3596cf 100644
--- a/test/racket-tests.el
+++ b/test/racket-tests.el
@@ -393,7 +393,7 @@ c.rkt. Visit each file, racket-run, and check as expected."
(call-process racket-program nil t nil "--version")
(buffer-substring-no-properties (point-min) (point-max)))))
-(defun racket-tests/expected-result-for-expand-p (result)
+(defun racket-tests/expected-result-for-expand-file-p (result)
"Test expected to fail because macro-debugger broken in Racket 7.6.
For use with :expected-result '(satisfies PRED). This matters
because ert-deftest is a macro evaluated at compile time, and we
@@ -402,18 +402,34 @@ want to use the value of `racket-program' at run time."
(ert-test-failed-p result)
(ert-test-passed-p result)))
+(defun racket-tests/racket-8.11.1-or-newer-p ()
+ (zerop
+ (call-process
+ racket-program nil nil nil
+ "-e" "(require version/utils) (unless (version<? \"8.11\" (version)) (exit
255))")))
+
+(defun racket-tests/expected-result-for-expand-expression-p (result)
+ "Test expected to fail because expansion differs in older Racket."
+ (if (racket-tests/racket-8.11.1-or-newer-p)
+ (ert-test-passed-p result)
+ (ert-test-failed-p result)))
+
;;; Macro stepper: File "shallow"
(defconst racket-tests/expand-mod-name "foo")
(defconst racket-tests/expand-shallow-0
- "«f:Original»
+ "«:button:racket-expand-hiding»: standard
+
+«f:Original»
(module foo racket/base (#%module-begin (define x 42) x))
")
(defconst racket-tests/expand-shallow-1
- "«f:Original»
+ "«:button:racket-expand-hiding»: standard
+
+«f:Original»
(module foo racket/base (#%module-begin (define x 42) x))
«f:Final»
@@ -421,7 +437,7 @@ want to use the value of `racket-program' at run time."
")
(ert-deftest racket-tests/expand-file-shallow ()
- :expected-result '(satisfies racket-tests/expected-result-for-expand-p)
+ :expected-result '(satisfies racket-tests/expected-result-for-expand-file-p)
(message "racket-tests/expand-file-shallow")
(racket-tests/with-back-end-settings
(let* ((dir (make-temp-file "test" t))
@@ -429,7 +445,8 @@ want to use the value of `racket-program' at run time."
(code "#lang racket/base\n(define x 42)\nx"))
(write-region code nil path nil 'no-wrote-file-message)
(find-file path)
- (racket-expand-file)
+ (let ((racket-expand-hiding 'standard))
+ (racket-expand-file))
(set-buffer "*Racket Stepper </>*")
(should (eq major-mode 'racket-stepper-mode))
(should (equal header-line-format "Press RET to step. C-u RET to step
all. C-h m to see help."))
@@ -444,13 +461,17 @@ want to use the value of `racket-program' at run time."
;;; Macro stepper: File "deep"
(defconst racket-tests/expand-deep-0
- "«f:Original»
+ "«f:macro hiding disabled by command prefix»
+
+«f:Original»
(module foo racket/base (#%module-begin (define x 42) x))
")
(defconst racket-tests/expand-deep-1
- "«f:Original»
+ "«f:macro hiding disabled by command prefix»
+
+«f:Original»
(module foo racket/base (#%module-begin (define x 42) x))
«f:1: Macro transformation»
@@ -469,7 +490,9 @@ want to use the value of `racket-program' at run time."
")
(defconst racket-tests/expand-deep-2
- "«f:Original»
+ "«f:macro hiding disabled by command prefix»
+
+«f:Original»
(module foo racket/base (#%module-begin (define x 42) x))
«f:1: Macro transformation»
@@ -511,7 +534,7 @@ want to use the value of `racket-program' at run time."
(unless (eq system-type 'windows-nt) ;requires `diff` program
(ert-deftest racket-tests/expand-file-deep ()
- :expected-result '(satisfies racket-tests/expected-result-for-expand-p)
+ :expected-result '(satisfies
racket-tests/expected-result-for-expand-file-p)
(message "racket-tests/expand-file-deep")
(racket-tests/with-back-end-settings
(let* ((dir (make-temp-file "test" t))
@@ -536,85 +559,82 @@ want to use the value of `racket-program' at run time."
;;; Macro stepper: Expression
-(defconst racket-tests/expand-expression-0
- "«f:Original»
-(cond ((< 1 2) #t) (else #f))
+(defconst racket-tests/expand-expression-original
+ "«f:macro hiding disabled by command prefix»
-")
-
-(defconst racket-tests/expand-expression-1
- "«f:Original»
+«f:Original»
(cond ((< 1 2) #t) (else #f))
-«f:1: expand-once»
-«x:@@ -1 +1 @@»
-«:diff-removed:-(cond ((< 1 2) #t) (else #f))»
-«:diff-added:+(if (< 1 2) (let-values () #t) (let-values () #f))»
-
")
-(defconst racket-tests/expand-expression-2
- "«f:Original»
+(defconst racket-tests/expand-expression-final
+ "«f:macro hiding disabled by command prefix»
+
+«f:Original»
(cond ((< 1 2) #t) (else #f))
-«f:1: expand-once»
+«f:1: Macro transformation»
«x:@@ -1 +1 @@»
«:diff-removed:-(cond ((< 1 2) #t) (else #f))»
-«:diff-added:+(if (< 1 2) (let-values () #t) (let-values () #f))»
+«:diff-added:+(if:1 (< 1 2) (let-values:1 () #t) (let-values:1 () #f))»
-«f:2: expand-once»
+«f:2: Add explicit #%app»
«x:@@ -1 +1 @@»
-«:diff-removed:-(if (< 1 2) (let-values () #t) (let-values () #f))»
-«:diff-added:+(if (#%app < 1 2) (let-values () '#t) (let-values () '#f))»
-
-")
+«:diff-removed:-(if:1 (< 1 2) (let-values:1 () #t) (let-values:1 () #f))»
+«:diff-added:+(if:1 (#%app < 1 2) (let-values:1 () #t) (let-values:1 () #f))»
-(defconst racket-tests/expand-expression-3
- "«f:Original»
-(cond ((< 1 2) #t) (else #f))
+«f:3: Macro transformation»
+«x:@@ -1 +1 @@»
+«:diff-removed:-(if:1 (#%app < 1 2) (let-values:1 () #t) (let-values:1 () #f))»
+«:diff-added:+(if:1 (#%app:2 < 1 2) (let-values:1 () #t) (let-values:1 () #f))»
-«f:1: expand-once»
+«f:4: Add explicit #%datum»
«x:@@ -1 +1 @@»
-«:diff-removed:-(cond ((< 1 2) #t) (else #f))»
-«:diff-added:+(if (< 1 2) (let-values () #t) (let-values () #f))»
+«:diff-removed:-(if:1 (#%app:2 < 1 2) (let-values:1 () #t) (let-values:1 ()
#f))»
+«:diff-added:+(if:1 (#%app:2 < (#%datum . 1) 2) (let-values:1 () #t)
(let-values:1 () #f))»
-«f:2: expand-once»
+«f:5: Macro transformation»
«x:@@ -1 +1 @@»
-«:diff-removed:-(if (< 1 2) (let-values () #t) (let-values () #f))»
-«:diff-added:+(if (#%app < 1 2) (let-values () '#t) (let-values () '#f))»
+«:diff-removed:-(if:1 (#%app:2 < (#%datum . 1) 2) (let-values:1 () #t)
(let-values:1 () #f))»
+«:diff-added:+(if:1 (#%app:2 < '1 2) (let-values:1 () #t) (let-values:1 ()
#f))»
-«f:3: expand-once»
+«f:6: Add explicit #%datum»
«x:@@ -1 +1 @@»
-«:diff-removed:-(if (#%app < 1 2) (let-values () '#t) (let-values () '#f))»
-«:diff-added:+(if (#%app < '1 '2) (let-values () '#t) (let-values () '#f))»
+«:diff-removed:-(if:1 (#%app:2 < '1 2) (let-values:1 () #t) (let-values:1 ()
#f))»
+«:diff-added:+(if:1 (#%app:2 < '1 (#%datum . 2)) (let-values:1 () #t)
(let-values:1 () #f))»
-")
+«f:7: Macro transformation»
+«x:@@ -1 +1 @@»
+«:diff-removed:-(if:1 (#%app:2 < '1 (#%datum . 2)) (let-values:1 () #t)
(let-values:1 () #f))»
+«:diff-added:+(if:1 (#%app:2 < '1 '2) (let-values:1 () #t) (let-values:1 ()
#f))»
-(defconst racket-tests/expand-expression-4
- "«f:Original»
-(cond ((< 1 2) #t) (else #f))
+«f:8: Add explicit #%datum»
+«x:@@ -1 +1 @@»
+«:diff-removed:-(if:1 (#%app:2 < '1 '2) (let-values:1 () #t) (let-values:1 ()
#f))»
+«:diff-added:+(if:1 (#%app:2 < '1 '2) (let-values:1 () (#%datum . #t))
(let-values:1 () #f))»
-«f:1: expand-once»
+«f:9: Macro transformation»
«x:@@ -1 +1 @@»
-«:diff-removed:-(cond ((< 1 2) #t) (else #f))»
-«:diff-added:+(if (< 1 2) (let-values () #t) (let-values () #f))»
+«:diff-removed:-(if:1 (#%app:2 < '1 '2) (let-values:1 () (#%datum . #t))
(let-values:1 () #f))»
+«:diff-added:+(if:1 (#%app:2 < '1 '2) (let-values:1 () '#t) (let-values:1 ()
#f))»
-«f:2: expand-once»
+«f:10: Add explicit #%datum»
«x:@@ -1 +1 @@»
-«:diff-removed:-(if (< 1 2) (let-values () #t) (let-values () #f))»
-«:diff-added:+(if (#%app < 1 2) (let-values () '#t) (let-values () '#f))»
+«:diff-removed:-(if:1 (#%app:2 < '1 '2) (let-values:1 () '#t) (let-values:1 ()
#f))»
+«:diff-added:+(if:1 (#%app:2 < '1 '2) (let-values:1 () '#t) (let-values:1 ()
(#%datum . #f)))»
-«f:3: expand-once»
+«f:11: Macro transformation»
«x:@@ -1 +1 @@»
-«:diff-removed:-(if (#%app < 1 2) (let-values () '#t) (let-values () '#f))»
-«:diff-added:+(if (#%app < '1 '2) (let-values () '#t) (let-values () '#f))»
+«:diff-removed:-(if:1 (#%app:2 < '1 '2) (let-values:1 () '#t) (let-values:1 ()
(#%datum . #f)))»
+«:diff-added:+(if:1 (#%app:2 < '1 '2) (let-values:1 () '#t) (let-values:1 ()
'#f))»
«f:Final»
-(if (#%app < '1 '2) (let-values () '#t) (let-values () '#f))
+(if:1 (#%app:2 < '1 '2) (let-values:1 () '#t) (let-values:1 () '#f))
")
(unless (eq system-type 'windows-nt) ;requires `diff` program
(ert-deftest racket-tests/expand-expression ()
+ :expected-result '(satisfies
racket-tests/expected-result-for-expand-expression-p)
(message "racket-tests/expand-expression")
(racket-tests/with-back-end-settings
(let* ((path (make-temp-file "test" nil ".rkt"))
@@ -630,25 +650,17 @@ want to use the value of `racket-program' at run time."
(should (racket-tests/see-back (concat "\n" name "> "))))
(goto-char (point-max)) ;after the cond expression
- (racket-expand-last-sexp)
+ (racket-expand-last-sexp 4) ;; i.e. C-u prefix
(set-buffer "*Racket Stepper </>*")
(should (eq major-mode 'racket-stepper-mode))
(should (equal header-line-format "Press RET to step. C-u RET to step
all. C-h m to see help."))
- (racket-tests/should-eventually
- (faceup-test-font-lock-buffer nil racket-tests/expand-expression-0))
- (racket-tests/press "RET")
- (racket-tests/should-eventually
- (faceup-test-font-lock-buffer nil racket-tests/expand-expression-1))
- (racket-tests/press "RET")
(racket-tests/should-eventually
- (faceup-test-font-lock-buffer nil racket-tests/expand-expression-2))
- (racket-tests/press "RET")
- (racket-tests/should-eventually
- (faceup-test-font-lock-buffer nil racket-tests/expand-expression-3))
- (racket-tests/press "RET")
+ (faceup-test-font-lock-buffer nil
racket-tests/expand-expression-original))
+
+ (racket-tests/press "C-u RET")
(racket-tests/should-eventually
- (faceup-test-font-lock-buffer nil racket-tests/expand-expression-4))
+ (faceup-test-font-lock-buffer nil
racket-tests/expand-expression-final))
(quit-window)
(with-racket-repl-buffer