2016 Update

Task/Y-combinator/00DESCRIPTION

@@ -3,7 +3,11 @@ This rules out the usual definition of a recursive function wherein a function i
 
 The [http://mvanier.livejournal.com/2897.html Y combinator] is itself a stateless function that, when applied to another stateless function, returns a recursive version of the function. The Y combinator is the simplest of the class of such functions, called [[wp:Fixed-point combinator|fixed-point combinators]].
 
-The task is to define the stateless Y combinator and use it to compute [[wp:Factorial|factorials]] and [[wp:Fibonacci number|Fibonacci numbers]] from other stateless functions or lambda expressions.
+
+;Task:
+Define the stateless Y combinator and use it to compute [[wp:Factorial|factorials]] and [[wp:Fibonacci number|Fibonacci numbers]] from other stateless functions or lambda expressions.
+
 
 ;Cf:
 * [http://vimeo.com/45140590 Jim Weirich: Adventures in Functional Programming]
+<br><br>

Task/Y-combinator/AppleScript/y-combinator-1.applescript

@@ -0,0 +1,99 @@
+-- Y COMBINATOR
+
+on |Y|(f)
+    script
+        on lambda(y)
+            script
+                on lambda(arg)
+                    y's lambda(y)'s lambda(arg)
+                end lambda
+            end script
+
+            f's lambda(result)
+
+        end lambda
+    end script
+
+    result's lambda(result)
+end |Y|
+
+
+-- TEST
+on run
+
+    -- Factorial
+    script fact
+        on lambda(f)
+            script
+                on lambda(n)
+                    if n = 0 then return 1
+                    n * (f's lambda(n - 1))
+                end lambda
+            end script
+        end lambda
+    end script
+
+
+    -- Fibonacci
+    script fib
+        on lambda(f)
+            script
+                on lambda(n)
+                    if n = 0 then return 0
+                    if n = 1 then return 1
+                    (f's lambda(n - 2)) + (f's lambda(n - 1))
+                end lambda
+            end script
+        end lambda
+    end script
+
+    {facts:map(|Y|(fact), range(0, 11)), fibs:map(|Y|(fib), range(0, 20))}
+
+    --> {facts:{1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800},
+    --> fibs:{0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765}}
+
+end run
+
+
+---------------------------------------------------------------------------
+
+
+-- GENERIC FUNCTIONS (FOR TEST)
+
+-- map :: (a -> b) -> [a] -> [b]
+on map(f, xs)
+    tell mReturn(f)
+        set lng to length of xs
+        set lst to {}
+        repeat with i from 1 to lng
+            set end of lst to lambda(item i of xs, i, xs)
+        end repeat
+        return lst
+    end tell
+end map
+
+-- range :: Int -> Int -> [Int]
+on range(m, n)
+    if n < m then
+        set d to -1
+    else
+        set d to 1
+    end if
+    set lst to {}
+    repeat with i from m to n by d
+        set end of lst to i
+    end repeat
+    return lst
+end range
+
+-- Lift 2nd class handler function into 1st class script wrapper
+-- mReturn :: Handler -> Script
+on mReturn(f)
+    if class of f is script then
+        f
+    else
+        script
+            property lambda : f
+        end script
+    end if
+end mReturn

Task/Y-combinator/AppleScript/y-combinator-2.applescript

@@ -0,0 +1,2 @@
+{facts:{1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800},
+fibs:{0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765}}

Task/Y-combinator/AppleScript/y-combinator.applescript

@@ -1,54 +0,0 @@
-to |Y|(f)
-  script x
-    to funcall(y)
-      script
-        to funcall(arg)
-          y's funcall(y)'s funcall(arg)
-        end funcall
-      end script
-      f's funcall(result)
-    end funcall
-  end script
-  x's funcall(x)
-end |Y|
-
-script
-  to funcall(f)
-    script
-      to funcall(n)
-        if n = 0 then return 1
-        n * (f's funcall(n - 1))
-      end funcall
-    end script
-  end funcall
-end script
-set fact to |Y|(result)
-
-script
-  to funcall(f)
-    script
-      to funcall(n)
-        if n = 0 then return 0
-        if n = 1 then return 1
-        (f's funcall(n - 2)) + (f's funcall(n - 1))
-      end funcall
-    end script
-  end funcall
-end script
-set fib to |Y|(result)
-
-set facts to {}
-repeat with i from 0 to 11
-  set end of facts to fact's funcall(i)
-end repeat
-
-set fibs to {}
-repeat with i from 0 to 20
-  set end of fibs to fib's funcall(i)
-end repeat
-
-{facts:facts, fibs:fibs}
-(*
-{facts:{1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800},
- fibs:{0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765}}
-*)

Task/Y-combinator/C++/y-combinator-2.cpp

@@ -1,6 +1,21 @@
-template <typename A, typename B>
-std::function<B(A)> Y (std::function<std::function<B(A)>(std::function<B(A)>)> f) {
-	return [f](A x) {
-		return f(Y(f))(x);
-	};
+#include <iostream>
+#include <functional>
+int main () {
+  auto y = ([] (auto f) { return
+              ([] (auto x) { return x (x); }
+                 ([=] (auto y) -> std:: function <int (int)> { return
+                    f ([=] (auto a) { return
+                          (y (y)) (a) ;});}));});
+
+  auto almost_fib = [] (auto f) { return
+                       [=] (auto n) { return
+                         n < 2? n: f (n - 1) + f (n - 2) ;};};
+  auto almost_fac = [] (auto f) { return
+                       [=] (auto n) { return
+                         n <= 1? n: n * f (n - 1); };};
+
+  auto fib = y (almost_fib);
+  auto fac = y (almost_fac);
+  std:: cout << fib (10) << '\n'
+             << fac (10) << '\n';
 }

Task/Y-combinator/C++/y-combinator-3.cpp

@@ -1,13 +1,6 @@
-template <typename A, typename B>
-struct YFunctor {
-  const std::function<std::function<B(A)>(std::function<B(A)>)> f;
-  YFunctor(std::function<std::function<B(A)>(std::function<B(A)>)> _f) : f(_f) {}
-  B operator()(A x) const {
-    return f(*this)(x);
-  }
-};
-
 template <typename A, typename B>
 std::function<B(A)> Y (std::function<std::function<B(A)>(std::function<B(A)>)> f) {
-  return YFunctor<A,B>(f);
+	return [f](A x) {
+		return f(Y(f))(x);
+	};
 }

Task/Y-combinator/C++/y-combinator-4.cpp

@@ -0,0 +1,13 @@
+template <typename A, typename B>
+struct YFunctor {
+  const std::function<std::function<B(A)>(std::function<B(A)>)> f;
+  YFunctor(std::function<std::function<B(A)>(std::function<B(A)>)> _f) : f(_f) {}
+  B operator()(A x) const {
+    return f(*this)(x);
+  }
+};
+
+template <typename A, typename B>
+std::function<B(A)> Y (std::function<std::function<B(A)>(std::function<B(A)>)> f) {
+  return YFunctor<A,B>(f);
+}

Task/Y-combinator/Forth/y-combinator-1.fth

@@ -0,0 +1,12 @@
+\ Address of an xt.
+variable 'xt
+\ Make room for an xt.
+: xt, ( -- ) here 'xt !  1 cells allot ;
+\ Store xt.
+: !xt ( xt -- ) 'xt @ ! ;
+\ Compile fetching the xt.
+: @xt, ( -- ) 'xt @ postpone literal postpone @ ;
+\ Compile the Y combinator.
+: y, ( xt1 -- xt2 ) >r :noname @xt, r> compile, postpone ; ;
+\ Make a new instance of the Y combinator.
+: y ( xt1 -- xt2 ) xt, y, dup !xt ;

Task/Y-combinator/Forth/y-combinator-2.fth

@@ -0,0 +1,7 @@
+\ Factorial
+10 :noname ( u1 xt -- u2 ) over ?dup if 1- swap execute * else 2drop 1 then ;
+y execute . 3628800 ok
+
+\ Fibonacci
+10 :noname ( u1 xt -- u2 ) over 2 < if drop else >r 1- dup r@ execute swap 1- r> execute + then ;
+y execute . 55 ok

Task/Y-combinator/JavaScript/y-combinator-6.js

@@ -17,4 +17,4 @@ let
     opentailfact= // Open version of the tail call variant of the factorial function
         fact=>(n,m=1)=>n<2?m:fact(n-1,n*m);
     tailfact= // Tail call version of factorial function
-        Y(parttailfact);
+        Y(opentailfact);

Task/Y-combinator/JavaScript/y-combinator-8.js

@@ -0,0 +1,2 @@
+var Y = f => (x => x(x))(y => f(x => y(y)(x)));
+var fac = Y(f => n => n > 1 ? n * f(n-1) : 1);

Task/Y-combinator/Mathematica/y-combinator.math

@@ -1,3 +1,3 @@
 Y = Function[f, #[#] &[Function[g, f[g[g][##] &]]]];
 factorial = Y[Function[f, If[# < 1, 1, # f[# - 1]] &]];
-fibonacci = Y[Function[f, If[# < 2, #, f[# - 1] + f[# - 2]] &];
+fibonacci = Y[Function[f, If[# < 2, #, f[# - 1] + f[# - 2]] &]];

Task/Y-combinator/Perl-6/y-combinator-1.pl6

@@ -1,4 +1,4 @@
-sub Y (&f) { { .($_) }( -> &y { f({ y(&y)($^arg) }) } ) }
+sub Y (&f) { sub (&x) { x(&x) }( sub (&y) { f(sub ($x) { y(&y)($x) }) } ) }
 sub fac (&f) { sub ($n) { $n < 2 ?? 1 !! $n * f($n - 1) } }
 sub fib (&f) { sub ($n) { $n < 2 ?? $n !! f($n - 1) + f($n - 2) } }
 say map Y($_), ^10 for &fac, &fib;

Task/Y-combinator/PowerShell/y-combinator-2.psh

@@ -0,0 +1,48 @@
+$Y = {
+    param ($f)
+
+    {
+        param ($x)
+
+        $f.InvokeReturnAsIs({
+            param ($y)
+
+            $x.InvokeReturnAsIs($x).InvokeReturnAsIs($y)
+        }.GetNewClosure())
+
+    }.InvokeReturnAsIs({
+        param ($x)
+
+        $f.InvokeReturnAsIs({
+            param ($y)
+
+            $x.InvokeReturnAsIs($x).InvokeReturnAsIs($y)
+        }.GetNewClosure())
+
+    }.GetNewClosure())
+}
+
+$fact = {
+    param ($f)
+
+    {
+        param ($n)
+
+        if ($n -eq 0) { 1 } else { $n * $f.InvokeReturnAsIs($n - 1) }
+
+    }.GetNewClosure()
+}
+
+$fib = {
+    param ($f)
+
+    {
+        param ($n)
+
+        if ($n -lt 2) { 1 } else { $f.InvokeReturnAsIs($n - 1) + $f.InvokeReturnAsIs($n - 2) }
+
+    }.GetNewClosure()
+}
+
+$Y.invoke($fact).invoke(5)
+$Y.invoke($fib).invoke(5)

Task/Y-combinator/Rust/y-combinator.rust

@@ -1,27 +1,24 @@
 use std::sync::Arc;
-use std::boxed::Box;
-use std::clone::Clone;
 
 //Arc<Box<Closure>>
-#[macro_export]
 macro_rules! abc {
     ($x:expr) => (Arc::new(Box::new($x)));
 }
 
 #[derive(Clone)]
-pub enum Mu<T> {
+enum Mu<T> {
     Roll(Arc<Box<Fn(Mu<T>)->T>>),
 }
 
-pub fn unroll<T>(Mu::Roll(f): Mu<T>) -> Arc<Box<Fn(Mu<T>)->T>> {f.clone()}
+fn unroll<T>(Mu::Roll(f): Mu<T>) -> Arc<Box<Fn(Mu<T>)->T>> {f.clone()}
 
-pub type Func<A, B> = Arc<Box<Fn(A)->B>>;
-pub type RecFunc<A, B> = Arc<Box<Fn(Func<A, B>) -> Func<A, B>>>;
+pub type Func<A> = Arc<Box<Fn(A)->A>>;
+pub type RecFunc<A> = Arc<Box<Fn(Func<A>) -> Func<A>>>;
 
-pub fn y<A, B>(f: RecFunc<A, B>) -> Func<A, B> {
-    let g:Arc<Box<Fn(Mu<Func<A, B>>)->Func<A, B>>> = abc!(move |x : Mu<Func<A, B>>| -> Func<A, B> {
+pub fn y<A: 'static>(f: RecFunc<A>) -> Func<A> {
+    let g: Arc<Box<Fn(Mu<Func<A>>)->Func<A>>> = abc!(move |x : Mu<Func<A>>| -> Func<A> {
         let f = f.clone();
-        abc!(move |a:A| -> B {
+        abc!(move |a:A| -> A {
             let f = f.clone();
             f(unroll(x.clone())(x.clone()))(a)
         })
@@ -29,16 +26,24 @@ pub fn y<A, B>(f: RecFunc<A, B>) -> Func<A, B> {
     g(Mu::Roll(g.clone()))
 }
 
-#[test]
-fn fib_test() {
-    let fib : RecFunc<i32, i32> = abc!(|f| abc!(move |x| if (x<2) { 1 } else { f(x-1) + f(x-2)}));
-    let b = y(fib)(10);
-    assert_eq!(b, 89);
+#[macro_export]
+macro_rules! y {
+    (|$name:ident| $fun:tt) => {
+        y(abc!(|$name| abc!($fun)))
+    }
 }
 
-#[test]
-fn fac_test() {
-    let fac : RecFunc<i32, i32> = abc!(|f| abc!(move |x| if (x==0) { 1 } else { f(x-1) * x }));
-    let c = y(fac)(10);
-    assert_eq!(c, 3628800);
+fn fac(n: u32) -> u32 {
+    let fn_: Func<u32> = y!(|f| (move |x| if x == 0 { 1 } else { f(x-1) * x }));
+    fn_(n)
+}
+
+fn fib(n: u32) -> u32 {
+    let fn_: Func<u32> = y!(|f| (move |x| if x < 2 { x } else { f(x-1) + f(x-2) }));
+    fn_(n)
+}
+
+fn main() {
+    println!("{}", fac(10));
+    println!("{}", fib(10))
 }

Task/Y-combinator/TXR/y-combinator-1.txr

@@ -0,0 +1,13 @@
+;; The Y combinator:
+(defun y (f)
+  [(op @1 @1)
+   (op f (op [@@1 @@1]))])
+
+;; The Y-combinator-based factorial:
+(defun fac (f)
+  (do if (zerop @1)
+         1
+         (* @1 [f (- @1 1)])))
+
+;; Test:
+(format t "~s\n" [[y fac] 4])

Task/Y-combinator/TXR/y-combinator-2.txr

@@ -0,0 +1 @@
+(op foo @1 (op bar @2 @@2))

Task/Y-combinator/TXR/y-combinator.txr

@@ -1,14 +0,0 @@
-@(do
-  ;; The Y combinator:
-  (defun y (f)
-    [(op @1 @1)
-     (op f (op [@@1 @@1]))])
-
-  ;; The Y-combinator-based factorial:
-  (defun fac (f)
-    (do if (zerop @1)
-           1
-           (* @1 [f (- @1 1)])))
-
-  ;; Test:
-  (format t "~s\n" [[y fac] 4]))