AdaPower Logged in as Guest
Ada Tools and Resources

Ada 95 Reference Manual
Ada Source Code Treasury
Bindings and Packages
Ada FAQ


Join >
Articles >
Ada FAQ >
Getting Started >
Home >
Books & Tutorials >
Source Treasury >
Packages for Reuse >
Latest Additions >
Ada Projects >
Press Releases >
Ada Audio / Video >
Home Pages >
Links >
Contact >
About >
Login >
Back
Downward Closures and the N Queen Problem (Brian Rogoff)

Downward Closures, well, if we want to be precise, we should call them "downward funargs",
since Ada already supports a restricted form of downward closure via 
generics. 

A little GNAT program which :

(1) Uses downward funargs
(2) Has a fair bit of subprogram nesting
(3) Solves the N Queen problem

-- N Queens Problem
--
-- see L.Allison. Continuations implement generators and streams.
--     Computer Journal 33(5) 460-465 1990
--
-- Cont = State -> Answer      where State=List,  Answer=Std_output
-- Generator = Cont -> State -> Answer = Cont -> Cont

with Ada.Text_IO; use  Ada.Text_IO;

procedure Generate is
    package Int_IO is new Ada.Text_IO.Integer_IO(Integer);
    type Node_Type;
    type List_Type is access Node_Type;
    type Node_Type is
        record
            Head : Integer;
            Tail : List_Type;
        end record;

    type Cont_Proc_Type is access procedure (L : in List_Type);
    type Gen_Proc_Type  is access procedure (Cont : Cont_Proc_Type;
                                            L : in List_Type);
    type Pred_Func_Type is access function (L : in List_Type) return Boolean;

    N : Integer;

    function Cons(I : Integer; L : List_Type) return List_Type is
        P:List_Type;
    begin
      P := new Node_Type;
      P.Head := I; P.Tail := L; return P;
    end Cons;

    -- generator "library"
    -- success : Cont

    procedure Success(L : List_Type) is

        procedure Print(L : List_Type) is
        begin
            if L /= null then
                Int_IO.Put(L.Head);
                Print(L.Tail);
            end if;
        end Print;

    begin
        if L /= null then
            New_Line;
            Put(" :");
            Print(L);
        end if;
    end Success;

    -- Choose :Int -> Cont -> Cont = Int -> Generator
    procedure Choose(N : Integer; Cont : Cont_Proc_Type; L : List_Type) is
    begin
        for I in 1..n loop
            Cont( Cons(I, L) );
        end loop;
      -- for each i       continue with i++L
    end Choose;

    -- Filter : (State -> boolean) -> Generator
    procedure Filter(P    : Pred_Func_Type;
                     Cont : Cont_Proc_Type;
                     L    : List_Type) is
    begin
       if P(L) then Cont(L); end if;      -- else fail
       -- if L ok then continue with L else do nothing
    end Filter;

    -- doo = gen**n :Int -> Generator -> Generator
    procedure Doo(N    : Integer;
                  Gen  : Gen_Proc_Type;
                  Cont : Cont_Proc_Type;
                  L    : List_Type ) is

        procedure Gen_Cont(L : List_Type) is
        begin
            Gen(Cont,L);
            -- gen and then cont, to L
        end Gen_Cont;

    begin
        if N = 0 then
            Cont(L);
        else
            Doo(N-1, Gen, Gen_Cont'Unrestricted_Access, L);
        end if;
         -- do (n-1) gen and then [gen and then cont], to L
    end Doo;

    -- n queens proper
    procedure Queen(N : Integer) is
        function Valid(L : List_Type) return Boolean is
            function V(Col : Integer; L2 : List_Type) return Boolean is
            begin
              if L2 = null then
                  return True;                    -- safe
              elsif
                (L.Head = L2.Head)    or      -- check rows
                (L2.Head+Col = L.Head) or      -- & diagonals
                (L2.Head-Col = L.Head)         -- other diags
              then
                  return False;                   -- threat
              else
                  return V(col+1, L2.Tail);
              end if;
            end V;
        begin
            if L = null then
                return True;
            else
                return V(1, L.Tail);
            end if;
        end Valid;

        -- choosevalid :Generator
        procedure Choose_Valid(Cont : Cont_Proc_Type; L : List_Type) is

            procedure Valid_Cont (L : List_Type) is
            begin
                Filter(Valid'Unrestricted_Access, Cont, L);
                -- check valid and if so continue, with L
            end Valid_Cont;

        begin
            Choose(N, Valid_Cont'Unrestricted_Access, L);
            -- choose row and then [check valid and if so continue], with L
        end Choose_Valid;

    begin
        Doo(N,
            Choose_Valid'Unrestricted_Access,
            Success'Unrestricted_Access,
            Null);
          --  [do  n times: choose a valid row] and if so succeed
    end Queen;

begin
    Put_Line("Enter a number and hit return");
    Int_IO.Get(N); Queen(N); New_Line;
    Put_Line("and that's it!");
end;


(c) 1998-2004 All Rights Reserved David Botton