Ada beginner Stack program - stack

Basically, I have 2 files ( .adb and .ads). I am totally new to Ada and also how to compile 2 files. The program is of a basic stack implementation. I got this compile error when I compiled the .adb file.
$ gcc -c test_adt_stack.adb
abstract_char_stack.ads:22:01: end of file expected, file can have only one compilation unit
The 2 files I have are:
abstract_char_stack.ads
-----------------------------------------------------------
package Abstract_Char_Stack is
type Stack_Type is private;
procedure Push(Stack : in out Stack_Type;
Item : in Character);
procedure Pop (Stack : in out Stack_Type;
Char : out Character);
private
type Space_Type is array(1..8) of Character;
type Stack_Type is record
Space : Space_Type;
Index : Natural := 0;
end record;
end Abstract_Char_Stack;
-----------------------------------------------------------
package body Abstract_Char_Stack is
----------------------------------------------
procedure Push(Stack : in out Stack_Type;
Item : in Character) is
begin
Stack.Index := Stack.Index + 1;
Stack.Space(Stack.Index) := Item;
end Push;
--------------------------------------------
procedure Pop (Stack : in out Stack_Type;
Char : out Character) is
begin
Char := Stack.Space(Stack.Index);
Stack.Index := Stack.Index - 1;
end Pop;
--------------------------------------------
end Abstract_Char_Stack;
and the other one is test_adt_stack.adb
-----------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with Abstract_Char_Stack; use Abstract_Char_Stack;
procedure Test_ADT_Stack is
S1 : Stack_Type;
S2 : Stack_Type;
Ch : Character;
begin
Push(S1,'H'); Push(S1,'E');
Push(S1,'L'); Push(S1,'L');
Push(S1,'O'); -- S1 holds O,L,L,E,H
for I in 1..5 loop
Pop(S1, Ch);
Put(Ch); -- displays OLLEH
Push(S2,Ch);
end loop; -- S2 holds H,E,L,L,O
New_Line;
Put_Line("Order is reversed");
for I in 1..5 loop
Pop(S2, Ch);
Put(Ch); -- displays HELLO
end loop;
end Test_ADT_Stack;
-----------------------------------------------------------
What am I doing wrong? I just want to have it compile and display what it's supposed to do. This was a study the program kind of assignment. But I can't make it compile or don't know if I am doing it right.

The problem is that GNAT [and FSF GNAT is what GCC uses, IIRC] does not allow multiple compilation-units in a single file. (This is due to how they manage the library, but that is perhaps a bit too detailed for a beginner to worry about.)
Solution, each of these needs its own file:
Abstract_Char_Stack Specification (abstract_char_stack.ads)
Abstract_Char_Stack Body (abstract_char_stack.adb)
Test_ADT_Stack [procedure] body (test_adt_stack.adb)

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
-----------------------------------------------------------
procedure Test_ADT_Stack is
enter code here
package Abstract_Char_Stack is
type Stack_Type is private;
procedure Push(Stack : in out Stack_Type;
Item : in Character);
procedure Pop (Stack : in out Stack_Type;
Char : out Character);
private
type Space_Type is array(1..8) of Character;
type Stack_Type is record
Space : Space_Type;
Index : Natural := 0;
end record;
end Abstract_Char_Stack;
use Test_ADT_Stack.Abstract_Char_Stack ;
S1 : Stack_Type;
S2 : Stack_Type;
Ch : Character;
-----------------------------------------------------------
package body Abstract_Char_Stack is
----------------------------------------------
procedure Push(Stack : in out Stack_Type;
Item : in Character) is
begin
Stack.Index := Stack.Index + 1;
Stack.Space(Stack.Index) := Item;
end Push;
--------------------------------------------
procedure Pop (Stack : in out Stack_Type;
Char : out Character) is
begin
Char := Stack.Space(Stack.Index);
Stack.Index := Stack.Index - 1;
end Pop;
--------------------------------------------
end Abstract_Char_Stack;
-----------------------------------------------------------
begin
Push(S1,'H'); Push(S1,'E');
Push(S1,'L'); Push(S1,'L');
Push(S1,'O'); -- S1 holds O,L,L,E,H
for I in 1..5 loop
Pop(S1, Ch);
Put(Ch); -- displays OLLEH
Push(S2,Ch);
end loop; -- S2 holds H,E,L,L,O
New_Line;
Put_Line("Order is reversed");
for I in 1..5 loop
Pop(S2, Ch);
Put(Ch); -- displays HELLO
end loop;
end Test_ADT_Stack;
-----------------------------------------------------------

Related

Dephi: faster way to convert a “dirty” string to a number

How can I make this code faster? the string can contain characters such as ", .?#" and possibly others.
Const Nums = ['0'..'9'];
function CleanNumber(s: String): Int64;
Var z: Cardinal;
begin
for z := length(s) downto 1 do
if not (s[z] in Nums) then Delete(s,z,1);
if s = '' then
Result := 0 else
Result := StrToInt64(s);
end;
Results (long loop):
CL2,CL3 = HeartWare's
32-bit, "dirty number" / "clean number"
Mine: 270ms, 165ms
CL2: 220ms, 210ms
CL3: 100ms, 110ms
DirtyStrToNum: 215ms, 90ms
64-bit, "dirty number" / "clean number"
Mine: 2280ms, 75ms
CL2: 1320ms, 130ms
CL3: 280ms, 25ms
DirtyStrToNum: 1390ms, 125ms
Here are two examples that for sure are faster than the one you have (deleting a character from a string is relatively slow):
This one works by pre-allocating a string of the maximum possible length and then filling it out with the digits as I come across them in the source string. No delete for every unsupported character, and no expansion of the target string for every supported character.
FUNCTION CleanNumber(CONST S : STRING) : Int64;
VAR
I,J : Cardinal;
C : CHAR;
T : STRING;
BEGIN
SetLength(T,LENGTH(S));
J:=LOW(T);
FOR I:=LOW(S) TO HIGH(S) DO BEGIN
C:=S[I];
IF (C>='0') AND (C<='9') THEN BEGIN
T[J]:=C;
INC(J)
END
END;
IF J=LOW(T) THEN
Result:=0
ELSE BEGIN
SetLength(T,J-LOW(T)); // or T[J]:=#0 [implementation-specific]
Result:=StrToInt64(T)
END
END;
This one works by simple multiplication of the end result by 10 and adding the corresponding digit value.
{$IFOPT Q+}
{$DEFINE OverflowEnabled }
{$ELSE }
{$Q+ If you want overflow checking }
{$ENDIF }
FUNCTION CleanNumber(CONST S : STRING) : Int64;
VAR
I : Cardinal;
C : CHAR;
BEGIN
Result:=0;
FOR I:=LOW(S) TO HIGH(S) DO BEGIN
C:=S[I];
IF (C>='0') AND (C<='9') THEN Result:=Result*10+(ORD(C)-ORD('0'))
END
END;
{$IFNDEF OverflowEnabled } {$Q-} {$ENDIF }
{$UNDEF OverflowEnabled }
Also note that I don't use IN or CharInSet as these are much slower than a simple inline >= and <= comparison.
Another comment I could make is the use of LOW and HIGH on the string variable. This makes it compatible with both 0-based strings (mobile compilers) and 1-based strings (desktop compilers).
Your function is slow mainly because of the Delete approach. Each call to Delete needs to move a lot of characters around.
A faster approach would be like this:
function DirtyStrToNum(const S: string): Int64;
var
tmp: string;
i, j: Integer;
const
DIGITS = ['0'..'9'];
begin
SetLength(tmp, S.Length);
j := 0;
for i := 1 to S.Length do
if CharInSet(S[i], DIGITS) then
begin
Inc(j);
tmp[j] := S[i];
end;
SetLength(tmp, j);
if tmp.IsEmpty then
Result := 0
else
Result := StrToInt64(tmp);
// Or, but not equivalent: Result := StrToInt64Def(tmp, 0);
end;
Notice I make a single allocation for a new string, and then only copy the minimum number of characters to it.

How to truncate a string to n char?

Unicode string can contain surrogate pairs (especially emoticons). Now I need to truncate this string to n chars. How can I do it safely without breaking any emoticons ?
The following code should be able to solve your issue:
FUNCTION IsDiacritical(C : CHAR) : BOOLEAN;
VAR
W : WORD ABSOLUTE C;
BEGIN
Result:=((W>=$1AB0) AND (W<=$1AFF)) OR
((W>=$0300) AND (W<=$036F)) OR
((W>=$1DC0) AND (W<=$1DFF))
END;
FUNCTION GetNextChar(VAR S : STRING) : STRING;
VAR
C : CHAR;
P : Cardinal;
BEGIN
CASE S.Length OF
0 : Result:='';
1 : Result:=S
ELSE // OTHERWISE //
Result:=''; P:=1;
FOR C IN S DO
IF NOT IsDiacritical(C) THEN
BREAK
ELSE BEGIN
Result:=Result+C;
INC(P)
END;
IF (P<LENGTH(S)) AND IsSurrogatePair(S,P) THEN
Result:=Result+COPY(S,P,2)
ELSE
Result:=Result+COPY(S,P,1)
END;
DELETE(S,1,Result.Length)
END;
FUNCTION GetStringByCodePoints(S : STRING ; CodePoints : Cardinal) : STRING;
VAR
I : Cardinal;
BEGIN
Result:='';
FOR I:=1 TO CodePoints DO Result:=Result+GetNextChar(S)
END;
PROCEDURE SetLengthByCodePoints(VAR S : STRING ; CodePoints : Cardinal);
BEGIN
SetLength(S,GetStringByCodePoints(S,CodePoints).Length)
END;
The GetStringByCodePoints is analogous to COPY, and SetLengthByCodePoints is analogous to SetLength. Both, however, takes the number of Code Points ("visible characters" or control characters) instead of characters.
If there are more Combining Diacritical code points, the relevant function can be extended to include these. The three groups I check for are the ones I could find by a simple Google search.

how to convert hexa to dec using delphi and hex to octal?

function HexToDec(Str: string): Integer;
var
i, M: Integer;
begin
Result:=0;
M:=1;
Str:=AnsiUpperCase(Str);
for i:=Length(Str) downto 1 do
begin
case Str[i] of
'1'..'9': Result:=Result+(Ord(Str[i])-Ord('0'))*M;
'A'..'F': Result:=Result+(Ord(Str[i])-Ord('A')+10)*M;
end;
M:=M shl 4;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Edit1.Text<>'' then
Label2.Caption:=IntToStr(HexToDec(Edit1.Text));
end;
How to using it without function, because i want to call the result again in other line, and how about hexa to octal ? am i must conver from hexa to dec and then dec to octal?
Delphi can do this already, so you don't need to write a function parsing the number. It is quite simple, actually:
function HexToDec(const Str: string): Integer;
begin
if (Str <> '') and ((Str[1] = '-') or (Str[1] = '+')) then
Result := StrToInt(Str[1] + '$' + Copy(Str, 2, MaxInt))
else
Result := StrToInt('$' + Str);
end;
Note that that also handles negative hex numbers, or numbers like +$1234.
How to using it without function, because i want to call the result again in other line ?
If you want to re-use the value, assign the result of HexToDec to a variable and use that in IntToStr.
FWIW, in your function, there is no need to call AnsiUpperCase, because all hex digits fall in the ASCII range anyway. A much simpler UpperCase should work too.
My first comment would be that you are not converting hex to decimal with your function (although you are converting to decimal as an intermediate) but rather hex to integer. IntToStr then converts integer to base 10, effectively. To generalise what you want then I would create two functions - strBaseToInt and IntToStrBase where Base is meant to imply e.g. 16 for hex, 10 for dec, 8 for octal, etc., and assuming the convention adopted by hex that A=10, and so on but to (possibly) Z = 35 making the maximum base possible 36.
I don't handle + or - but that could be added easily.
In the reverse funtion, again for simplicity of illustration I have ommitted supporting negative values.
Edit
Thanks to Rudy for this improvement
Edit 2 - Overflow test added, as per comments
function StrBaseToInt(const Str: string; const Base : integer): Integer;
var
i, iVal, iTest: Longword;
begin
if (Base > 36) or (Base < 2) then raise Exception.Create('Invalid Base');
Result:=0;
iTest := 0;
for i:=1 to Length(Str) do
begin
case Str[i] of
'0'..'9': iVal := (Ord(Str[i])-Ord('0'));
'A'..'Z': iVal := (Ord(Str[i])-Ord('A')+10);
'a'..'z': iVal := (Ord(Str[i])-Ord('a')+10);
else raise Exception.Create( 'Illegal character found');
end;
if iVal < Base then
begin
Result:=Result * Base + iVal;
if Result < iTest then // overflow test!
begin
raise Exception.Create( 'Overflow occurred');
end
else
begin
iTest := Result;
end;
end
else
begin
raise Exception.Create( 'Illegal character found');
end;
end;
end;
Then, for example your HexToOct function would look like this
function HexToOct( Value : string ) : string;
begin
Result := IntToStrBase( StrBaseToInt( Value, 16), 8 );
end;
Additional
A general function would be
function BaseToBase( const Value : string; const FromBase, ToBase : integer ) : string;
begin
Result := IntToStrBase( StrBaseToInt( Value, FromBase ),ToBase );
end;

by what to replace TSysCharSet that is deprecated under nextgen?

This is the declaration of TSysCharSet under delphi Berlin
TSysCharSet = set of Char deprecated; // Holds Char values in the ordinal range of 0..255 only.
it is now deprecated, but by what to replace it ? i just need to gave to my function some set of char like [' ', #9, #13, #10]
If all you need is to carry around a group of (unicode) characters then you don't need TSysCharSet. Just use a dynamic array of char:
var
MyCharArray : TArray<char>;
begin
MyCharArray := [' ',#9,#13,#10];
end;
TSysCharSet was primarily used in the CharInSet routine; In the docs they refer to TCharHelper as a replacement for CharInSet since a TSysCharSet cannot contain unicode characters.
uses System.Character;
var
WhiteSpace : TSysCharSet;
ac : ansichar;
c : char;
begin
// replace this....
ac := #9;
WhiteSpace := [' ',#9,#13,#10];
if CharInSet(ac, WhiteSpace) then
begin
end;
// ...with this:
c := #9;
if c.IsWhiteSpace then
begin
end
end

Delphi : Operator not aplicable to this operand type

im a beginner to Aplication forms in Delphi, i need a little help please. So its basically a program that does Aritmetic count for numbers from
Memo box. I wanna also add interval to it. (-15;20> And i wanna do it for all ODD numbers.
Variables are listed here
soucet:SUM,
pocet:count of numbers,
Prumer:Arithmetic mean
procedure TForm1.Button3Click(Sender: TObject);
var soucet,prumer,x: Real;
i,pocet:Integer;
begin
Memo1.Clear;
soucet:=0;
pocet:=0;
i:=0;
While i<= Memo1.Lines.Count-1 do begin --
x:=StrToFloat (Memo1.lines[i]); --
If (x>-5) and (x<=5) then begin
soucet:= soucet + x;
inc(pocet);
end;
inc(i);
end;
If pocet>0 then begin
prumer:=soucet/pocet;
Memo1.Text:= floattostr(prumer);
end
else Memo1.Text:= 'Žádná čísla z intervalu (-15;20>';
But i only want this code to be for ODD numbers...
procedure TForm1.Button3Click(Sender: TObject);
var soucet,prumer,x: Real;
i,pocet:Integer;
begin
Memo1.clear;
soucet:=0;
pocet:=0;
i:=0;
While i<= Memo1.Lines.Count-1 do begin --
x:=StrToFloat (Memo1.lines[i]); --
If (x>-5) and (x<=5) then begin
If x mod 2<>0 then begin
soucet:= soucet + x;
inc(pocet);
end;
end;
inc(i);
end;
If pocet>0 then begin
prumer:=soucet/pocet;
Memo1.Text:= floattostr(prumer);
end
else Memo1.Text:= 'Žádná čísla z intervalu (-15;20>';
The problem is that it shows : Operator not aplicable to this operand type.
What should i do to remove this error ?
You have your xdeclared as real but the modoperator works on integer
Either
Declare x as integer and use StrToInt, TryStrToInt or StrToIntDef io StrToFloat
Truncate the real to an int like this: if Trunc(x) mod 2 <> 0 or even better use the built-in odd function like this: if odd(Trunc(x))
This will solve your immediate problem but you might want to read up on
input validation
clean code
and not related to your current code but important enough to mention
error/resource handling (try...finally)

Resources