steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

rosetta-code.y-combinator: add ackerman functions to demonstrate several inputs

db4
Jon Harper 2012-08-04 22:31:10 +02:00 committed by John Benediktsson
parent e980e26f70
commit cc621ee5ee
2 changed files with 12 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
extra/rosetta-code/y-combinator/y-combinator-tests.factor
View File

@ -3,4 +3,5 @@ IN: rosetta-code.y-combinator
[ 120 ] [ 5 [ almost-fac ] Y call ] unit-test [ 120 ] [ 5 [ almost-fac ] Y call ] unit-test
[ 8 ] [ 6 [ almost-fib ] Y call ] unit-test [ 8 ] [ 6 [ almost-fib ] Y call ] unit-test
[ 61 ] [ 3 3 [ almost-ack ] Y call ] unit-test

12
extra/rosetta-code/y-combinator/y-combinator.factor
View File

@ -1,6 +1,6 @@
! Copyright (c) 2012 Anonymous ! Copyright (c) 2012 Anonymous
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: fry kernel math ; USING: combinators fry kernel locals math ;
IN: rosetta-code.y-combinator IN: rosetta-code.y-combinator
! http://rosettacode.org/wiki/Y_combinator ! http://rosettacode.org/wiki/Y_combinator
@ -31,3 +31,13 @@ IN: rosetta-code.y-combinator
! fibonacci sequence ! fibonacci sequence
: almost-fib ( quot -- quot ) : almost-fib ( quot -- quot )
'[ dup 2 >= [ 1 2 [ - @ ] bi-curry@ bi + ] when ] ; '[ 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
] ;