home bbs files messages ]

Forums before death by AOL, social media and spammers... "We can't have nice things"

   comp.os.vms      DEC's VAX* line of computers & VMS.      264,096 messages   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]

   Message 263,803 of 264,096   
   =?UTF-8?Q?Arne_Vajh=C3=B8j?= to All   
   Re: Unsafe code blocks   
   19 Nov 25 21:32:48   
   
   From: arne@vajhoej.dk   
      
   On 11/19/2025 8:26 PM, Arne Vajhøj wrote:   
   > But you can do the same in Ada.   
   >   
   > Both doing similar to above and by using Unchecked_Conversion   
   > and Valid.   
      
   > Procedure ColorFul is   
      
   Maybe this variant is more Option'esque:   
      
   with Unchecked_Conversion;   
      
   with Ada.Text_IO, Ada.Integer_Text_IO;   
      
   use Ada.Text_IO, Ada.Integer_Text_IO;   
      
   Procedure ColorFul2 is   
      
   type Color is (Red, Green, Blue);   
   for Color use (Red => 1, Green => 2, Blue => 3);   
   for Color'Size use Integer'Size;   
      
   procedure Put(col : Color) is   
      
   begin   
        case col is   
            when Red => Put("Red");   
            when Green => Put("Green");   
            when Blue => Put("Blue");   
        end case;   
   end Put;   
      
   type ColorOption(Valid : Boolean := False) is record   
       case Valid is   
          when False =>   
             null;   
          when True =>   
             Value : Color;   
       end case;   
   end record;   
      
   function ColorSome(col : Color) return ColorOption is   
      
   res : ColorOption;   
      
   begin   
        res := (Valid => True, Value => col);   
        return res;   
   end ColorSome;   
      
   function ColorNone return ColorOption is   
      
   res : ColorOption;   
      
   begin   
        res := (Valid => False);   
        return res;   
   end ColorNone;   
      
   function Integer2ColorNice(I : Integer) return ColorOption is   
      
   res : ColorOption;   
      
   begin   
       case I is   
           when 1 => res := ColorSome(Red);   
           when 2 => res := ColorSome(Green);   
           when 3 => res := ColorSome(Blue);   
           when others => res := ColorNone;   
       end case;   
       return res;   
   end Integer2ColorNice;   
      
   function Integer2ColorTricky(I : Integer) return ColorOption is   
      
   function BitI2C is new Unchecked_Conversion(Source => Integer, Target =>   
   Color);   
      
   temp : Color;   
   res : ColorOption;   
      
   begin   
       temp := BitI2C(I);   
       if temp'Valid then   
           res := ColorSome(temp);   
       else   
           res := ColorNone;   
       end if;   
       return res;   
   end Integer2ColorTricky;   
      
   col : ColorOption;   
      
   begin   
        for I in 0..4 loop   
            col := Integer2ColorNice(I);   
            Put(I, Width => 1);   
            Put(" is ");   
            if col.Valid then   
                Put(col.Value);   
            else   
                Put("not a valid color");   
            end if;   
            New_Line;   
        end loop;   
        for I in 0..4 loop   
            col := Integer2ColorTricky(I);   
            Put(I, Width => 1);   
            Put(" is ");   
            if col.Valid then   
                Put(col.Value);   
            else   
                Put("not a valid color");   
            end if;   
            New_Line;   
        end loop;   
   end ColorFul2;   
      
   Arne   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]


(c) 1994,  bbs@darkrealms.ca