Universal Lambda Machine

From Rosetta Code
Revision as of 23:17, 24 February 2024 by Petelomax (talk | contribs) (→‎{{header|Perl}}: fixed syntax)
Task
Universal Lambda Machine
You are encouraged to solve this task according to the task description, using any language you may know.

One of the foundational mathematical constructs behind computer science is the universal machine, as a machine that can emulate the behaviour of any other machine, given a description of it. Alan Turing introduced the idea of a universal Turing machine in 1936–1937.

The lambda calculus is an even older, and in many ways simpler, model of computation. That simplicity is reflected in the Binary Lambda Calculus (BLC for short), which describes lambda terms with binary tokens 00 for lambda, 01 for application, and 1^n0 for variable n (which binds to the n'th enclosing lambda).

BLC also specifies a way to represent bits and lists as lambda terms, which provides the following I/O convention:

The lambda universal machine parses the binary encoding of a lambda term from the start of its input, applies that term to the remainder of input, and outputs the result interpreted as a list of bits or bytes.

BLC as a programming language has its own entry on Rosetta Code at https://rosettacode.org/wiki/Category:Binary_Lambda_Calculus which links to more detailed descriptions of the language.

Task

Simulate the universal lambda machine Or in other words, write a BLC interpreter. Support either bit-mode or byte-mode, or preferably both (with byte-mode as the default, and a -b command line flag for bit mode).

To test your universal lambda machine, you should execute the following BLC programs.

For bit-mode, one should reproduce the BLC Rosetta Code solutions of

producing as much output as possible before running out of stack/heap space).

Also, the 342 bit program 

010100011010000000011000010110011110000010010111110111100001010110000000011000011111000000101111110110010111111011001011110100111010111100010000001011100101010001101000000000010110000101011111101111100000010101111011111011111100001011000000101111111010110111000000111111000010110111101110011110100000010110000011011000100000101111000111001110

should produce output 

11010

For byte-mode, one should reproduce the BLC Rosetta Code solutions of

When run on the 186-byte binary file https://www.ioccc.org/2012/tromp/tromp/symbolic.Blc followed by input 010000011100111001110100000011100111010, it should output 

(\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)))))))

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) : 

  01010001
   10100000
    00010101
     10000000
      00011110
       00010111
        11100111
         10000101
          11001111
          000000111
         10000101101
        1011100111110
       000111110000101
      11101001 11010010
     11001110   00011011
    00001011     11100001
   11110000       11100110
  11110111         11001111
 01110110           00011001
00011010             00011010

Byte-wise (showing https://www.ioccc.org/2012/tromp/uni8.Blc in hex, again with whitespace for decorational purposes only): 

 19468
  05580
   05f00
    bfe5f
     85f3f
      03c2d
     b9fc3f8
    5e9d65e5f
   0decb f0fc3
  9befe   185f7
 0b7fb     00cf6
7bb03       91a1a

C

#ifndef M
#define M 50000
#endif
#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
enum {I,O,V,A,L};
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,
    A,14,L,A,2,V,0,L,A,5,A,2,  V,0,O,O,A},b,s;
long nc = 0, nf = 0, na = 0; // number of cells, number freed, number of allocs
typedef struct _{long t,r; struct _*e,*n;} C;C*e,*f,*l,*S[M];
void x(long l,long u){for(;l<=u;T[n++]=T[l++]);}
long g(){i--||(i=b,c=getchar());return c>>i&1;}
void d(C*l){!l||--l->r||(d(l->e),d(l->n),l->n=f,nf++,f=l);}
long p(long m){if(g()){for(T[n++]=V;g();T[n]++){}n++;}else
          T[m]=n++&&g()?(T[m+1]=p(++n),A):L,p(n);return n-m;}
int main(int t,char **_){char o;
 b=t>1?0:7;T[43]=p(n);i=0;
 for(t=b?10:26;;)switch(T[t]){
  case I: g();i++;assert(n<M-99);if(~c&&b){x(0,6);for(T[n-5]=96;i;T[n++]=!g())
           x(0,9);}x(c<0?7:b,9);T[n++]=!b&&!g();break;
  case O: t=b+t>42?(o=2*o|t&1,28):(putchar
              (b?o:t+8),fflush(stdout),b?12:28);break;
  case V: l=e;for(t=T[t+1];t--;e=e->n){}
                   t=e->t;(e=e->e)&&e->r++;d(l);break;
  case A: t+=2;
          nc++;
          f||(na++,f=calloc(1,sizeof(C)));
          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--){fprintf(stderr,"\n%ld cells\n%ld freed\n%ld allocated\n", nc, nf, na);return 0;};S[s]->n=e;e=S[s];t++;break;
 }
 fprintf(stderr,"%ld cells %ld allocated\n", nf, na);
 return T[t+2];
}

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
  }
});

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

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

Ruby

#!/usr/bin/ruby
def bit2lam(bit)
  return lambda { |x0| lambda { |x1| bit==0 ? x0 : x1 } }
end
def byte2lam(bits,n)
  return n==0 ? lambda { |_| lambda { |y| y } }
              : lambda { |z| z.call(bit2lam((bits>>(n-1))&1)).call(byte2lam(bits,n-1)) }
end
def input(n)             # input from n'th character onward
  if n >= $inp.length()
    c = STDIN.getbyte
    $inp.append(c==nil ? (lambda { |_| lambda { |y| y } })
                       : lambda { |z| z.call($bytemode ? byte2lam(c,8) : bit2lam(c&1)).call(input(n+1)) } )
  end
  return $inp[n]
end
def lam2bit(lambit)
  return lambit.call(lambda { |_| 0 }).call(lambda { |_| 1 }).call(0)  # force suspension
end
def lam2byte(lambits, x)
  return lambits.call(lambda { |lambit| lambda { |lamtail| lambda { |_| lam2byte(lamtail, 2*x+lam2bit(lambit)) } } }).call(x)
end
def output(prog)
  return prog.call(lambda { |c| putc($bytemode ? lam2byte(c,0) : (lam2bit(c)==0 ? '0' : '1')) and (lambda { |tail| lambda { |_| output(tail) } }) }).call(0)
end
def getbit()
  if ($nbit==0)
    $progchar = STDIN.getbyte
    $nbit = $bytemode ? 8 : 1
  end
  return ($progchar >> $nbit -= 1) & 1
end
def program()
  if getbit()==1                 # variable
    i = 0
    while (getbit()==1) do i += 1 end
    return lambda { |*args| args[i] }
  elsif getbit()==1          # application
    p = program()
    q = program()
    return lambda { |*args| p.call(*args).call(lambda { |arg| q.call(*args).call(arg) }) }  # suspend argument
  else
    p = program()
    return lambda { |*args| lambda { |arg| p.call(arg, *args) } } # extend environment with one more argument
  end
end
$inp = []
$nbit = $progchar = 0
$bytemode = ARGV.length <= 0
$prog = program().call(0)
output($prog.call(input(0)))             # run program with empty env on input

Wren

Translation of: Ruby

Input is assumed to be terminated by pressing return. 

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()
Output:

342 bit example: 

Input:
010100011010000000011000010110011110000010010111110111100001010110000000011000011111000000101111110110010111111011001011110100111010111100010000001011100101010001101000000000010110000101011111101111100000010101111011111011111100001011000000101111111010110111000000111111000010110111101110011110100000010110000011011000100000101111000111001110

Output:
11010

Quine example: 

Input:
000101100100011010000000000001011011110010111100111111011111011010000101100100011010000000000001011011110010111100111111011111011010

Output:
000101100100011010000000000001011011110010111100111111011111011010000101100100011010000000000001011011110010111100111111011111011010

100 doors example: 

Input:
0001000100010101000110100000010110000011001110110010100011010000000000101111111000000101111101011001011001000110100001111100110100101111101111000000001011111111110110011001111111011100000000101111110000001011111010110011011100101011000000101111011001011110011110011110110100000000001011011100111011110000000001000000111001110100000000101101110110

Output:
1001000010000001000000001000000000010000000000001000000000000001000000000000000010000000000000000001
Retrieved from "https://rosettacode.org/wiki/Universal_Lambda_Machine?oldid=360912"