Y combinator
From Rosetta Code
You are encouraged to solve this task according to the task description, using any language you may know.
In strict functional programming and the lambda calculus, functions (lambda expressions) don't have state and are only allowed to refer to arguments of enclosing functions. This rules out the usual definition of a recursive function wherein a function is associated with the state of a variable and this variable's state is used in the body of the function.
The 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 fixed-point combinators.
The task is to define the stateless Y combinator and use it to compute factorials and Fibonacci numbers from other stateless functions or lambda expressions.
[edit] ALGOL 68
Note: This specimen retains the original Python coding style.BEGIN
MODE F = PROC(INT)INT;
MODE Y = PROC(Y)F;
# compare python Y = lambda f: (lambda x: x(x)) (lambda y: f( lambda *args: y(y)(*args)))#
PROC y = (PROC(F)F f)F: ( (Y x)F: x(x)) ( (Y z)F: f((INT arg )INT: z(z)( arg )));
PROC fib = (F f)F: (INT n)INT: CASE n IN n,n OUT f(n-1) + f(n-2) ESAC;
FOR i TO 10 DO print(y(fib)(i)) OD
END
[edit] AppleScript
AppleScript is not terribly "functional" friendly. However, it is capable enough to support the Y combinator.
AppleScript does not have anonymous functions, but it does have anonymous objects. The code below implements the latter with the former (using a handler (i.e. function) named 'funcall' in each anonymous object).
Unfortunately, an anonymous object can only be created in its own statement ('script'...'end script' can not be in an expression). Thus, we have to apply Y to the automatic 'result' variable that holds the value of the previous statement.
The identifier used for Y uses "pipe quoting" to make it obviously distinct from the y used inside the definition.
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}}
*)
[edit] BlitzMax
BlitzMax doesn't support anonymous functions or classes, so everything needs to be explicitly named.
SuperStrict
'Boxed type so we can just use object arrays for argument lists
Type Integer
Field val:Int
Function Make:Integer(_val:Int)
Local i:Integer = New Integer
i.val = _val
Return i
End Function
End Type
'Higher-order function type - just a procedure attached to a scope
Type Func Abstract
Method apply:Object(args:Object[]) Abstract
End Type
'Function definitions - extend with fields as locals and implement apply as body
Type Scope Extends Func Abstract
Field env:Scope
'Constructor - bind an environment to a procedure
Function lambda:Scope(env:Scope) Abstract
Method _init:Scope(_env:Scope) 'Helper to keep constructors small
env = _env ; Return Self
End Method
End Type
'Based on the following definition:
'(define (Y f)
' (let ((_r (lambda (r) (f (lambda a (apply (r r) a))))))
' (_r _r)))
'Y (outer)
Type Y Extends Scope
Field f:Func 'Parameter - gets closed over
Function lambda:Scope(env:Scope) 'Necessary due to highly limited constructor syntax
Return (New Y)._init(env)
End Function
Method apply:Func(args:Object[])
f = Func(args[0])
Local _r:Func = YInner1.lambda(Self)
Return Func(_r.apply([_r]))
End Method
End Type
'First lambda within Y
Type YInner1 Extends Scope
Field r:Func 'Parameter - gets closed over
Function lambda:Scope(env:Scope)
Return (New YInner1)._init(env)
End Function
Method apply:Func(args:Object[])
r = Func(args[0])
Return Func(Y(env).f.apply([YInner2.lambda(Self)]))
End Method
End Type
'Second lambda within Y
Type YInner2 Extends Scope
Field a:Object[] 'Parameter - not really needed, but good for clarity
Function lambda:Scope(env:Scope)
Return (New YInner2)._init(env)
End Function
Method apply:Object(args:Object[])
a = args
Local r:Func = YInner1(env).r
Return Func(r.apply([r])).apply(a)
End Method
End Type
'Based on the following definition:
'(define fac (Y (lambda (f)
' (lambda (x)
' (if (<= x 0) 1 (* x (f (- x 1)))))))
Type FacL1 Extends Scope
Field f:Func 'Parameter - gets closed over
Function lambda:Scope(env:Scope)
Return (New FacL1)._init(env)
End Function
Method apply:Object(args:Object[])
f = Func(args[0])
Return FacL2.lambda(Self)
End Method
End Type
Type FacL2 Extends Scope
Function lambda:Scope(env:Scope)
Return (New FacL2)._init(env)
End Function
Method apply:Object(args:Object[])
Local x:Int = Integer(args[0]).val
If x <= 0 Then Return Integer.Make(1) ; Else Return Integer.Make(x * Integer(FacL1(env).f.apply([Integer.Make(x - 1)])).val)
End Method
End Type
'Based on the following definition:
'(define fib (Y (lambda (f)
' (lambda (x)
' (if (< x 2) x (+ (f (- x 1)) (f (- x 2)))))))
Type FibL1 Extends Scope
Field f:Func 'Parameter - gets closed over
Function lambda:Scope(env:Scope)
Return (New FibL1)._init(env)
End Function
Method apply:Object(args:Object[])
f = Func(args[0])
Return FibL2.lambda(Self)
End Method
End Type
Type FibL2 Extends Scope
Function lambda:Scope(env:Scope)
Return (New FibL2)._init(env)
End Function
Method apply:Object(args:Object[])
Local x:Int = Integer(args[0]).val
If x < 2
Return Integer.Make(x)
Else
Local f:Func = FibL1(env).f
Local x1:Int = Integer(f.apply([Integer.Make(x - 1)])).val
Local x2:Int = Integer(f.apply([Integer.Make(x - 2)])).val
Return Integer.Make(x1 + x2)
EndIf
End Method
End Type
'Now test
Local _Y:Func = Y.lambda(Null)
Local fac:Func = Func(_Y.apply([FacL1.lambda(Null)]))
Print Integer(fac.apply([Integer.Make(10)])).val
Local fib:Func = Func(_Y.apply([FibL1.lambda(Null)]))
Print Integer(fib.apply([Integer.Make(10)])).val
[edit] Bracmat
The lambda abstraction
(λx.x)y
translates to
/('(x.$x))$y
in Bracmat code.
( ( Y
= /(
' ( g
. /('(x.$g'($x'$x)))
$ /('(x.$g'($x'$x)))
)
)
)
& ( g
= /(
' ( r
. /(
' ( n
. $n:~>0&1
| $n*($r)$($n+-1)
)
)
)
)
)
& ( h
= /(
' ( r
. /(
' ( n
. $n:(1|2)&1
| ($r)$($n+-1)+($r)$($n+-2)
)
)
)
)
)
& 0:?i
& whl
' ( 1+!i:~>10:?i
& out$(str$(!i "!=" (!Y$!g)$!i))
)
& 0:?i
& whl
' ( 1+!i:~>10:?i
& out$(str$("fib(" !i ")=" (!Y$!h)$!i))
)
&
)
Output:
1!=1 2!=2 3!=6 4!=24 5!=120 6!=720 7!=5040 8!=40320 9!=362880 10!=3628800 fib(1)=1 fib(2)=1 fib(3)=2 fib(4)=3 fib(5)=5 fib(6)=8 fib(7)=13 fib(8)=21 fib(9)=34 fib(10)=55
[edit] C
C doesn't have first class functions, so we demote everything to second class to match.#include <stdio.h>
#include <stdlib.h>
/* func: our one and only data type; it holds either a pointer to
a function call, or an integer. Also carry a func pointer to
a potential parameter, to simulate closure */
typedef struct func_t *func;
typedef struct func_t {
func (*func) (func, func), _;
int num;
} func_t;
func new(func(*f)(func, func), func _) {
func x = malloc(sizeof(func_t));
x->func = f;
x->_ = _; /* closure, sort of */
x->num = 0;
return x;
}
func call(func f, func g) {
return f->func(f, g);
}
func Y(func(*f)(func, func)) {
func _(func x, func y) { return call(x->_, y); }
func_t __ = { _ };
func g = call(new(f, 0), &__);
g->_ = g;
return g;
}
func num(int n) {
func x = new(0, 0);
x->num = n;
return x;
}
func fac(func f, func _null) {
func _(func self, func n) {
int nn = n->num;
return nn > 1 ? num(nn * call(self->_, num(nn - 1))->num)
: num(1);
}
return new(_, f);
}
func fib(func f, func _null) {
func _(func self, func n) {
int nn = n->num;
return nn > 1
? num( call(self->_, num(nn - 1))->num +
call(self->_, num(nn - 2))->num )
: num(1);
}
return new(_, f);
}
void show(func n) { printf(" %d", n->num); }
int main() {
int i;
func f = Y(fac);
printf("fac: ");
for (i = 1; i < 10; i++)
show( call(f, num(i)) );
printf("\n");
f = Y(fib);
printf("fib: ");
for (i = 1; i < 10; i++)
show( call(f, num(i)) );
printf("\n");
return 0;
}
- Output
fac: 1 2 6 24 120 720 5040 40320 362880 fib: 1 2 3 5 8 13 21 34 55
[edit] C#
using System;
class Program
{
delegate Func<int, int> Recursive(Recursive recursive);
static void Main()
{
Func<Func<Func<int, int>, Func<int, int>>, Func<int, int>> Y =
f => ((Recursive)(g => (f(x => g(g)(x)))))((Recursive)(g => f(x => g(g)(x))));
var fac = Y(f => x => x < 2 ? 1 : x * f(x - 1));
var fib = Y(f => x => x < 2 ? x : f(x - 1) + f(x - 2));
Console.WriteLine(fac(6));
Console.WriteLine(fib(6));
}
}
Output:
720 8
[edit] C++
compile withg++ --std=c++0x ycomb.cc
#include <iostream>
#include <functional>
typedef std::function<int(int)> Func;
struct RecursiveFunc {
std::function<Func(RecursiveFunc)> o;
};
Func fix (std::function<Func(Func)> f) {
RecursiveFunc r = {
[f](RecursiveFunc w) {
return f([w](int x) {
return w.o(w)(x);
});
}
};
return r.o(r);
}
Func almost_fac (Func f) {
return [f](int n) {
if (n <= 1) return 1;
return n * f(n - 1);
};
}
Func almost_fib (Func f) {
return [f](int n) {
if (n <= 2) return 1;
return f(n - 1) + f(n - 2);
};
}
int main() {
auto fib = fix(almost_fib);
auto fac = fix(almost_fac);
std::cout << "fib(10) = " << fib(10) << std::endl;
std::cout << "fac(10) = " << fac(10) << std::endl;
return 0;
}
[edit] Clojure
(defn Y [f]
((fn [x] (x x))
(fn [x]
(f (fn [& args]
(apply (x x) args))))))
(def fac
(fn [f]
(fn [n]
(if (zero? n) 1 (* n (f (dec n)))))))
(def fib
(fn [f]
(fn [n]
(condp = n
0 0
1 1
(+ (f (dec n))
(f (dec (dec n))))))))
Sample output:
user> ((Y fac) 10) 3628800 user> ((Y fib) 10) 55
Y can be written slightly more concisely via syntax sugar:
(defn Y [f]
(#(% %) #(f (fn [& args] (apply (% %) args)))))
[edit] Common Lisp
(defun Y (f)
((lambda (x) (funcall x x))
(lambda (y)
(funcall f (lambda (&rest args)
(apply (funcall y y) args))))))
(defun fac (f)
(lambda (n)
(if (zerop n)
1
(* n (funcall f (1- n))))))
(defun fib (f)
(lambda (n)
(case n
(0 0)
(1 1)
(otherwise (+ (funcall f (- n 1))
(funcall f (- n 2)))))))
;; CL-USER> (loop for i from 1 to 10 collect (list i (funcall (Y #'fac) i) (funcall (Y #'fib) i)))
;; ((1 1 1) (2 2 1) (3 6 2) (4 24 3) (5 120 5) (6 720 8) (7 5040 13)
;; (8 40320 21) (9 362880 34) (10 3628800 55))
[edit] D
Though D is a statically typed language it's possible to write a stateless generic Y combinator compactly (DMD 2.058):
import std.stdio, std.traits, std.algorithm, std.range;
auto Y(F)(F f) {
alias void delegate() D;
alias ReturnType!(ParameterTypeTuple!F) Ret;
alias ParameterTypeTuple!(ParameterTypeTuple!F) Pars;
return ((Ret delegate(Pars) delegate(D) x) =>
x(cast(D)x))(
(D y) =>
f((Pars args) =>
(cast(Ret delegate(Pars))(cast(D delegate(D))y)(y))(args)
)
);
}
void main() { // Demo code
auto factorial = Y((int delegate(int) self) =>
(int n) => 0 == n ? 1 : n * self(n - 1)
);
auto ackermann = Y((ulong delegate(ulong, ulong) self) =>
(ulong m, ulong n) {
if (m == 0) return n + 1;
if (n == 0) return self(m - 1, 1);
return self(m - 1, self(m, n - 1));
});
writeln("factorial: ", map!factorial(iota(10)));
writeln("ackermann(3, 5): ", ackermann(3, 5));
}
Output:
factorial: [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880] ackermann(3, 5): 253
[edit] Delphi
May work with Delphi 2009 and 2010 too.
(The translation is not literal; e.g. the function argument type is left unspecified to increase generality.)
program Y;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
YCombinator = class sealed
class function Fix<T> (F: TFunc<TFunc<T, T>, TFunc<T, T>>): TFunc<T, T>; static;
end;
TRecursiveFuncWrapper<T> = record // workaround required because of QC #101272 (http://qc.embarcadero.com/wc/qcmain.aspx?d=101272)
type
TRecursiveFunc = reference to function (R: TRecursiveFuncWrapper<T>): TFunc<T, T>;
var
O: TRecursiveFunc;
end;
class function YCombinator.Fix<T> (F: TFunc<TFunc<T, T>, TFunc<T, T>>): TFunc<T, T>;
var
R: TRecursiveFuncWrapper<T>;
begin
R.O := function (W: TRecursiveFuncWrapper<T>): TFunc<T, T>
begin
Result := F (function (I: T): T
begin
Result := W.O (W) (I);
end);
end;
Result := R.O (R);
end;
type
IntFunc = TFunc<Integer, Integer>;
function AlmostFac (F: IntFunc): IntFunc;
begin
Result := function (N: Integer): Integer
begin
if N <= 1 then
Result := 1
else
Result := N * F (N - 1);
end;
end;
function AlmostFib (F: TFunc<Integer, Integer>): TFunc<Integer, Integer>;
begin
Result := function (N: Integer): Integer
begin
if N <= 2 then
Result := 1
else
Result := F (N - 1) + F (N - 2);
end;
end;
var
Fib, Fac: IntFunc;
begin
Fib := YCombinator.Fix<Integer> (AlmostFib);
Fac := YCombinator.Fix<Integer> (AlmostFac);
Writeln ('Fib(10) = ', Fib (10));
Writeln ('Fac(10) = ', Fac (10));
end.
[edit] E
def y := fn f { fn x { x(x) }(fn y { f(fn a { y(y)(a) }) }) }
def fac := fn f { fn n { if (n<2) {1} else { n*f(n-1) } }}
def fib := fn f { fn n { if (n == 0) {0} else if (n == 1) {1} else { f(n-1) + f(n-2) } }}
? pragma.enable("accumulator")
? accum [] for i in 0..!10 { _.with(y(fac)(i)) }
[1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880]
? accum [] for i in 0..!10 { _.with(y(fib)(i)) }
[0, 1, 1, 2, 3, 5, 8, 13, 21, 34]
[edit] Ela
open Con
let fix = \f -> (\x -> (& f (x x))) (\x -> (& f (x x)))
let fac _ 0 = 1
fac f n = n * f (n-1)
let fib _ 0 = 0
fib _ 1 = 1
fib f n = f (n-1) + f (n-2)
let _ = rec writen
(fix fac 12)
(fix fib 12)
Output:
479001600 144
[edit] Erlang
Y = fun(M) -> (fun(X) -> X(X) end)(fun (F) -> M(fun(A) -> (F(F))(A) end) end) end.
Fac = fun (F) ->
fun (0) -> 1;
(N) -> N * F(N-1)
end
end.
Fib = fun(F) ->
fun(0) -> 0;
(1) -> 1;
(N) -> F(N-1) + F(N-2)
end
end.
(Y(Fac))(5). %% 120
(Y(Fib))(8). %% 21
[edit] F#
type 'a mu = Roll of ('a mu -> 'a)
let unroll (Roll x) = x
//val unroll : 'a mu -> 'a
let fix f = (fun x a -> f (unroll x x) a) (Roll (fun x a -> f (unroll x x) a))
//val fix : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b = <fun>
let fac f = function
0 -> 1
| n -> n * f (n-1)
//val fac : (int -> int) -> int -> int = <fun>
let fib f = function
0 -> 0
| 1 -> 1
| n -> f (n-1) + f (n-2)
//val fib : (int -> int) -> int -> int = <fun>
fix fac 5;;
// val it : int = 120
fix fib 8;;
// val it : int = 21
[edit] Factor
In rosettacode/Y.factor
USING: fry kernel math ;
IN: rosettacode.Y
: Y ( quot -- quot )
'[ [ dup call call ] curry _ call ] dup call( x -- x ) ;
: almost-fac ( quot -- quot )
'[ dup zero? [ drop 1 ] [ dup 1 - _ call * ] if ] ;
: almost-fib ( quot -- quot )
'[ dup 2 >= [ 1 2 [ - _ call ] bi-curry@ bi + ] when ] ;
In rosettacode/Y-tests.factor
USING: kernel tools.test rosettacode.Y ;
IN: rosettacode.Y.tests
[ 120 ] [ 5 [ almost-fac ] Y call ] unit-test
[ 8 ] [ 6 [ almost-fib ] Y call ] unit-test
running the tests :
( scratchpad - auto ) "rosettacode.Y" test
Loading resource:work/rosettacode/Y/Y-tests.factor
Unit Test: { [ 120 ] [ 5 [ almost-fac ] Y call ] }
Unit Test: { [ 8 ] [ 6 [ almost-fib ] Y call ] }
[edit] GAP
Y := function(f)
local u;
u := x -> x(x);
return u(y -> f(a -> y(y)(a)));
end;
fib := function(f)
local u;
u := function(n)
if n < 2 then
return n;
else
return f(n-1) + f(n-2);
fi;
end;
return u;
end;
Y(fib)(10);
# 55
fac := function(f)
local u;
u := function(n)
if n < 2 then
return 1;
else
return n*f(n-1);
fi;
end;
return u;
end;
Y(fac)(8);
# 40320
[edit] Genyris
def fac (f)
function (n)
if (equal? n 0) 1
* n (f (- n 1))
def fib (f)
function (n)
cond
(equal? n 0) 0
(equal? n 1) 1
else (+ (f (- n 1)) (f (- n 2)))
def Y (f)
(function (x) (x x))
function (y)
f
function (&rest args) (apply (y y) args)
assertEqual ((Y fac) 5) 120
assertEqual ((Y fib) 8) 21
[edit] Go
package main
import "fmt"
type Func func(int) int
type FuncFunc func(Func) Func
type RecursiveFunc func (RecursiveFunc) Func
func main() {
fac := fix(almost_fac)
fib := fix(almost_fib)
fmt.Println("fac(10) = ", fac(10))
fmt.Println("fib(10) = ", fib(10))
}
func fix(f FuncFunc) Func {
g := func(r RecursiveFunc) Func {
return f(func(x int) int {
return r(r)(x)
})
}
return g(g)
}
func almost_fac(f Func) Func {
return func(x int) int {
if x <= 1 {
return 1
}
return x * f(x-1)
}
}
func almost_fib(f Func) Func {
return func(x int) int {
if x <= 2 {
return 1
}
return f(x-1)+f(x-2)
}
}
[edit] Groovy
Here is the simplest (unary) form of applicative order Y:
def Y = { le -> ({ f -> f(f) })({ f -> le { x -> f(f)(x) } }) }
def factorial = Y { fac ->
{ n -> n <= 2 ? n : n * fac(n - 1) }
}
assert 2432902008176640000 == factorial(20G)
def fib = Y { fibStar ->
{ n -> n <= 1 ? n : fibStar(n - 1) + fibStar(n - 2) }
}
assert fib(10) == 55
This version was translated from the one in The Little Schemer by Friedman and Felleisen. The use of the variable name le is due to the fact that the authors derive Y from an ordinary recursive length function.
A variadic version of Y in Groovy looks like this:
def Y = { le -> ({ f -> f(f) })({ f -> le { Object[] args -> f(f)(*args) } }) }
def mul = Y { mulStar -> { a, b -> a ? b + mulStar(a - 1, b) : 0 } }
1.upto(10) {
assert mul(it, 10) == it * 10
}
[edit] Haskell
The obvious definition of the Y combinator in Haskell canot be used because it contains an infinite recursive type (a = a -> b). Defining a data type (Mu) allows this recursion to be broken.
newtype Mu a = Roll { unroll :: Mu a -> a }
fix :: (a -> a) -> a
fix = \f -> (\x -> f (unroll x x)) $ Roll (\x -> f (unroll x x))
fac :: Integer -> Integer
fac = fix $ \f n -> if (n <= 0) then 1 else n * f (n-1)
fibs :: [Integer]
fibs = fix $ \fbs -> 0 : 1 : fix zipP fbs (tail fbs)
where zipP f (x:xs) (y:ys) = x+y : f xs ys
main = do
print $ map fac [1 .. 20]
print $ take 20 fibs
The usual version using recursion, disallowed by the task:
fix :: (a -> a) -> a
fix f = f (fix f)
fac :: Integer -> Integer
fac' f n | n <= 0 = 1
| otherwise = n * f (n-1)
fac = fix fac'
-- a simple but wasteful exponential time definition:
fib :: Integer -> Integer
fib' f 0 = 0
fib' f 1 = 1
fib' f n = f (n-1) + f (n-2)
fib = fix fib'
-- Or for far more efficiency, compute a lazy infinite list. This is
-- a Y-combinator version of: fibs = 0:1:zipWith (+) fibs (tail fibs)
fibs :: [Integer]
fibs' a = 0:1:(fix zipP a (tail a))
where
zipP f (x:xs) (y:ys) = x+y : f xs ys
fibs = fix fibs'
-- This code shows how the functions can be used:
main = do
print $ map fac [1 .. 20]
print $ map fib [0 .. 19]
print $ take 20 fibs
[edit] J
In J, functions cannot take functions of the same type as arguments. In other words, verbs cannot take verbs and adverbs or conjunctions cannot take adverbs or conjunctions. However, the Y combinator can be implemented indirectly using, for example, the linear representations of verbs. (Y becomes a wrapper which takes a verb as an argument and serializes it, and the underlying self referring system interprets the serialized representation of a verb as the corresponding verb):
Y=. ((((&>)/)(1 : '(5!:5)<''x'''))(&([ 128!:2 ,&<)))f.
The factorial and Fibonacci examples:
u=. [ NB. Function (left)
n=. ] NB. Argument (right)
sr=. [ 128!:2 ,&< NB. Self referring
fac=. (1:`(n * u sr n - 1:)) @. (0: < n)
fac f. Y 10
3628800
Fib=. ((u sr n - 2:) + u sr n - 1:) ^: (1: < n)
Fib f. Y 10
55
The functions' stateless codings are shown next:
fac f. Y NB. Showing the stateless recursive factorial function...
'1:`(] * [ ([ 128!:2 ,&<) ] - 1:)@.(0: < ])&>/'&([ 128!:2 ,&<)
fac f. NB. Showing the stateless factorial step...
1:`(] * [ ([ 128!:2 ,&<) ] - 1:)@.(0: < ])
Fib f. Y NB. Showing the stateless recursive Fibonacci function...
'(([ ([ 128!:2 ,&<) ] - 2:) + [ ([ 128!:2 ,&<) ] - 1:)^:(1: < ])&>/'&([ 128!:2 ,&<)
Fib f. NB. Showing the stateless Fibonacci step...
(([ ([ 128!:2 ,&<) ] - 2:) + [ ([ 128!:2 ,&<) ] - 1:)^:(1: < ])
A structured derivation of Y follows:
sr=. [ 128!:2 ,&< NB. Self referring
lw=. '(5!:5)<''x''' (1 :) NB. Linear representation of a word
Y=. (&>)/lw(&sr) f.
Y=. 'Y'f. NB. Fixing it
[edit] Java
Java doesn't (currently) have function types. But we can use a generic function interface in the same way.
interface Function<A, B> {
public B call(A x);
}
interface RecursiveFunc<F> extends Function<RecursiveFunc<F>, F> {
}
public class YCombinator {
public static <A,B> Function<A,B> fix(final Function<Function<A,B>, Function<A,B>> f) {
RecursiveFunc<Function<A,B>> r =
new RecursiveFunc<Function<A,B>>() {
public Function<A,B> call(final RecursiveFunc<Function<A,B>> w) {
return f.call(new Function<A,B>() {
public B call(A x) {
return w.call(w).call(x);
}
});
}
};
return r.call(r);
}
public static void main(String[] args) {
Function<Function<Integer,Integer>, Function<Integer,Integer>> almost_fib =
new Function<Function<Integer,Integer>, Function<Integer,Integer>>() {
public Function<Integer,Integer> call(final Function<Integer,Integer> f) {
return new Function<Integer,Integer>() {
public Integer call(Integer n) {
if (n <= 2) return 1;
return f.call(n - 1) + f.call(n - 2);
}
};
}
};
Function<Function<Integer,Integer>, Function<Integer,Integer>> almost_fac =
new Function<Function<Integer,Integer>, Function<Integer,Integer>>() {
public Function<Integer,Integer> call(final Function<Integer,Integer> f) {
return new Function<Integer,Integer>() {
public Integer call(Integer n) {
if (n <= 1) return 1;
return n * f.call(n - 1);
}
};
}
};
Function<Integer,Integer> fib = fix(almost_fib);
Function<Integer,Integer> fac = fix(almost_fac);
System.out.println("fib(10) = " + fib.call(10));
System.out.println("fac(10) = " + fac.call(10));
}
}
[edit] JavaScript
function Y(f) {
var g = f(function() {
return g.apply(this, arguments);
});
return g;
}
var fac = Y(function(f) {
return function(n) {
return n > 1 ? n * f(n - 1) : 1;
};
});
var fib = Y(function(f) {
return function(n) {
return n > 1 ? f(n - 1) + f(n - 2) : n;
};
});
The standard version of the Y combinator does not use lexically bound local variables (or any local variables at all), which necessitates adding a wrapper function and some code duplication - the remaining locale variables are only there to make the relationship to the previous implementation more explicit:
function Y(f) {
var g = f((function(h) {
return function() {
var g = f(h(h));
return g.apply(this, arguments);
}
})(function(h) {
return function() {
var g = f(h(h));
return g.apply(this, arguments);
}
}));
return g;
}
Changing the oder of function application (ie the place where f gets called) and making use of the fact that we're generating a fixed-point, this can be reduced to
function Y(f) {
return (function(h) {
return h(h);
})(function(h) {
return f(function() {
return h(h).apply(this, arguments);
});
});
}
A functionally equivalent, but even simpler version using the implicit this parameter is also possible:
function pseudoY(f) {
return function g() {
return f.apply(g, arguments);
};
}
var fac = pseudoY(function(n) {
return n > 1 ? n * this(n - 1) : 1;
});
var fib = pseudoY(function(n) {
return n > 1 ? this(n - 1) + this(n - 2) : n;
});
However, pseudoY() is not a fixed-point combinator.
[edit] Joy
DEFINE y == [dup cons] swap concat dup cons i;
fac == [ [pop null] [pop succ] [[dup pred] dip i *] ifte ] y.
[edit] Lua
Y = function (f)
return function(...)
return (function(x) return x(x) end)(function(x) return f(function(y) return x(x)(y) end) end)(...)
end
end
Usage:
almostfactorial = function(f) return function(n) return n > 0 and n * f(n-1) or 1 end end
almostfibs = function(f) return function(n) return n < 2 and n or f(n-1) + f(n-2) end end
factorial, fibs = Y(almostfactorial), Y(almostfibs)
print(factorial(7))
[edit] Objective-C
#import <Foundation/Foundation.h>
typedef int (^Func)(int);
typedef Func (^FuncFunc)(Func);
typedef struct RecursiveFunc {
Func (^o)(struct RecursiveFunc);
} RecursiveFunc;
Func fix (FuncFunc f) {
RecursiveFunc r = {
[[^(RecursiveFunc w) {
return f([[^(int x) {
return w.o(w)(x);
} copy] autorelease]);
} copy] autorelease]
};
return r.o(r);
}
int main (int argc, const char *argv[]) {
NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init];
FuncFunc almost_fac = ^Func(Func f) {
return [[^(int n) {
if (n <= 1) return 1;
return n * f(n - 1);
} copy] autorelease];
};
FuncFunc almost_fib = ^Func(Func f) {
return [[^(int n) {
if (n <= 2) return 1;
return f(n - 1) + f(n - 2);
} copy] autorelease];
};
Func fib = fix(almost_fib);
Func fac = fix(almost_fac);
NSLog(@"fib(10) = %d", fib(10));
NSLog(@"fac(10) = %d", fac(10));
[pool release];
return 0;
}
[edit] OCaml
The Y-combinator over functions may be written directly in OCaml provided rectypes are enabled:
let fix f g = (fun x a -> f (x x) a) (fun x a -> f (x x) a) g
Polymorphic variants are the simplest workaround in the absence of rectypes:
let fix f = (fun (`X x) -> f(x (`X x))) (`X(fun (`X x) y -> f(x (`X x)) y));;
Otherwise, an ordinary variant can be defined and used:
type 'a mu = Roll of ('a mu -> 'a);;
let unroll (Roll x) = x;;
let fix f = (fun x a -> f (unroll x x) a) (Roll (fun x a -> f (unroll x x) a));;
let fac f = function
0 -> 1
| n -> n * f (n-1)
;;
let fib f = function
0 -> 0
| 1 -> 1
| n -> f (n-1) + f (n-2)
;;
(* val unroll : 'a mu -> 'a mu -> 'a = <fun>
val fix : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b = <fun>
val fac : (int -> int) -> int -> int = <fun>
val fib : (int -> int) -> int -> int = <fun> *)
fix fac 5;;
(* - : int = 120 *)
fix fib 8;;
(* - : int = 21 *)
The usual version using recursion, disallowed by the task:
let rec fix f x = f (fix f) x;;
[edit] Oz
declare
Y = fun {$ F}
{fun {$ X} {X X} end
fun {$ X} {F fun {$ Z} {{X X} Z} end} end}
end
Fac = {Y fun {$ F}
fun {$ N}
if N == 0 then 1 else N*{F N-1} end
end
end}
Fib = {Y fun {$ F}
fun {$ N}
case N of 0 then 0
[] 1 then 1
else {F N-1} + {F N-2}
end
end
end}
in
{Show {Fac 5}}
{Show {Fib 8}}
[edit] Perl
my $Y = sub { my ($f) = @_; sub {my ($x) = @_; $x->($x)}->(sub {my ($y) = @_; $f->(sub {$y->($y)->(@_)})})};
my $fac = sub {my ($f) = @_; sub {my ($n) = @_; $n < 2 ? 1 : $n * $f->($n-1)}};
print join(' ', map {$Y->($fac)->($_)} 0..9), "\n";
my $fib = sub {my ($f) = @_; sub {my ($n) = @_; $n == 0 ? 0 : $n == 1 ? 1 : $f->($n-1) + $f->($n-2)}};
print join(' ', map {$Y->($fib)->($_)} 0..9), "\n";
[edit] Perl 6
sub Y ($f) { { .($_) }( -> $y { $f({ $y($y)($^arg) }) } ) }
sub fac ($f) { sub ($n) { $n < 2 ?? 1 !! $n * $f($n - 1) } }
say map(Y(&fac), ^10).perl;
sub fib ($f) { sub ($n) { $n < 2 ?? $n !! $f($n - 1) + $f($n - 2) } }
say map(Y(&fib), ^10).perl;
Note that Perl 6 doesn't actually need a Y combinator because you can name anonymous functions from the inside:
(Currently broken under Rakudo 2010.08)
say .(10) given sub (Int $x) { $x < 2 ?? 1 !! $x * &?ROUTINE($x - 1); }
[edit] PHP
<?php
function Y($f) {
$g = function($w) use($f) {
return $f(function($x) use($w) {
$_ = $w($w);
return $_($x);
});
};
return $g($g);
}
$fibonacci = Y(function($f) {
return function($i) use($f) { return ($i <= 1) ? $i : ($f($i-1) + $f($i-2)); };
});
echo $fibonacci(10), "\n";
$factorial = Y(function($f) {
return function($i) use($f) { return ($i <= 1) ? 1 : ($f($i - 1) * $i); };
});
echo $factorial(10), "\n";
?>
[edit] PicoLisp
(de Y (F)
(let X (curry (F) (Y) (F (curry (Y) @ (pass (Y Y)))))
(X X) ) )
[edit] Factorial
# Factorial
(de fact (F)
(curry (F) (N)
(if (=0 N)
1
(* N (F (dec N))) ) ) )
: ((Y fact) 6)
-> 720
[edit] Fibonacci sequence
# Fibonacci
(de fibo (F)
(curry (F) (N)
(if (> 2 N)
1
(+ (F (dec N)) (F (- N 2))) ) ) )
: ((Y fibo) 22)
-> 28657
[edit] Ackermann function
# Ackermann
(de ack (F)
(curry (F) (X Y)
(cond
((=0 X) (inc Y))
((=0 Y) (F (dec X) 1))
(T (F (dec X) (F X (dec Y)))) ) ) )
: ((Y ack) 3 4)
-> 125
[edit] Pop11
define Y(f);
procedure (x); x(x) endprocedure(
procedure (y);
f(procedure(z); (y(y))(z) endprocedure)
endprocedure
)
enddefine;
define fac(h);
procedure (n);
if n = 0 then 1 else n * h(n - 1) endif
endprocedure
enddefine;
define fib(h);
procedure (n);
if n < 2 then 1 else h(n - 1) + h(n - 2) endif
endprocedure
enddefine;
Y(fac)(5) =>
Y(fib)(5) =>
Output:
** 120 ** 8
[edit] PostScript
y {
{dup cons} exch concat dup cons i
}.
/fac {
{ {pop zero?} {pop succ} {{dup pred} dip i *} ifte }
y
}.
[edit] PowerShell
PowerShell Doesn't have true closure, in order to fake it, the script-block is converted to text and inserted whole into the next function using variable expansion in double-quoted strings.
For simple translation of lambda calculus, lambda translates as param inside of a ScriptBlock, 
translates as Invoke-Expression "{}", invocation (written as a space) translates to InvokeReturnAsIs.
$fac = {
param([ScriptBlock] $f)
invoke-expression @"
{
param([int] `$n)
if (`$n -le 0) {1}
else {`$n * {$f}.InvokeReturnAsIs(`$n - 1)}
}
"@
}
$fib = {
param([ScriptBlock] $f)
invoke-expression @"
{
param([int] `$n)
switch (`$n)
{
0 {1}
1 {1}
default {{$f}.InvokeReturnAsIs(`$n-1)+{$f}.InvokeReturnAsIs(`$n-2)}
}
}
"@
}
$Z = {
param([ScriptBlock] $f)
invoke-expression @"
{
param([ScriptBlock] `$x)
{$f}.InvokeReturnAsIs(`$(invoke-expression @`"
{
param(```$y)
{`$x}.InvokeReturnAsIs({`$x}).InvokeReturnAsIs(```$y)
}
`"@))
}.InvokeReturnAsIs({
param([ScriptBlock] `$x)
{$f}.InvokeReturnAsIs(`$(invoke-expression @`"
{
param(```$y)
{`$x}.InvokeReturnAsIs({`$x}).InvokeReturnAsIs(```$y)
}
`"@))
})
"@
}
$Z.InvokeReturnAsIs($fac).InvokeReturnAsIs(5)
$Z.InvokeReturnAsIs($fib).InvokeReturnAsIs(5)
[edit] Prolog
Works with SWI-Prolog and module lambda, written by Ulrich Neumerkel found there http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl.
The code is inspired from this page : http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/ISO-Hiord#Hiord (p 106).
Original code is from Hermenegildo and al : Hiord: A Type-Free Higher-Order Logic Programming Language with Predicate Abstraction, pdf accessible here http://www.stups.uni-duesseldorf.de/asap/?id=129.
:- use_module(lambda).
% The Y combinator
y(P, Arg, R) :-
Pred = P +\Nb2^F2^call(P,Nb2,F2,P),
call(Pred, Arg, R).
test_y_combinator :-
% code for Fibonacci function
Fib = \NFib^RFib^RFibr1^(NFib < 2 ->
RFib = NFib
;
NFib1 is NFib - 1,
NFib2 is NFib - 2,
call(RFibr1,NFib1,RFib1,RFibr1),
call(RFibr1,NFib2,RFib2,RFibr1),
RFib is RFib1 + RFib2
),
y(Fib, 10, FR), format('Fib(~w) = ~w~n', [10, FR]),
% code for Factorial function
Fact = \NFact^RFact^RFactr1^(NFact = 1 ->
RFact = NFact
;
NFact1 is NFact - 1,
call(RFactr1,NFact1,RFact1,RFactr1),
RFact is NFact * RFact1
),
y(Fact, 10, FF), format('Fact(~w) = ~w~n', [10, FF]).
The output :
?- test_y_combinator. Fib(10) = 55 Fact(10) = 3628800 true.
[edit] Python
>>> Y = lambda f: (lambda x: x(x))(lambda y: f(lambda *args: y(y)(*args)))
>>> fac = lambda f: lambda n: (1 if n<2 else n*f(n-1))
>>> [ Y(fac)(i) for i in range(10) ]
[1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880]
>>> fib = lambda f: lambda n: 0 if n == 0 else (1 if n == 1 else f(n-1) + f(n-2))
>>> [ Y(fib)(i) for i in range(10) ]
[0, 1, 1, 2, 3, 5, 8, 13, 21, 34]
[edit] R
Y <- function(f) {
(function(x) { (x)(x) })( function(y) { f( (function(a) {y(y)})(a) ) } )
}
fac <- function(f) {
function(n) {
if (n<2)
1
else
n*f(n-1)
}
}
fib <- function(f) {
function(n) {
if (n <= 1)
n
else
f(n-1) + f(n-2)
}
}
for(i in 1:9) print(Y(fac)(i))
for(i in 1:9) print(Y(fib)(i))
[edit] REBOL
Y: closure [g] [do func [f] [f :f] closure [f] [g func [x] [do f :f :x]]]
- usage example
fact*: closure [h] [func [n] [either n <= 1 [1] [n * h n - 1]]]
fact: Y :fact*
[edit] REXX
/*REXX program to implement Y combinator. */
numeric digits 20
parse arg Y
say 'fib'
say Y(fib (50)) /*Fibonacci series.*/
say 'fib'
say Y(fib (12 11 10 9 8 7 6 5 4 3 2 1 0)) /*Fibonacci series.*/
say 'fact'
say Y(fact (5)) /*single factorial.*/
say 'Dfact'
say Y(fact (0 1 2 3 4 5 6 7 8 9 10 11)) /*single factorial.*/
say 'Dfact'
say Y(dfact (4 5 6 7 8 9 10 11 12 13)) /*double factorial.*/
say 'Tfact'
say Y(tfact (4 5 6 7 8 9 10 11 12 13)) /*triple factorial.*/
say 'Qfact'
say Y(qfact (4 5 6 7 8 40)) /*quadruple factorial.*/
say 'length'
say Y(length (when for to where whenceforth)) /*lengths*/
say 'reverse'
say Y(reverse (23 678 1007 45 mas I ma)) /*reverses*/
say 'trunc'
say Y(trunc (-7.0005 12 3.14159 6.4 78.999)) /*truncs*/
exit
Y: lambda=;arg Y _;do j=1 for words(_);interpret ,
'lambda=lambda' Y'('word(_,j)')';end;return lambda
fib: procedure; arg x; if x<2 then return x; s=0; a=0; b=1
do j=2 to x; s=a+b; a=b; b=s; end; return s
dfact: procedure; arg x; !=1; do j=x to 2 by -2;!=!*j; end; return !
tfact: procedure; arg x; !=1; do j=x to 2 by -3;!=!*j; end; return !
qfact: procedure; arg x; !=1; do j=x to 2 by -3;!=!*j; end; return !
fact: procedure; arg x; !=1; do j=2 to x ;!=!*j; end; return !
Output:
fib 12586269025 fib 144 89 55 34 21 13 8 5 3 2 1 1 0 fact 120 Dfact 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800 Dfact 8 15 48 105 384 945 3840 10395 46080 135135 Tfact 4 10 18 28 80 162 280 880 1944 3640 Qfact 4 10 18 28 80 26582634158080000 length 4 3 2 5 11 reverse 32 876 7001 54 SAM I AM trunc -7 12 3 6 78
[edit] Ruby
Using a lambda:
irb(main):001:0> Y = lambda do |f|
irb(main):002:1* lambda {|g| g[g]}[lambda do |g|
irb(main):003:3* f[lambda {|*args| g[g][*args]}]
irb(main):004:3> end]
irb(main):005:1> end
=> #<Proc:0x00000204f5e6e0@(irb):1 (lambda)>
irb(main):006:0> Fac = lambda{|f| lambda{|n| n < 2 ? 1 : n * f[n-1]}}
=> #<Proc:0x00000202a88aa0@(irb):6 (lambda)>
irb(main):007:0> Array.new(10) {|i| Y[Fac][i]}
=> [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880]
irb(main):008:0> Fib = lambda{|f| lambda{|n| n < 2 ? n : f[n-1] + f[n-2]}}
=> #<Proc:0x00000201a968b8@(irb):8 (lambda)>
irb(main):009:0> Array.new(10) {|i| Y[Fib][i]}
=> [0, 1, 1, 2, 3, 5, 8, 13, 21, 34]
Using a method:
def y(&f)
lambda do |g|
f.call {|*args| g[g][*args]}
end.tap {|g| break g[g]}
end
Fac = y {|&f| lambda {|n| n < 2 ? 1 : n * f[n - 1]}}
Fib = y {|&f| lambda {|n| n < 2 ? n : f[n - 1] + f[n - 2]}}
p Array.new(10) {|i| Fac[i]}
# => [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880]
p Array.new(10) {|i| Fib[i]}
# => [0, 1, 1, 2, 3, 5, 8, 13, 21, 34]
[edit] Scala
Credit goes to the thread in scala blog
def Y[A,B](f: (A=>B)=>(A=>B)) = {
case class W(wf: W=>A=>B) {
def apply(w: W) = wf(w)
}
val g: W=>A=>B = w => f(w(w))(_)
g(W(g))
}
Example
val factorial = Y[Int, Int](f => i => if (i <= 0) 1 else f(i - 1) * i)
[edit] Scheme
(define Y
(lambda (f)
((lambda (x) (x x))
(lambda (g)
(f (lambda (x) ((g g) x)))))))
(define fac
(Y
(lambda (f)
(lambda (x)
(if (< x 2)
1
(* x (f (- x 1))))))))
(define fib
(Y
(lambda (f)
(lambda (x)
(if (< x 2)
x
(+ (f (- x 1)) (f (- x 2))))))))
(display (fac 6))
(newline)
(display (fib 6))
(newline)
Output:
720 8
[edit] Slate
The Y combinator is already defined in slate as:
Method traits define: #Y &builder:
[[| :f | [| :x | f applyWith: (x applyWith: x)]
applyWith: [| :x | f applyWith: (x applyWith: x)]]].
[edit] Smalltalk
Y := [:f| [:x| x value: x] value: [:g| f value: [:x| (g value: g) value: x] ] ].
fib := Y value: [:f| [:i| i <= 1 ifTrue: [i] ifFalse: [(f value: i-1) + (f value: i-2)] ] ].
(fib value: 10) displayNl.
fact := Y value: [:f| [:i| i = 0 ifTrue: [1] ifFalse: [(f value: i-1) * i] ] ].
(fact value: 10) displayNl.
Output:
55 3628800
[edit] Standard ML
- datatype 'a mu = Roll of ('a mu -> 'a)
fun unroll (Roll x) = x
fun fix f = (fn x => fn a => f (unroll x x) a) (Roll (fn x => fn a => f (unroll x x) a))
fun fac f 0 = 1
| fac f n = n * f (n-1)
fun fib f 0 = 0
| fib f 1 = 1
| fib f n = f (n-1) + f (n-2)
;
datatype 'a mu = Roll of 'a mu -> 'a
val unroll = fn : 'a mu -> 'a mu -> 'a
val fix = fn : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b
val fac = fn : (int -> int) -> int -> int
val fib = fn : (int -> int) -> int -> int
- List.tabulate (10, fix fac);
val it = [1,1,2,6,24,120,720,5040,40320,362880] : int list
- List.tabulate (10, fix fib);
val it = [0,1,1,2,3,5,8,13,21,34] : int list
[edit] Tcl
Y combinator is derived in great detail here.
[edit] Ursala
The standard y combinator doesn't work in Ursala due to eager evaluation, but an alternative is easily defined as shown
(r "f") "x" = "f"("f","x")
my_fix "h" = r ("f","x"). ("h" r "f") "x"
or by this shorter expression for the same thing in point free form.
my_fix = //~&R+ ^|H\~&+ ; //~&R
Normally you'd like to define a function recursively by writing
f = h(f), where h(f) is just the body of the
function with recursive calls to f in it. With a fixed point
combinator such as my_fix as defined above, you do almost the same thing, except it's f = my_fix
"f". h("f"), where the dot represents lambda abstraction and the
quotes signify a dummy variable. Using this
method, the definition of the factorial function becomes
#import nat
fact = my_fix "f". ~&?\1! product^/~& "f"+ predecessor
To make it easier, the compiler has a directive to let you install your own fixed point combinator for it to use, which looks like this,
#fix my_fix
with your choice of function to be used in place of my_fix.
Having done that, you may express recursive functions per convention by circular definitions,
as in this example of a Fibonacci function.
fib = {0,1}?</1! sum+ fib~~+ predecessor^~/~& predecessor
Note that this way is only syntactic sugar for the for explicit way
shown above. Without a fixed point combinator given in the #fix
directive, this definition of fib
would not have compiled. (Ursala allows user defined fixed point
combinators because they're good for other things besides
functions.)
To confirm that all this works, here is a test program applying
both of the functions defined above to the numbers from 1 to 8.
#cast %nLW
examples = (fact* <1,2,3,4,5,6,7,8>,fib* <1,2,3,4,5,6,7,8>)
output:
( <1,2,6,24,120,720,5040,40320>, <1,2,3,5,8,13,21,34>)
The fixed point combinator defined above is theoretically correct but inefficient and limited to first order functions, whereas the standard distribution includes a library (sol) providing a hierarchy of fixed point combinators suitable for production use and with higher order functions. A more efficient alternative implementation of my_fix would be general_function_fixer 0 (with 0 signifying the lowest order of fixed point combinators), or if that's too easy, then by this definition.
#import sol
#fix general_function_fixer 1
my_fix "h" = "h" my_fix "h"
Note that this equation is solved using the next fixed point combinator in the hierarchy.
Categories:
- Programming Tasks
- Classic CS problems and programs
- Recursion
- ALGOL 68
- AppleScript
- BlitzMax
- Bracmat
- C
- C sharp
- C++
- Clojure
- Common Lisp
- D
- Delphi
- E
- Ela
- Erlang
- F Sharp
- Factor
- GAP
- Genyris
- Go
- Groovy
- Haskell
- J
- Java
- JavaScript
- Joy
- Lua
- Objective-C
- OCaml
- Oz
- Perl
- Perl 6
- PHP
- PicoLisp
- Pop11
- PostScript
- Initlib
- PowerShell
- Prolog
- Python
- R
- REBOL
- REXX
- Ruby
- Scala
- Scheme
- Slate
- Smalltalk
- Standard ML
- Tcl
- Ursala
- ACL2/Omit
- Ada/Omit
- PureBasic/Omit
- TI-89 BASIC/Omit
