(Arne Babenhauserheide)
2017-07-30: examples: add y-combinator examples: add y-combinator
diff --git a/examples/doctests-test.w b/examples/y-combinator.w
copy from examples/doctests-test.w
copy to examples/y-combinator.w
--- a/examples/doctests-test.w
+++ b/examples/y-combinator.w
@@ -1,25 +1,85 @@
#!/usr/bin/env sh
# -*- wisp -*-
guile -L $(dirname $(dirname $(realpath "$0"))) -c '(import (wisp-scheme) (language wisp spec))'
-exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples doctests-test) main)' -s "$0" "$@"
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples y-combinator) main)' -s "$0" "$@"
; !#
-define-module : examples doctests-test
-
-import : examples doctests
+define-module : examples y-combinator
-define : foo
- . "(test 'foo
- (test-equal \"bar\" (foo)))
- "
- . "bar"
+;; Poor mans y-combinator from William Byrds talk: https://www.youtube.com/watch?v=OyfBQmvr2Hc&t=2844s
+define fac-pmy-zealous-wisp
+ :
+ λ : !
+ λ : n
+ :
+ ! !
+ . n
+ λ : !
+ λ : n
+ if : zero? n
+ . 1
+ * n
+ :
+ ! !
+ - n 1
+
+define fac-pmy-pragmatic-wisp
+ :
+ λ : !
+ λ : n
+ (! !) n
+ λ : !
+ λ : n
+ if : zero? n
+ . 1
+ * n : (! !) {n - 1}
+
-define %this-module : current-module
+;; Poor mans y-combinator from William Byrds talk: https://www.youtube.com/watch?v=OyfBQmvr2Hc&t=2844s
+define facres-pmy
+ . (((λ (!)
+ (λ (n)
+ ((! !) n)))
+ (λ (!)
+ (λ (n)
+ (if (zero? n)
+ 1
+ (* n ((! !) (- n 1)))))))
+ 5)
+
+;; from rosetta code: https://rosettacode.org/wiki/Y_combinator#Scheme
+define Y
+ λ : h
+ : λ (x) : x x
+ λ : g
+ h : λ args : apply (g g) args
+
+define fac
+ Y
+ λ : f
+ λ : x
+ if : < x 2
+ . 1
+ * x : f : - x 1
+
+define fib
+ Y
+ λ : f
+ λ : x
+ if : < x 2
+ . x
+ + : f : - x 1
+ f : - x 2
+
+
define : main args
- . " Testing doctests
- (test 'mytest
- (test-assert #t)
- (test-assert #f))
-"
- doctests-testmod %this-module
-
+ display : fac-pmy-zealous-wisp 5
+ newline
+ display : fac-pmy-pragmatic-wisp 5
+ newline
+ display facres-pmy
+ newline
+ display : fac 6
+ newline
+ display : fib 6
+ newline