################################################################
 #
 # Lambda Calculus demonstration in Perl
 # 4 April 1999 
 # M-J. Dominus (mjd-perl-lc@plover.com)
 # http://www.plover.com/~mjd/perl/lambda/
 #
 ############
 #
 # Truth and truth testing
 # IF = %btf.btf
 $IF = sub { my $b = shift;
 sub { my $t = shift;
 sub { my $f = shift;
 ($b)->($t)->($f);
 }
 }
 }
 ;
 
 # TRUE = %xy.x
 $TRUE = sub { my $x = shift;
 sub { my $y = shift;
 $x;
 }
 }
 ;
 
 # FALSE = %xy.y
 $FALSE = sub { my $x = shift;
 sub { my $y = shift;
 $y;
 }
 }
 ;
 ############
 #
 # Pairs (conses)
 
 # PAIR = %xyb.bxy
 $PAIR = sub { my $x = shift;
 sub { my $y = shift;
 sub { my $b = shift;
 ($b)->($x)->($y);
 }
 }
 }
 ;
 
 # FIRST = %p.(p TRUE)
 $FIRST = sub { my $p = shift;
 ($p)->($TRUE);
 }
 ;
 
 # SECOND = %p.(p FALSE)
 $SECOND = sub { my $p = shift;
 ($p)->($FALSE);
 }
 ;
 
 ############
 #
 # Numerals
 #
 
 $ZERO = ($PAIR)->($TRUE)->($TRUE);
 $SUCC = sub { my $n = shift;
 ($PAIR)->($FALSE)->($n);
 }
 ;
 $ONE = ($SUCC)->($ZERO);
 $TWO = ($SUCC)->($ONE);
 $IS_ZERO = sub { my $n = shift;
 ($FIRST)->($n);
 }
 ;
 $PRED = sub { my $n = shift;
 ($SECOND)->($n);
 }
 ;
 
 
 ############
 #
 # We use this utility function only for checking to see if the
 # addition was done correctly
 # 
 
 sub convert_to_perl_number {
 my $n = shift;
 my $o = 0;
 until ($IF->($IS_ZERO->($n))->(1)->(undef)) {
 $o++; $n = $PRED->($n);
 }
 $o;
 }
 ############
 #
 # Fixed-point combinator
 # YM has the property that
 # (YM f Q) = f (YM f)
 # for any Q
 #
 # YM = %f.(%x.(%y.f (x x)))(%x.(%y.f (x x)))
 
 $YM = sub { my $f = shift;
 (sub { my $x = shift; 
 sub { my $y = shift; 
 $f->($x->($x));
 };
 })->
 (sub { my $x = shift; 
 sub { my $y = shift; 
 $f->($x->($x));
 };
 })
 
 }
 ;
 
 # Q is arbitrary, so we use something simple: %x.x
 $FORCE = sub { my $x = shift; $x };
 
 ############
 #
 # Here's the basis for our addition function
 # R = %g.(%mn.(IF (IS_ZERO m) 
 # (%q.n)
 # (%q.(g FORCE) (PRED m) (SUCC n))
 # ) FORCE
 # )
 
 $R = sub { my $g = shift;
 sub { my $m = shift;
 sub { my $n = shift; 
 $IF->($IS_ZERO->($m))
 ->(sub { my $q = shift; $n} )
 ->(sub { my $q = shift;
 ($g->($FORCE))
 ->($PRED->($m))
 ->($SUCC->($n));
 })->($FORCE);
 }
 }
 }
 ;
 
 # This constructs the actual addition function
 $ADD = $YM->($R)->($FORCE); 
 
 # Add 1+1 with recursive addition function
 $mystery_result = $ADD->($ONE)->($ONE);
 print "1+1 = ", convert_to_perl_number($mystery_result), "\n";
 
</div><div class="naked_ctrl">
<form action="/index.cgi/contrast" method="get" name="gate">
<p><a href="http://altstyle.alfasado.net">AltStyle</a> によって変換されたページ <a href="https://perl.plover.com/lambda/jfp/lambda-brief.pl">(-&gt;オリジナル)</a>
/ <label>アドレス: <input type="text" name="naked_post_url" value="https://perl.plover.com/lambda/jfp/lambda-brief.pl" size="22" /></label> <label>モード: <select name="naked_post_mode">
<option value="default">デフォルト</option>
<option value="speech">音声ブラウザ</option>
<option value="ruby">ルビ付き</option>
<option value="contrast" selected="selected">配色反転</option>
<option value="larger-text">文字拡大</option>
<option value="mobile">モバイル</option>
</select>
<input type="submit" value="表示" />
</p>
</form>
</div>