with Ada.Containers.Vectors;
with Ada.Strings;  use Ada.Strings;
with Put_Title;

procedure LAL_DDA is
    Collection : Repinfo_Collection;

    A_Basic_Record       : Basic_Record         := Basic_Record'(A => 42);
    Another_Basic_Record : Basic_Record         := (A => 42);
    Nix                  : constant Null_Record := (null record);

    procedure Process_Type_Decl (Decl : Base_Type_Decl);
    --  Display all representation information that is available in
    --  ``Collection`` for this type declaration.

    procedure Process_Variants
      (Variants : Variant_Representation_Array; Prefix : String);
    --  Display all representation information for the given record variants.
    --  ``Prefix`` is used as a prefix for all printed lines.

    package Expr_Vectors is new Ada.Containers.Vectors (Positive, Expr);
    use type Expr_Vectors.Vector;
    package Expr_Vector_Vectors is new Ada.Containers.Vectors
      (Positive, Expr_Vectors.Vector);

    function Test_Discriminants
      (Decl : Base_Type_Decl) return Expr_Vector_Vectors.Vector;
    --  Fetch the vector of discriminants to use for testing from nearby Test
    --  pragmas.

    procedure Error (Node : Ada_Node'Class; Message : String) with No_Return;
    --  Abort the App with the given error ``Message``, contextualized using
    --  ``Node`` 's source location.

    package App is new Libadalang.Helpers.App
      (Name         => "lal_dda",
       Description  =>
         "Exercize Libadalang's Data_Decomposition API on type declarations",
       App_Setup    => App_Setup,
       Process_Unit => Process_Unit);

    package Args is
        use GNATCOLL.Opt_Parse;

        package Rep_Info_Files is new Parse_Option_List
          (App.Args.Parser, "-i", "--rep-info-file",
           Arg_Type   => Unbounded_String,
           Accumulate => True,
           Help       => "Output for the compiler's -gnatR4j option");

    <endfold id='1'>end</endfold id='1'> Args;

    ---------------
    -- App_Setup --
    ---------------

    procedure App_Setup (Context : App_Context; Jobs : App_Job_Context_Array) is
        pragma Unreferenced (Context, Jobs);
    <beginfold id='1'>begin</beginfold id='1'>
        Collection := Load (Filename_Array (Args.Rep_Info_Files.Get));
    exception
        when Exc : Loading_Error =>
            Put_Line
              ("Loading_Error raised while loading representation information:");
            Put_Line (Exception_Message (Exc));
            New_Line;
    <endfold id='1'>end</endfold id='1'> App_Setup;

    ------------------
    -- Process_Unit --
    ------------------

    procedure Process_Unit (Context : App_Job_Context; Unit : Analysis_Unit) is
        pragma Unreferenced (Context);

        function Process (Node : Ada_Node'Class) return Visit_Status;

        function Process (Node : Ada_Node'Class) return Visit_Status is
        <beginfold id='1'>begin</beginfold id='1'>
            <beginfold id='2'>case</beginfold id='2'> Node.Kind is
                when Ada_Base_Type_Decl =>
                    Process_Type_Decl (Node.As_Base_Type_Decl);

                when Ada_Pragma_Node =>
                    declare
                        PN   : constant Pragma_Node := Node.As_Pragma_Node;
                        Name : constant Text_Type := To_Lower (PN.F_Id.Text);
                        Decl : Ada_Node;
                    <beginfold id='1'>begin</beginfold id='1'>
                        <beginfold id='3'>if</beginfold id='3'> Name = "test_object_type" then
                            Decl := PN.Previous_Sibling;
                            <beginfold id='3'>if</beginfold id='3'> Decl.Kind /= Ada_Object_Decl then
                                Error
                                  (Node,
                                    "previous declaration must be an object"
                                    & " declaration");
                            <endfold id='3'>end if</endfold id='3'>;
                            Process_Type_Decl
                              (Decl.As_Object_Decl
                                .F_Type_Expr
                                .P_Designated_Type_Decl);
                        <endfold id='3'>end if</endfold id='3'>;
                        <beginfold id='3'>if</beginfold id='3'> I > 1 then
                            Put (", ");
                        <endfold id='3'>end if</endfold id='3'>;
                    <endfold id='1'>end</endfold id='1'>;

                when others =>
                    null;
            <endfold id='2'>end case</endfold id='2'>;
            return Into;
        <endfold id='1'>end</endfold id='1'> Process;

    <beginfold id='1'>begin</beginfold id='1'>
        Put_Title
          ('#', "Analyzing " & Ada.Directories.Simple_Name (Unit.Get_Filename));
        <beginfold id='3'>if</beginfold id='3'> Unit.Has_Diagnostics then
            for D of Unit.Diagnostics <beginfold id='4'>loop</beginfold id='4'>
                Put_Line (Unit.Format_GNU_Diagnostic (D));
            <endfold id='4'>end loop</endfold id='4'>;
            New_Line;
            return;

        elsif not Unit.Root.Is_Null then
            Unit.Root.Traverse (Process'Access);
        <endfold id='3'>end if</endfold id='3'>;
    <endfold id='1'>end</endfold id='1'> Process_Unit;
<endfold id='1'>end</endfold id='1'> LAL_DDA;

type Car is <beginfold id='5'>record</beginfold id='5'>
    Identity       : Long_Long_Integer;
    Number_Wheels  : Positive range 1 .. 16#FF#E1;
    Number_Wheels  : Positive range 16#F.FF#E+2 .. 2#1111_1111#;
    Paint          : Color;
    Horse_Power_kW : Float range 0.0 .. 2_000.0;
    Consumption    : Float range 0.0 .. 100.0;
<endfold id='5'>end record</endfold id='5'>;

type Null_Record is null record;

type Traffic_Light_Access is access Mutable_Variant_Record;
Any_Traffic_Light       : Traffic_Light_Access :=
                           new Mutable_Variant_Record;
Aliased_Traffic_Light   : aliased Mutable_Variant_Record;

pragma Unchecked_Union (Union);
pragma Convention (C, Union);    -- optional

type Programmer is new Person
                   and Printable
with
   <beginfold id='5'>record</beginfold id='5'>
      Skilled_In : Language_List;
   <endfold id='5'>end record</endfold id='5'>;

3#12.112#e3
3#12.11 use
--     ^ invalid
3#12.23#e3
--    ^ invalid
3#12.11ds#
--     ^ invalid
1211ds
--  ^ invalid
