Universal Lambda Machine: Difference between revisions
m
Move Haskell before JavaScript
imported>Tromp (add universal Lambda machine in Ruby) |
m (Move Haskell before JavaScript) |
||
| (25 intermediate revisions by 5 users not shown) | |||
Line 25:
Also, the 342 bit program
<
should produce output
<
For byte-mode, one should reproduce the
Line 34:
* https://rosettacode.org/wiki/Execute_Brain****#Binary_Lambda_Calculus
When run on the 186-byte binary file https://www.ioccc.org/2012/tromp/tromp/symbolic.Blc followed by input 010000011100111001110100000011100111010, it should output
<pre>(\a \b a (a (a b))) (\a \b a (a b))
\a (\b \c b (b c)) ((\b \c b (b c)) ((\b \c b (b c)) a))
\a \b (\c \d c (c d)) ((\c \d c (c d)) a) ((\c \d c (c d)) ((\c \d c (c d)) a) b)
\a \b (\c (\d \e d (d e)) a ((\d \e d (d e)) a c)) ((\c \d c (c d)) ((\c \d c (c d)) a) b)
\a \b (\c \d c (c d)) a ((\c \d c (c d)) a ((\c \d c (c d)) ((\c \d c (c d)) a) b))
\a \b (\c a (a c)) ((\c \d c (c d)) a ((\c \d c (c d)) ((\c \d c (c d)) a) b))
\a \b a (a ((\c \d c (c d)) a ((\c \d c (c d)) ((\c \d c (c d)) a) b)))
\a \b a (a ((\c a (a c)) ((\c \d c (c d)) ((\c \d c (c d)) a) b)))
\a \b a (a (a (a ((\c \d c (c d)) ((\c \d c (c d)) a) b))))
\a \b a (a (a (a ((\c (\d \e d (d e)) a ((\d \e d (d e)) a c)) b))))
\a \b a (a (a (a ((\c \d c (c d)) a ((\c \d c (c d)) a b)))))
\a \b a (a (a (a ((\c a (a c)) ((\c \d c (c d)) a b)))))
\a \b a (a (a (a (a (a ((\c \d c (c d)) a b))))))
\a \b a (a (a (a (a (a ((\c a (a c)) b))))))
\a \b a (a (a (a (a (a (a (a b)))))))</pre>
=={{header|Binary Lambda Calculus}}==
The following self interpreters are taken from the IOCCC entry at https://www.ioccc.org/2012/tromp/hint.html
Bit-wise (the whitespace is actually not part of the program and should be removed before feeding it into the universal machine) :
<
10100000
00010101
Line 62 ⟶ 77:
01110110 00011001
00011010 00011010
</pre>
Byte-wise (showing https://www.ioccc.org/2012/tromp/uni8.Blc in hex, again with whitespace for decorational purposes only):
<
05580
05f00
Line 78 ⟶ 93:
0b7fb 00cf6
7bb03 91a1a
</pre>
=={{header|Bruijn}}==
We use bruijn's meta encoding and its [https://text.marvinborner.de/2023-09-03-21.html meta-circular self-interpreter]. Since results are not always streamed lazily, infinite output needs to be shortened by taking only the first n elements of the output list.
<syntaxhighlight lang="bruijn">
:import std/Combinator .
:import std/Number/Binary .
:import std/Meta M
:import std/List .
# converts string to list of bits
str→blc map (c ∘ lsb)
:test (str→blc "0010") ([[1]] : ([[1]] : ([[0]] : {}[[1]])))
# converts list of bits to string
blc→str map [0 '0' '1']
:test (blc→str ([[1]] : ([[1]] : ([[0]] : {}[[1]])))) ("0010")
# evaluates BLC string
main str→blc → M.blc→meta+rest → &M.eval → blc→str
# --- tests ---
id "0010"
# 342 bit IO example
io "010100011010000000011000010110011110000010010111110111100001010110000000011000011111000000101111110110010111111011001011110100111010111100010000001011100101010001101000000000010110000101011111101111100000010101111011111011111100001011000000101111111010110111000000111111000010110111101110011110100000010110000011011000100000101111000111001110"
# quine example
quine "000101100100011010000000000001011011110010111100111111011111011010000101100100011010000000000001011011110010111100111111011111011010"
# 100 doors example
doors "0001000100010101000110100000010110000011001110110010100011010000000000101111111000000101111101011001011001000110100001111100110100101111101111000000001011111111110110011001111111011100000000101111110000001011111010110011011100101011000000101111011001011110011110011110110100000000001011011100111011110000000001000000111001110100000000101101110110"
# sieve of Eratosthenes example
primes "00010001100110010100011010000000010110000010010001010111110111101001000110100001110011010000000000101101110011100111111101111000000001111100110111000000101100000110110"
:test (main id) (empty)
:test (main io) ("11010")
:test (main quine) (quine)
:test (take (+20) (main doors)) ("10010000100000010000")
:test (take (+20) (main primes)) ("00110101000101000101")
</syntaxhighlight>
=={{header|C}}==
<syntaxhighlight lang="c">#
#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
enum {I,O,V,A,L}; // Input Output Variable Application Lambda
// in term space T, application (f a) is A followed by length of f,
// followed by f and a. Variable (de-Bruijn) i is V followed by i.
long n=44,i,c,T[M]={L,A,8,A,2, V,0,L,L,V,
A,30,L,A,2,V,0,L,A,5,A,7,L,V,0,O,
Line 113 ⟶ 174:
assert(f&&s<M);S[s++]=l=f;f=l->n;
l->r=1;l->t=t+T[t-1];(l->e=e)&&e->r++;break;
case L: if(!s--){
}
return T[t+2];
}
</syntaxhighlight>
=={{header|Haskell}}==
A bit-wise only ULM:
<syntaxhighlight lang="haskell">
import System.IO
import Data.List
import Text.Parsec
import Control.Applicative hiding ((<|>), many)
data WHNF = SYM !Char | FUN (WHNF -> WHNF)
fun :: WHNF -> WHNF -> WHNF
fun (SYM c) _ = error $ "Cannot apply symbol " ++ [c]
fun (FUN f) w = f w
expr :: Monad m => ParsecT String u m ([WHNF] -> WHNF)
expr = char '0' *> (buildLambda <$ char '0' <*> expr
<|> buildApply <$ char '1' <*> expr <*> expr)
<|> buildVar <$> pred.length <$> many (char '1') <* char '0' where
buildLambda e env = FUN $ \arg -> e (arg:env)
buildApply e1 e2 env = e1 env `fun` e2 env
buildVar n env = env !! n
buildIO prog = whnfToString . (prog [] `fun` ) . stringToWhnf where
stringToWhnf :: [Char] -> WHNF
stringToWhnf = foldr (whnfCons . bitToWhnf . fromEnum) whnfFalse where
bitToWhnf :: Integral a => a -> WHNF
bitToWhnf n = if even n then whnfTrue else whnfFalse
whnfCons :: WHNF -> WHNF -> WHNF
whnfCons fw gw = FUN $ \hw -> hw `fun` fw `fun` gw
whnfToString = map whnfToChar . whnfToList where
cons2sym :: WHNF
cons2sym = whnfConst . whnfConst $ SYM ':'
whnfToList :: WHNF -> [WHNF]
whnfToList l = case (l `fun` cons2sym) of
SYM ':' -> l `fun` whnfTrue : whnfToList (l `fun` whnfFalse)
FUN _ -> []
whnfToChar :: WHNF -> Char
whnfToChar iw = c where (SYM c) = iw `fun` SYM '0' `fun` SYM '1'
whnfConst :: WHNF -> WHNF
whnfConst = FUN . const
whnfTrue :: WHNF
whnfTrue = FUN whnfConst
whnfFalse :: WHNF
whnfFalse = whnfConst $ FUN id
main = do
hSetBuffering stdout NoBuffering
interact $ either (error . show) id . parse (buildIO <$> expr <*> getInput) ""
</syntaxhighlight>
Feel free to replace this by a solution for both bit-wise and byte-wise.
=={{header|JavaScript}}==
<syntaxhighlight lang="javascript">#!/usr/local/bin/node --stack-size=8192
let bytemode = process.argv.length <= 2;
var data;
var nchar = 0;
var nbit = 0;
var progchar;
function bit2lam(bit) {
return function(x0) { return function(x1) { return bit ? x1 : x0 } }
}
function byte2lam(bits,n) {
return n==0 ? (function(_) { return function(y) { return y } }) // nil
: (function(z) { return z (bit2lam((bits>>(n-1))&1))
(byte2lam(bits,n-1)) }) // cons bitn bits>n
}
function input(n) { // input from n'th character onward
if (n >= data.length)
return function(z) { { return function(y) { return y } } } // nil
let c = data[n];
return function(z) { return z (bytemode ? byte2lam(c,8) : bit2lam(c&1)) (input(n+1)) } // cons charn chars>n
}
function lam2bit(lambit) {
return lambit(function(_){return 0})(function(_){return 1})() // force suspension
}
function lam2byte(lambits, x) {
return lambits(function(lambit) {
return function(lamtail) {
return function(_) { return lam2byte(lamtail, 2*x + lam2bit(lambit)) }
}
})(Buffer.from([x])) // end of byte
}
function output(prog) {
return prog(function(c) { // more chars
process.stdout.write(bytemode ? lam2byte(c,0) : lam2bit(c) ? '1' : '0');
return function(tail) {
return function(_) { return output(tail) }
}
})(0) // end of output
}
function getbit() {
if (nbit==0) {
progchar = data[nchar++];
nbit = bytemode ? 8 : 1;
}
return (progchar >> --nbit) & 1;
}
function program() {
if (getbit()) { // variable
var i = 0;
while (getbit()==1) { i++ }
return function() { return arguments[i] }
} else if (getbit()) { // application
let p = program();
let q = program();
return function(...args) {
return p(...args)(function(arg) { return q(...args)(arg) }) // suspend argument
}
} else {
let p = program();
return function(...args) {
return function(arg) { return p(arg, ...args) } // extend environment with one more argument
}
}
}
process.stdin.on('readable', () => {
if ((data = process.stdin.read()) != null) {
prog = program()();
output(prog(input(nchar))) // run program with empty env on input
}
});</syntaxhighlight>
=={{header|Perl}}==
<syntaxhighlight lang="perl">#!/usr/bin/perl
sub bit2lam {
my $bit = pop;
sub { my $x0 = pop; sub { my $x1 = pop; $bit ? $x1 : $x0 } }
}
sub byte2lam {
my ($bits,$n) = @_;
$n == 0 ? sub { sub { pop } } # nil
: sub { pop->(bit2lam(vec$bits,$n-1,1))->(byte2lam($bits,$n-1)) }
}
sub input {
my $n = pop; # input from n'th character onward
if ($n >= @B) {
my $c = getc;
push @B, !defined($c) ? sub {sub { pop } } # nil
: sub { pop->($bytemode ? byte2lam($c,8) : bit2lam($c))->(input($n+1)) }
}
$B[$n];
}
sub lam2bit {
pop->(sub{0})->(sub{1})->() # force suspension
}
sub lam2byte {
my ($lambits, $x) = @_; # 2nd argument is partial byte
$lambits->(sub { my $lambit = pop; sub { my $tail = pop; sub { lam2byte($tail, 2*$x + lam2bit($lambit)) }
}})->(chr $x) # end of byte
}
sub output {
pop->(sub { my $c = pop; print($bytemode ? lam2byte($c,0) : lam2bit($c));
sub { my $tail = pop; sub { output($tail) } } })->(0) # end of output
}
sub getbit {
$n ||= ($c = getc, $bytemode ? 8 : 1);
vec $c,--$n,1;
}
sub program {
if (getbit()) { # variable
my $i;
$i++ while getbit();
sub { $_[$i] }
} elsif (getbit()) { # application
my $p=program();
my $q=program();
sub { my @env = @_; $p->(@env)->(sub { $q->(@env)->(pop) }) } # suspend argument
} else {
my $p = program();
sub { my @env = @_; sub { $p->(pop,@env) } } # extend environment with one more argument
}
}
$bytemode = !pop; # any argument sets bitmode instead
$| = 1; # non zero value sets autoflush
$prog = program()->();
output $prog->(input(0)) # run program with empty env on input</syntaxhighlight>
=={{header|Phix}}==
Translation of "how it works" and hence bitmode-only, except for leading ' '..'/' trick, and I managed to get Quine8 to work with only a minor kludge.<br>
If you think you can get blc8 to work, just be grateful that I decided at the eleventh hour and by the skin of my teeth against obfuscating this..
<syntaxhighlight lang="phix">
with javascript_semantics
constant IOP = 0, // code for gro, wr0, wr1, put
VAR = 1, // code for variable lookup
APP = 2, // code for applications
ABS = 3, // code for abstractions
ROOT = 1 // sentinel kept at stack[1]
sequence nexts, envps, refs, terms, // stack
mem // memory
integer ip, // instruction pointer
ep, // end of code pointer
frep, // freelist
contp, // continuation stack
envp // environment pointer
--constant M = 512 -- grow automatically
constant M = 50000 -- fixed limit (~safer)
-- (Programs that are left to run out of memory will tend to
-- gradually slow the machine, and sometimes even hang it.)
procedure grow_memory()
if M!=512 then crash("out of memory") end if
-- else 512->1024->2048->4096->8192, etc.
mem &= repeat(0,length(mem))
end procedure
procedure Gc(integer p)
// garbage collection (stack only, but not mem)
while p>ROOT do
refs[p] -= 1
if refs[p] then exit end if
Gc(nexts[p])
nexts[p] = frep
frep = p
p = envps[p]
end while
end procedure
procedure Var()
integer e = envp, t = envp,
x = mem[ip+1], i = 1
while i<=x and e!=ROOT do
e = nexts[e]
i += 1
end while
assert(e!=ROOT,"UNDEFINED VARIABLE %d", {x})
ip = terms[e]
envp = envps[e]
refs[envp] += 1
Gc(t)
end procedure
bool bitmode
string src, tgt
integer sdx = 0, b = 0, c
function nextbit()
if b=0 then
if sdx>=length(src) then return -1 end if
sdx += 1
c = src[sdx]
b = iff(bitmode?1:8)
end if
b -= 1
return shift_bits(c,b)&&1
end function
procedure Gro()
integer c = nextbit(), sc = ep+1
sequence g = iff(c!=-1?{ABS,APP,8,APP,2,VAR,0,ABS,ABS,VAR,even(c)}
:{ABS,ABS,VAR,0})
ep += length(g)
if ep>=length(mem) then grow_memory() end if
mem[sc..ep] = g
end procedure
string outlog = ""
integer o = 0, ob = 0
bool quine8 -- mini-kludge...
procedure Put()
integer ch = '1'-odd(ip)
ip = 3;
if not bitmode then
o = o*2+odd(ch)
ob += 1
if ob<8 then return end if
ch = o
o = 0
ob = 0
end if
if quine8 then
printf(1,"%02x",ch)
else
puts(1,ch)
end if
outlog &= ch
end procedure
procedure Abs()
// pops continuation and pushes it to environment
integer t = contp
contp = nexts[t]
nexts[t] = envp
envp = t
ip += 1
end procedure
procedure App()
// pushes continuation for argument
int x = mem[ip+1]
integer t = frep, e, term = ip+2+x
if t=0 then
nexts = append(nexts,0)
envps = append(envps,0)
refs = append(refs,0)
terms = append(terms,0)
t = length(terms)
end if
frep = nexts[t]
refs[t] = 1
terms[t] = term
if term>22 and term!=ep then
e = envp
refs[e] += 1
else
e = ROOT
end if
envps[t] = e
nexts[t] = contp
contp = t
ip += 2
end procedure
procedure Iop()
if ip>=ep then
Gro()
else
Put() // ip is an element of {6,13,20,21}
end if
Gc(envp)
envp = ROOT
end procedure
function NeedBit()
integer b = nextbit()
assert(b!=-1,"UNEXPECTED EOF")
return b
end function
function Parse()
integer t, start = ep, p, bit
bool need = false
while true do
if ep+2>=length(mem) then grow_memory() end if
bit = nextbit()
if bit==-1 then
if not need then exit end if
crash("UNFINISHED EXPRESSION");
elsif bit then
t = 0
while NeedBit() do t+=1 end while
ep += 2
mem[ep-1..ep] = {VAR,t}
exit
elsif NeedBit() then
t = ep+1
ep += 2;
mem[t..t+1] = {APP,Parse()}
need = true
else
ep += 1
mem[ep] = ABS
end if
end while
return ep-start
end function
procedure Krivine(bool soe)
ep = 25
mem[1..24] = {APP, 21, ABS, APP, 9, VAR, 0, ABS, APP, ABS, APP, 2,
VAR, IOP, ABS, APP, 4, APP, 1, VAR, IOP, IOP, 0, APP}
mem[25] = Parse()
{nexts,envps,refs,terms} = {{0},{0},{1},{0}}
{b,frep,contp,envp,ip} = {0,0,0,ROOT,1}
while true do
integer mip = mem[ip]
-- (aside: there is simply no way to exit loop from within
-- switch in JavaScript, since break is overloaded,
-- hence also banned on desktop/Phix under with js.)
if (mip=ABS and not contp)
or length(outlog)>length(tgt) then -- (soe all done)
exit
end if
switch mip do
case VAR: Var();
case APP: App();
case ABS: Abs();
case IOP: Iop();
default: crash("CORRUPT TERM");
end switch
end while
if not soe then -- (which has a forced early exit)
int rc = mem[ip+2]
assert(rc=0,"CONTINUATIONS EXHAUSTED")
end if
printf(1,"\n\n")
end procedure
constant tests = {{"Quine","000101100100011010000000000001011011110010111100111111011111011010"&
"000101100100011010000000000001011011110010111100111111011111011010",1},
{"Quine8",x"16468005bcbcfdf68016468005bcbcfdf680",1},
{"Sieve of Eratosthenes",
"00010001100110010100011010000000010110000010010001010111110111101001000110100001110"&
"011010000000000101101110011100111111101111000000001111100110111000000101100000110110",
"0011010100010100010100010000010100000100010100010000010000010100000100010100000100010000010"&
"0000001000101000101000100000000000001000100000101000000000101000001000001000100000100000101"&
"0000000001010001010000000000010000000000010001010001000001010000000001000001000001000001010"&
"0000100010100000000010000000000000100010100010000000000000100000100000000010100010000010000"&
"0001000001000001000100000100000001000100000001000000000101000000000101000001000100000100000"&
"0010001010001000000000001000000010001000000010001000001000000000001010000000000000000010000"&
"0100000000010000010000010100000100000000010000010000010100000100000100010100000000000100000"&
"0000101000100000100000101000000000001000100000100000001000000000100000001000000000100000001"&
"0000010000010001000000010000010001000000010001000000000000010000000001000000000001010000000"&
"0010100010100000000010000000000000100010100010000000000000100010100010000000000000000000100"&
"0100000001000000000100000001000100000100000100000000000001000100000100000100000001000001000"&
"00000000100010000010100."},
{"100 doors",
"00010001000101010001101000000101100000110011101100101000110100000000001011111110000001"&
"01111101011001011001000110100001111100110100101111101111000000001011111111110110011001"&
"11111101110000000010111111000000101111101011001101110010101100000010111101100101111001"&
"1110011110110100000000001011011100111011110000000001000000111001110100000000101101110110",
"10010000100000010000000010000000000100000000000010000000000000010000000000000000100000"&
"00000000000001"},
{"342",
"0101000110100000000110000101100111100000100101111101111000010101100000000110000111110"&
"0000010111111011001011111101100101111010011101011110001000000101110010101000110100000"&
"0000010110000101011111101111100000010101111011111011111100001011000000101111111010110"&
"111000000111111000010110111101110011110100000010110000011011000100000101111000111001110",
"11010"},
{"0^0",
"0001010110100000010110111011010",
"1"},
{"Hello, World!",
" Hello, world!\n",2},
}
for ti,t in tests do
printf(1,"%s:\n",{t[1]})
src = t[2]
bitmode = (src[1]&&#FE)='0'
quine8 = ti==2
if ti<=2 then
if quine8 then
for c in src do
printf(1,"%02x",c)
end for
else
printf(1,src)
end if
printf(1," (src)\n")
end if
object t3 = t[3]
if integer(t3) then t3 = src[t3..$] end if
bool soe = t3[$]='.' -- (force an early quit)
-- (no point leaving it running if you(/I) can't
-- be bothered to verify the output properly...)
if soe then t3 = t3[1..$-1] end if
tgt = t3
{sdx,b,outlog,o,ob} = {0,0,"",0,0}
mem = repeat(0,M) -- if M=512, extended as needed (and it will be)
Krivine(soe)
integer ld = length(outlog)-length(tgt)
if ld then
assert(soe and ld==1)
outlog = outlog[1..$-1]
end if
assert(outlog==tgt)
end for
</syntaxhighlight>
{{out}}
<pre>
Quine:
000101100100011010000000000001011011110010111100111111011111011010000101100100011010000000000001011011110010111100111111011111011010 (src)
000101100100011010000000000001011011110010111100111111011111011010000101100100011010000000000001011011110010111100111111011111011010
Quine8:
16468005BCBCFDF68016468005BCBCFDF680 (src)
16468005BCBCFDF68016468005BCBCFDF680
Sieve of Eratosthenes:
00110101000101000101000100000101000001000101000100000100000101000001000101000001000100000100000001000101000101000100000000000001000100000101000000000101000001000001000100000100000101000000000101000101000000000001000000000001000101000100000101000000000100000100000100000101000001000101000000000100000000000001000101000100000000000001000001000000000101000100000100000001000001000001000100000100000001000100000001000000000101000000000101000001000100000100000001000101000100000000000100000001000100000001000100000100000000000101000000000000000001000001000000000100000100000101000001000000000100000100000101000001000001000101000000000001000000000101000100000100000101000000000001000100000100000001000000000100000001000000000100000001000001000001000100000001000001000100000001000100000000000001000000000100000000000101000000000101000101000000000100000000000001000101000100000000000001000101000100000000000000000001000100000001000000000100000001000100000100000100000000000001000100000100000100000001000001000000000001000100000101000
100 doors:
1001000010000001000000001000000000010000000000001000000000000001000000000000000010000000000000000001
342:
11010
0^0:
1
Hello, World!:
Hello, world!
</pre>
=={{header|Python}}==
<syntaxhighlight lang="python">#!/usr/local/bin/python3
import os,sys
def bit2lam(bit) :
return lambda x0: lambda x1: x1 if bit else x0
def byte2lam(bits,n) :
if (n==0) :
return lambda _:lambda y: y
return lambda z: z (bit2lam((bits>>(n-1))&1)) (byte2lam(bits,n-1))
def input(n) : # input from n'th character onward
if n >= len(inp) :
c = os.read(0,1)
inp.append((lambda _: lambda y: y) if c==b''
else lambda z: z(byte2lam(c[0],8) if bytemode else bit2lam(c[0]&1))(input(n+1)))
return inp[n]
def lam2bit(lambit) :
return lambit(lambda _: 0)(lambda _: 1)(0) # force suspension
def lam2byte(lambits, x) :
return lambits(lambda lambit: lambda lamtail: lambda _: lam2byte(lamtail, 2*x+lam2bit(lambit)))(bytes([x]))
def output(prog) :
return prog(lambda c: os.write(1,lam2byte(c,0) if bytemode else (b'1' if lam2bit(c) else b'0')) and (lambda tail: lambda _ : output(tail)))(0)
def getbit() :
global nbit, progchar
if nbit==0 :
progchar = os.read(0,1)[0]
nbit = 8 if bytemode else 1
nbit -= 1
return (progchar >> nbit) & 1
def program() :
if getbit() : # variable
i = 0
while (getbit()==1) : i += 1
return lambda *args : args[i]
elif getbit() : # application
p = program()
q = program()
return lambda *args : p(*args)(lambda arg: q(*args)(arg)) # suspend argument
else :
p = program()
return lambda *args: lambda arg: p(arg, *args) # extend environment with one more argument
sys.setrecursionlimit(8192)
inp = []
nbit = progchar = 0
bytemode = len(sys.argv) <= 1
prog = program()(0)
output(prog(input(0))) # run program with empty env on input</syntaxhighlight>
=={{header|Ruby}}==
Line 173 ⟶ 778:
$prog = program().call(0)
output($prog.call(input(0))) # run program with empty env on input</syntaxhighlight>
=={{header|Wren}}==
{{trans|Ruby}}
Input is assumed to be terminated by pressing return.
<syntaxhighlight lang="wren">import "os" for Process
import "io" for Stdin
var inp = []
var progchar = 0
var nbit = 0
var bytemode = Process.arguments.count == 0
var bit2lam = Fn.new { |bit| Fn.new { |x0| Fn.new { |x1| bit == 0 ? x0 : x1 } } }
var byte2lam // recursive
byte2lam = Fn.new { |bits, n|
return n == 0 ?
Fn.new { Fn.new { |y| y } } :
Fn.new { |z| z.call(bit2lam.call(bits>>(n-1) & 1)).call(byte2lam.call(bits, n-1)) }
}
// input from 'n'th character onward
var input // recursive
input = Fn.new { |n|
if (n >= inp.count) {
var c = Stdin.readByte()
inp.add(c == 10 ?
Fn.new { Fn.new { |y| y } } :
Fn.new { |z| z.call(bytemode ?
byte2lam.call(c, 8) : bit2lam.call(c&1)).call(input.call(n+1)) }
)
}
return inp[n]
}
// force suspension
var lam2bit = Fn.new { |lambit| lambit.call(Fn.new { 0 }).call(Fn.new { 1 }).call(0) }
var lam2byte // recursive
lam2byte = Fn.new { |lambits, x|
return lambits.call(
Fn.new { |lambit| Fn.new { |lamtail| Fn.new { lam2byte.call(lamtail, 2*x+lam2bit.call(lambit)) } } }).call(x)
}
var output // recursive
output = Fn.new { |prog|
return prog.call(Fn.new { |c|
System.write(bytemode ? String.fromByte(lam2byte.call(c, 0)) : (lam2bit.call(c) == 0 ? "0" : "1"))
return Fn.new { |tail| Fn.new { output.call(tail) } }
}).call(0)
}
var getbit = Fn.new {
if (nbit == 0) {
progchar = Stdin.readByte()
nbit = bytemode ? 8 : 1
}
nbit = nbit - 1
return (progchar >> nbit) & 1
}
var program // recursive
program = Fn.new {
if (getbit.call() != 0) { // variable
var i = 0
while (getbit.call() == 1) i = i + 1
return Fn.new { |args| args[i] }
} else if (getbit.call() != 0) { // application
var p = program.call()
var q = program.call()
// suspend argument
return Fn.new { |args|
return p.call(args).call(Fn.new { |arg| q.call(args).call(arg) })
}
} else {
// extend environment with one more argument
var p = program.call()
return Fn.new { |args| Fn.new { |arg| p.call([arg] + args) } }
}
}
System.print("Input:")
var prog = program.call().call([0])
System.print("\nOutput:")
// run program with empty environment on input
output.call(prog.call(input.call(0)))
System.print()</syntaxhighlight>
{{out}}
342 bit example:
<pre>
Input:
010100011010000000011000010110011110000010010111110111100001010110000000011000011111000000101111110110010111111011001011110100111010111100010000001011100101010001101000000000010110000101011111101111100000010101111011111011111100001011000000101111111010110111000000111111000010110111101110011110100000010110000011011000100000101111000111001110
Output:
11010
</pre>
Quine example:
<pre>
Input:
000101100100011010000000000001011011110010111100111111011111011010000101100100011010000000000001011011110010111100111111011111011010
Output:
000101100100011010000000000001011011110010111100111111011111011010000101100100011010000000000001011011110010111100111111011111011010
</pre>
100 doors example:
<pre>
Input:
0001000100010101000110100000010110000011001110110010100011010000000000101111111000000101111101011001011001000110100001111100110100101111101111000000001011111111110110011001111111011100000000101111110000001011111010110011011100101011000000101111011001011110011110011110110100000000001011011100111011110000000001000000111001110100000000101101110110
Output:
1001000010000001000000001000000000010000000000001000000000000001000000000000000010000000000000000001
</pre>
Sieve of Eratosthenes example (output manually terminated after first 1024 bits printed):
<pre>
Input:
00010001100110010100011010000000010110000010010001010111110111101001000110100001110011010000000000101101110011100111111101111000000001111100110111000000101100000110110
Output:
0011010100010100010100010000010100000100010100010000010000010100000100010100000100010000010000000100010100010100010000000000000100010000010100000000010100000100000100010000010000010100000000010100010100000000000100000000000100010100010000010100000000010000010000010000010100000100010100000000010000000000000100010100010000000000000100000100000000010100010000010000000100000100000100010000010000000100010000000100000000010100000000010100000100010000010000000100010100010000000000010000000100010000000100010000010000000000010100000000000000000100000100000000010000010000010100000100000000010000010000010100000100000100010100000000000100000000010100010000010000010100000000000100010000010000000100000000010000000100000000010000000100000100000100010000000100000100010000000100010000000000000100000000010000000000010100000000010100010100000000010000000000000100010100010000000000000100010100010000000000000000000100010000000100000000010000000100010000010000010000000000000100010000010000010000000100000100000000000100010000010100^C
</pre>
| |||