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;
|
