Data commit

Task/Stack/Free-Pascal/stack-1.pas

@@ -0,0 +1,23 @@
+program Stack;
+ {$IFDEF FPC}{$MODE DELPHI}{$IFDEF WINDOWS}{$APPTYPE CONSOLE}{$ENDIF}{$ENDIF}
+ {$ASSERTIONS ON}
+uses Generics.Collections;
+
+var
+  lStack: TStack<Integer>;
+begin
+  lStack := TStack<Integer>.Create;
+  try
+    lStack.Push(1);
+    lStack.Push(2);
+    lStack.Push(3);
+    Assert(lStack.Peek = 3); // 3 should be at the top of the stack
+
+    Write(lStack.Pop:2);   // 3
+    Write(lStack.Pop:2);   // 2
+    Writeln(lStack.Pop:2); // 1
+    Assert(lStack.Count = 0, 'Stack is not empty'); // should be empty
+  finally
+    lStack.Free;
+  end;
+end.

Task/Stack/Free-Pascal/stack-2.pas

@@ -0,0 +1,159 @@
+PROGRAM StackObject.pas;
+{$IFDEF FPC}
+    {$mode objfpc}{$H+}{$J-}{$m+}{$R+}
+{$ELSE}
+    {$APPTYPE CONSOLE}
+{$ENDIF}
+(*)
+
+        Free Pascal Compiler version 3.2.0 [2020/06/14] for x86_64
+        TheStack free and readable alternative at C/C++ Sidxeeds
+        compiles natively to almost any platform, including raSidxberry PI *
+        Can run independently from DELPHI / Lazarus
+
+        For debian Linux: apt -y install fpc
+        It contains a text IDE called fp
+
+        This is an experiment for a stack that can handle almost any
+        simple type of variable.
+
+        What happens after retrieving the variable is TBD by you.
+
+        https://www.freepascal.org/advantage.var
+(*)
+
+
+USES
+        Classes   ,
+        Crt       ,
+        Variants  ;
+        {$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} // Use for variants
+
+TYPE
+
+    Stack   =   OBJECT
+
+                    CONST
+
+                        CrLf    =   #13#10  ;
+
+                    TYPE
+
+                        VariantArr = array  of variant ;
+
+                    PRIVATE
+
+                            Ar  :   VariantArr  ;
+
+                            {$MACRO ON}
+                                {$DEFINE STACKSIZE  :=  Length ( Ar )           * Ord ( Length ( Ar ) > 0 ) }
+                                {$DEFINE TOP        :=  STACKSIZE - 1           * Ord ( STACKSIZE > 0 )     }
+                                {$DEFINE SLEN       :=  length ( Ar [ TOP ] )   * Ord ( Length ( Ar [ TOP ] ) > 0 ) }
+
+                            FUNCTION    IsEmpty             : boolean   ;
+                            PROCEDURE   Print                           ;
+                            FUNCTION    Pop                 : variant   ;
+                            FUNCTION    Peep                : variant   ;
+                            PROCEDURE   Push        ( item  : variant ) ;
+                            FUNCTION    SecPop              : variant   ;
+
+                    PUBLIC
+                            CONSTRUCTOR Create                          ;
+
+                END;
+
+
+    CONSTRUCTOR Stack.Create ;
+
+        BEGIN
+                SetLength ( Ar, STACKSIZE ) ;
+        END;
+
+    FUNCTION    Stack.IsEmpty  : boolean ;
+
+        BEGIN
+                IsEmpty := ( STACKSIZE < 1 ) ;
+        END;
+
+
+    PROCEDURE   Stack.Print  ;
+
+        VAR
+                i   :   shortint ;
+        BEGIN
+                IF ( TOP < 1 ) or ( IsEmpty ) THEN
+                    BEGIN
+                        WriteLn ( CrLf + '<empty stack>' ) ;
+                        EXIT ;
+                    END;
+                WriteLn ( CrLf , '<top>') ;
+
+                FOR i := ( TOP )  DOWNTO 0 DO WriteLn ( Ar [ i ] ) ;
+                WriteLn ( '<bottom>' ) ;
+        END;
+
+
+    FUNCTION    Stack.Pop : variant ;
+
+        BEGIN
+                IF IsEmpty THEN EXIT        ;
+                Pop        := Ar [ TOP ]    ;
+                SetLength  ( Ar, TOP )      ;
+        END;
+
+
+    FUNCTION    Stack.Peep  : variant ;
+
+        BEGIN
+                IF IsEmpty THEN EXIT        ;
+                Peep        := Ar [ TOP ]   ;
+        END;
+
+
+    PROCEDURE   Stack.Push  ( item : variant ) ;
+
+        BEGIN
+                SetLength ( Ar, STACKSIZE + 1 ) ;
+                Ar  [ TOP ]   := item           ;
+        END;
+
+
+    FUNCTION    Stack.SecPop : variant ;
+
+        (*) Pop and Wipe    (*)
+
+        BEGIN
+                IF IsEmpty THEN EXIT                            ;
+                SecPop      := Ar [ TOP ]                       ;
+                Ar [ TOP ]  := StringOfChar ( #255  , SLEN )    ;
+                Ar [ TOP ]  := StringOfChar ( #0    , SLEN )    ;
+                SetLength  ( Ar, TOP )                          ;
+        END;
+
+VAR
+        n   :   integer  ;
+        r   :   real     ;
+        S   :   string   ;
+        So  :   Stack    ;
+
+
+BEGIN
+
+        So.Create                           ;
+        So.Print                            ;
+        n   := 23                           ;
+        So.Push  ( n )                      ;
+        S   := '3 guesses '                 ;
+        So.Push  ( S )                      ;
+        r   :=  1.23                        ;
+        So.Push  ( r )                      ;
+        WriteLn  ( 'Peep : ', So.Peep  )    ;
+        So.Push  ( 'Nice Try' )             ;
+        So.Print                            ;
+        WriteLn                             ;
+        WriteLn  ( 'SecPop : ',So.SecPop )  ;
+        WriteLn  ( 'SecPop : ',So.SecPop )  ;
+        WriteLn  ( 'SecPop : ',So.SecPop )  ;
+        WriteLn  ( 'SecPop : ',So.SecPop )  ;
+        So.Print                            ;
+END.