From a8ee7cc523f5961f1413e6b2eb0a50307a25affb Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Sun, 15 Mar 2020 16:12:05 +0100
Subject: [PATCH] utils: Add procedure-fixed-arity?.

---
 utils-tests.rkt |  4 ++++
 utils.rkt       | 14 +++++++++++++-
 2 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/utils-tests.rkt b/utils-tests.rkt
index 4a5c2ef..1198428 100644
--- a/utils-tests.rkt
+++ b/utils-tests.rkt
@@ -125,3 +125,7 @@
     (check-equal? e3 '(a b)) (check-equal? l3 (list (set 1) (set 2))))
   (check-equal? (ht-values/list->set #hash((a . (1 1))))
                 (hash 'a (set 1))))
+
+(test-case "Functions"
+  (check-true (procedure-fixed-arity? not))
+  (check-false (procedure-fixed-arity? +)))
diff --git a/utils.rkt b/utils.rkt
index b2c3161..f286562 100644
--- a/utils.rkt
+++ b/utils.rkt
@@ -32,7 +32,8 @@
                [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))))]
 
-               [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
  (contract-out [variable-mapping? contract?]
                [string-variable-mapping? contract?]
@@ -317,3 +318,14 @@
 (define (ht-values/list->set ht)
   (for/hash ([(k v) (in-hash ht)])
     (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]))