[function] new style

function.rkt

@@ -1,69 +1,7 @@
 #lang typed/racket/base
 
-;; Track procedure arity
-;; Applications:
-;; - 
-;; - vectorized ops
-;; - (TODO) improve apply/map? ask Leif
-
 (provide
   curry:
 )
 
-;; -----------------------------------------------------------------------------
+(require trivial/private/function)
-
-(require
-  (for-syntax
-    typed/racket/base
-    racket/syntax
-    syntax/id-table
-    syntax/parse
-    syntax/stx
-    trivial/private/common
-))
-
-;; =============================================================================
-
-(begin-for-syntax (define-syntax-class procedure/arity
-  #:attributes (expanded arity)
-  (pattern e
-   #:with e+ (expand-expr #'e)
-   #:with a (parse-procedure-arity #'e+)
-   #:when (syntax-e #'a)
-   #:attr expanded #'e+
-   #:attr arity #'a)
-))
-
-;; -----------------------------------------------------------------------------
-
-(define-syntax (curry: stx)
-  (syntax-parse stx
-   [(_ p:procedure/arity)
-    #:with (x* ...) (for/list ([_i (in-range (syntax-e #'p.arity))]) (gensym))
-    #:with p+ (for/fold ([e (quasisyntax/loc stx (p #,@#`#,(reverse (syntax-e #'(x* ...)))))])
-                        ([x (in-list (syntax-e #'(x* ...)))])
-                (quasisyntax/loc stx
-                  (lambda (#,x) #,e)))
-    (syntax/loc stx p+)]
-   [_
-    (raise-user-error 'curry "Fail ~a" (syntax->datum stx))]))
-
-(define-for-syntax id+procedure-arity (make-free-id-table))
-(define-for-syntax procedure-arity-key 'procedure:arity)
-
-;; -----------------------------------------------------------------------------
-
-(define-for-syntax (parse-procedure-arity stx)
-  (cond
-   [(syntax-property stx procedure-arity-key)
-    => (lambda (x) x)]
-   [(identifier? stx)
-    (free-id-table-ref id+procedure-arity stx #f)]
-   [else
-    (syntax-parse stx #:literals (#%plain-lambda)
-     [(#%plain-lambda (x*:id ...) e* ...)
-      (length (syntax-e #'(x* ...)))]
-     ;; TODO polydots, keywords, optional args
-     ;; TODO standard library functions
-     [_ #f])]))
-

private/function.rkt

@@ -0,0 +1,51 @@
+#lang typed/racket/base
+
+;; Track procedure arity
+;; Applications:
+;; - 
+;; - vectorized ops
+;; - (TODO) improve apply/map? ask Leif
+
+(provide
+  curry:
+)
+
+;; -----------------------------------------------------------------------------
+
+(require
+  (for-syntax
+    typed/racket/base
+    syntax/parse
+    trivial/private/common
+))
+
+;; =============================================================================
+
+(begin-for-syntax
+  (define (parse-procedure-arity stx)
+    (syntax-parse stx #:literals (#%plain-lambda)
+     [(#%plain-lambda (x*:id ...) e* ...)
+      (length (syntax-e #'(x* ...)))]
+     ;; TODO polydots, keywords, optional args
+     ;; TODO standard library functions
+     [_ #f]))
+
+  (define-values (arity-key proc? define-proc let-proc)
+    (make-value-property 'procedure:arity parse-procedure-arity))
+  (define-syntax-class/predicate procedure/arity proc?)
+)
+
+;; -----------------------------------------------------------------------------
+
+(define-syntax (curry: stx)
+  (syntax-parse stx
+   [(_ p:procedure/arity)
+    #:with (x* ...) (for/list ([_i (in-range (syntax-e #'p.evidence))]) (gensym))
+    #:with p+ (for/fold ([e (quasisyntax/loc stx (p #,@#`#,(reverse (syntax-e #'(x* ...)))))])
+                        ([x (in-list (syntax-e #'(x* ...)))])
+                (quasisyntax/loc stx
+                  (lambda (#,x) #,e)))
+    (syntax/loc stx p+)]
+   [_
+    (raise-user-error 'curry "Fail ~a" (syntax->datum stx))]))
+