------------------------------------------------------------------------------ -- Templates Parser -- -- -- -- Copyright (C) 2004-2012, AdaCore -- -- -- -- This library 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 3, or (at your option) any -- -- later version. This library is distributed in the hope that it will be -- -- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of -- -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- -- As a special exception under Section 7 of GPL version 3, you are -- -- granted additional permissions described in the GCC Runtime Library -- -- Exception, version 3.1, as published by the Free Software Foundation. -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- -- 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. -- ------------------------------------------------------------------------------ with Ada.Text_IO; separate (Templates_Parser) package body Definitions is ----------- -- Clone -- ----------- function Clone (D : Tree) return Tree is begin return new Def'(D.all); end Clone; ----------- -- Parse -- ----------- function Parse (Line : String) return Tree is -- Format to parse: = ['|'] K, L : Natural; Name : Unbounded_String; Value : Unbounded_String; Ref : Natural; begin K := Strings.Fixed.Index (Line, "="); if K = 0 then raise Internal_Error with "SET wrong definition, missing name or value"; end if; Name := To_Unbounded_String (Fixed.Trim (Line (Line'First .. K - 1), Both)); -- Check if we have a single value declare Data : constant String := Fixed.Trim (Line (K + 1 .. Line'Last), Both); begin L := Fixed.Index (Data, "|"); if L = 0 then -- Single data, this can be a ref or a value if Data (Data'First) = '$' then Ref := Positive'Value (Data (Data'First + 1 .. Data'Last)); return new Def' (Name, (Definitions.Ref, Null_Unbounded_String, Ref)); else Value := To_Unbounded_String (No_Quote (Fixed.Trim (Data (L + 1 .. Data'Last), Left))); return new Def'(Name, (Definitions.Const, Value, 1)); end if; else -- Multiple data, the first one must be a ref, the second a value if Data (Data'First) /= '$' then raise Internal_Error with "SET, reference expected found a value"; end if; Ref := Positive'Value (Data (Data'First + 1 .. L - 1)); Value := To_Unbounded_String (No_Quote (Fixed.Trim (Data (L + 1 .. Data'Last), Left))); return new Def' (Name, (Definitions.Ref_Default, Value, Ref)); end if; end; end Parse; ---------------- -- Print_Tree -- ---------------- procedure Print_Tree (D : Tree) is N : constant Node := D.N; begin Text_IO.Put (To_String (D.Name) & " = "); case D.N.Kind is when Const => Text_IO.Put (Quote (To_String (N.Value))); when Ref => Text_IO.Put ('$' & Utils.Image (N.Ref)); when Ref_Default => Text_IO.Put ('$' & Utils.Image (N.Ref) & " | " & Quote (To_String (N.Value))); end case; end Print_Tree; ------------- -- Release -- ------------- procedure Release (D : in out Tree) is procedure Unchecked_Free is new Unchecked_Deallocation (Def, Tree); begin Unchecked_Free (D); end Release; end Definitions;