Add and use relax-arg-type/any.

networks.rkt

@@ -679,15 +679,18 @@
 
   (: pretty-print-state-graph-with (-> Graph (-> Any Any) Graph))
   (define (pretty-print-state-graph-with gr pprinter)
-    (define (e-pprinter/any [x : Any])
+    (update-graph
-      (pretty-print-set-sets (assert-type x (Setof (Setof Any)))))
+     gr
-    (update-graph gr #:v-func pprinter #:e-func e-pprinter/any))
+     #:v-func pprinter
+     #:e-func (relax-arg-type/any pretty-print-set-sets (Setof (Setof Any)))))
 
   (: pretty-print-state-graph (-> Graph Graph))
   (define (pretty-print-state-graph gr)
     (define (pprinter/any [x : Any])
       (pretty-print-state (assert-type x (State Any))))
-    (pretty-print-state-graph-with gr pprinter/any))
+    (pretty-print-state-graph-with
+     gr
+     (relax-arg-type/any pretty-print-state (State Any))))
 
   (define ppsg pretty-print-state-graph)
 

scribblings/utils.scrbl

@@ -107,6 +107,21 @@ is abstract.
 (eval:error (send obj abstract-increment 1))
 ]}
 
+@defform[(relax-arg-type/any name arg-type)]{
+
+Defines a unary anonymous function whose argument type is @racket[Any], and
+which calls @racket[name], with the argument coerced to @racket[arg-type].
+
+@ex[
+(relax-arg-type/any add1 Number)
+]
+
+The main use of this macro is to allow easily passing different one-argument
+functions as arguments of the type @racket[(-> Any Any)].  See for example
+@racket[update-graph].
+
+}
+
 @section{Hashtable injection}
 
 This section defines some utilities to streamline the usage of hash tables

utils.rkt

@@ -7,6 +7,7 @@
  Variable VariableMapping GeneralPair
 
  assert-type for/first/typed for*/first/typed define/abstract/error
+ relax-arg-type/any
  eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/:
  extract-symbols any->string stringify-variable-mapping string->any
  handle-org-booleans map-sexp read-org-sexp unorg unstringify-pairs
@@ -65,6 +66,9 @@
   [(_ (name:id args:id ...))
    #`(define/public (name args ...) (error 'name "abstract method"))])
 
+(define-syntax-parse-rule (relax-arg-type/any name:id arg-type:expr)
+  (λ ([x : Any]) (name (assert-type x arg-type))))
+
 (: eval-with (-> (VariableMapping Any) Any AnyValues))
 (define (eval-with ht expr)
   (parameterize ([current-namespace (make-base-namespace)])