Fix 9 occurrences of define-lambda-to-define

The `define` form supports a shorthand for defining functions.

Author: resyntax-ci[bot]

typed-racket-lib/typed-racket/typecheck/integer-refinements.rkt

@@ -71,143 +71,127 @@
            #:attr obj (if (Object? o) o -empty-obj)))
 
 ;; < <= >= =
-(define (numeric-comparison-function prop-constructor)
-  (λ (args-stx result)
-    (syntax-parse args-stx
-      [((~var e1 (w/obj+type -Int)) (~var e2 (w/obj+type -Int)))
-       (define p (prop-constructor (attribute e1.obj) (attribute e2.obj)))
-       (add-p/not-p result p)]
-      [((~var e1 (w/type -Int)) (~var e2 (w/type -Int)) (~var e3 (w/type -Int)))
-       #:when (or (and (Object? (attribute e1.obj)) (Object? (attribute e2.obj)))
-                  (and (Object? (attribute e2.obj)) (Object? (attribute e3.obj))))
-       (define p (-and (prop-constructor (attribute e1.obj) (attribute e2.obj))
-                       (prop-constructor (attribute e2.obj) (attribute e3.obj))))
-       (add-p/not-p result p)]
-      [_  result])))
+(define ((numeric-comparison-function prop-constructor) args-stx result)
+  (syntax-parse args-stx
+    [((~var e1 (w/obj+type -Int)) (~var e2 (w/obj+type -Int)))
+     (define p (prop-constructor (attribute e1.obj) (attribute e2.obj)))
+     (add-p/not-p result p)]
+    [((~var e1 (w/type -Int)) (~var e2 (w/type -Int)) (~var e3 (w/type -Int)))
+     #:when (or (and (Object? (attribute e1.obj)) (Object? (attribute e2.obj)))
+                (and (Object? (attribute e2.obj)) (Object? (attribute e3.obj))))
+     (define p
+       (-and (prop-constructor (attribute e1.obj) (attribute e2.obj))
+             (prop-constructor (attribute e2.obj) (attribute e3.obj))))
+     (add-p/not-p result p)]
+    [_ result]))
 
 ;; +/-
-(define (plus/minus plus?)
-  (λ (args-stx result)
-    (match result
-      [(tc-result1: ret-t ps orig-obj)
-       (syntax-parse args-stx
-         ;; +/- (2 args)
-         [((~var e1 (w/obj+type -Int))
-           (~var e2 (w/obj+type -Int)))
-          (define (sign o) (if plus? o (scale-obj -1 o)))
-          (define l (-lexp (attribute e1.obj) (sign (attribute e2.obj))))
-          (ret (-refine/fresh x ret-t (-eq (-lexp x) l))
-               ps
-               l)]
-         ;; +/- (3 args)
-         [((~var e1 (w/obj+type -Int))
-           (~var e2 (w/obj+type -Int))
-           (~var e3 (w/obj+type -Int)))
-          (define (sign o) (if plus? o (scale-obj -1 o)))
-          (define l (-lexp (attribute e1.obj) (sign (attribute e2.obj)) (sign (attribute e3.obj))))
-          (ret (-refine/fresh x ret-t (-eq (-lexp x) l))
-               ps
-               l)]
-         [_ result])]
-      [_ result])))
+(define ((plus/minus plus?) args-stx result)
+  (match result
+    [(tc-result1: ret-t ps orig-obj)
+     (syntax-parse args-stx
+       ;; +/- (2 args)
+       [((~var e1 (w/obj+type -Int)) (~var e2 (w/obj+type -Int)))
+        (define (sign o)
+          (if plus?
+              o
+              (scale-obj -1 o)))
+        (define l (-lexp (attribute e1.obj) (sign (attribute e2.obj))))
+        (ret (-refine/fresh x ret-t (-eq (-lexp x) l)) ps l)]
+       ;; +/- (3 args)
+       [((~var e1 (w/obj+type -Int)) (~var e2 (w/obj+type -Int)) (~var e3 (w/obj+type -Int)))
+        (define (sign o)
+          (if plus?
+              o
+              (scale-obj -1 o)))
+        (define l (-lexp (attribute e1.obj) (sign (attribute e2.obj)) (sign (attribute e3.obj))))
+        (ret (-refine/fresh x ret-t (-eq (-lexp x) l)) ps l)]
+       [_ result])]
+    [_ result]))
 
 ;; equal?/eqv?/eq?
 ;; if only one side is a supported type, we can learn integer equality for
 ;; a result of `#t`, whereas if both sides are of the supported type,
 ;; we learn on both `#t` and `#f` answers
-(define (equality-function supported-type)
-  (λ (args-stx result)
-    (syntax-parse args-stx
-      [((~var e1 (w/obj+type supported-type)) (~var e2 (w/obj+type supported-type)))
-       (define p (-eq (attribute e1.obj) (attribute e2.obj)))
-       (add-p/not-p result p)]
-      [((~var e1 (w/obj+type supported-type)) (~var e2 (w/obj+type Univ)))
-       (define p (-eq (attribute e1.obj) (attribute e2.obj)))
-       (add-to-pos-side result p)]
-      [((~var e1 (w/obj+type Univ)) (~var e2 (w/obj+type supported-type)))
-       (define p (-eq (attribute e1.obj) (attribute e2.obj)))
-       (add-to-pos-side result p)]
-      [_  result])))
+(define ((equality-function supported-type) args-stx result)
+  (syntax-parse args-stx
+    [((~var e1 (w/obj+type supported-type)) (~var e2 (w/obj+type supported-type)))
+     (define p (-eq (attribute e1.obj) (attribute e2.obj)))
+     (add-p/not-p result p)]
+    [((~var e1 (w/obj+type supported-type)) (~var e2 (w/obj+type Univ)))
+     (define p (-eq (attribute e1.obj) (attribute e2.obj)))
+     (add-to-pos-side result p)]
+    [((~var e1 (w/obj+type Univ)) (~var e2 (w/obj+type supported-type)))
+     (define p (-eq (attribute e1.obj) (attribute e2.obj)))
+     (add-to-pos-side result p)]
+    [_ result]))
 
 ;;  *
-(define product-function
-  (λ (args-stx result)
-    (match result
-      [(tc-result1: ret-t ps orig-obj)
-       (syntax-parse args-stx
-         [((~var e1 (w/obj+type -Int)) (~var e2 (w/obj+type -Int)))
-          (define product-obj (-obj* (attribute e1.obj) (attribute e2.obj)))
-          (cond
-            [(Object? product-obj)
-             (ret (-refine/fresh x ret-t (-eq (-lexp x) product-obj))
-                  ps
-                  product-obj)]
-            [else result])]
-         [_ result])]
-      [_ result])))
+(define (product-function args-stx result)
+  (match result
+    [(tc-result1: ret-t ps orig-obj)
+     (syntax-parse args-stx
+       [((~var e1 (w/obj+type -Int)) (~var e2 (w/obj+type -Int)))
+        (define product-obj (-obj* (attribute e1.obj) (attribute e2.obj)))
+        (cond
+          [(Object? product-obj)
+           (ret (-refine/fresh x ret-t (-eq (-lexp x) product-obj)) ps product-obj)]
+          [else result])]
+       [_ result])]
+    [_ result]))
 
 ;; make-vector
-(define make-vector-function
-  (λ (args-stx result)
-    (match result
-      [(tc-result1: ret-t ps orig-obj)
-       (syntax-parse args-stx
-         [((~var size (w/obj+type -Int)) . _)
-          (ret (-refine/fresh v ret-t (-eq (-lexp (-vec-len-of (-id-path v)))
-                                           (attribute size.obj)))
-               ps
-               orig-obj)]
-         [_ result])]
-      [_ result])))
+(define (make-vector-function args-stx result)
+  (match result
+    [(tc-result1: ret-t ps orig-obj)
+     (syntax-parse args-stx
+       [((~var size (w/obj+type -Int)) . _)
+        (ret (-refine/fresh v ret-t (-eq (-lexp (-vec-len-of (-id-path v))) (attribute size.obj)))
+             ps
+             orig-obj)]
+       [_ result])]
+    [_ result]))
 
 ;; modulo
-(define modulo-function
-  (λ (args-stx result)
-    (match result
-      [(tc-result1: ret-t ps orig-obj)
-       (syntax-parse args-stx
-         [((~var e1 (w/type -Int)) (~var e2 (w/obj+type -Nat)))
-          (ret (-refine/fresh x ret-t (-lt (-lexp x) (attribute e2.obj)))
-               ps
-               orig-obj)]
-         [_ result])]
-      [_ result])))
+(define (modulo-function args-stx result)
+  (match result
+    [(tc-result1: ret-t ps orig-obj)
+     (syntax-parse args-stx
+       [((~var e1 (w/type -Int)) (~var e2 (w/obj+type -Nat)))
+        (ret (-refine/fresh x ret-t (-lt (-lexp x) (attribute e2.obj))) ps orig-obj)]
+       [_ result])]
+    [_ result]))
 
 ;; random
-(define random-function
-  (λ (args-stx result)
-    (match result
-      [(tc-result1: ret-t ps orig-obj)
-       (syntax-parse args-stx
-         ;; random (1 arg)
-         [((~var e1 (w/obj+type -Nat)))
-          (ret (-refine/fresh x ret-t (-lt (-lexp x) (attribute e1.obj)))
-               ps
-               orig-obj)]
-         ;; random (2 arg)
-         [((~var e1 (w/type -Int)) (~var e2 (w/type -Int)))
-          #:when (or (Object? (attribute e1.obj))
-                     (Object? (attribute e2.obj)))
-          (ret (-refine/fresh x ret-t (-and (-leq (attribute e1.obj) (-lexp x))
-                                            (-lt (-lexp x) (attribute e2.obj))))
-               ps
-               orig-obj)]
-         [_ result])]
-      [_ result])))
+(define (random-function args-stx result)
+  (match result
+    [(tc-result1: ret-t ps orig-obj)
+     (syntax-parse args-stx
+       ;; random (1 arg)
+       [((~var e1 (w/obj+type -Nat)))
+        (ret (-refine/fresh x ret-t (-lt (-lexp x) (attribute e1.obj))) ps orig-obj)]
+       ;; random (2 arg)
+       [((~var e1 (w/type -Int)) (~var e2 (w/type -Int)))
+        #:when (or (Object? (attribute e1.obj)) (Object? (attribute e2.obj)))
+        (ret (-refine/fresh x
+                            ret-t
+                            (-and (-leq (attribute e1.obj) (-lexp x))
+                                  (-lt (-lexp x) (attribute e2.obj))))
+             ps
+             orig-obj)]
+       [_ result])]
+    [_ result]))
 
 ;; add1 / sub1
-(define (add/sub-1-function add?)
-  (λ (args-stx result)
-    (match result
-      [(tc-result1: ret-t ps orig-obj)
-       (syntax-parse args-stx
-         [((~var e1 (w/obj+type -Int)))
-          (define l ((if add? -lexp-add1 -lexp-sub1) (attribute e1.obj)))
-          (ret (-refine/fresh x ret-t (-eq (-lexp x) l))
-               ps
-               l)]
-         [_ result])]
-      [_ result])))
+(define ((add/sub-1-function add?) args-stx result)
+  (match result
+    [(tc-result1: ret-t ps orig-obj)
+     (syntax-parse args-stx
+       [((~var e1 (w/obj+type -Int)))
+        (define l ((if add? -lexp-add1 -lexp-sub1) (attribute e1.obj)))
+        (ret (-refine/fresh x ret-t (-eq (-lexp x) l)) ps l)]
+       [_ result])]
+    [_ result]))
 
 (define linear-integer-function-table
   (make-immutable-free-id-table

typed-racket-test/performance/infer-timing.rkt

@@ -405,7 +405,8 @@
   (displayln `(big ,n))
   (define ty-list (append ts ts))
   (collect-garbage) (collect-garbage) (collect-garbage)
-  (define run (λ () (void (bigcall n ty-list))))
+  (define (run)
+    (void (bigcall n ty-list)))
   (cond [hsbencher
          (define-values (vs t r gc)
            (time-apply run null))