* FRACTRAN interpreter written by Viktors Berstis
* FRACTRAN - one of the most compact programming languages. A John Conway discovery.
* A FRACTRAN program is simply a list of rational fractions
* The Fractran computer tries multiplying the accumulator by the
* fractions in the list until one gets an integer result.
* Then the process repeats. The accumulator starts with 10 in it.
* The computer is extremely inefficient and needs to handle very large integers.
* The demo program here computes a sequence of all prime numbers.
* The answers occur when the accumulator is a power of 10, and the exponent is
* the prime number found.
* A FRACTRAN program (not shown), about three times larger, can implement a
* universal turing machine.
* Hint for those trying to figure out how this works:
* Look at the prime factorization of all of the numbers involved
* Array of the fractions in the FRACTRAN program
* The fractions are stored as a string of primes, each to the appropriate power
Frac = ARRAY('9')
* Fractran program to calculate all prime numbers by Devin Kilminster:
" 3 / 11 " ; Frac< 1> = " 3^1 11^-1 "
"847 / 45 " ; Frac< 2> = " 3^-2 5^-1 7^1 11^2 "
"143 / 6 " ; Frac< 3> = " 2^-1 3^-1 11^1 13^1 "
" 7 / 3 " ; Frac< 4> = " 3^-1 7^1 "
" 10 / 91 " ; Frac< 5> = " 2^1 5^1 7^-1 13^-1 "
" 3 / 7 " ; Frac< 6> = " 3^1 7^-1 "
" 36 / 325 " ; Frac< 7> = " 2^2 3^2 5^-2 13^-1 "
" 1 / 2 " ; Frac< 8> = " 2^-1 "
" 36 / 5 " ; Frac< 9> = " 2^2 3^2 5^-1 "
* Pow10 is a pattern to check when Acc is a power of ten
Pow10 = POS(0) SPAN(' ') '2^' SPAN(&DIG) $ pow ' 5^' *pow SPAN(' ') RPOS(0)
* Fact is a pattern to extract one term from the fraction
Fact = SPAN(' ') SPAN(&DIG) . base '^' SPAN(&DIG '-') . pow
* Function to multiply the symbolic fractions:
DEFINE('MULT(x,y)')
* Starting value for the accumulator:
Acc = " 2^1 5^1 "
LOOP J = 1
TEST s = MULT(Frac,Acc)
J = J + 1
* If there is a negative power, it is not an integer
s '-' :S(TEST)
Acc = s
Acc Pow10 :F(LOOP)
OUTPUT = Acc ' = Accumulator, prime = ' pow :(LOOP)
* Multiply two symbolic fractions:
MULT x Fact = ' ' :F(done)
y ' ' base '^' SPAN(&DIG '-') . p = ' ' base '^' (p + pow) :S(MULT)
y = y ' ' base '^' pow ' ' :(MULT)
* Remove terms to the zero power:
done y ' ' SPAN(&DIG) '^0 ' = ' ' :S(done)
* Change multiple blanks to single blanks:
db y ' ' SPAN(' ') = ' ' :S(db)
MULT = y :(RETURN)
END