From b913efe8b131db4acd13946ed5e3825d8644fe43 Mon Sep 17 00:00:00 2001
From: admin <admin@vouivredigital.com>
Date: Sat, 23 Sep 2023 15:13:00 +0900
Subject: [PATCH] Compare function types with TBD types

---
 curry-tests.scm | 26 ++++++++++++++++++++------
 curry.scm       |  3 ++-
 2 files changed, 22 insertions(+), 7 deletions(-)

diff --git a/curry-tests.scm b/curry-tests.scm
index 57c7182..b51ca02 100644
--- a/curry-tests.scm
+++ b/curry-tests.scm
@@ -1,5 +1,6 @@
 (define-module (vdc curry tests)
   #:use-module (vdc curry)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64)
   #:use-module (srfi srfi-71))
 
@@ -16,6 +17,11 @@
 (define-syntax-rule (test-type given expected-bare)
   (test-assert (equal-types? given (parse expected-bare))))
 
+(define (sym-sets symtab alist)
+  (fold (lambda (x prev)
+	  ((@@ (vdc curry) sym-set) prev (car x) (cdr x)))
+	symtab alist))
+
 (let ((t e (expand '() '(λc x x))))
   (test-type t '(1 . 1))
   (test-equal '(lambda (x) x) e))
@@ -25,11 +31,14 @@
 (let ((t e (expand '() '((λc x x) #t))))
   (test-type t 0)
   (test-equal #t (primitive-eval e)))
-(let ((bindings `((id  . ,(parse '(1 . 1)))
-		  (∘   . ,(parse '((2 . 3) . ((1 . 2) . (1 . 3)))))
-		  (⊙   . ,(parse '((1 . 2) . ((2 . 3) . (1 . 3)))))
-		  (map . ,(parse '((0 . 0) . (0 . 0))))
-		  (+   . ,(parse '(0 . (0 . 0)))))))
+(let ((bindings
+       (sym-sets
+	'()
+	`((id  . ,(parse '(1 . 1)))
+	  (∘   . ,(parse '((2 . 3) . ((1 . 2) . (1 . 3)))))
+	  (⊙   . ,(parse '((1 . 2) . ((2 . 3) . (1 . 3)))))
+	  (map . ,(parse '((0 . 0) . (0 . 0))))
+	  (+   . ,(parse '(0 . (0 . 0))))))))
   (let ((t e (expand bindings '(∘ id id))))
     (test-type t '(7 . 7))
     (test-equal e '((∘ id) id)))
@@ -39,6 +48,8 @@
   (let ((t e (expand bindings '(∘ id id #t))))
     (test-type t 0)
     (test-equal e '(((∘ id) id) #t)))
+  (let ((t e (expand bindings '(λc f (∘ f)))))
+    (test-type t '((2 . 3) . ((1 . 2) . (1 . 3)))))
   (let ((t e (expand bindings '(map (+ 1) '(1 2 3)))))
     (test-type t 0)
     (test-equal e '((map (+ 1)) '(1 2 3))))
@@ -68,7 +79,10 @@
   (test-type t #f)
   (test-equal e '(+ 1 2 3)))
 
-(let ((bindings `((* . ,(parse '(0 . (0 . 0)))))))
+(let ((bindings
+       (sym-sets
+	'()
+	`((* . ,(parse '(0 . (0 . 0))))))))
   ;; Typed Scheme can be used by untyped Scheme...
   (let ((t e (expand bindings '(+ 1 (* 2 3) 4))))
     (test-type t #f)
diff --git a/curry.scm b/curry.scm
index d2bea84..aec314c 100644
--- a/curry.scm
+++ b/curry.scm
@@ -154,7 +154,8 @@
 	   (set-node-content! ny z)
 	   (massoc m x z)))
 	((and (pair? x) (not y))
-	 (type-error 0 nx ny))
+	 (set-node-content! ny x)
+	 m)
 	((and (pair? y) (not x))
 	 (type-error 0 nx ny))
 	;; cases with TVs
-- 
2.39.2