gcc/ada/g-awk.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              G N A T . A W K                             --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2000-2014, AdaCore                     --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.Exceptions;
  33 with Ada.Text_IO;
  34 with Ada.Strings.Unbounded;
  35 with Ada.Strings.Fixed;
  36 with Ada.Strings.Maps;
  37 with Ada.Unchecked_Deallocation;
  38
  39 with GNAT.Directory_Operations;
  40 with GNAT.Dynamic_Tables;
  41 with GNAT.OS_Lib;
  42
  43 package body GNAT.AWK is
  44
  45    use Ada;
  46    use Ada.Strings.Unbounded;
  47
  48    -----------------------
  49    -- Local subprograms --
  50    -----------------------
  51
  52    --  The following two subprograms provide a functional interface to the
  53    --  two special session variables, that are manipulated explicitly by
  54    --  Finalize, but must be declared after Finalize to prevent static
  55    --  elaboration warnings.
  56
  57    function Get_Def return Session_Data_Access;
  58    procedure Set_Cur;
  59
  60    ----------------
  61    -- Split mode --
  62    ----------------
  63
  64    package Split is
  65
  66       type Mode is abstract tagged null record;
  67       --  This is the main type which is declared abstract. This type must be
  68       --  derived for each split style.
  69
  70       type Mode_Access is access Mode'Class;
  71
  72       procedure Current_Line (S : Mode; Session : Session_Type)
  73         is abstract;
  74       --  Split current line of Session using split mode S
  75
  76       ------------------------
  77       -- Split on separator --
  78       ------------------------
  79
  80       type Separator (Size : Positive) is new Mode with record
  81          Separators : String (1 .. Size);
  82       end record;
  83
  84       procedure Current_Line
  85         (S       : Separator;
  86          Session : Session_Type);
  87
  88       ---------------------
  89       -- Split on column --
  90       ---------------------
  91
  92       type Column (Size : Positive) is new Mode with record
  93          Columns : Widths_Set (1 .. Size);
  94       end record;
  95
  96       procedure Current_Line (S : Column; Session : Session_Type);
  97
  98    end Split;
  99
 100    procedure Free is new Unchecked_Deallocation
 101      (Split.Mode'Class, Split.Mode_Access);
 102
 103    ----------------
 104    -- File_Table --
 105    ----------------
 106
 107    type AWK_File is access String;
 108
 109    package File_Table is
 110       new Dynamic_Tables (AWK_File, Natural, 1, 5, 50);
 111    --  List of file names associated with a Session
 112
 113    procedure Free is new Unchecked_Deallocation (String, AWK_File);
 114
 115    -----------------
 116    -- Field_Table --
 117    -----------------
 118
 119    type Field_Slice is record
 120       First : Positive;
 121       Last  : Natural;
 122    end record;
 123    --  This is a field slice (First .. Last) in session's current line
 124
 125    package Field_Table is
 126       new Dynamic_Tables (Field_Slice, Natural, 1, 10, 100);
 127    --  List of fields for the current line
 128
 129    --------------
 130    -- Patterns --
 131    --------------
 132
 133    --  Define all patterns style: exact string, regular expression, boolean
 134    --  function.
 135
 136    package Patterns is
 137
 138       type Pattern is abstract tagged null record;
 139       --  This is the main type which is declared abstract. This type must be
 140       --  derived for each patterns style.
 141
 142       type Pattern_Access is access Pattern'Class;
 143
 144       function Match
 145         (P       : Pattern;
 146          Session : Session_Type) return Boolean
 147       is abstract;
 148       --  Returns True if P match for the current session and False otherwise
 149
 150       procedure Release (P : in out Pattern);
 151       --  Release memory used by the pattern structure
 152
 153       --------------------------
 154       -- Exact string pattern --
 155       --------------------------
 156
 157       type String_Pattern is new Pattern with record
 158          Str  : Unbounded_String;
 159          Rank : Count;
 160       end record;
 161
 162       function Match
 163         (P       : String_Pattern;
 164          Session : Session_Type) return Boolean;
 165
 166       --------------------------------
 167       -- Regular expression pattern --
 168       --------------------------------
 169
 170       type Pattern_Matcher_Access is access Regpat.Pattern_Matcher;
 171
 172       type Regexp_Pattern is new Pattern with record
 173          Regx : Pattern_Matcher_Access;
 174          Rank : Count;
 175       end record;
 176
 177       function Match
 178         (P       : Regexp_Pattern;
 179          Session : Session_Type) return Boolean;
 180
 181       procedure Release (P : in out Regexp_Pattern);
 182
 183       ------------------------------
 184       -- Boolean function pattern --
 185       ------------------------------
 186
 187       type Callback_Pattern is new Pattern with record
 188          Pattern : Pattern_Callback;
 189       end record;
 190
 191       function Match
 192         (P       : Callback_Pattern;
 193          Session : Session_Type) return Boolean;
 194
 195    end Patterns;
 196
 197    procedure Free is new Unchecked_Deallocation
 198      (Patterns.Pattern'Class, Patterns.Pattern_Access);
 199
 200    -------------
 201    -- Actions --
 202    -------------
 203
 204    --  Define all action style : simple call, call with matches
 205
 206    package Actions is
 207
 208       type Action is abstract tagged null record;
 209       --  This is the main type which is declared abstract. This type must be
 210       --  derived for each action style.
 211
 212       type Action_Access is access Action'Class;
 213
 214       procedure Call
 215         (A       : Action;
 216          Session : Session_Type) is abstract;
 217       --  Call action A as required
 218
 219       -------------------
 220       -- Simple action --
 221       -------------------
 222
 223       type Simple_Action is new Action with record
 224          Proc : Action_Callback;
 225       end record;
 226
 227       procedure Call
 228         (A       : Simple_Action;
 229          Session : Session_Type);
 230
 231       -------------------------
 232       -- Action with matches --
 233       -------------------------
 234
 235       type Match_Action is new Action with record
 236          Proc : Match_Action_Callback;
 237       end record;
 238
 239       procedure Call
 240         (A       : Match_Action;
 241          Session : Session_Type);
 242
 243    end Actions;
 244
 245    procedure Free is new Unchecked_Deallocation
 246      (Actions.Action'Class, Actions.Action_Access);
 247
 248    --------------------------
 249    -- Pattern/Action table --
 250    --------------------------
 251
 252    type Pattern_Action is record
 253       Pattern : Patterns.Pattern_Access;  -- If Pattern is True
 254       Action  : Actions.Action_Access;    -- Action will be called
 255    end record;
 256
 257    package Pattern_Action_Table is
 258       new Dynamic_Tables (Pattern_Action, Natural, 1, 5, 50);
 259
 260    ------------------
 261    -- Session Data --
 262    ------------------
 263
 264    type Session_Data is record
 265       Current_File : Text_IO.File_Type;
 266       Current_Line : Unbounded_String;
 267       Separators   : Split.Mode_Access;
 268       Files        : File_Table.Instance;
 269       File_Index   : Natural := 0;
 270       Fields       : Field_Table.Instance;
 271       Filters      : Pattern_Action_Table.Instance;
 272       NR           : Natural := 0;
 273       FNR          : Natural := 0;
 274       Matches      : Regpat.Match_Array (0 .. 100);
 275       --  Latest matches for the regexp pattern
 276    end record;
 277
 278    procedure Free is
 279       new Unchecked_Deallocation (Session_Data, Session_Data_Access);
 280
 281    --------------
 282    -- Finalize --
 283    --------------
 284
 285    procedure Finalize (Session : in out Session_Type) is
 286    begin
 287       --  We release the session data only if it is not the default session
 288
 289       if Session.Data /= Get_Def then
 290          --  Release separators
 291
 292          Free (Session.Data.Separators);
 293
 294          Free (Session.Data);
 295
 296          --  Since we have closed the current session, set it to point now to
 297          --  the default session.
 298
 299          Set_Cur;
 300       end if;
 301    end Finalize;
 302
 303    ----------------
 304    -- Initialize --
 305    ----------------
 306
 307    procedure Initialize (Session : in out Session_Type) is
 308    begin
 309       Session.Data := new Session_Data;
 310
 311       --  Initialize separators
 312
 313       Session.Data.Separators :=
 314         new Split.Separator'(Default_Separators'Length, Default_Separators);
 315
 316       --  Initialize all tables
 317
 318       File_Table.Init  (Session.Data.Files);
 319       Field_Table.Init (Session.Data.Fields);
 320       Pattern_Action_Table.Init (Session.Data.Filters);
 321    end Initialize;
 322
 323    -----------------------
 324    -- Session Variables --
 325    -----------------------
 326
 327    Def_Session : Session_Type;
 328    Cur_Session : Session_Type;
 329
 330    ----------------------
 331    -- Private Services --
 332    ----------------------
 333
 334    function Always_True return Boolean;
 335    --  A function that always returns True
 336
 337    function Apply_Filters
 338      (Session : Session_Type) return Boolean;
 339    --  Apply any filters for which the Pattern is True for Session. It returns
 340    --  True if a least one filters has been applied (i.e. associated action
 341    --  callback has been called).
 342
 343    procedure Open_Next_File
 344      (Session : Session_Type);
 345    pragma Inline (Open_Next_File);
 346    --  Open next file for Session closing current file if needed. It raises
 347    --  End_Error if there is no more file in the table.
 348
 349    procedure Raise_With_Info
 350      (E       : Exceptions.Exception_Id;
 351       Message : String;
 352       Session : Session_Type);
 353    pragma No_Return (Raise_With_Info);
 354    --  Raises exception E with the message prepended with the current line
 355    --  number and the filename if possible.
 356
 357    procedure Read_Line (Session : Session_Type);
 358    --  Read a line for the Session and set Current_Line
 359
 360    procedure Split_Line (Session : Session_Type);
 361    --  Split session's Current_Line according to the session separators and
 362    --  set the Fields table. This procedure can be called at any time.
 363
 364    ----------------------
 365    -- Private Packages --
 366    ----------------------
 367
 368    -------------
 369    -- Actions --
 370    -------------
 371
 372    package body Actions is
 373
 374       ----------
 375       -- Call --
 376       ----------
 377
 378       procedure Call
 379         (A       : Simple_Action;
 380          Session : Session_Type)
 381       is
 382          pragma Unreferenced (Session);
 383       begin
 384          A.Proc.all;
 385       end Call;
 386
 387       ----------
 388       -- Call --
 389       ----------
 390
 391       procedure Call
 392         (A       : Match_Action;
 393          Session : Session_Type)
 394       is
 395       begin
 396          A.Proc (Session.Data.Matches);
 397       end Call;
 398
 399    end Actions;
 400
 401    --------------
 402    -- Patterns --
 403    --------------
 404
 405    package body Patterns is
 406
 407       -----------
 408       -- Match --
 409       -----------
 410
 411       function Match
 412         (P       : String_Pattern;
 413          Session : Session_Type) return Boolean
 414       is
 415       begin
 416          return P.Str = Field (P.Rank, Session);
 417       end Match;
 418
 419       -----------
 420       -- Match --
 421       -----------
 422
 423       function Match
 424         (P       : Regexp_Pattern;
 425          Session : Session_Type) return Boolean
 426       is
 427          use type Regpat.Match_Location;
 428       begin
 429          Regpat.Match
 430            (P.Regx.all, Field (P.Rank, Session), Session.Data.Matches);
 431          return Session.Data.Matches (0) /= Regpat.No_Match;
 432       end Match;
 433
 434       -----------
 435       -- Match --
 436       -----------
 437
 438       function Match
 439         (P       : Callback_Pattern;
 440          Session : Session_Type) return Boolean
 441       is
 442          pragma Unreferenced (Session);
 443       begin
 444          return P.Pattern.all;
 445       end Match;
 446
 447       -------------
 448       -- Release --
 449       -------------
 450
 451       procedure Release (P : in out Pattern) is
 452          pragma Unreferenced (P);
 453       begin
 454          null;
 455       end Release;
 456
 457       -------------
 458       -- Release --
 459       -------------
 460
 461       procedure Release (P : in out Regexp_Pattern) is
 462          procedure Free is new Unchecked_Deallocation
 463            (Regpat.Pattern_Matcher, Pattern_Matcher_Access);
 464       begin
 465          Free (P.Regx);
 466       end Release;
 467
 468    end Patterns;
 469
 470    -----------
 471    -- Split --
 472    -----------
 473
 474    package body Split is
 475
 476       use Ada.Strings;
 477
 478       ------------------
 479       -- Current_Line --
 480       ------------------
 481
 482       procedure Current_Line (S : Separator; Session : Session_Type) is
 483          Line   : constant String := To_String (Session.Data.Current_Line);
 484          Fields : Field_Table.Instance renames Session.Data.Fields;
 485          Seps   : constant Maps.Character_Set := Maps.To_Set (S.Separators);
 486
 487          Start  : Natural;
 488          Stop   : Natural;
 489
 490       begin
 491          --  First field start here
 492
 493          Start := Line'First;
 494
 495          --  Record the first field start position which is the first character
 496          --  in the line.
 497
 498          Field_Table.Increment_Last (Fields);
 499          Fields.Table (Field_Table.Last (Fields)).First := Start;
 500
 501          loop
 502             --  Look for next separator
 503
 504             Stop := Fixed.Index
 505               (Source => Line (Start .. Line'Last),
 506                Set    => Seps);
 507
 508             exit when Stop = 0;
 509
 510             Fields.Table (Field_Table.Last (Fields)).Last := Stop - 1;
 511
 512             --  If separators are set to the default (space and tab) we skip
 513             --  all spaces and tabs following current field.
 514
 515             if S.Separators = Default_Separators then
 516                Start := Fixed.Index
 517                  (Line (Stop + 1 .. Line'Last),
 518                   Maps.To_Set (Default_Separators),
 519                   Outside,
 520                   Strings.Forward);
 521
 522                if Start = 0 then
 523                   Start := Stop + 1;
 524                end if;
 525
 526             else
 527                Start := Stop + 1;
 528             end if;
 529
 530             --  Record in the field table the start of this new field
 531
 532             Field_Table.Increment_Last (Fields);
 533             Fields.Table (Field_Table.Last (Fields)).First := Start;
 534
 535          end loop;
 536
 537          Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
 538       end Current_Line;
 539
 540       ------------------
 541       -- Current_Line --
 542       ------------------
 543
 544       procedure Current_Line (S : Column; Session : Session_Type) is
 545          Line   : constant String := To_String (Session.Data.Current_Line);
 546          Fields : Field_Table.Instance renames Session.Data.Fields;
 547          Start  : Positive := Line'First;
 548
 549       begin
 550          --  Record the first field start position which is the first character
 551          --  in the line.
 552
 553          for C in 1 .. S.Columns'Length loop
 554
 555             Field_Table.Increment_Last (Fields);
 556
 557             Fields.Table (Field_Table.Last (Fields)).First := Start;
 558
 559             Start := Start + S.Columns (C);
 560
 561             Fields.Table (Field_Table.Last (Fields)).Last := Start - 1;
 562
 563          end loop;
 564
 565          --  If there is some remaining character on the line, add them in a
 566          --  new field.
 567
 568          if Start - 1 < Line'Length then
 569
 570             Field_Table.Increment_Last (Fields);
 571
 572             Fields.Table (Field_Table.Last (Fields)).First := Start;
 573
 574             Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
 575          end if;
 576       end Current_Line;
 577
 578    end Split;
 579
 580    --------------
 581    -- Add_File --
 582    --------------
 583
 584    procedure Add_File
 585      (Filename : String;
 586       Session  : Session_Type)
 587    is
 588       Files : File_Table.Instance renames Session.Data.Files;
 589
 590    begin
 591       if OS_Lib.Is_Regular_File (Filename) then
 592          File_Table.Increment_Last (Files);
 593          Files.Table (File_Table.Last (Files)) := new String'(Filename);
 594       else
 595          Raise_With_Info
 596            (File_Error'Identity,
 597             "File " & Filename & " not found.",
 598             Session);
 599       end if;
 600    end Add_File;
 601
 602    procedure Add_File
 603      (Filename : String)
 604    is
 605
 606    begin
 607       Add_File (Filename, Cur_Session);
 608    end Add_File;
 609
 610    ---------------
 611    -- Add_Files --
 612    ---------------
 613
 614    procedure Add_Files
 615      (Directory             : String;
 616       Filenames             : String;
 617       Number_Of_Files_Added : out Natural;
 618       Session               : Session_Type)
 619    is
 620       use Directory_Operations;
 621
 622       Dir      : Dir_Type;
 623       Filename : String (1 .. 200);
 624       Last     : Natural;
 625
 626    begin
 627       Number_Of_Files_Added := 0;
 628
 629       Open (Dir, Directory);
 630
 631       loop
 632          Read (Dir, Filename, Last);
 633          exit when Last = 0;
 634
 635          Add_File (Filename (1 .. Last), Session);
 636          Number_Of_Files_Added := Number_Of_Files_Added + 1;
 637       end loop;
 638
 639       Close (Dir);
 640
 641    exception
 642       when others =>
 643          Raise_With_Info
 644            (File_Error'Identity,
 645             "Error scanning directory " & Directory
 646             & " for files " & Filenames & '.',
 647             Session);
 648    end Add_Files;
 649
 650    procedure Add_Files
 651      (Directory             : String;
 652       Filenames             : String;
 653       Number_Of_Files_Added : out Natural)
 654    is
 655
 656    begin
 657       Add_Files (Directory, Filenames, Number_Of_Files_Added, Cur_Session);
 658    end Add_Files;
 659
 660    -----------------
 661    -- Always_True --
 662    -----------------
 663
 664    function Always_True return Boolean is
 665    begin
 666       return True;
 667    end Always_True;
 668
 669    -------------------
 670    -- Apply_Filters --
 671    -------------------
 672
 673    function Apply_Filters
 674      (Session : Session_Type) return Boolean
 675    is
 676       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
 677       Results : Boolean := False;
 678
 679    begin
 680       --  Iterate through the filters table, if pattern match call action
 681
 682       for F in 1 .. Pattern_Action_Table.Last (Filters) loop
 683          if Patterns.Match (Filters.Table (F).Pattern.all, Session) then
 684             Results := True;
 685             Actions.Call (Filters.Table (F).Action.all, Session);
 686          end if;
 687       end loop;
 688
 689       return Results;
 690    end Apply_Filters;
 691
 692    -----------
 693    -- Close --
 694    -----------
 695
 696    procedure Close (Session : Session_Type) is
 697       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
 698       Files   : File_Table.Instance renames Session.Data.Files;
 699
 700    begin
 701       --  Close current file if needed
 702
 703       if Text_IO.Is_Open (Session.Data.Current_File) then
 704          Text_IO.Close (Session.Data.Current_File);
 705       end if;
 706
 707       --  Release Filters table
 708
 709       for F in 1 .. Pattern_Action_Table.Last (Filters) loop
 710          Patterns.Release (Filters.Table (F).Pattern.all);
 711          Free (Filters.Table (F).Pattern);
 712          Free (Filters.Table (F).Action);
 713       end loop;
 714
 715       for F in 1 .. File_Table.Last (Files) loop
 716          Free (Files.Table (F));
 717       end loop;
 718
 719       File_Table.Set_Last (Session.Data.Files, 0);
 720       Field_Table.Set_Last (Session.Data.Fields, 0);
 721       Pattern_Action_Table.Set_Last (Session.Data.Filters, 0);
 722
 723       Session.Data.NR := 0;
 724       Session.Data.FNR := 0;
 725       Session.Data.File_Index := 0;
 726       Session.Data.Current_Line := Null_Unbounded_String;
 727    end Close;
 728
 729    ---------------------
 730    -- Current_Session --
 731    ---------------------
 732
 733    function Current_Session return not null access Session_Type is
 734    begin
 735       return Cur_Session.Self;
 736    end Current_Session;
 737
 738    ---------------------
 739    -- Default_Session --
 740    ---------------------
 741
 742    function Default_Session return not null access Session_Type is
 743    begin
 744       return Def_Session.Self;
 745    end Default_Session;
 746
 747    --------------------
 748    -- Discrete_Field --
 749    --------------------
 750
 751    function Discrete_Field
 752      (Rank    : Count;
 753       Session : Session_Type) return Discrete
 754    is
 755    begin
 756       return Discrete'Value (Field (Rank, Session));
 757    end Discrete_Field;
 758
 759    function Discrete_Field_Current_Session
 760      (Rank    : Count) return Discrete is
 761       function Do_It is new Discrete_Field (Discrete);
 762    begin
 763       return Do_It (Rank, Cur_Session);
 764    end Discrete_Field_Current_Session;
 765
 766    -----------------
 767    -- End_Of_Data --
 768    -----------------
 769
 770    function End_Of_Data
 771      (Session : Session_Type) return Boolean
 772    is
 773    begin
 774       return Session.Data.File_Index = File_Table.Last (Session.Data.Files)
 775         and then End_Of_File (Session);
 776    end End_Of_Data;
 777
 778    function End_Of_Data
 779      return Boolean
 780    is
 781    begin
 782       return End_Of_Data (Cur_Session);
 783    end End_Of_Data;
 784
 785    -----------------
 786    -- End_Of_File --
 787    -----------------
 788
 789    function End_Of_File
 790      (Session : Session_Type) return Boolean
 791    is
 792    begin
 793       return Text_IO.End_Of_File (Session.Data.Current_File);
 794    end End_Of_File;
 795
 796    function End_Of_File
 797      return Boolean
 798    is
 799    begin
 800       return End_Of_File (Cur_Session);
 801    end End_Of_File;
 802
 803    -----------
 804    -- Field --
 805    -----------
 806
 807    function Field
 808      (Rank    : Count;
 809       Session : Session_Type) return String
 810    is
 811       Fields : Field_Table.Instance renames Session.Data.Fields;
 812
 813    begin
 814       if Rank > Number_Of_Fields (Session) then
 815          Raise_With_Info
 816            (Field_Error'Identity,
 817             "Field number" & Count'Image (Rank) & " does not exist.",
 818             Session);
 819
 820       elsif Rank = 0 then
 821
 822          --  Returns the whole line, this is what $0 does under Session_Type
 823
 824          return To_String (Session.Data.Current_Line);
 825
 826       else
 827          return Slice (Session.Data.Current_Line,
 828                        Fields.Table (Positive (Rank)).First,
 829                        Fields.Table (Positive (Rank)).Last);
 830       end if;
 831    end Field;
 832
 833    function Field
 834      (Rank    : Count) return String
 835    is
 836    begin
 837       return Field (Rank, Cur_Session);
 838    end Field;
 839
 840    function Field
 841      (Rank    : Count;
 842       Session : Session_Type) return Integer
 843    is
 844    begin
 845       return Integer'Value (Field (Rank, Session));
 846
 847    exception
 848       when Constraint_Error =>
 849          Raise_With_Info
 850            (Field_Error'Identity,
 851             "Field number" & Count'Image (Rank)
 852             & " cannot be converted to an integer.",
 853             Session);
 854    end Field;
 855
 856    function Field
 857      (Rank    : Count) return Integer
 858    is
 859    begin
 860       return Field (Rank, Cur_Session);
 861    end Field;
 862
 863    function Field
 864      (Rank    : Count;
 865       Session : Session_Type) return Float
 866    is
 867    begin
 868       return Float'Value (Field (Rank, Session));
 869
 870    exception
 871       when Constraint_Error =>
 872          Raise_With_Info
 873            (Field_Error'Identity,
 874             "Field number" & Count'Image (Rank)
 875             & " cannot be converted to a float.",
 876             Session);
 877    end Field;
 878
 879    function Field
 880      (Rank    : Count) return Float
 881    is
 882    begin
 883       return Field (Rank, Cur_Session);
 884    end Field;
 885
 886    ----------
 887    -- File --
 888    ----------
 889
 890    function File
 891      (Session : Session_Type) return String
 892    is
 893       Files : File_Table.Instance renames Session.Data.Files;
 894
 895    begin
 896       if Session.Data.File_Index = 0 then
 897          return "??";
 898       else
 899          return Files.Table (Session.Data.File_Index).all;
 900       end if;
 901    end File;
 902
 903    function File
 904      return String
 905    is
 906    begin
 907       return File (Cur_Session);
 908    end File;
 909
 910    --------------------
 911    -- For_Every_Line --
 912    --------------------
 913
 914    procedure For_Every_Line
 915      (Separators : String        := Use_Current;
 916       Filename   : String        := Use_Current;
 917       Callbacks  : Callback_Mode := None;
 918       Session    : Session_Type)
 919    is
 920       Quit : Boolean;
 921
 922    begin
 923       Open (Separators, Filename, Session);
 924
 925       while not End_Of_Data (Session) loop
 926          Read_Line (Session);
 927          Split_Line (Session);
 928
 929          if Callbacks in Only .. Pass_Through then
 930             declare
 931                Discard : Boolean;
 932             begin
 933                Discard := Apply_Filters (Session);
 934             end;
 935          end if;
 936
 937          if Callbacks /= Only then
 938             Quit := False;
 939             Action (Quit);
 940             exit when Quit;
 941          end if;
 942       end loop;
 943
 944       Close (Session);
 945    end For_Every_Line;
 946
 947    procedure For_Every_Line_Current_Session
 948      (Separators : String        := Use_Current;
 949       Filename   : String        := Use_Current;
 950       Callbacks  : Callback_Mode := None)
 951    is
 952       procedure Do_It is new For_Every_Line (Action);
 953    begin
 954       Do_It (Separators, Filename, Callbacks, Cur_Session);
 955    end For_Every_Line_Current_Session;
 956
 957    --------------
 958    -- Get_Line --
 959    --------------
 960
 961    procedure Get_Line
 962      (Callbacks : Callback_Mode := None;
 963       Session   : Session_Type)
 964    is
 965       Filter_Active : Boolean;
 966
 967    begin
 968       if not Text_IO.Is_Open (Session.Data.Current_File) then
 969          raise File_Error;
 970       end if;
 971
 972       loop
 973          Read_Line (Session);
 974          Split_Line (Session);
 975
 976          case Callbacks is
 977
 978             when None =>
 979                exit;
 980
 981             when Only =>
 982                Filter_Active := Apply_Filters (Session);
 983                exit when not Filter_Active;
 984
 985             when Pass_Through =>
 986                Filter_Active := Apply_Filters (Session);
 987                exit;
 988
 989          end case;
 990       end loop;
 991    end Get_Line;
 992
 993    procedure Get_Line
 994      (Callbacks : Callback_Mode := None)
 995    is
 996    begin
 997       Get_Line (Callbacks, Cur_Session);
 998    end Get_Line;
 999
1000    ----------------------
1001    -- Number_Of_Fields --
1002    ----------------------
1003
1004    function Number_Of_Fields
1005      (Session : Session_Type) return Count
1006    is
1007    begin
1008       return Count (Field_Table.Last (Session.Data.Fields));
1009    end Number_Of_Fields;
1010
1011    function Number_Of_Fields
1012      return Count
1013    is
1014    begin
1015       return Number_Of_Fields (Cur_Session);
1016    end Number_Of_Fields;
1017
1018    --------------------------
1019    -- Number_Of_File_Lines --
1020    --------------------------
1021
1022    function Number_Of_File_Lines
1023      (Session : Session_Type) return Count
1024    is
1025    begin
1026       return Count (Session.Data.FNR);
1027    end Number_Of_File_Lines;
1028
1029    function Number_Of_File_Lines
1030      return Count
1031    is
1032    begin
1033       return Number_Of_File_Lines (Cur_Session);
1034    end Number_Of_File_Lines;
1035
1036    ---------------------
1037    -- Number_Of_Files --
1038    ---------------------
1039
1040    function Number_Of_Files
1041      (Session : Session_Type) return Natural
1042    is
1043       Files : File_Table.Instance renames Session.Data.Files;
1044    begin
1045       return File_Table.Last (Files);
1046    end Number_Of_Files;
1047
1048    function Number_Of_Files
1049      return Natural
1050    is
1051    begin
1052       return Number_Of_Files (Cur_Session);
1053    end Number_Of_Files;
1054
1055    ---------------------
1056    -- Number_Of_Lines --
1057    ---------------------
1058
1059    function Number_Of_Lines
1060      (Session : Session_Type) return Count
1061    is
1062    begin
1063       return Count (Session.Data.NR);
1064    end Number_Of_Lines;
1065
1066    function Number_Of_Lines
1067      return Count
1068    is
1069    begin
1070       return Number_Of_Lines (Cur_Session);
1071    end Number_Of_Lines;
1072
1073    ----------
1074    -- Open --
1075    ----------
1076
1077    procedure Open
1078      (Separators : String       := Use_Current;
1079       Filename   : String       := Use_Current;
1080       Session    : Session_Type)
1081    is
1082    begin
1083       if Text_IO.Is_Open (Session.Data.Current_File) then
1084          raise Session_Error;
1085       end if;
1086
1087       if Filename /= Use_Current then
1088          File_Table.Init (Session.Data.Files);
1089          Add_File (Filename, Session);
1090       end if;
1091
1092       if Separators /= Use_Current then
1093          Set_Field_Separators (Separators, Session);
1094       end if;
1095
1096       Open_Next_File (Session);
1097
1098    exception
1099       when End_Error =>
1100          raise File_Error;
1101    end Open;
1102
1103    procedure Open
1104      (Separators : String       := Use_Current;
1105       Filename   : String       := Use_Current)
1106    is
1107    begin
1108       Open (Separators, Filename, Cur_Session);
1109    end Open;
1110
1111    --------------------
1112    -- Open_Next_File --
1113    --------------------
1114
1115    procedure Open_Next_File
1116      (Session : Session_Type)
1117    is
1118       Files : File_Table.Instance renames Session.Data.Files;
1119
1120    begin
1121       if Text_IO.Is_Open (Session.Data.Current_File) then
1122          Text_IO.Close (Session.Data.Current_File);
1123       end if;
1124
1125       Session.Data.File_Index := Session.Data.File_Index + 1;
1126
1127       --  If there are no mores file in the table, raise End_Error
1128
1129       if Session.Data.File_Index > File_Table.Last (Files) then
1130          raise End_Error;
1131       end if;
1132
1133       Text_IO.Open
1134         (File => Session.Data.Current_File,
1135          Name => Files.Table (Session.Data.File_Index).all,
1136          Mode => Text_IO.In_File);
1137    end Open_Next_File;
1138
1139    -----------
1140    -- Parse --
1141    -----------
1142
1143    procedure Parse
1144      (Separators : String       := Use_Current;
1145       Filename   : String       := Use_Current;
1146       Session    : Session_Type)
1147    is
1148       Filter_Active : Boolean;
1149       pragma Unreferenced (Filter_Active);
1150
1151    begin
1152       Open (Separators, Filename, Session);
1153
1154       while not End_Of_Data (Session) loop
1155          Get_Line (None, Session);
1156          Filter_Active := Apply_Filters (Session);
1157       end loop;
1158
1159       Close (Session);
1160    end Parse;
1161
1162    procedure Parse
1163      (Separators : String       := Use_Current;
1164       Filename   : String       := Use_Current)
1165    is
1166    begin
1167       Parse (Separators, Filename, Cur_Session);
1168    end Parse;
1169
1170    ---------------------
1171    -- Raise_With_Info --
1172    ---------------------
1173
1174    procedure Raise_With_Info
1175      (E       : Exceptions.Exception_Id;
1176       Message : String;
1177       Session : Session_Type)
1178    is
1179       function Filename return String;
1180       --  Returns current filename and "??" if this information is not
1181       --  available.
1182
1183       function Line return String;
1184       --  Returns current line number without the leading space
1185
1186       --------------
1187       -- Filename --
1188       --------------
1189
1190       function Filename return String is
1191          File : constant String := AWK.File (Session);
1192       begin
1193          if File = "" then
1194             return "??";
1195          else
1196             return File;
1197          end if;
1198       end Filename;
1199
1200       ----------
1201       -- Line --
1202       ----------
1203
1204       function Line return String is
1205          L : constant String := Natural'Image (Session.Data.FNR);
1206       begin
1207          return L (2 .. L'Last);
1208       end Line;
1209
1210    --  Start of processing for Raise_With_Info
1211
1212    begin
1213       Exceptions.Raise_Exception
1214         (E,
1215          '[' & Filename & ':' & Line & "] " & Message);
1216       raise Constraint_Error; -- to please GNAT as this is a No_Return proc
1217    end Raise_With_Info;
1218
1219    ---------------
1220    -- Read_Line --
1221    ---------------
1222
1223    procedure Read_Line (Session : Session_Type) is
1224
1225       function Read_Line return String;
1226       --  Read a line in the current file. This implementation is recursive
1227       --  and does not have a limitation on the line length.
1228
1229       NR  : Natural renames Session.Data.NR;
1230       FNR : Natural renames Session.Data.FNR;
1231
1232       ---------------
1233       -- Read_Line --
1234       ---------------
1235
1236       function Read_Line return String is
1237          Buffer : String (1 .. 1_024);
1238          Last   : Natural;
1239
1240       begin
1241          Text_IO.Get_Line (Session.Data.Current_File, Buffer, Last);
1242
1243          if Last = Buffer'Last then
1244             return Buffer & Read_Line;
1245          else
1246             return Buffer (1 .. Last);
1247          end if;
1248       end Read_Line;
1249
1250    --  Start of processing for Read_Line
1251
1252    begin
1253       if End_Of_File (Session) then
1254          Open_Next_File (Session);
1255          FNR := 0;
1256       end if;
1257
1258       Session.Data.Current_Line := To_Unbounded_String (Read_Line);
1259
1260       NR := NR + 1;
1261       FNR := FNR + 1;
1262    end Read_Line;
1263
1264    --------------
1265    -- Register --
1266    --------------
1267
1268    procedure Register
1269      (Field   : Count;
1270       Pattern : String;
1271       Action  : Action_Callback;
1272       Session : Session_Type)
1273    is
1274       Filters   : Pattern_Action_Table.Instance renames Session.Data.Filters;
1275       U_Pattern : constant Unbounded_String := To_Unbounded_String (Pattern);
1276
1277    begin
1278       Pattern_Action_Table.Increment_Last (Filters);
1279
1280       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1281         (Pattern => new Patterns.String_Pattern'(U_Pattern, Field),
1282          Action  => new Actions.Simple_Action'(Proc => Action));
1283    end Register;
1284
1285    procedure Register
1286      (Field   : Count;
1287       Pattern : String;
1288       Action  : Action_Callback)
1289    is
1290    begin
1291       Register (Field, Pattern, Action, Cur_Session);
1292    end Register;
1293
1294    procedure Register
1295      (Field   : Count;
1296       Pattern : GNAT.Regpat.Pattern_Matcher;
1297       Action  : Action_Callback;
1298       Session : Session_Type)
1299    is
1300       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1301
1302       A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1303                     new Regpat.Pattern_Matcher'(Pattern);
1304    begin
1305       Pattern_Action_Table.Increment_Last (Filters);
1306
1307       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1308         (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1309          Action  => new Actions.Simple_Action'(Proc => Action));
1310    end Register;
1311
1312    procedure Register
1313      (Field   : Count;
1314       Pattern : GNAT.Regpat.Pattern_Matcher;
1315       Action  : Action_Callback)
1316    is
1317    begin
1318       Register (Field, Pattern, Action, Cur_Session);
1319    end Register;
1320
1321    procedure Register
1322      (Field   : Count;
1323       Pattern : GNAT.Regpat.Pattern_Matcher;
1324       Action  : Match_Action_Callback;
1325       Session : Session_Type)
1326    is
1327       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1328
1329       A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1330                     new Regpat.Pattern_Matcher'(Pattern);
1331    begin
1332       Pattern_Action_Table.Increment_Last (Filters);
1333
1334       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1335         (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1336          Action  => new Actions.Match_Action'(Proc => Action));
1337    end Register;
1338
1339    procedure Register
1340      (Field   : Count;
1341       Pattern : GNAT.Regpat.Pattern_Matcher;
1342       Action  : Match_Action_Callback)
1343    is
1344    begin
1345       Register (Field, Pattern, Action, Cur_Session);
1346    end Register;
1347
1348    procedure Register
1349      (Pattern : Pattern_Callback;
1350       Action  : Action_Callback;
1351       Session : Session_Type)
1352    is
1353       Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1354
1355    begin
1356       Pattern_Action_Table.Increment_Last (Filters);
1357
1358       Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1359         (Pattern => new Patterns.Callback_Pattern'(Pattern => Pattern),
1360          Action  => new Actions.Simple_Action'(Proc => Action));
1361    end Register;
1362
1363    procedure Register
1364      (Pattern : Pattern_Callback;
1365       Action  : Action_Callback)
1366    is
1367    begin
1368       Register (Pattern, Action, Cur_Session);
1369    end Register;
1370
1371    procedure Register
1372      (Action  : Action_Callback;
1373       Session : Session_Type)
1374    is
1375    begin
1376       Register (Always_True'Access, Action, Session);
1377    end Register;
1378
1379    procedure Register
1380      (Action  : Action_Callback)
1381    is
1382    begin
1383       Register (Action, Cur_Session);
1384    end Register;
1385
1386    -----------------
1387    -- Set_Current --
1388    -----------------
1389
1390    procedure Set_Current (Session : Session_Type) is
1391    begin
1392       Cur_Session.Data := Session.Data;
1393    end Set_Current;
1394
1395    --------------------------
1396    -- Set_Field_Separators --
1397    --------------------------
1398
1399    procedure Set_Field_Separators
1400      (Separators : String       := Default_Separators;
1401       Session    : Session_Type)
1402    is
1403    begin
1404       Free (Session.Data.Separators);
1405
1406       Session.Data.Separators :=
1407         new Split.Separator'(Separators'Length, Separators);
1408
1409       --  If there is a current line read, split it according to the new
1410       --  separators.
1411
1412       if Session.Data.Current_Line /= Null_Unbounded_String then
1413          Split_Line (Session);
1414       end if;
1415    end Set_Field_Separators;
1416
1417    procedure Set_Field_Separators
1418      (Separators : String       := Default_Separators)
1419    is
1420    begin
1421       Set_Field_Separators (Separators, Cur_Session);
1422    end Set_Field_Separators;
1423
1424    ----------------------
1425    -- Set_Field_Widths --
1426    ----------------------
1427
1428    procedure Set_Field_Widths
1429      (Field_Widths : Widths_Set;
1430       Session      : Session_Type)
1431    is
1432    begin
1433       Free (Session.Data.Separators);
1434
1435       Session.Data.Separators :=
1436         new Split.Column'(Field_Widths'Length, Field_Widths);
1437
1438       --  If there is a current line read, split it according to
1439       --  the new separators.
1440
1441       if Session.Data.Current_Line /= Null_Unbounded_String then
1442          Split_Line (Session);
1443       end if;
1444    end Set_Field_Widths;
1445
1446    procedure Set_Field_Widths
1447      (Field_Widths : Widths_Set)
1448    is
1449    begin
1450       Set_Field_Widths (Field_Widths, Cur_Session);
1451    end Set_Field_Widths;
1452
1453    ----------------
1454    -- Split_Line --
1455    ----------------
1456
1457    procedure Split_Line (Session : Session_Type) is
1458       Fields : Field_Table.Instance renames Session.Data.Fields;
1459    begin
1460       Field_Table.Init (Fields);
1461       Split.Current_Line (Session.Data.Separators.all, Session);
1462    end Split_Line;
1463
1464    -------------
1465    -- Get_Def --
1466    -------------
1467
1468    function Get_Def return Session_Data_Access is
1469    begin
1470       return Def_Session.Data;
1471    end Get_Def;
1472
1473    -------------
1474    -- Set_Cur --
1475    -------------
1476
1477    procedure Set_Cur is
1478    begin
1479       Cur_Session.Data := Def_Session.Data;
1480    end Set_Cur;
1481
1482 begin
1483    --  We have declared two sessions but both should share the same data.
1484    --  The current session must point to the default session as its initial
1485    --  value. So first we release the session data then we set current
1486    --  session data to point to default session data.
1487
1488    Free (Cur_Session.Data);
1489    Cur_Session.Data := Def_Session.Data;
1490 end GNAT.AWK;