1-- Copyright (c) 1990 Regents of the University of California. 2-- All rights reserved. 3-- 4-- The primary authors of ayacc were David Taback and Deepak Tolani. 5-- Enhancements were made by Ronald J. Schmalz. 6-- 7-- Send requests for ayacc information to ayacc-info@ics.uci.edu 8-- Send bug reports for ayacc to ayacc-bugs@ics.uci.edu 9-- 10-- Redistribution and use in source and binary forms are permitted 11-- provided that the above copyright notice and this paragraph are 12-- duplicated in all such forms and that any documentation, 13-- advertising materials, and other materials related to such 14-- distribution and use acknowledge that the software was developed 15-- by the University of California, Irvine. The name of the 16-- University may not be used to endorse or promote products derived 17-- from this software without specific prior written permission. 18-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR 19-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED 20-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. 21 22-- Module : command_line_interface.ada 23-- Component of : common_library 24-- Version : 1.2 25-- Date : 11/21/86 16:02:24 26-- SCCS File : disk21~/rschm/hasee/sccs/common_library/sccs/sxcommand_line_interface.ada 27 28with Text_IO; use Text_IO; 29with String_scanner; 30---------------------------------------------------------------- 31 32Package body command_line_interface is 33 34 SCCS_ID : constant String := "@(#) command_line_interface.addisk21~/rschm/hasee/sccs/common_library, Version 1.2"; 35 36 37--| Provides primitives for getting at the command line arguments. 38 39--| Overview 40 41Package sp renames String_pkg; 42Package ss renames String_scanner; 43 44type Name_value is --| Name/Value pair 45 record 46 Name: sp.String_type; --| Name of value 47 Value: sp.String_type; --| Value associated with name 48 Was_retrieved: boolean:=FALSE; --| Flag indicating whether name-value 49 end record; -- association has been retrieved by tool 50 51type Token_type is (Ada_ID,Word,Bound_to,None); 52 53Package Token_type_IO is new Enumeration_IO(Token_type); 54use Token_type_IO; 55 56 57 Maximum_Command_Length : constant := 1024; 58 59 subtype Command_Line_Type is String (1 .. Maximum_Command_Length); 60 61 Arg_string : Command_Line_Type; --| String obtained from operating system 62 63 N_arg_count: Argument_count; --| Count of named args 64 P_arg_count: Argument_count; --| Count of positional args 65 66 Rejected: boolean := FALSE; 67 68 Tool_Name : String_Type; 69 70Named_args: array(argument_index) 71 of Name_value; 72 73Positional_args: array(argument_index) 74 of sp.String_type; 75 76 77 procedure Read_Command_Line 78 (Command_Args : out Command_Line_Type) is separate; 79 --** 80 --| Description: Read_Command_Line is the machine dependent interface to 81 --| the Operating System Command Line. 82 --** 83 84---------------------------------------------------------------- 85 86-- Local functions: 87 88 procedure Set_Tool_Name (To : in String) is 89 begin 90 Tool_Name := Create (To & ": "); 91 end Set_Tool_Name; 92 93 94 procedure CLI_Error (Error_Message : in String) is 95 begin 96 New_Line; 97 Put_Line (Value (Tool_Name) & Error_Message); 98 end CLI_Error; 99 100 101procedure Get_token( 102 Scan_string : in out ss.Scanner; 103 Argument : in out sp.String_type; 104 Kind: in out Token_type 105 ) is 106 107 Last_arg: sp.String_type; 108 Last_kind: Token_type; 109 Found: boolean; 110 Delimeter: sp.String_type; 111 Delim_string: ss.Scanner; 112 More_commas: boolean := FALSE; 113 Tail: sp.String_type; 114 115begin 116 117 if Rejected then 118 Argument := Last_arg; 119 Kind := Last_kind; 120 Rejected := FALSE; 121 else 122 if ss.Is_sequence(" ,",Scan_string) then 123 ss.Scan_sequence(" ,",Scan_string,Found,Delimeter); 124 Delim_string := ss.Make_scanner(Delimeter); 125 loop 126 ss.Skip_space(Delim_string); 127 exit when not ss.More(Delim_string); 128 ss.Forward(Delim_string); 129 if More_commas then 130 CLI_Error ("Missing Positional Argument."); 131 raise missing_positional_arg; 132 end if; 133 More_commas := TRUE; 134 end loop; 135 end if; 136 if ss.Is_Ada_Id(Scan_string) then 137 ss.Scan_Ada_Id(Scan_string,Found,Argument); 138 if ss.Is_Literal("=>",Scan_string) or 139 ss.Is_Literal("""",Scan_string) or 140 ss.Is_sequence(" ,",Scan_string) or 141 not ss.More(Scan_string) then 142 Kind := Ada_ID; 143 else 144 if ss.Is_not_sequence(" ,",Scan_string) then 145 ss.Scan_not_sequence(" ,",Scan_string,Found,Tail); 146 Argument := sp."&"(Argument,Tail); 147 Kind := Word; 148 else 149 ss.Scan_word(Scan_string,Found,Tail); 150 Argument := sp."&"(Argument,Tail); 151 Kind := Word; 152 end if; 153 end if; 154 elsif ss.Is_Literal("=>",Scan_string) then 155 ss.Scan_Literal("=>",Scan_string,Found); 156 Argument := sp.Create("=>"); 157 Kind := Bound_to; 158 elsif ss.Is_quoted(Scan_string) then 159 ss.Scan_quoted(Scan_string,Found,Argument); 160 Kind := Word; 161 elsif ss.Is_enclosed('(',')',Scan_string) then 162 ss.Scan_enclosed('(',')',Scan_string,Found,Argument); 163 Kind := Word; 164 elsif ss.Is_not_sequence(" ,",Scan_string) then 165 ss.Scan_not_sequence(" ,",Scan_string,Found,Argument); 166 Kind := Word; 167 elsif ss.Is_word(Scan_string) then 168 ss.Scan_word(Scan_string,Found,Argument); 169 Kind := Word; 170 else 171 Argument := sp.Create(""); 172 Kind := None; 173 end if; 174 Last_kind := Kind; 175 Last_arg := Argument; 176 end if; 177end Get_token; 178 179----------------------------------------------------------------------- 180 181procedure Save_named( 182 Name : in sp.String_type; 183 Value : in sp.String_type 184 ) is 185 186begin 187 N_arg_count := N_arg_count + 1; 188 Named_args(N_arg_count).Name := Name; 189 Named_args(N_arg_count).Value := Value; 190end Save_named; 191 192procedure Save_positional( 193 Value : in sp.String_type 194 ) is 195 196begin 197 if N_arg_count > 0 then 198 CLI_Error ("Invalid Parameter Order, " & 199 "Positional arguments must precede Named."); 200 raise invalid_parameter_order; 201 end if; 202 P_arg_count := P_arg_count + 1; 203 Positional_args(P_arg_count) := Value; 204end Save_positional; 205 206procedure Reject_token is 207 208begin 209 Rejected := TRUE; 210end Reject_token; 211 212---------------------------------------------------------------- 213 214procedure Initialize (Tool_Name : in String) is 215 216begin 217 218 Set_Tool_Name (To => Tool_Name); 219 220 declare 221 222 type State_type is (Have_nothing,Have_Ada_ID,Have_bound_to); 223 224 Start_Index : integer; --| 225 End_Index: integer; --| Indices of characters in argument string 226 227 Scan_string: ss.Scanner; --| Scanned argument string 228 Argument: sp.String_Type; --| Argument scanned from argument string 229 Kind: Token_type; --| Kind of argument- WORD, =>, Ada_ID 230 Old_arg: sp.String_Type; --| Previously scanned argument 231 Found: boolean; 232 233 State: State_type := Have_nothing; 234 --| State of argument in decision tree 235 236 begin 237 238 Start_Index := Arg_string'first; 239 End_Index := Arg_string'first; 240 241 N_arg_count := 0; 242 P_arg_count := 0; 243 244 -- Get the command line from the operating system 245 Read_Command_Line (Arg_String); 246 247 -- Remove trailing blanks and final semicolon 248 for i in reverse Arg_string'range loop 249 if Arg_string(i) /= ' ' then 250 if Arg_string(i) = ';' then 251 End_Index := i - 1; 252 else 253 End_Index := i; 254 end if; 255 exit; 256 end if; 257 end loop; 258 259 Skip_Leading_White_Space : 260 for i in Arg_String'First .. End_Index 261 loop 262 if Arg_String (i) /= ' ' and then 263 Arg_String (i) /= Ascii.HT then 264 265 Start_Index := i; 266 exit Skip_Leading_White_Space; 267 268 end if; 269 end loop Skip_Leading_White_Space; 270 271 272 Verify_Balanced_Parentheses : 273 declare 274 Left_Parens : Natural := 0; 275 Right_Parens : Natural := 0; 276 begin 277 278 for i in Start_Index .. End_Index 279 loop 280 281 if Arg_String (i) = '(' then 282 Left_Parens := Left_Parens + 1; 283 elsif Arg_String (i) = ')' then 284 Right_Parens := Right_Parens + 1; 285 end if; 286 287 end loop; 288 289 if Left_Parens /= Right_Parens then 290 CLI_Error ("Unbalanced Parentheses."); 291 raise Unbalanced_Parentheses; 292 end if; 293 294 end Verify_Balanced_Parentheses; 295 296 -- Convert argument string to scanner and remove enclosing parantheses 297 298 Scan_string := ss.Make_scanner(sp.Create( 299 Arg_string(Start_Index .. End_Index))); 300 301 if ss.Is_enclosed('(',')',Scan_string) then 302 ss.Mark(Scan_string); 303 ss.Scan_enclosed('(',')',Scan_string,Found,Argument); 304 ss.Skip_Space(Scan_string); 305 if not ss.More(Scan_string) then 306 ss.Destroy_Scanner(Scan_string); 307 Scan_string := ss.Make_scanner(Argument); 308 else 309 ss.Restore(Scan_string); 310 end if; 311 end if; 312 313 -- Parse argument string and save arguments 314 loop 315 Get_token(Scan_string,Argument,Kind); 316 case State is 317 when Have_nothing => 318 case Kind is 319 when Ada_ID => 320 Old_arg := Argument; 321 State := Have_Ada_ID; 322 when Word => 323 Save_positional(Argument); 324 State := Have_nothing; 325 when Bound_to => 326 State := Have_nothing; 327 CLI_Error ("Invalid Named Association."); 328 raise invalid_named_association; 329 when None => 330 null; 331 end case; 332 when Have_Ada_ID => 333 case Kind is 334 when Ada_ID => 335 Save_positional(Old_arg); 336 Old_arg := Argument; 337 State := Have_Ada_ID; 338 when Word => 339 Save_positional(Old_arg); 340 Save_positional(Argument); 341 State := Have_nothing; 342 when Bound_to => 343 State := Have_bound_to; 344 when None => 345 Save_positional(Old_arg); 346 end case; 347 when Have_bound_to => 348 case Kind is 349 when Ada_ID | Word => 350 Save_named(Old_arg,Argument); 351 State := Have_nothing; 352 when Bound_to => 353 State := Have_bound_to; 354 CLI_Error ("Invalid Named Association."); 355 raise invalid_named_association; 356 when None => 357 CLI_Error ("Invalid Named Association."); 358 raise invalid_named_association; 359 360 end case; 361 end case; 362 exit when Kind = None; 363 end loop; 364 end; 365end Initialize; 366 367-------------------------------------------------------------------------- 368 369function Named_arg_count --| Return number of named arguments 370 return Argument_count is 371 372begin 373 return N_arg_count; 374end; 375 376---------------------------------------------------------------- 377 378function Positional_arg_count --| Return number of positional arguments 379 return Argument_count is 380 381begin 382 return P_arg_count; 383end; 384 385---------------------------------------------------------------- 386 387function Positional_arg_value( --| Return an argument value 388 N: Argument_index --| Position of desired argument 389 ) return string is --| Raises: no_arg 390 391--| Effects: Return the Nth argument. If there is no argument at 392--| position N, no_arg is raised. 393 394--| N/A: modifies, errors 395 396begin 397 if N > P_arg_count then 398 CLI_Error ("Internal Error, Argument" & Argument_Index'Image (N) & 399 " does not exist. Please submit an LCR."); 400 raise no_arg; 401 else 402 return sp.Value(Positional_args(N)); 403 end if; 404end; 405 406---------------------------------------------------------------- 407 408function Positional_arg_value( --| Return an argument value 409 N: Argument_index --| Position of desired argument 410 ) return sp.String_type is --| Raises: no_arg 411 412--| Effects: Return the Nth argument. If there is no argument at 413--| position N, no_arg is raised. 414 415--| N/A: modifies, errors 416 417begin 418 if N > P_arg_count then 419 CLI_Error ("Internal Error, Argument" & Argument_Index'Image (N) & 420 " does not exist. Please submit an LCR."); 421 raise no_arg; 422 else 423 return Positional_args(N); 424 end if; 425end; 426 427---------------------------------------------------------------- 428 429function Named_arg_value(--| Return a named argument value 430 Name: string; 431 Default: string 432 ) return string is 433 434--| Effects: Return the value associated with Name on the command 435--| line. If there was none, return Default. 436 437begin 438 for i in 1..N_arg_count 439 loop 440 if sp.Equal(sp.Upper(Named_args(i).Name),sp.Upper(sp.Create(Name))) then 441 Named_args(i).Was_retrieved := TRUE; 442 return sp.Value(Named_args(i).Value); 443 end if; 444 end loop; 445 return Default; 446end; 447 448function Named_arg_value(--| Return a named argument value 449 Name: string; 450 Default: string 451 ) return String_Type is 452 453--| Effects: Return the value associated with Name on the command 454--| line. If there was none, return Default. 455 456begin 457 return Create (Named_Arg_Value (Name, Default)); 458end Named_Arg_Value; 459 460---------------------------------------------------------------- 461 462function Named_arg_value(--| Return a named argument value 463 Name: string; 464 Default: sp.String_type 465 ) return sp.String_type is 466 467--| Effects: Return the value associated with Name on the command 468--| line. If there was none, return Default. 469 470begin 471 for i in 1..N_arg_count 472 loop 473 if sp.Equal(sp.Upper(Named_args(i).Name),sp.Upper(sp.Create(Name))) then 474 Named_args(i).Was_retrieved := TRUE; 475 return Named_args(i).Value; 476 end if; 477 end loop; 478 return Default; 479end; 480 481---------------------------------------------------------------- 482 483function Arguments --| Return the entire argument string 484 return string is 485 486--| Effects: Return the entire command line, except for the name 487--| of the command itself. 488 489begin 490 return Arg_string; 491end; 492 493---------------------------------------------------------------- 494 495 function Parse_Aggregate (Aggregate_Text : in String) 496 return String_Lists.List is 497 type State_type is (Have_Nothing, 498 Have_Ada_ID, 499 Have_Bound_To); 500 501 First : Natural := Aggregate_Text'First; 502 Last : Natural := Aggregate_Text'Last; 503 504 Component_List : String_Lists.List := String_Lists.Create; 505 506 Argument : sp.String_Type; --| Argument scanned from argument string 507 Kind : Token_type; --| Kind of argument- WORD, =>, Ada_ID 508 Scan_string : ss.Scanner; --| Scanned argument string 509 510 Aggregate_Contents : String_Type; 511 Enclosed_Aggregate_Found : Boolean := False; 512 513 begin 514 515 if Aggregate_Text'Length > 0 then 516 517 Scan_String := SS.Make_Scanner (Create (Aggregate_Text (First .. Last))); 518 519 SS.Scan_Enclosed ( '(', ')', 520 Scan_String, 521 Found => Enclosed_Aggregate_Found, 522 Result => Aggregate_Contents, 523 Skip => True); 524 525 if Enclosed_Aggregate_Found then 526 SS.Destroy_Scanner (Scan_String); 527 Scan_String := SS.Make_Scanner (Aggregate_Contents); 528 end if; 529 530 Parse_Aggregate_String : 531 loop 532 533 Get_token(Scan_string, Argument, Kind); 534 535 exit Parse_Aggregate_String when Kind = None; 536 537 String_Lists.Attach (Component_List, Argument); 538 539 end loop Parse_Aggregate_String; 540 541 end if; 542 543 return Component_List; 544 545 end Parse_Aggregate; 546 547 function Parse_Aggregate 548 (Aggregate_Text : in String_Type) 549 return String_Lists.List is 550 begin 551 return Parse_Aggregate (Value (Aggregate_Text)); 552 end Parse_Aggregate; 553 554---------------------------------------------------------------- 555 556 function Convert (Parameter_Text : in String) return Parameter_Type is 557 begin 558 return Parameter_Type'Value (Parameter_Text); 559 exception 560 when Constraint_Error => 561 CLI_Error ("Invalid Parameter, """ & 562 Value (Mixed (Parameter_Text)) & 563 """ is not a legal value for type " & 564 Value (Mixed (Type_Name)) & '.'); 565 raise Invalid_Parameter; 566 end Convert; 567 568---------------------------------------------------------------- 569 570procedure Finalize is --| Raises: unreferenced_named_arg 571 572begin 573 for i in 1..Named_arg_count loop 574 if Named_args(i).Was_retrieved = FALSE then 575 CLI_Error ("Invalid Parameter Association, " & 576 Value (Mixed (Named_Args (i).Name)) & 577 " is not a valid Formal Parameter."); 578 raise unreferenced_named_arg; 579 end if; 580 end loop; 581end Finalize; 582 583------------------------------------------------------------------- 584 585end command_line_interface; 586