From cc621ee5ee7bba4a628ee1e1734ed8064979cec5 Mon Sep 17 00:00:00 2001
From: Jon Harper <jon.harper87@gmail.com>
Date: Sat, 4 Aug 2012 22:31:10 +0200
Subject: [PATCH] rosetta-code.y-combinator: add ackerman functions to
 demonstrate several inputs

---
 .../y-combinator/y-combinator-tests.factor           |  1 +
 extra/rosetta-code/y-combinator/y-combinator.factor  | 12 +++++++++++-
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/extra/rosetta-code/y-combinator/y-combinator-tests.factor b/extra/rosetta-code/y-combinator/y-combinator-tests.factor
index e76e18eee9..08feb197c4 100644
--- a/extra/rosetta-code/y-combinator/y-combinator-tests.factor
+++ b/extra/rosetta-code/y-combinator/y-combinator-tests.factor
@@ -3,4 +3,5 @@ IN: rosetta-code.y-combinator
 
 [ 120 ] [ 5 [ almost-fac ] Y call ] unit-test
 [ 8 ]   [ 6 [ almost-fib ] Y call ] unit-test
+[ 61 ]  [ 3 3 [ almost-ack ] Y call ] unit-test
 
diff --git a/extra/rosetta-code/y-combinator/y-combinator.factor b/extra/rosetta-code/y-combinator/y-combinator.factor
index 96dc2d3d9a..0eb68c6aae 100644
--- a/extra/rosetta-code/y-combinator/y-combinator.factor
+++ b/extra/rosetta-code/y-combinator/y-combinator.factor
@@ -1,6 +1,6 @@
 ! Copyright (c) 2012 Anonymous
 ! See http://factorcode.org/license.txt for BSD license.
-USING: fry kernel math ;
+USING: combinators fry kernel locals math ;
 IN: rosetta-code.y-combinator
 
 ! http://rosettacode.org/wiki/Y_combinator
@@ -31,3 +31,13 @@ IN: rosetta-code.y-combinator
 ! fibonacci sequence
 : almost-fib ( quot -- quot )
     '[ dup 2 >= [ 1 2 [ - @ ] bi-curry@ bi + ] when ] ;
+
+! Ackermann–Péter function
+:: almost-ack ( quot -- quot )
+    [
+        {
+          { [ over zero? ] [ nip 1 + ] }
+          { [ dup zero? ] [ [ 1 - ] [ drop 1 ] bi* quot call ] }
+          [ [ drop 1 - ] [ 1 - quot call ] 2bi quot call ]
+        } cond
+    ] ;