]> git.vouivredigital.com Git - vouivre.git/commitdiff
Test flipped function composition
authoradmin <admin@vouivredigital.com>
Wed, 6 Sep 2023 10:55:44 +0000 (19:55 +0900)
committeradmin <admin@vouivredigital.com>
Wed, 6 Sep 2023 10:55:44 +0000 (19:55 +0900)
curry-tests.scm

index 4d01adb13dc1de91562a51dcb71820a9db820e4e..d866c0dd14dcff543565c420f787fd9758ea05f6 100644 (file)
 (test-error (e '(+ 1 (λc (x) x))))
 
 ;; composition
-;; we are going for (∘ * 1+ 1 3) ≡ ((∘ * 1+) 1 3) ≡ (((∘ * 1+) 1) 3) where:
-;; ∘ ≡ (λc (g f) (λc (x) (g (f x))))
-;; * ≡ (λc (x y) (* x y))
-;; and 1+ is the Scheme procedure.
-(test-equal (* (1+ 1) 3)
-  (e '((λc (g f) (λc (x) (g (f x)))) (λc (x y) (* x y)) 1+ 1 3)))
-(test-equal (* (1+ 1) 3)
-  (e '(((λc (g f) (λc (x) (g (f x)))) (λc (x y) (* x y)) 1+) 1 3)))
-(test-equal (* (1+ 1) 3)
-  (e '((((λc (g f) (λc (x) (g (f x)))) (λc (x y) (* x y)) 1+) 1) 3)))
+;; ∘ ≡ function composition ≡ (λc (g f) (λc (x) (g (f x))))
+;; ۰ ≡ flipped ∘ ≡ (λc (f g) (λc (x) (g (f x))))
+(test-equal (expt (1+ 1) 3)
+  ;; (∘ expt 1+ 1 3)
+  (e '((λc (g f) (λc (x) (g (f x)))) ; ∘
+       (λc (x y) (expt x y))          ; expt
+       1+ 1 3)))
+(test-equal (expt (1+ 1) 3)
+  ;; ((∘ expt 1+) 1 3)
+  (e '(((λc (g f) (λc (x) (g (f x))))        ; ∘
+       (λc (x y) (expt x y))          ; expt
+       1+)
+       1 3)))
+(test-equal (expt (1+ 1) 3)
+  ;; (((∘ expt 1+) 1) 3)
+  (e '((((λc (g f) (λc (x) (g (f x))))       ; ∘
+        (λc (x y) (expt x y))         ; expt
+        1+)
+       1)
+       3)))
+(test-equal (1+ (expt 2 3))
+  ;; ((∘ (∘ 1+) expt) 2 3)
+  (e '(((λc (g f) (λc (x) (g (f x))))        ; ∘
+       ((λc (g f) (λc (x) (g (f x))))        ; ∘
+        (λc (x) (1+ x)))              ; 1+
+       (λc (x y) (expt x y))          ; expt
+       )
+       2 3)))
+(test-equal (expt 2 (1+ 3))
+  ;; (expt x (1+ y)) ≡ (∘ (۰ 1+) expt)
+  (e '(((λc (g f) (λc (x) (g (f x))))                        ; ∘
+       ((λc (f g) (λc (x) (g (f x)))) (λc (x) (1+ x))) ; (۰ 1+)
+       (λc (x y) (expt x y))                          ; expt
+       )
+       2 3)))
 
 ;; misc
 (test-equal 3 (e '(+ 1 ((λc (x) x) 2))))