utils: Add procedure-fixed-arity?.

This commit is contained in:
Sergiu Ivanov 2020-03-15 16:12:05 +01:00
parent f005d77516
commit a8ee7cc523
2 changed files with 17 additions and 1 deletions

View file

@ -125,3 +125,7 @@
(check-equal? e3 '(a b)) (check-equal? l3 (list (set 1) (set 2)))) (check-equal? e3 '(a b)) (check-equal? l3 (list (set 1) (set 2))))
(check-equal? (ht-values/list->set #hash((a . (1 1)))) (check-equal? (ht-values/list->set #hash((a . (1 1))))
(hash 'a (set 1)))) (hash 'a (set 1))))
(test-case "Functions"
(check-true (procedure-fixed-arity? not))
(check-false (procedure-fixed-arity? +)))

View file

@ -32,7 +32,8 @@
[collect-by-key (-> (listof any/c) (listof any/c) (values (listof any/c) (listof (listof any/c))))] [collect-by-key (-> (listof any/c) (listof any/c) (values (listof any/c) (listof (listof any/c))))]
[collect-by-key/sets (-> (listof any/c) (listof any/c) (values (listof any/c) (listof (set/c any/c))))] [collect-by-key/sets (-> (listof any/c) (listof any/c) (values (listof any/c) (listof (set/c any/c))))]
[ht-values/list->set (-> (hash/c any/c (listof any/c)) (hash/c any/c (set/c any/c)))]) [ht-values/list->set (-> (hash/c any/c (listof any/c)) (hash/c any/c (set/c any/c)))]
[procedure-fixed-arity? (-> procedure? boolean?)])
;; Contracts ;; Contracts
(contract-out [variable-mapping? contract?] (contract-out [variable-mapping? contract?]
[string-variable-mapping? contract?] [string-variable-mapping? contract?]
@ -317,3 +318,14 @@
(define (ht-values/list->set ht) (define (ht-values/list->set ht)
(for/hash ([(k v) (in-hash ht)]) (for/hash ([(k v) (in-hash ht)])
(values k (list->set v)))) (values k (list->set v))))
;;; =========
;;; Functions
;;; =========
;;; Returns #t if the function has fixed arity (i.e. if it does not
;;; take a variable number of arguments).
(define (procedure-fixed-arity? func)
(match (procedure-arity func)
[(arity-at-least _) #f] [arity #t]))