wisp
 
(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