Change dynamic-require wrappers; DRY doc index tests

racket/commands/requires.rkt

@@ -69,10 +69,10 @@
                                          (list/c 'drop   module-path? number?))))
 (define mod+level? (list/c module-path? number?))
 
-
-(define-polyfill (show-requires _)
-  #:module macro-debugger/analysis/check-requires
-  (error 'requires "Won't work until you `raco pkg install macro-debugger-lib`"))
+(define show-requires
+  (safe-dynamic-require 'macro-debugger/analysis/check-requires
+                        'show-requires
+                        (λ () (error 'requires "Won't work until you `raco pkg install macro-debugger-lib`"))))
 
 (define/contract (analyze path-str)
   (-> path-string? requires-analysis?)

racket/define-fallbacks.rkt

@@ -0,0 +1,38 @@
+;; Copyright (c) 2024 by Greg Hendershott.
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+#lang racket/base
+
+(require (for-syntax racket/base
+                     "safe-dynamic-require.rkt")
+         syntax/parse/define)
+
+(provide define-fallbacks)
+
+;; safe-dynamic-require is most useful in scenarios where an entire
+;; module might not be installed. Note that tools like
+;; go-to-definition will always go to the safe-dynamic-require site,
+;; because that is the binding site. Any binding from a normal
+;; (non-dynamic) require is shadowed by the dynamic require.
+;;
+;; Another scenario is where a module is always installed, but over
+;; time has added exports; therefore an older version might be
+;; installed. In this case it can be nicer to do a plain, non-dynamic
+;; require of the module, and use define-fallbacks to create
+;; definitions /only/ for identifiers not supplied by the installed
+;; version of the module. As a result, tools like go-to-definition
+;; will handle normally imported bindings in the usual way (go to the
+;; definition in that other module's source), which is very
+;; convenient.
+
+(define-syntax-parser define-fallback
+  [(_ mod:id (id:id arg:expr ...) body:expr ...+)
+   (if (safe-dynamic-require (syntax-e #'mod) (syntax-e #'id))
+       #'(begin)
+       #'(define (id arg ...)
+           body ...))])
+
+(define-syntax-parser define-fallbacks
+  [(_ mod:id [(id:id arg:expr ...) body:expr ...+] ...+)
+   #`(begin
+       (define-fallback mod (id arg ...) body ...) ...)])

racket/find-module-path-completions.rkt

@@ -22,8 +22,7 @@
 ;;; devoted to this. For example "HELLO?\n" => "OK\n\n" / "ERROR\n\n".
 ;;; Thereafter the status quo loop.)
 
-(require racket/match
-         "util.rkt")
+(require "safe-dynamic-require.rkt")
 
 (module+ main
   (define dir (current-directory)) ;FIXME: Get from command-line
@@ -37,9 +36,10 @@
       (loop)))
   (exit 0))
 
-(define-polyfill (find-module-path-completions dir)
-  #:module drracket/find-module-path-completions
-  (λ (_str) (list)))
+(define find-module-path-completions
+  (safe-dynamic-require 'drracket/find-module-path-completions
+                        'find-module-path-completions
+                        (λ () (λ (_dir) (λ (_str) null)))))
 
 (define (init dir)
   (define get (find-module-path-completions dir))

racket/interaction.rkt

@@ -6,6 +6,7 @@
 (require racket/format
          racket/gui/dynamic
          racket/set
+         "safe-dynamic-require.rkt"
          "gui.rkt"
          "repl-output.rkt"
          "repl-session.rkt"
@@ -42,7 +43,7 @@
     [else v]))
 
 (define current-get-interaction-evt
-  (dynamic-require 'racket/base 'current-get-interaction-evt (λ () #f)))
+  (safe-dynamic-require 'racket/base 'current-get-interaction-evt))
 
 ;; Get a string from current-submissions channel in the best manner
 ;; available given the version of Racket. Avoids hard dependency on

racket/safe-dynamic-require.rkt

@@ -0,0 +1,33 @@
+;; Copyright (c) 2024 by Greg Hendershott.
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+#lang racket/base
+
+(require (for-syntax racket/base)
+         syntax/parse/define)
+
+(provide safe-dynamic-require
+         module-installed?
+         rhombus-installed?)
+
+;; Although dynamic-require calls `fail-thunk` when `id` does not
+;; exist in `mod`, it raises exn:fail if `mod` doesn't exist.
+;;
+;; This wrapper calls fail-thunk called consistently.
+;;
+;; We define this in a submodule in order to require it at both phase
+;; 0 and 1, the latter for use in the define-fallbacks macro below.
+(define (safe-dynamic-require mod id [fail-thunk (λ () #f)])
+  (with-handlers ([exn:fail? (λ _ (fail-thunk))])
+    (dynamic-require mod id fail-thunk)))
+
+;; Some predicates useful for e.g. tests that may run against various
+;; versions of Racket.
+
+(define (module-installed? mod)
+  (and (safe-dynamic-require mod #f)
+       #t))
+
+(define rhombus-installed?
+  (let ([v (module-installed? 'rhombus)])
+    (λ () v)))

racket/scribble.rkt

@@ -248,50 +248,27 @@
 
 (module+ test
   (define older?
-    (not (dynamic-require 'scribble/manual-struct 'index-desc? (λ () #f))))
-  (let ([results (doc-index-lookup "match")])
-    (check-true (for/or ([v (in-list results)])
-                  (match v
-                    [(list "match" "syntax" "racket/match, racket" family
-                           _path _anchor)
-                     (equal? family (if older? "" "Racket"))]
-                    [_ #f]))
-                (format "~v" results))
-    (when (rhombus-installed?)
-      (check-true (for/or ([v (in-list results)])
-                    (match v
-                      [(list "match" kind "rhombus" family
-                             _path _anchor)
-                       (and (equal? family (if older? "" "Rhombus"))
-                            (equal? kind (if older? "value" "expression")))]
-                      [_ #f]))
-                  (format "~v" results))))
-  (let ([results (doc-index-lookup "set-label")])
-    (check-true (for/or ([v (in-list results)])
-                  (match v
-                    [(list "set-label" "method of message%" "racket/gui/base, racket/gui" family
-                           _path _anchor)
-                     (equal? family (if older? "" "Racket"))]
-                    [_ #f]))
-                (format "~v" results)))
-  (let ([results (doc-index-lookup "print")])
-    (check-true (for/or ([v (in-list results)])
-                  (match v
-                    [(list "print" "procedure" "racket/base, racket" family
-                           _path _anchor)
-                     (equal? family (if older? "" "Racket"))]
-                    [_ #f]))
-                (format "~v" results))
-    (when (rhombus-installed?)
-      (check-true (for/or ([v (in-list results)])
-                    (match v
-                      [(list "print" kind libs family
-                             _path _anchor)
-                       (and (equal? libs (if older? "(lib rhombus/rx.rhm)" "rhombus/rx"))
-                            (equal? family (if older? "" "Rhombus"))
-                            (equal? kind (if older? "value" "regexp charset operator")))]
-                      [_ #f]))
-                  (format "~v" results)))))
+    (not (safe-dynamic-require 'scribble/manual-struct 'index-desc?)))
+  (define (check-lookup term kind libs fams)
+    (define results (doc-index-lookup term))
+    (check-true
+     (for/or ([v (in-list results)])
+       (match v
+         [(list (== term) (== kind) (== libs) (== (if older? "" fams))
+                _path _anchor)
+          #t]
+         [_ #f]))
+     (format "~s not found in ~s" (list term kind libs fams) results)))
+  (check-lookup "match" "syntax" "racket/match, racket" "Racket")
+  (when (rhombus-installed?)
+    (check-lookup "match" (if older? "value" "expression") "rhombus" "Rhombus"))
+  (check-lookup "set-label" "method of message%" "racket/gui/base, racket/gui" "Racket")
+  (check-lookup "print" "procedure" "racket/base, racket" "Racket")
+  (when (rhombus-installed?)
+    (check-lookup "print"
+                  (if older? "value" "regexp charset operator")
+                  (if older? "(lib rhombus/rx.rhm)" "rhombus/rx")
+                  "Rhombus")))
 
 ;;; This is for the requires/find command
 

racket/util.rkt

@@ -1,11 +1,13 @@
-;; Copyright (c) 2013-2022 by Greg Hendershott.
+;; Copyright (c) 2013-2024 by Greg Hendershott.
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 
 #lang racket/base
 
 (require (for-syntax racket/base)
          syntax/parse/define
-         racket/format)
+         racket/format
+         "define-fallbacks.rkt"
+         "safe-dynamic-require.rkt")
 
 (provide string->namespace-syntax
          syntax-or-sexpr->syntax
@@ -20,9 +22,8 @@
          log-racket-mode-fatal
          time-apply/log
          with-time/log
-         define-polyfill
-         define-fallbacks
-         rhombus-installed?)
+         (all-from-out "define-fallbacks.rkt")
+         (all-from-out "safe-dynamic-require.rkt"))
 
 (define (string->namespace-syntax str)
   (namespace-syntax-introduce
@@ -57,42 +58,3 @@
 
 (define-simple-macro (with-time/log what e ...+)
   (time-apply/log what (λ () e ...) '()))
-
-;;; dynamic-require with backup implementation
-
-(define-simple-macro (define-polyfill (id:id arg:expr ...)
-                       #:module mod:id
-                       body:expr ...+)
-  (define id
-    (with-handlers ([exn:fail? (λ (_exn)
-                                 (λ (arg ...) body ...))])
-      (dynamic-require 'mod 'id))))
-
-;;; similar, but defining fallbacks only for items not imported by a
-;;; normal require
-
-;; advantage: Things like go-to definition work as expected in the
-;; normal, non-fallback case. Whereas with define-polyfill, the
-;; identifier _always_ results from the dynamic-require, and go-to def
-;; always goes there.
-
-(define-syntax-parser define-fallback
-  [(_ mod:id (id:id arg:expr ...) body:expr ...+)
-   (if (with-handlers ([exn:fail? (λ _ #f)])
-         (dynamic-require (syntax-e #'mod) (syntax-e #'id)))
-       #'(void)
-       #'(define (id arg ...)
-           body ...))])
-
-(define-syntax-parser define-fallbacks
-  [(_ mod:id [(id:id arg:expr ...) body:expr ...+] ...+)
-   #'(begin
-       (define-fallback mod (id arg ...) body ...) ...)])
-
-;;; Predicate mainly intended for use by tests
-
-(define rhombus-installed?
-  (let ([v (with-handlers ([exn:fail? (λ _ #f)])
-             (dynamic-require 'rhombus #f)
-             #t)])
-    (λ () v)))