From dc1b4eb4bbc9e86895f595aa9ea4f58800085b0e Mon Sep 17 00:00:00 2001
From: admin <admin@vouivredigital.com>
Date: Sat, 23 Sep 2023 15:16:07 +0900
Subject: [PATCH] Fix issues with (vdc base) and add reversed composition

- Call guile's 1+ instead of itself
- Curry internal applications of higher order functions
- Declare types at both expansion and compilation time
---
 base.scm  | 38 +++++++++++++++++++++++++++++++-------
 curry.scm | 21 +++++++++++++--------
 2 files changed, 44 insertions(+), 15 deletions(-)

diff --git a/base.scm b/base.scm
index 377421d..a2aef3d 100644
--- a/base.scm
+++ b/base.scm
@@ -1,6 +1,7 @@
 (define-module (vdc base)
-  #:use-module ((rnrs base) :prefix rnrs:)
-  #:use-module ((srfi srfi-1) :prefix srfi-1:)
+  #:use-module ((guile) #:select (1+) #:prefix guile:)
+  #:use-module ((rnrs base) #:prefix rnrs:)
+  #:use-module ((srfi srfi-1) #:prefix srfi-1:)
   #:use-module (vdc curry)
   #:export
   (∘)
@@ -539,22 +540,45 @@
 (cudefine (finite? x) (rnrs:finite? x))
 
 (∷ fold ((0 . (0 . 0)) . (0 . (0 . 0))))
-(cudefine (fold f x xs) (srfi-1:fold f x xs))
+(cudefine (fold f x xs)
+	  (srfi-1:fold
+	   (lambda (x prev)
+	     ((f x) prev))
+	   x xs))
 
 (∷ fold-right ((0 . (0 . 0)) . (0 . (0 . 0))))
-(cudefine (fold-right f x xs) (srfi-1:fold-right f x xs))
+(cudefine (fold-right f x xs)
+	  (srfi-1:fold-right
+	   (lambda (x prev)
+	     ((f x) prev))
+	   x xs))
 
 (∷ reduce ((0 . (0 . 0)) . (0 . 0)))
-(cudefine (reduce f xs) (srfi-1:reduce f (error "empty list") xs))
+(cudefine (reduce f xs)
+	  (when (null? xs)
+	    (error "empty list"))
+	  (srfi-1:reduce
+	   (lambda (x prev)
+	     ((f x) prev))
+	   0
+	   xs))
 
 (∷ reduce-right ((0 . (0 . 0)) . (0 . 0)))
-(cudefine (reduce-right f xs) (srfi-1:reduce-right f (error "empty list") xs))
+(cudefine (reduce-right f xs)
+	  (when (null? xs)
+	    (error "empty list"))
+	  (srfi-1:reduce-right
+	   (lambda (x prev)
+	     ((f x) prev))
+	   0
+	   xs))
 
 (∷ map ((0 . 0) . (0 . 0)))
 (cudefine (map f xs) (srfi-1:map f xs))
 
 (∷ 1+ (0 . 0))
-(cudefine (1+ x) (1+ x))
+(cudefine (1+ x) (guile:1+ x))
 
 (definec (identity x) x)
 (definec (∘ g f) (λc x (g (f x))))
+(definec (⊙ f g) (∘ g f))
diff --git a/curry.scm b/curry.scm
index aec314c..117e9f5 100644
--- a/curry.scm
+++ b/curry.scm
@@ -276,14 +276,19 @@
      (let ((t e (expand symtab body)))
        (if (not t)
 	   (type-error 5 "in body of" `(definec ,name ,body))
-	   (values
-	    #f
-	    `(begin
-	       ((@@ (vdc curry) ∷%)
-		',name
-		((@ (vdc curry) parse)
-		 ',(bare-type t)))
-	       (define ,name ,e))))))
+	   ;; We need to declare the type twice. Once, in `expand', to ensure
+	   ;; the type will be available in future `expand' calls. Second, in
+	   ;; the expanded expression, so that it gets compiled.
+	   (begin
+	     (∷% name t)
+	     (values
+	      #f
+	      `(begin
+		 ((@@ (vdc curry) ∷%)
+		  ',name
+		  ((@ (vdc curry) parse)
+		   ',(bare-type t)))
+		 (define ,name ,e)))))))
     ((f)
      (let ((t e (expand symtab f)))
        (values
-- 
2.39.5