Ackermann
module ackermann; import ascii/parse; function ack with m of integer, n of integer yielding integer is n + 1 when m == 0, ack(m - 1, 1) when n == 0, ack(m - 1, ack(m, n - 1)) otherwise; program ackermann with args of args_string is declare n of integer where n = 1; eval args[1] with parse into n when args size > 0; call ack with 3, n into &result; print "Ack(3,", n, "): ", result", eol;Fannkuch
module fannkuch;
procedure fannkuch with n of integer yielding integer is
allocate
perm of integer string upto n;
perm1 of integer string upto n;
count of integer string upto n;
max_perm of integer string upto n;
declare max_flips_count, m, r of integer where m = n - 1, r = n;
modify x in perm over i yielding i!;
repeat
while r <> 1 do
assign r into count[r-1];
decr r;
if not (perm1[1] == 0 or perm1[m] == m) then
copy x from perm1 into perm;
declare flips_count, k of integer where k = perm[0];
while k <> 0 do
let k2 = (k+1) / 2;
foreach i in 1 to k2 do
swap perm[i] with perm[k-i];
incr flips_count;
assign perm[0] into k;
if flips_count > max_flips_count then
assign flips_count into max_flips_count;
copy x from perm1 into max_perm;
repeat
return max_flips_count when r == n;
assign perm1[1] into &perm0
copy x from (slice perm1 from 2 to r) into (slice perm1 from 1 to r - 1);
assign perm0 into perm1[r];
decr count[r];
break when count[r]?;
incr r;
program fannkuch with args of args_string is
declare n of integer where n = 7;
eval args[1] with parse into n when args size > 0;
eval n with fannkuch into &result;
print "pfannkuchen(", n, ") = ", result, eol;
Spell Check
module spell_check;
import ascii/parse;
literal dict_hash_size is 1079;
program Spell_Check with args of args_string is
declare dict of <ascii+ string> set {dict_hash_size};
open file of ascii text where path = "dictionary.txt";
foreach [word of ascii+ string] in file do
add word into dict;
close file;
foreach [word of ascii+ string] in stdin do
print word, eol when word not_in dict;
Random Number
import ascii/parse;
module random;
literal
IM is 139968;
IA is 3877;
IC is 29573;
variable last of integer/32 is 42;
procedure gen_random with max of number/64 yielding number/64 is
assign
(last * IA + IC) % IM into last;
(max * last! / IM) into result;
constant format of io_format is [width = 10];
program random with args of args_string is
eval args[0] with parse_integer_32 into &n when args size > 0 else 1;
foreach i in 1 to n do
call gen_random with 100.0 into nil;
call gen_random with 100.0 into &x;
print format -> x, eol;
takfp
module takfp; import ascii/parse; function tak with x of number/32, y of number/32, z of number/32 yielding number/32 is z when y >= x, tak(tak(x-1.0,y,z), tak(y-1.0,z,x), tak(z-1.0,x,y)) otherwise; program takfp with args of args_string is eval args[0] with parse_number_32 into &n when args size > 0 else 1; call tak with n*3, n*2, n*1 into &x; print x, eol;takfp
procedure nsieve with m of integer, is_prime of bit array is
set is_prime;
foreach i in 2 to m where is_prime[i] do
foreach k in i+1 to m by i do
reset is_prime[k];
incr result;
program n_sieve_bits do
declare n of cardinal;
eval args[1] with parse into n when args size > 0 else 2;
assign 2 into n when n < 2;
let m = (1 $< n) * 10_000;
allocate flags of bit array within 1 to m+1;
call nsieve with m, flags into &count;
print "Primes up to ", m, " ", count, eol;
let m = (1 $< n - 1)*10000;
print "Primes up to ", m, " ", count, eol;
let m = (1 $< n - 2)*10000;
print "Primes up to ", m, " ", count, eol;