From a8734e7c9e4ac1a44eabc5e6460f91331e948a06 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sun, 1 Jan 2023 00:17:06 -0500
Subject: infer: n-arity functions.

---
 infer.scm | 25 ++++++++++++++++++++-----
 1 file changed, 20 insertions(+), 5 deletions(-)

diff --git a/infer.scm b/infer.scm
index c9da6ef..b1e468c 100644
--- a/infer.scm
+++ b/infer.scm
@@ -18,6 +18,9 @@
   (from function-type-from)
   (to function-type-to))
 
+(define (make-function-type* . types)
+  (reduce-right make-function-type #f types))
+
 (define int (make-named-type 'int))
 (define bool (make-named-type 'bool))
 
@@ -121,11 +124,12 @@
      (define arg-constraints (concatenate %arg-constraints))
      (define-values (proc-env proc-constraints)
        (make-constraints proc env))
-     ;; (define-values (arg-env arg-constraints)
-     ;;   (make-constraints arg env))
      (define return-type (make-fresh-variable-type))
-     (define call-type (make-function-type (assq-ref arg-env (car args))
-                                           return-type))
+     (define call-type
+       (fold-right make-function-type return-type
+                   (map (lambda (arg)
+                          (assq-ref arg-env arg))
+                        args)))
      (values (append (list (cons exp return-type))
                      proc-env
                      arg-env)
@@ -138,7 +142,16 @@
 (define %default-env
   `((not . ,(make-function-type bool bool))
     (add1 . ,(make-function-type int int))
-    (sub1 . ,(make-function-type int int))))
+    (sub1 . ,(make-function-type int int))
+    (+ . ,(make-function-type* int int int))
+    (- . ,(make-function-type* int int int))
+    (* . ,(make-function-type* int int int))
+    (/ . ,(make-function-type* int int int))
+    (= . ,(make-function-type* int int bool))
+    (< . ,(make-function-type* int int bool))
+    (<= . ,(make-function-type* int int bool))
+    (> . ,(make-function-type* int int bool))
+    (>= . ,(make-function-type* int int bool))))
 
 (define (make-constraints* exp)
   (parameterize ((unique-counter 0))
@@ -209,3 +222,5 @@
 (test-equal (infer '((lambda (x) x) 6)) int)
 (test-equal (infer '((lambda (x) (if (not #t) (add1 x) (sub1 x))) 1)) int)
 (test-equal (false-if-exception (infer '((lambda (x) (if #t 1 x)) #f))) #f)
+(test-equal (infer '((lambda (x) (+ 1 x)) 2)) int)
+(test-equal (infer '((lambda (x) (= 1 x)) 2)) bool)
-- 
cgit v1.2.3