Drawing Bowling Pins (pyramid) with Recursion in Ada - recursion

I know this is pushing the good will of the community by presenting my least elaborate work expecting someone to come and save me but I simply have no choice with nothing to lose. I've gone through packets, files, types, flags and boxes the last few weeks but I haven't covered much of recursion. Especially not drawing with recursion. My exam is in roughly one week and I hope this is ample time to repeat and learn simple recursion tricks like that of drawing bowling pins or other patterns:
I I I I I
I I I I
I I I
I I
I
n = 5
The problem I have with recursion is that I don't quite get it. How are you supposed to approach a problem like drawing pins like this using recursion?
The closest I've come is
I I I
I I
I
n = 3
and that's using
THIS CODE NOW WORKS
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure pyramidchaser is
subtype X_Type is Integer range 0..30;
X: X_Type;
Indent : Integer := 0;
procedure Numbergrabber (X : out Integer) is
begin
Put("Enter a number: ");
Get(X);
Skip_Line;
end Numbergrabber;
procedure PrintSpaces(I : in Integer) is
begin
if I in X_Type then
Put(" ");
else
return;
end if;
PrintSpaces(I - 1);
end Printspaces;
procedure PrintPins(i, n: in Integer) is
begin
if i >= n then
return;
end if;
Put('I');
Put(' ');
PrintPins(i + 1, n);
end Printpins;
function Pins (X, Indent: in Integer) return Integer is
Printed : Integer;
begin
Printed:= 0;
if X > 0 then
PrintSpaces(Indent);
PrintPins(0, X);
New_Line;
Printed := X + Pins(X - 1, Indent + 1);
end if;
return Printed;
end Pins;
Bowlingpins : Integer;
begin
Numbergrabber(X);
Bowlingpins:= Pins(X, Indent);
end pyramidchaser;
but with that I throw in a sum I dont really need just to kick off the recursive part which I dont really know why I do except it seems to be needed to be there. I experimented with code from a completely different assignment, thats why it looks the way it does. I know mod 2 will grant me too many new lines but at least it was an approach to finding heights to the pyramid. I understand the real approach is something similar to N+1 as with each step of the growing pyramid a new line is needed, but I dont know how to implement it.
I don't expect anyone to present a complete code but I hope somebody can clue me in on how to think on the way towards finding a solution.
I can still pass the exam without knowing recursion as its typically 2 assignments where one is and one isnt recursion and you need to pass one or the other, but given that I have some time I thought Id give it a chance.
As always, immensely thankful for anyone fighting the good fight!
Seeing this post gathered some attention Id like to expand the pyramid to one a little more complex:
THE PYRAMID PROBLEM 2
hope someone looks at it. I didnt expect so many good answers, I thought why not throw all I have out there.
Level 1
|=|
Level 2
|===|
||=||
|===|
Level 3
|=====|
||===||
|||=|||
||===||
|=====|
it needs to be figured out recursively. so some way it has to build both upwards and downwards from the center.
To clarify Im studying for an exam and surely so are many others whom would be thankful for code to sink their teeth in. Maybe theres an easy way to apply what Tama built in terms of bowling pin lines in pyramid walls?

Bowling pins:
Printing ----I---- is just: (I'm going to use dashes instead of spaces throughout for readability)
Put_Line (4 * "-" & "I" & 4 * "-");
And printing the whole bowling triangle could be:
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Text_IO; use Ada.Text_IO;
procedure Main is
procedure Print_Bowling_Line (Dashes : Natural; Pins : Positive) is
Middle : constant String := (if Pins = 1 then "I"
else (Pins - 1) * "I-" & "I");
begin
Put_Line (Dashes * "-" & Middle & Dashes * "-");
end Print_Bowling_Line;
begin
Print_Bowling_Line (0, 5);
Print_Bowling_Line (1, 4);
Print_Bowling_Line (2, 3);
Print_Bowling_Line (3, 2);
Print_Bowling_Line (4, 1);
end Main;
Writing the five repeated lines as a loop is quite obvious. For recursion, there are two ways.
Tail recursion
Tail recursion is the more natural 'ask questions, then shoot' approach; first check the parameter for an end-condition, if not, do some things and finally call self.
procedure Tail_Recurse (Pins : Natural) is
begin
if Pins = 0 then
return;
end if;
Print_Bowling_Line (Total_Pins - Pins, Pins);
Tail_Recurse (Pins - 1);
end Tail_Recurse;
Head recursion
Head recursion is what mathematicians love; how do you construct a proof for N? Well, assuming you already have a proof for N-1, you just apply X and you're done. Again, we need to check the end condition before we go looking for a proof for N-1, otherwise we would endlessly recurse and get a stack overflow.
procedure Head_Recurse (Pins : Natural) is
begin
if Pins < Total_Pins then
Head_Recurse (Pins + 1); -- assuming N + 1 proof here
end if;
Print_Bowling_Line (Total_Pins - Pins, Pins);
end Head_Recurse;
For the full code, expand the following snippet:
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Text_IO; use Ada.Text_IO;
procedure Main is
Total_Pins : Natural := 5;
procedure Print_Bowling_Line (Dashes : Natural; Pins : Positive) is
Middle : constant String := (if Pins = 1 then "I"
else (Pins - 1) * "I-" & "I");
begin
Put_Line (Dashes * "-" & Middle & Dashes * "-");
end Print_Bowling_Line;
procedure Tail_Recurse (Pins : Natural) is
begin
if Pins = 0 then
return;
end if;
Print_Bowling_Line (Total_Pins - Pins, Pins);
Tail_Recurse (Pins - 1);
end Tail_Recurse;
procedure Head_Recurse (Pins : Natural) is
begin
if Pins < Total_Pins then
Head_Recurse (Pins + 1); -- assuming N + 1 proof here
end if;
Print_Bowling_Line (Total_Pins - Pins, Pins);
end Head_Recurse;
begin
Total_Pins := 8;
Head_Recurse (1);
end Main;
For simplicity, I don't pass around the second number, that indicates the stopping condition, but rather set it once before running the whole.
I always find it unfortunate to try to learn a technique by applying it where it makes the code more complicated, rather than less. So I want to show you a problem where recursion really does shine. Write a program that prints a maze with exactly one path between every two points in the maze, using the following depth-first-search pseudo code:
start by 'visiting' any field (2,2 in this example)
(recursion starts with this:)
while there are any neighbours that are unvisited,
pick one at random and
connect the current field to that field and
run this procedure for the new field
As you can see in the animation below, this should meander randomly until it gets 'stuck' in the bottom left, after which it backtracks to a node that still has an unvisited neighbour. Finally, when everything is filled, all the function calls that are still active will return because for each node there will be no neighbours left to connect to.
You can use the skeleton code in the snippet below. The answer should only modify the Depth_First_Make_Maze procedure. It need be no longer than 15 lines, calling Get_Unvisited_Neighbours, Is_Empty on the result, Get_Random_Neighbour and Connect (and itself, of course).
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers; use Ada.Containers;
with Ada.Containers.Vectors;
with Ada.Numerics.Discrete_Random;
procedure Main is
N : Positive := 11; -- should be X*2 + 1 for some X >= 1
type Cell_Status is (Filled, Empty);
Maze : array (1 .. N, 1 .. N) of Cell_Status := (others => (others => Filled));
procedure Print_Maze is
begin
for Y in 1 .. N loop
for X in 1 .. N loop
declare
C : String := (case Maze (X, Y) is
--when Filled => "X", -- for legibility,
when Filled => "█", -- unicode block 0x2588 for fun
when Empty => " ");
begin
Put (C);
end;
end loop;
Put_Line ("");
end loop;
end Print_Maze;
type Cell_Address is record
X : Positive;
Y : Positive;
end record;
procedure Empty (Address : Cell_Address) is
begin
Maze (Address.X, Address.Y) := Empty;
end Empty;
procedure Connect (Address1 : Cell_Address; Address2 : Cell_Address) is
Middle_X : Positive := (Address1.X + Address2.X) / 2;
Middle_Y : Positive := (Address1.Y + Address2.Y) / 2;
begin
Empty (Address1);
Empty (Address2);
Empty ((Middle_X, Middle_Y));
end Connect;
function Cell_At (Address : Cell_Address) return Cell_Status is (Maze (Address.X, Address.Y));
function Left (Address : Cell_Address) return Cell_Address is (Address.X - 2, Address.Y);
function Right (Address : Cell_Address) return Cell_Address is (Address.X + 2, Address.Y);
function Up (Address : Cell_Address) return Cell_Address is (Address.X, Address.Y - 2);
function Down (Address : Cell_Address) return Cell_Address is (Address.X, Address.Y + 2);
type Neighbour_Count is new Integer range 0 .. 4;
package Neighbours_Package is new Ada.Containers.Vectors (Index_Type => Natural, Element_Type => Cell_Address);
use Neighbours_Package;
function Get_Unvisited_Neighbours (Address : Cell_Address) return Neighbours_Package.Vector is
NeighbourList : Neighbours_Package.Vector;
begin
NeighbourList.Reserve_Capacity (4);
if Address.X >= 4 then
declare
L : Cell_Address := Left (Address);
begin
if Cell_At (L) = Filled then
NeighbourList.Append (L);
end if;
end;
end if;
if Address.Y >= 4 then
declare
U : Cell_Address := Up (Address);
begin
if Cell_At (U) = Filled then
NeighbourList.Append (U);
end if;
end;
end if;
if Address.X <= (N - 3) then
declare
R : Cell_Address := Right (Address);
begin
if Cell_At (R) = Filled then
NeighbourList.Append (R);
end if;
end;
end if;
if Address.Y <= (N - 3) then
declare
D : Cell_Address := Down (Address);
begin
if Cell_At (D) = Filled then
NeighbourList.Append (D);
end if;
end;
end if;
return NeighbourList;
end Get_Unvisited_Neighbours;
package Rnd is new Ada.Numerics.Discrete_Random (Natural);
Gen : Rnd.Generator;
function Get_Random_Neighbour (List : Neighbours_Package.Vector) return Cell_Address is
Random : Natural := Rnd.Random (Gen);
begin
if Is_Empty (List) then
raise Program_Error with "Cannot select any item from an empty list";
end if;
declare
Index : Natural := Random mod Natural (List.Length);
begin
return List (Index);
end;
end Get_Random_Neighbour;
procedure Depth_First_Make_Maze (Address : Cell_Address) is
begin
null;
end Depth_First_Make_Maze;
begin
Rnd.Reset (Gen);
Maze (1, 2) := Empty; -- entrance
Maze (N, N - 1) := Empty; -- exit
Depth_First_Make_Maze ((2, 2));
Print_Maze;
end Main;
To see the answer, expand the following snippet.
procedure Depth_First_Make_Maze (Address : Cell_Address) is
begin
loop
declare
Neighbours : Neighbours_Package.Vector := Get_Unvisited_Neighbours (Address);
begin
exit when Is_Empty (Neighbours);
declare
Next_Node : Cell_Address := Get_Random_Neighbour (Neighbours);
begin
Connect (Address, Next_Node);
Depth_First_Make_Maze (Next_Node);
end;
end;
end loop;
end Depth_First_Make_Maze;
Converting recursion to loop
Consider how a function call works; we take the actual parameters and put them on the call stack along with the function's address. When the function completes, we take those values off the stack again and put back the return value.
We can convert a recursive function by replacing the implicit callstack containing the parameters with an explicit stack. I.e. instead of:
procedure Foo (I : Integer) is
begin
Foo (I + 1);
end Foo;
We would put I onto the stack, and as long as there are values on the stack, peek at the top value and do the body of the Foo procedure using that value. When there is a call to Foo within that body, push the value you would call the procedure with instead, and restart the loop so that we immediately start processing the new value. If there is no call to self in this case, we discard the top value on the stack.
Restructuring a recursive procedure in this way will give you an insight into how it works, especially since pushing on to the stack is now separated from 'calling' that function since you explicitly take an item from the stack and do something with it.
You will need a stack implementation, here is one that is suitable:
Bounded_Stack.ads
generic
max_stack_size : Natural;
type Element_Type is private;
package Bounded_Stack is
type Stack is private;
function Create return Stack;
procedure Push (Onto : in out Stack; Item : Element_Type);
function Pop (From : in out Stack) return Element_Type;
function Top (From : in out Stack) return Element_Type;
procedure Discard (From : in out Stack);
function Is_Empty (S : in Stack) return Boolean;
Stack_Empty_Error : exception;
Stack_Full_Error : exception;
private
type Element_List is array (1 .. max_stack_size) of Element_Type;
type Stack is
record
list : Element_List;
top_index : Natural := 0;
end record;
end Bounded_Stack;
Bounded_Stack.adb
package body Bounded_Stack is
function Create return Stack is
begin
return (top_index => 0, list => <>);
end Create;
procedure Push (Onto : in out Stack; Item : Element_Type) is
begin
if Onto.top_index = max_stack_size then
raise Stack_Full_Error;
end if;
Onto.top_index := Onto.top_index + 1;
Onto.list (Onto.top_index) := Item;
end Push;
function Pop (From : in out Stack) return Element_Type is
Top_Value : Element_Type := Top (From);
begin
From.top_index := From.top_index - 1;
return Top_Value;
end Pop;
function Top (From : in out Stack) return Element_Type is
begin
if From.top_index = 0 then
raise Stack_Empty_Error;
end if;
return From.list (From.top_index);
end Top;
procedure Discard (From : in out Stack) is
begin
if From.top_index = 0 then
raise Stack_Empty_Error;
end if;
From.top_index := From.top_index - 1;
end Discard;
function Is_Empty (S : in Stack) return Boolean is (S.top_index = 0);
end Bounded_Stack;
It can be instantiated with a maximum stack size of Width*Height, since the worst case scenario is when you happen to choose a non-forking path that visits each cell once:
N_As_Cell_Size : Natural := (N - 1) / 2;
package Cell_Stack is new Bounded_Stack(max_stack_size => N_As_Cell_Size * N_As_Cell_Size, Element_Type => Cell_Address);
Take your answer to the previous assignment, and rewrite it without recursion, using the stack above instead.
To see the answer, expand the following snippet.
procedure Depth_First_Make_Maze (Address : Cell_Address) is
Stack : Cell_Stack.Stack := Cell_Stack.Create;
use Cell_Stack;
begin
Push (Stack, Address);
loop
exit when Is_Empty (Stack);
declare
-- this shadows the parameter, which we shouldn't refer to directly anyway
Address : Cell_Address := Top (Stack);
Neighbours : Neighbours_Package.Vector := Get_Unvisited_Neighbours (Address);
begin
if Is_Empty (Neighbours) then
Discard (Stack); -- equivalent to returning from the function in the recursive version
else
declare
Next_Cell : Cell_Address := Get_Random_Neighbour (Neighbours);
begin
Connect (Address, Next_Cell);
Push (Stack, Next_Cell); -- equivalent to calling self in the recursive version
end;
end if;
end;
end loop;
end Depth_First_Make_Maze;

You’re going to print as many lines as there are pins. Each line has an indentation consisting of a number of spaces and a number of pins, each printed as "I " (OK,there's an extra space at the end of the line, but no one's going to see that).
Start off with no leading spaces and the number of pins you were asked to print.
The next line needs one more leading space and one fewer pin (unless, of course, that would mean printing no pins, in which case we're done).

I don't program in Ada (it looks like a strange Pascal to me), but there is an obvious algorithmic problem in your Pins function.
Basically, if you want to print a pyramid whose base is N down to the very bottom where base is 1, you would need to do something like this (sorry for crude pascalization of the code).
procedure PrintPins(i, n: Integer)
begin
if i >= n then return;
Ada.Text_IO.Put('I'); // Print pin
Ada.Text_IO.Put(' '); // Print space
PrintPins(i + 1, n); // Next iteration
end;
function Pins(x, indent: Integer): Integer
printed: Integer;
begin
printed := 0;
if x > 0 then
PrintSpaces(indent); // Print indentation pretty much using the same artificial approach as by printing pins
PrintPins(0, x);
(*Print new line here*)
(*Now go down the next level and print another
row*)
printed := x + Pins(x - 1, indent + 1);
end;
return printed;
end
P.S. You don't need a specific function to count the number of printed pins here. It's just a Gauss sequence sum of the range 1..N, which is given by N(N + 1)/2

A variation of this program is to use both head recursion and tail recursion in the same procedure.
The output of such a program is
Enter the number of rows in the pyramid: 5
I I I I I
I I I I
I I I
I I
I
I
I I
I I I
I I I I
I I I I I
N = 5
Tail recursion produces the upper triangle and head recursion produces the lower triangle.

The way you develop a recursive algorithm is to pretend that you already have a subprogram that does what you want, except for the first bit, and you know, or can figure out, how to do the first bit. Then your algorithm is
Do the first bit
Call the subprogram to do the rest on what remains,
taking into account the effect of the first bit, if necessary
The trick is that "Call the subprogram to do the rest" is a recursive call to the subprogram you're creating.
It's always possible that the subprogram may be called when there's nothing to do, so you have to take that into account:
if Ending Condition then
Do any final actions
return [expression];
end if;
Do the first bit
Call the subprogram to do the rest
And you're done. By repreatedly doing the first bit until the ending condition is True, you end up doing the whole thing.
As an example, the function Get_Line in Ada.Text_IO may be implemented (this is not how it is usually implemented) by thinking, "I know how to get the first Character of the line. If I have a function to return the rest of the line, then I can return the first Character concatenated with the function result." So:
function Get_Line return String is
C : Character;
begin
Get (Item => C);
return C & Get_Line;
end Get_Line;
But what if we're already at the end of a line, so there's no line to get?
function Get_Line return String is
C : Character;
begin
if End_Of_Line then
Skip_Line;
return "";
end if;
Get (Item => C);
return C & Get_Line;
end Get_Line;
For your problem the first bit is printing a row with an indent and a number of pins, and the ending condition is when there are no more rows to print.
For your pyramid problem, this tail recursion scheme doesn't work. You need to do "middle recursion":
if Level = 1 then
Print the line for Level
return
end if
Print the top line for Level
Recurse for Level - 1
Print the bottom line for Level

Related

Return the greatest of 3 float values in Ada

I'm trying to create a subprogram that receives 3 float values and returns the greatest of the 3.
My code:
procedure is
function Biggest(A, B, C: in Float) return Float is
X: Float; -- Greatest value
begin
X:= Float'Max(B, C);
if A <= X then
null;
else
X:= A;
end if;
return Float'Ceiling(X);
end Biggest;
A, B, C: Float;
begin
Put("Mata in tre flyttal: ");
Get(A);
Get(B);
Get(C);
Put("Det största av dessa värden är: ");
Put(Biggest(A,B,C), Fore=>0, Aft=>0, Exp=>0);
I dont really understand where I went wrong.
Your answer is overly complicated.
Just set 'X' (bad name by the way) to A, then compare the others to X.
So...
Big : Float = A;
begin
if B > Big then Big := B; end if;
if C > Big then Big := C; end if;
return Big;
end;
Alright idk what changed but its working now. The only change I made is to change the Float'Rounding to Float'Ceiling which I doubt made it work.

How to preserve a value in a case statement in verilog

When designing finite state machines in verilog, I find myself writing code like this a lot to preserve a value in a particular state.
always#(state, a, b) begin
case(state) begin
S1: a = b;
S2: a = a; // preserve a;
endcase
end
This is necessary because if I don’t specify a value for each register in the sensitivity list, the compiler will infer a latch. To me this feels like a code smell, but I’m not experienced enough to know for sure. Is this the best way to preserve a value in verilog?
Preserve state means to create a latch, which is a device that do exactly that.
a=a is a null statement and you should not use it at all.
Do not use sensetivity lists in the always block, they are error prone, use #* instead.
And, for latches, you should use non-blocking assignments.
Your latch case statement should look like the following:
always#(*) begin
case(state) begin
S1: a <= b;
S2: // do nothing about 'a', a will not change.
endcase
end
in general the FSM scheme use in industry uses clocks and looks like the following:
always#(posedge clk) begin
case(state) begin
S1: begin
next_state <= S2;
a <= b;
end
S2: // do nothing about 'a', a will not change.
....
endcase
end
assign state = next_state;

How to debug an Ada program?

I did the problem and when I try to compile it said that identifier expected but I did all right.
with.Ada.TexT_IO;use Ada.Text_IO;
Procedure Isort1 is
type node;
type link is access node;
type node is
record
value:integer;
rest:Character;
next:link;
end record;
package IntIO is new Ada.Text_IO.Integer_IO(integer);use IntIO;
int:integer;
l:link;
pt:array(1..100)of link;
ch:character;
begin
for i in 1..10 loop pt(i):=null;
end loop;
loop
put("put an integer key (1 thru 10),99 to stop ");
get(int);
exit when int=99;
put("enter the other info,1 char ");
get(ch);
pt(int):= new node'(int,ch,pt(int));
end loop;
for i in 1..10 loop
i:=pt(i);
while I /=null loop
put(I.value);
put("... ");
put(I.rest);
new_line;
I:=I.next;
end loop;
end loop;
end Isort1;
Your assumption that you "did all right" is clearly wrong.
It appears that you are learning Ada after knowing some other programming language. You appear to be mixing ideas from other language(s) into your Ada code.
Let's organize and indent your code first.
with.Ada.TexT_IO;use Ada.Text_IO;
Procedure Isort1 is
type node;
type link is access node;
type node is
record
value:integer;
rest:Character;
next:link;
end record;
package IntIO is new Ada.Text_IO.Integer_IO(integer);use IntIO;
int:integer;
l:link;
pt:array(1..100)of link;
ch:character;
begin
for i in 1..10 loop pt(i):=null;
end loop;
loop
put("put an integer key (1 thru 10),99 to stop ");
get(int);
exit when int=99;
put("enter the other info,1 char ");
get(ch);
pt(int):= new node'(int,ch,pt(int));
end loop;
for i in 1..10 loop
i:=pt(i);
while I /=null loop
put(I.value);
put("... ");
put(I.rest);
new_line;
I:=I.next;
end loop;
end loop;
end Isort1;
Your first line begins with "with.Ada.TexT_IO;". It should say "with Ada.Text_I0;". Capitalization differences are not the problem. The problem is the period '.' following the reserved word "with".
Once that problem is fixed the compiler will tell you that you have an error in the line containing
i:=pt(i);
The error messages from the compiler are shown in the screen capture below.
It appears that you want the variable I to contain an instance of type node, but variable I is never declared and is never assigned a value.

Record aggregate with dynamic choice

I need to write a value consisting of all 0 except for bit Bit in a hardware register, where the register is somewhat like
type Bit_Number is range 0 .. 31;
type Bits_1 is array (Bit_Number) of Boolean
with
Component_Size => 1,
Size => 32;
Register_1 : Bits_1
with
Volatile,
Address => System'To_Address (16#1234_5678#);
Register_1 (typical of registers in Atmel's ATSAM3X8E, as in the Arduino Due) is defined as write-only, and it's unspecified what you get back if you read it, and it's unspecified what access widths are legal; all we are told is that when we write to the register only the 1 bits have any effect. (Incidentally, this means that the GNAT-specific aspect Volatile_Full_Access or the changes proposed in AI12-0128 won't help).
Enabling a pin in a GPIO peripheral involves setting its Bit in several registers. For reasons which I can't change (AdaCore's SVD2Ada), each register has its own equivalent of the Bits_1 array type above.
I want to write
procedure Set_Bit (Bit : Bit_Number) is
begin
Register_1 := (Bit => True, others => False);
Register_2 := (Bit => True, others => False);
...
end Set_Bit;
but the compiler says
19. procedure Set_Bit (Bit : Bit_Number) is
20. begin
21. Register_1 := (Bit => True, others => False);
|
>>> dynamic or empty choice in aggregate must be the only choice
which is a reference to ARM 4.3.3(17),
The discrete_choice_list of an array_component_association is allowed to have a discrete_choice that is a nonstatic choice_expression or that is a subtype_indication or range that defines a nonstatic or null range, only if it is the single discrete_choice of its discrete_choice_list, and there is only one array_component_association in the array_aggregate.
I can work round this,
procedure Set_Bit (Bit : Bit_Number) is
begin
declare
B : Bits_1 := (others => False);
begin
B (Bit) := True;
Register_1 := B;
end;
... ad nauseam
end Set_Bit;
but this seems very clumsy! Any other suggestions?
Does it have to be an array?
An alternative could be:
with Interfaces;
procedure Set_Bit is
Register : Interfaces.Unsigned_32;
begin
for J in 0..31 loop
Register := 2**J;
end loop;
end Set_Bit;
I think that this can be a little cumbersome , but if you need an array you could initialize it as a whole using concatenated sliced aggregates:
for J in 0 .. 31 loop
Register := Bits'(others => False)(0..J-1) &
True & Bits'(others => False)(J+1..31);
end loop;
It looks like a candidate for a function:
function Single_Bit (Set : in Bit_Number) return Bits_1 is
begin
return Result : Bits_1 := (others => False) do
Result (Set) := True;
end return;
end Single_Bit;
And then:
Register_1 := Single_Bit (Set => Some_Bit);
Register_2 := Single_Bit (Set => Another_Bit);
Example 1
This uses the Shift_Left operation.
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Conversion;
with Interfaces; use Interfaces;
procedure Main_Test is
function One_Bit (Index : Natural) return Unsigned_32 is (Shift_Left (1, Index));
type Bit_Array_32_Index is range 0 .. 31;
type Bit_Array_17_Index is range 0 .. 16;
type Bit_Array_32 is array (Bit_Array_32_Index) of Boolean with Component_Size => 1, Size => 32;
type Bit_Array_17 is array (Bit_Array_17_Index) of Boolean with Component_Size => 1, Size => 17;
-- For every new array type instantiate a convert function.
function Convert is new Ada.Unchecked_Conversion (Unsigned_32, Bit_Array_32);
function Convert is new Ada.Unchecked_Conversion (Unsigned_32, Bit_Array_17);
B32 : Bit_Array_32 with Volatile;
B17 : Bit_Array_17 with Volatile;
begin
B17 := Convert (One_Bit (2)) or Convert (One_Bit (5));
B32 := Convert (One_Bit (2) or One_Bit (5));
for E of B17 loop
Put (Boolean'Pos (E), 1);
end loop;
New_Line;
for E of B32 loop
Put (Boolean'Pos (E), 1);
end loop;
end;
Result
00100100000000000
00100100000000000000000000000000
Warnings
main.adb:21:04: warning: types for unchecked conversion have different sizes
main.adb:21:04: warning: size of "Unsigned_32" is 32, size of "Bit_Array_17" is 17
main.adb:21:04: warning: 15 high order bits of source will be ignored
Example generics
This uses the Shift_Left operation but with generics.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Conversion;
with Interfaces; use Interfaces;
procedure Main is
package Unsigned_32_IO is new Ada.Text_IO.Modular_IO (Unsigned_32);
type Bit_Array_32_Index is range 0 .. 31;
type Bit_Array_17_Index is range 0 .. 16;
type Bit_Array_32 is array (Bit_Array_32_Index) of Boolean with Component_Size => 1, Size => 32;
type Bit_Array_17 is array (Bit_Array_17_Index) of Boolean with Component_Size => 1, Size => 32;
generic
type I is (<>);
type T is array (I) of Boolean;
procedure Generic_Put (Item : T; Width : Field; Base : Number_Base);
procedure Generic_Put (Item : T; Width : Field; Base : Number_Base) is
function Convert_To_Unsigned_32 is new Ada.Unchecked_Conversion (T, Unsigned_32);
begin
Unsigned_32_IO.Put (Convert_To_Unsigned_32 (Item), Width, Base);
end;
generic
type I is (<>);
type T is array (I) of Boolean;
function Generic_Shift_Left (Value : Unsigned_32; Amount : Natural) return T;
function Generic_Shift_Left (Value : Unsigned_32; Amount : Natural) return T is
function Convert_To_Bit_Array_32 is new Ada.Unchecked_Conversion (Unsigned_32, T);
begin
return Convert_To_Bit_Array_32 (Interfaces.Shift_Left (Value, Amount));
end;
function Shift_Left is new Generic_Shift_Left (Bit_Array_32_Index, Bit_Array_32);
function Shift_Left is new Generic_Shift_Left (Bit_Array_17_Index, Bit_Array_17);
procedure Put is new Generic_Put (Bit_Array_32_Index, Bit_Array_32);
procedure Put is new Generic_Put (Bit_Array_17_Index, Bit_Array_17);
B32 : Bit_Array_32 with Volatile;
B17 : Bit_Array_17 with Volatile;
begin
B32 := Shift_Left (1, 2) or Shift_Left (1, 5);
B17 := Shift_Left (1, 2) or Shift_Left (1, 5);
Put (B17, 0, 2);
New_Line;
Put (B32, 0, 2);
end;
Result
2#100100#
2#100100#
gprbuild -v
GPRBUILD GPL 2015 (20150428) (i686-pc-mingw32)
Questions
Does it work on big-endian machine?
I haven't tested. See does bit-shift depend on endianness?

Are there any differences between these two files?

I have two ada files shown below
A1.ada
procedure KOR616 is
I : Integer := 3;
procedure Lowest_Level( Int : in out Integer );
pragma Inline( Lowest_Level );
procedure Null_Proc is
begin
null;
end;
procedure Lowest_Level( Int : in out Integer ) is
begin
if Int > 0 then
Int := 7;
Null_Proc;
else
Int := Int + 1;
end if;
end;
begin
while I < 7 loop
Lowest_Level( I );
end loop;
end;
Next shown below is B1.ada
procedure Lowest_Level( Int : in out Integer );
pragma Inline( Lowest_Level );
procedure Lowest_Level( Int : in out Integer ) is
procedure Null_Proc is
begin
null;
end;
begin
if Int > 0 then
Int := 7;
Null_Proc;
else
Int := Int + 1;
end if;
end Lowest_Level;
with Lowest_Level;
procedure KOR618 is
I : Integer := 3;
begin
while I < 7 loop
Lowest_Level( I );
end loop;
end;
Is there any difference between these two files?
As written, KOR616 (A1) and KOR618 (B1) are going to have the same effect. The difference is a matter of visibility (and the compiled code will be different, of course, but I doubt that matters).
In A1, the bodies of both Null_Proc and Lowest_Level can see I, but nothing outside KOR616 can see them. Also, the body of KOR616 can see Null_Proc.
In B1, Lowest_Level (but not Null_Proc) is visible to the whole program, not just KOR618.
In B1, Null_Proc isn't inlined. (It is not within Lowest_Level).
In A1, procedure Null_Proc is not nested in procedure Lowest_Level; in B1, it is nested in procedure Lowest_Level. Regarding pragma Inline, "an implementation is free to follow or to ignore the recommendation expressed by the pragma." I'd expect the in-lining of nested subprograms to be implementation dependent.
Well, the main difference is that in the second example Null_Proc is unavailable outside of Lowest_Level. In the first example, if you felt like it later you could have KOR618 or any other routine you might add later also call Null_Proc.
Generally I don't define routines inside other routines like that unless there is some reason why the inner routine makes no sense outside of the outer routine. The obvious example would be if the inner routine operates on local variables declared in the outer routine (without passing them as parameters).
In this case Null_Proc is about as general an operation as it gets, so I don't see any compelling reason to squirel it away inside Lowest_Level like that. Of course, it doesn't do anything at all, so I don't any compelling reason for it to exist in the first place. :-)

Resources