improved reduce-right interface

day01-hard/main.scm

@@ -28,37 +28,32 @@
 (define (Y f) (f (lambda (x) ((Y f) x))))
 (define (Y2 f) (f (lambda (x y) ((Y2 f) x y))))
 
-(define (reduce-right reducer initial) (Y
+(define (reduce-right initial reducer) (Y
   (lambda (f) (lambda (values)
     (if (null? values) initial (reducer (car values) (f (cdr values))))))))
 
-(define (map mapper) (reduce-right
+(define (map mapper) (reduce-right '()
-  (lambda (current accumulator) (cons (mapper current) accumulator))
+  (lambda (current accumulator) (cons (mapper current) accumulator))))
-  '()))
 
 (define (concat left right)
-  ((reduce-right
+  ((reduce-right right (lambda (current accumulator) (cons current accumulator)))
-    (lambda (current accumulator) (cons current accumulator))
+    left))
-    right)
-  left))
 
 ;=============== flat ======================
-(define flat (reduce-right concat '()))
+(define flat (reduce-right '() concat))
 
 (assert-eq "flat test 1 failed"
   '(1 2 3 4 5 (6 7) 8)
   (flat '((1 2) (3 4) (5 (6 7) 8))))
 
-(define (filter predicate) (reduce-right
+(define (filter predicate) (reduce-right '()
   (lambda (current accumulator)
-    (if (predicate current) (cons current accumulator) accumulator))
+    (if (predicate current) (cons current accumulator) accumulator))))
-  '()))
 
 ;=============== first ======================
-(define (first predicate) (reduce-right
+(define (first predicate) (reduce-right '()
   (lambda (current accumulator)
-    (if (predicate current) current accumulator))
+    (if (predicate current) current accumulator))))
-  '()))
 
 (assert-eq "first with is-not-empty test 1 failed"
   '(1 2 3)
@@ -70,12 +65,12 @@
 
 (define (compose-two f g) (lambda (x) (f (g x))))
 
-(define compose (reduce-right compose-two id))
+(define compose (reduce-right id compose-two))
 
 (define (combine combiner)
   (lambda (a b) (if (null? a) b (if (null? b) a (combiner a b)))))
 
-(define sum (reduce-right + 0))
+(define sum (reduce-right 0 +))
 
 (define (repeat value) (Y
   (lambda (f) (lambda (n)
@@ -214,9 +209,8 @@
 (define solve-line (compose (list
   string->number
   list->string
-  (reduce-right
+  (reduce-right '()
-    (combine (lambda (left right) (cons (car left) (cdr right))))
+    (combine (lambda (left right) (cons (car left) (cdr right)))))
-    '())
   (map (lambda (char) ((repeat char) 2)))
   car
   (tokenize-aoc solution-tokens)