--  In place of a README:
--
--  Written in 2004 by Georg Bauhaus
--
--  This file contains sources of a program demonstrating a small device
--  that allows some "functional" programming of number sequences. It is
--  bundled with all needed library units. The idea was stolen from ML's
--  infinite lists where it is known as "ints", for example. The device
--  offers poor man's infinite sequences.
--
--  The main unit is "funtasy". Running the compiler on this unit should
--  be sufficient to build the executable program. The author suggests you
--  turn assertion checks on.

with Funcy_Stuff;
with Sample;

with Ada.Text_IO;

--  $Date: Wed, 22 Sep 2004 21:49:07 +0200 $
--  $Revision: 1.4 $

--   This main program demonstrates a possible use of `Funcy_Stuff.Chain`s.
--  (The word "fun" is probably mentioned too often... SCNR)

procedure funtasy is

   use Funcy_Stuff;

   --   Each of the following variables is capable of producing a sequence
   --  of "wrapped numbers". The value provided to the function in the
   --  initializing expression approximates the sequence's first value
   --  from below.

   odds: Chain := Sample.odd(13);
   pragma assert(odds.n = 15);

   evens: Chain := Sample.even(13);
   pragma assert(evens.n = 14);

   fingers: Chain := Sample.gimme_five(2);
   pragma assert(fingers.n = 5);

   go_on: Chain := Sample.carot(41);
   pragma assert(go_on.n = 42);

   primes: Chain := Sample.prime(0);
   pragma assert(primes.n = 2);


   package IO is new  Ada.Text_IO.Integer_IO(Natural);
   package TIO renames Ada.Text_IO;

begin  -- funtasy

   --   Each of the following loops prints the numbers as the sequence
   --  provides them, one by one. `succ` returns the next value iterating
   --  along the sequence.

   TIO.put_line("odd numbers:");
   loop
      exit when odds.n > 20;

      IO.put(odds.n);

      odds := succ(odds);
   end loop;

   TIO.new_line(2);


   TIO.put_line("even numbers:");
   loop
      exit when evens.n > 20;

      IO.put(evens.n);

      evens := succ(evens);
   end loop;

   TIO.new_line(2);


   TIO.put_line("multiples of 5:");
   loop
      exit when fingers.n > 20;

      IO.put(fingers.n);

      fingers := succ(fingers);
   end loop;

   TIO.new_line(2);


   TIO.put_line("prime numbers:");
   loop
      exit when primes.n > 100;

      IO.put(primes.n, width => 5);

      primes := succ(primes);
   end loop;

   TIO.new_line(2);


   --  positive numbers.  Uncomment if you want to see them :-) And if you
   --  want a /dev/zero like generator, just omit advancing via `succ`.

--     Ctl_C: loop
--         IO.put(go_on.n);
--         go_on := succ(go_on);
--     end loop Ctl_C;


end funtasy;

--   This is a lame attempt to mimick ML's infinite lists.

--   If you want to understand how `Chain`s work, look into the body of
--  this package. The `succ` function advances from one `Chain` value to
--  the next. The current number value wrapped in a `Chain` value is
--  directly accessible as the record component `n`.

--  $Date: Wed, 22 Sep 2004 21:33:51 +0200 $
--  $Revision: 1.2 $

package Funcy_Stuff is

   pragma preelaborate;

   type Chain;

   type Link is
     access function(m: Natural) return Chain;
   --  the next value in the `Chain` sequence after the one with `m`

   type Chain is record
      n: Natural := 0;
      f: Link;
   end record;

   function succ(c: Chain) return Chain;
   --  one more than `c`

end Funcy_Stuff;

-- $Revision: 1.2 $

package body Funcy_Stuff is

   function succ(c: Chain) return Chain is
   begin
      return Chain'(n => c.f(c.n).n,
                    f => c.f);
   end succ;

end Funcy_Stuff;
with Fun;

--   A number of example "sequence generators"

--  $Date: Wed, 22 Sep 2004 21:33:51 +0200 $
--  $Revision: 1.3 $

package Sample is


   --  Nondecreasing Sequences

   --  Construction scheme: with each of the following predicates on
   --  Natural numbers, instantiates `Fun.next`. The results are `Chain`
   --  generating functions, so to speak. Iterate along a `Chain` using
   --  `Funcy_Stuff.succ`.

   --  This is the way to make your own generators.


   function is_even (m: Natural) return Boolean;
   function is_odd (m: Natural) return Boolean;
   function is_prime (m: Natural) return Boolean;
   function is_multiple_of_5 (m: Natural) return Boolean;
   function yes (m: Natural) return Boolean;

   function even is new Fun.next(is_even);
   --   the next even

   function odd is new Fun.next(is_odd);
   --   the next odd

   function gimme_five is new Fun.next(is_multiple_of_5);
   --   the next multiple of 5

   function carot is new Fun.next(yes);
   --   (I have been thinking about donkeys and carots)

   function prime is new Fun.next(is_prime);
   --   the next prime number

end Sample;

--  $Revision: 1.2 $

package body Sample is


-- ----------------
-- is_even
-- ----------------

   function is_even(m: Natural) return Boolean is
   begin
      return m mod 2 = 0;
   end is_even;


-- ----------------
-- is_multiple_of_5
-- ----------------

   function is_multiple_of_5(m: Natural) return Boolean is
   begin
      return m rem 5 = 0;
   end is_multiple_of_5;



-- ----------------
-- is_odd
-- ----------------

   function is_odd(m: Natural) return Boolean is
   begin
      return not is_even(m);
   end is_odd;


-- ----------------
-- is_prime
-- ----------------

   package Primes_Cache is
      --  nice to have

   end Primes_Cache;

   function is_prime(m: Natural) return Boolean is

      function check_remaining(p: Natural) return Boolean;
      --   starting at 7, try dividing p without remainder

      function check_remaining(p: Natural) return Boolean is
         k: Positive := 7;
      begin
         loop    -- poor, hopping odd divisors, no sqrt :-(
            exit when k >= p / 2;

            if p rem k = 0 then
               return false;
            end if;

            k := k + 2;
         end loop;
         return true;
      end check_remaining;

   begin  -- is_prime
      case m is
         when 0 | 1 => return false;
         when 2 | 3 | 5 => return true;
         when others =>
            return -- multiple of 2 or 5?: false
              not (m rem 2 = 0 or m rem 5 = 0)
              and then -- 6k + 1 or 6k + 5: might
               ((m rem 6 = 1 or m rem 6 = 5) and then check_remaining(m));
      end case;
   end is_prime;


-- ----------------
-- yes
-- ----------------

   function yes(m: Natural) return Boolean is
   begin
      return True;
   end yes;


end Sample;

-- $Revision: 1.2 $

with Funcy_Stuff;

--   An instance of `next` returns a `Chain` value. `Chain`s have a
--  `succ` function that can be used in an iteration.

--  $Date: Wed, 22 Sep 2004 21:33:51 +0200 $

package Fun is

   pragma preelaborate;

   generic
      with function test(num: Natural) return Boolean;
      --  a predicate testing an expression involving the successor of `num`

   function next(m: Natural) return Funcy_Stuff.Chain;
   --   the next chain item in the sequence after `m` according to `test`

end Fun;
-- $Revision: 1.3 $

package body Fun is


   -- ----------------
   -- next
   -- ----------------

   --  If the `test` of the successor of `m` succeeds, the next chain
   --  item will be wrapping the successor. Otherwise `next` will try
   --  the next item in the sequence.

   function next (m: Natural) return Funcy_Stuff.Chain is
   begin
      if test(m + 1) then
         return (m + 1, next'access);
      end if;

      return next(m + 1);
   end next;


end Fun;