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

diff --git a/base.scm b/base.scm
index 377421d8b496cdfb785602a319aa2ec17bde13e9..a2aef3d462832a4c7095d1cc4de8dc45e0f23cd2 100644 (file)
--- 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 aec314c31fd9e8582a8c25592622834f743b8b9a..117e9f517abf72aa3c1abb07dffa5c71f4adf13e 100644 (file)
--- 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