Index: src/natools-s_expressions-printers-pretty-config.adb ================================================================== --- src/natools-s_expressions-printers-pretty-config.adb +++ src/natools-s_expressions-printers-pretty-config.adb @@ -296,18 +296,18 @@ procedure Update (Param : in out Parameters; Expression : in out Lockable.Descriptor'Class) is - Interpreter : Interpreters.Interpreter := Config_Interpreter; + Interpreter : constant Interpreters.Interpreter := Config_Interpreter; begin Update (Interpreter, Param, Expression); end Update; procedure Update - (Interpreter : in out Interpreters.Interpreter; + (Interpreter : in Interpreters.Interpreter; Param : in out Parameters; Expression : in out Lockable.Descriptor'Class) is begin Interpreter.Execute (Expression, Param, True); end Update; @@ -317,25 +317,35 @@ ------------------------------ -- Interpreter Constructors -- ------------------------------ function Config_Interpreter return Interpreters.Interpreter is - Result : Interpreters.Interpreter; + Quoted_SI, Newline_SI, Space_SI, Result : Interpreters.Interpreter; begin + -- Setup subinterpreters + Add_Separator_Commands (Newline_SI, True, True); + Add_Newline_Encoding_Commands (Newline_SI); + Add_Quoted_Commands (Quoted_SI); + Add_Quoted_Escape_Commands (Quoted_SI); + Add_Separator_Commands (Space_SI, True, False); + + -- Build final interpreter Result.Add_Command (To_Atom ("escape"), - Set_Quoted_String'(others => <>)); + Set_Quoted_String'(Subinterpreter => Quoted_SI)); Result.Add_Command (To_Atom ("indent"), Set_Indentation'(null record)); Result.Add_Command (To_Atom ("indentation"), Set_Indentation'(null record)); Result.Add_Command (To_Atom ("no-indent"), Set_Indentation'(null record)); Result.Add_Command (To_Atom ("no-indentation"), Set_Indentation'(null record)); - Result.Add_Command (To_Atom ("newline"), Set_Newline'(others => <>)); + Result.Add_Command (To_Atom ("newline"), + Set_Newline'(Subinterpreter => Newline_SI)); Result.Add_Command (To_Atom ("quoted"), - Set_Quoted_String'(others => <>)); - Result.Add_Command (To_Atom ("space"), Set_Space_At'(others => <>)); + Set_Quoted_String'(Subinterpreter => Quoted_SI)); + Result.Add_Command (To_Atom ("space"), + Set_Space_At'(Subinterpreter => Space_SI)); Result.Add_Command (To_Atom ("tab-stop"), Set_Tab_Stop'(null record)); Result.Add_Command (To_Atom ("width"), Set_Width'(null record)); Result.Add_Command (To_Atom ("no-width"), Set_Width'(null record)); Result.Add_Command (To_Atom ("extended-token"), @@ -522,11 +532,11 @@ ------------------------- -- Invididual Commands -- ------------------------- procedure Execute - (Self : in out Set_Width; + (Self : in Set_Width; State : in out Parameters; Context : in Boolean; Name : in Atom) is pragma Unreferenced (Self, Context, Name); @@ -534,11 +544,11 @@ State.Width := 0; end Execute; procedure Execute - (Self : in out Set_Width; + (Self : in Set_Width; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class) is pragma Unreferenced (Self, Context); @@ -548,11 +558,11 @@ Read_Screen_Offset (Cmd, State.Width, Has_Value); end Execute; procedure Execute - (Self : in out Set_Tab_Stop; + (Self : in Set_Tab_Stop; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class) is pragma Unreferenced (Self, Context); @@ -566,11 +576,11 @@ end if; end Execute; procedure Execute - (Self : in out Set_Indentation; + (Self : in Set_Indentation; State : in out Parameters; Context : in Boolean; Name : in Atom) is pragma Unreferenced (Self, Context, Name); @@ -578,11 +588,11 @@ State.Indentation := 0; end Execute; procedure Execute - (Self : in out Set_Indentation; + (Self : in Set_Indentation; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class) is pragma Unreferenced (Self, Context); @@ -610,40 +620,35 @@ end if; end Execute; procedure Execute - (Self : in out Set_Newline; + (Self : in Set_Newline; + State : in out Parameters; + Context : in Boolean; + Cmd : in out Lockable.Descriptor'Class) is + begin + pragma Assert (not Self.Subinterpreter.Is_Empty); + Cmd.Next; + Self.Subinterpreter.Execute (Cmd, State, Context); + end Execute; + + + procedure Execute + (Self : in Set_Space_At; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class) is begin - if Self.Subinterpreter.Is_Empty then - Add_Separator_Commands (Self.Subinterpreter, True, True); - Add_Newline_Encoding_Commands (Self.Subinterpreter); - end if; + pragma Assert (not Self.Subinterpreter.Is_Empty); Cmd.Next; Self.Subinterpreter.Execute (Cmd, State, Context); end Execute; procedure Execute - (Self : in out Set_Space_At; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class) is - begin - if Self.Subinterpreter.Is_Empty then - Add_Separator_Commands (Self.Subinterpreter, True, False); - end if; - Cmd.Next; - Self.Subinterpreter.Execute (Cmd, State, Context); - end Execute; - - - procedure Execute - (Self : in out Set_Char_Encoding; + (Self : in Set_Char_Encoding; State : in out Parameters; Context : in Boolean; Name : in Atom) is pragma Unreferenced (Context, Name); @@ -651,11 +656,11 @@ State.Char_Encoding := Self.Value; end Execute; procedure Execute - (Self : in out Set_Newline_Encoding; + (Self : in Set_Newline_Encoding; State : in out Parameters; Context : in Boolean; Name : in Atom) is pragma Unreferenced (Context, Name); @@ -663,11 +668,11 @@ State.Newline := Self.Value; end Execute; procedure Execute - (Self : in out Set_Separator; + (Self : in Set_Separator; State : in out Parameters; Context : in Boolean; Name : in Atom) is pragma Unreferenced (Context, Name); @@ -679,11 +684,11 @@ end if; end Execute; procedure Execute - (Self : in out Set_All_Separators; + (Self : in Set_All_Separators; State : in out Parameters; Context : in Boolean; Name : in Atom) is pragma Unreferenced (Context, Name); @@ -695,11 +700,11 @@ end if; end Execute; procedure Execute - (Self : in out Set_All_Separators; + (Self : in Set_All_Separators; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class) is Subinterpreter : Interpreters.Interpreter; @@ -708,11 +713,11 @@ Subinterpreter.Execute (Cmd, State, Context); end Execute; procedure Execute - (Self : in out Set_Hex_Casing; + (Self : in Set_Hex_Casing; State : in out Parameters; Context : in Boolean; Name : in Atom) is pragma Unreferenced (Context, Name); @@ -720,11 +725,11 @@ State.Hex_Casing := Self.Value; end Execute; procedure Execute - (Self : in out Set_Fallback; + (Self : in Set_Fallback; State : in out Parameters; Context : in Boolean; Name : in Atom) is pragma Unreferenced (Context); @@ -733,11 +738,11 @@ Update_Casing (State.Hex_Casing, Name); end Execute; procedure Execute - (Self : in out Set_Token; + (Self : in Set_Token; State : in out Parameters; Context : in Boolean; Name : in Atom) is pragma Unreferenced (Context, Name); @@ -745,11 +750,11 @@ State.Token := Self.Value; end Execute; procedure Execute - (Self : in out Set_Token; + (Self : in Set_Token; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class) is pragma Unreferenced (Self, Context); @@ -773,11 +778,11 @@ end; end Execute; procedure Execute - (Self : in out Set_Quoted_Escape; + (Self : in Set_Quoted_Escape; State : in out Parameters; Context : in Boolean; Name : in Atom) is pragma Unreferenced (Context); @@ -786,11 +791,11 @@ Update_Casing (State.Hex_Casing, Name); end Execute; procedure Execute - (Self : in out Set_Quoted; + (Self : in Set_Quoted; State : in out Parameters; Context : in Boolean; Name : in Atom) is pragma Unreferenced (Context, Name); @@ -798,20 +803,16 @@ State.Quoted := Self.Value; end Execute; procedure Execute - (Self : in out Set_Quoted_String; + (Self : in Set_Quoted_String; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class) is begin - if Self.Subinterpreter.Is_Empty then - Add_Quoted_Commands (Self.Subinterpreter); - Add_Quoted_Escape_Commands (Self.Subinterpreter); - end if; - + pragma Assert (not Self.Subinterpreter.Is_Empty); Cmd.Next; Self.Subinterpreter.Execute (Cmd, State, Context); end Execute; end Natools.S_Expressions.Printers.Pretty.Config; Index: src/natools-s_expressions-printers-pretty-config.ads ================================================================== --- src/natools-s_expressions-printers-pretty-config.ads +++ src/natools-s_expressions-printers-pretty-config.ads @@ -42,11 +42,11 @@ (Param : in out Parameters; Expression : in out Lockable.Descriptor'Class); -- Update parameters using a temporary interpreter procedure Update - (Interpreter : in out Interpreters.Interpreter; + (Interpreter : in Interpreters.Interpreter; Param : in out Parameters; Expression : in out Lockable.Descriptor'Class); -- Update parameters using Interpreter (wrapper around its Execute) procedure Print @@ -75,121 +75,121 @@ Newline : in Boolean); -- Inject commands into subinterpreter type Set_Width is new Interpreters.Command with null record; procedure Execute - (Self : in out Set_Width; + (Self : in Set_Width; State : in out Parameters; Context : in Boolean; Name : in Atom); procedure Execute - (Self : in out Set_Width; + (Self : in Set_Width; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class); type Set_Space_At is new Interpreters.Command with record Subinterpreter : Interpreters.Interpreter; end record; procedure Execute - (Self : in out Set_Space_At; + (Self : in Set_Space_At; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class); type Set_Tab_Stop is new Interpreters.Command with null record; procedure Execute - (Self : in out Set_Tab_Stop; + (Self : in Set_Tab_Stop; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class); type Set_Indentation is new Interpreters.Command with null record; procedure Execute - (Self : in out Set_Indentation; + (Self : in Set_Indentation; State : in out Parameters; Context : in Boolean; Name : in Atom); procedure Execute - (Self : in out Set_Indentation; + (Self : in Set_Indentation; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class); type Set_Quoted is new Interpreters.Command with record Value : Quoted_Option; end record; procedure Execute - (Self : in out Set_Quoted; + (Self : in Set_Quoted; State : in out Parameters; Context : in Boolean; Name : in Atom); type Set_Token is new Interpreters.Command with record Value : Token_Option; end record; procedure Execute - (Self : in out Set_Token; + (Self : in Set_Token; State : in out Parameters; Context : in Boolean; Name : in Atom); procedure Execute - (Self : in out Set_Token; + (Self : in Set_Token; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class); type Set_Hex_Casing is new Interpreters.Command with record Value : Encodings.Hex_Casing; end record; procedure Execute - (Self : in out Set_Hex_Casing; + (Self : in Set_Hex_Casing; State : in out Parameters; Context : in Boolean; Name : in Atom); type Set_Quoted_Escape is new Interpreters.Command with record Value : Quoted_Escape_Type; end record; procedure Execute - (Self : in out Set_Quoted_Escape; + (Self : in Set_Quoted_Escape; State : in out Parameters; Context : in Boolean; Name : in Atom); type Set_Char_Encoding is new Interpreters.Command with record Value : Character_Encoding; end record; procedure Execute - (Self : in out Set_Char_Encoding; + (Self : in Set_Char_Encoding; State : in out Parameters; Context : in Boolean; Name : in Atom); type Set_Fallback is new Interpreters.Command with record Value : Atom_Encoding; end record; procedure Execute - (Self : in out Set_Fallback; + (Self : in Set_Fallback; State : in out Parameters; Context : in Boolean; Name : in Atom); type Set_Newline is new Interpreters.Command with record Subinterpreter : Interpreters.Interpreter; end record; procedure Execute - (Self : in out Set_Newline; + (Self : in Set_Newline; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class); type Set_Newline_Encoding is new Interpreters.Command with record Value : Newline_Encoding; end record; procedure Execute - (Self : in out Set_Newline_Encoding; + (Self : in Set_Newline_Encoding; State : in out Parameters; Context : in Boolean; Name : in Atom); type Set_Separator is new Interpreters.Command with record @@ -197,35 +197,35 @@ After : Entity; Value : Boolean; Newline : Boolean; end record; procedure Execute - (Self : in out Set_Separator; + (Self : in Set_Separator; State : in out Parameters; Context : in Boolean; Name : in Atom); type Set_All_Separators is new Interpreters.Command with record Value : Boolean; Newline : Boolean; end record; procedure Execute - (Self : in out Set_All_Separators; + (Self : in Set_All_Separators; State : in out Parameters; Context : in Boolean; Name : in Atom); procedure Execute - (Self : in out Set_All_Separators; + (Self : in Set_All_Separators; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class); type Set_Quoted_String is new Interpreters.Command with record Subinterpreter : Interpreters.Interpreter; end record; procedure Execute - (Self : in out Set_Quoted_String; + (Self : in Set_Quoted_String; State : in out Parameters; Context : in Boolean; Cmd : in out Lockable.Descriptor'Class); end Natools.S_Expressions.Printers.Pretty.Config;