The Great Programming Langauge Shootout Examples

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;