File : asis-text-set_get.adb
------------------------------------------------------------------------------
-- --
-- ASIS-for-GNAT IMPLEMENTATION COMPONENTS --
-- --
-- A S I S . T E X T . S E T _ G E T --
-- --
-- B o d y --
-- --
-- Copyright (c) 1995-1999, Free Software Foundation, Inc. --
-- --
-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 2, or (at your option) any later --
-- version. ASIS-for-GNAT is distributed in the hope that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details. You should have received a copy of the --
-- GNU General Public License distributed with ASIS-for-GNAT; see file --
-- COPYING. If not, write to the Free Software Foundation, 59 Temple Place --
-- - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- ASIS-for-GNAT was originally developed by the ASIS-for-GNAT team at the --
-- Software Engineering Laboratory of the Swiss Federal Institute of --
-- Technology (LGL-EPFL) in Lausanne, Switzerland, in cooperation with the --
-- Scientific Research Computer Center of Moscow State University (SRCC --
-- MSU), Russia, with funding partially provided by grants from the Swiss --
-- National Science Foundation and the Swiss Academy of Engineering --
-- Sciences. ASIS-for-GNAT is now maintained by Ada Core Technologies Inc --
-- (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Asis.Exceptions; use Asis.Exceptions;
with Asis.Set_Get; use Asis.Set_Get;
with A4G.Contt; use A4G.Contt;
with A4G.Contt.TT; use A4G.Contt.TT;
with A4G.Vcheck; use A4G.Vcheck;
with Sinput; use Sinput;
package body Asis.Text.Set_Get is
---------
-- Get --
---------
function Line_Length (L : Line) return Character_Position is
begin
return L.Length;
end Line_Length;
function Line_Location (L : Line) return Source_Ptr is
begin
if not (L.Enclosing_Context = Get_Current_Cont and then
L.Enclosing_Tree = Get_Current_Tree)
then
Reset_Tree (L.Enclosing_Context, L.Enclosing_Tree);
end if;
return L.Sloc;
exception
when ASIS_Failed =>
Add_Call_Information
(Outer_Call => "Asis.Text.Set_Get.Line_Location");
raise;
end Line_Location;
function Valid (L : Line) return Boolean is
begin
return Is_Opened (L.Enclosing_Context) and then
Later (Opened_At (L.Enclosing_Context), L.Obtained);
end Valid;
------------------------
-- Debug_Image (Span) --
------------------------
function Debug_Image (The_Span : in Span) return String is
LT : String renames ASIS_Line_Terminator;
begin
return LT
& "Debug image for Asis.Text.Span:"
& LT
& "First Line : "
& Int'Image (Int (The_Span.First_Line))
& LT
& "First Column : "
& Int'Image (Int (The_Span.First_Column))
& LT
& "Last Line : "
& Int'Image (Int (The_Span.Last_Line))
& LT
& "Last Column : "
& Int'Image (Int (The_Span.Last_Column))
& LT
& LT;
end Debug_Image;
---------
-- Set --
---------
procedure Set_Line_Length (L : in out Line; N : Character_Position) is
begin
L.Length := N;
end Set_Line_Length;
procedure Set_Line_Location (L : in out Line; S : Source_Ptr) is
begin
L.Rel_Sloc := L.Rel_Sloc + (S - L.Sloc);
L.Sloc := S;
end Set_Line_Location;
---------------
-- Set_Lines --
---------------
procedure Set_Lines (LList : in out Line_List; El : Element) is
First_Line : Line_Number := LList'First;
Last_Line : Line_Number := LList'Last;
El_Sloc : Source_Ptr := Location (El);
-- This call to Get_Location resets the tree for El, if needed;
-- and this makes all the routine "tree-swapping-safe"
Sloc_Move : Source_Ptr := Rel_Sloc (El) - El_Sloc;
-- Sloc_Move in fact is equal to - Sloc (Top (Enclosing_CU)),
-- so by adding Sloc_Move we can get relative Sloc for lines:
-- We define local variables for Element characteristics in order
-- not to compute this in the loop:
El_Encl_Unit : Unit_Id := Encl_Unit_Id (El);
El_Encl_Cont : Context_Id := Encl_Cont_Id (El);
El_Encl_Tree : Tree_Id := Encl_Tree (El);
El_Obtained : ASIS_OS_Time := Obtained (El);
SFI : Source_File_Index := Get_Source_File_Index (El_Sloc);
Src_First : Source_Ptr := Source_First (SFI);
Src : Source_Buffer_Ptr := Source_Text (SFI);
S : Source_Ptr;
begin
-- the only thing which requires special processing is
-- setting of the length of the last Line in LList if
-- this Line corresponds to the last line in the compilation
-- containing El.
-- We start from settings which do not require any
-- special processing. We take from Element all which can
-- be safely "transferred" into Lines. Note, that we know,
-- that El is valid, that is, the Context from which it had been
-- obtained was not closed after obtaining this Element. So we
-- simply copy the time when El was obtained in all the Lines
-- in Line list
for LN in First_Line .. Last_Line loop
LList (LN).Enclosing_Unit := El_Encl_Unit;
LList (LN).Enclosing_Context := El_Encl_Cont;
LList (LN).Enclosing_Tree := El_Encl_Tree;
LList (LN).Obtained := El_Obtained;
LList (LN).Sloc := Line_Start (Logical_Line_Number (LN), SFI);
LList (LN).Rel_Sloc := LList (LN).Sloc + Sloc_Move;
end loop;
-- and now - counting Line lengths:
for LN in First_Line .. Last_Line - 1 loop
S := LList (LN + 1).Sloc - 1;
while S > Src_First and then
(Src (S) = ASCII.CR or else Src (S) = ASCII.LF) and then
S >= LList (LN).Sloc
loop
S := S - 1;
end loop;
if S = Src_First then
-- Empty lines in the beginning of a source file
LList (LN).Length := 0;
else
LList (LN).Length :=
Character_Position (S - LList (LN).Sloc + 1);
end if;
end loop;
-- and, finally, the special case of the last Line in the list:
S := LList (Last_Line).Sloc;
while S < Source_Last (SFI) and then
Src (S) /= ASCII.CR and then
Src (S) /= Ascii.LF
loop
S := S + 1;
end loop;
LList (Last_Line).Length :=
Character_Position (S - LList (Last_Line).Sloc);
end Set_Lines;
end Asis.Text.Set_Get