/tags/matreshka-0.0.6/tools/aflex/src/template_manager.adb

http://github.com/landgraf/matreshka · Ada · 749 lines · 658 code · 35 blank · 56 comment · 32 complexity · 8fece01a0dc24f19951efd442b2fc9e8 MD5 · raw file

  1. -- Copyright (c) 1990 Regents of the University of California.
  2. -- All rights reserved.
  3. --
  4. -- This software was developed by John Self of the Arcadia project
  5. -- at the University of California, Irvine.
  6. --
  7. -- Redistribution and use in source and binary forms are permitted
  8. -- provided that the above copyright notice and this paragraph are
  9. -- duplicated in all such forms and that any documentation,
  10. -- advertising materials, and other materials related to such
  11. -- distribution and use acknowledge that the software was developed
  12. -- by the University of California, Irvine. The name of the
  13. -- University may not be used to endorse or promote products derived
  14. -- from this software without specific prior written permission.
  15. -- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
  16. -- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
  17. -- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  18. -- TITLE template manager
  19. -- AUTHOR: John Self (UCI)
  20. -- DESCRIPTION supports output of internalized templates for the IO and DFA
  21. -- packages.
  22. -- NOTES This package is quite a memory hog, and is really only useful on
  23. -- virtual memory systems. It could use an external file to store the
  24. -- templates like the skeleton manager. This would save memory at the
  25. -- cost of a slight reduction in speed and the necessity of keeping
  26. -- copies of the template files in a known place.
  27. -- $Header: /dc/uc/self/arcadia/aflex/ada/src/RCS/template_managerB.a,v 1.21 1992/12/29 22:46:15 self Exp self $
  28. with Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO;
  29. with Ada.Wide_Wide_Text_IO;
  30. with MISC_DEFS, EXTERNAL_FILE_MANAGER, MISC;
  31. use MISC_DEFS;
  32. package body Template_Manager is
  33. use Ada.Strings.Wide_Wide_Unbounded;
  34. use Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO;
  35. use Ada.Wide_Wide_Text_IO;
  36. type File_Array is array (Positive range <>) of Unbounded_Wide_Wide_String;
  37. function "+" (Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
  38. renames To_Unbounded_Wide_Wide_String;
  39. DFA_Template : constant File_Array :=
  40. (
  41. -- DFA TEMPLATE START
  42. +"",
  43. +" YYText_Ptr : Integer; -- points to start of yytext in buffer",
  44. +"",
  45. +" -- yy_ch_buf has to be 2 characters longer than YY_BUF_SIZE because we",
  46. +" -- need to put in 2 end-of-buffer characters (this is explained where",
  47. +" -- it is done) at the end of yy_ch_buf",
  48. +" YY_READ_BUF_SIZE : constant Integer := 8192;",
  49. +" YY_BUF_SIZE : constant Integer := YY_READ_BUF_SIZE * 2;",
  50. +" -- Size of input buffer",
  51. +"",
  52. +" type Unbounded_Character_Array is",
  53. +" array (Integer range <>) of Wide_Wide_Character;",
  54. +"",
  55. +" type Ch_Buf_Type is record",
  56. +" Data : Unbounded_Character_Array (0 .. YY_BUF_SIZE + 1);",
  57. +" end record;",
  58. +"",
  59. +" function Previous",
  60. +" (Data : Ch_Buf_Type; Index : Integer) return Wide_Wide_Character;",
  61. +" procedure Next",
  62. +" (Data : Ch_Buf_Type;",
  63. +" Index : in out Integer;",
  64. +" Code : out Wide_Wide_Character);",
  65. +"",
  66. +" YY_Ch_Buf : Ch_Buf_Type;",
  67. +" YY_CP : Integer;",
  68. +" YY_BP : Integer;",
  69. +"",
  70. +" YY_C_Buf_P : Integer; -- Points to current character in buffer",
  71. +"",
  72. +" function YYText return Wide_Wide_String;",
  73. +" function YYLength return Integer;",
  74. +" procedure YY_DO_BEFORE_ACTION;",
  75. +"",
  76. +" -- These variables are needed between calls to YYLex.",
  77. +"",
  78. +" YY_Init : Boolean := True; -- do we need to initialize YYLex?",
  79. +" YY_Start : Integer := 0; -- current start state number",
  80. +" subtype YY_State_Type is Integer;",
  81. +" YY_Last_Accepting_State : YY_State_Type;",
  82. +" YY_Last_Accepting_Cpos : Integer;",
  83. +"",
  84. +"%%",
  85. +"",
  86. +" function YYText return Wide_Wide_String is",
  87. +" Aux : constant Wide_Wide_String (1 .. YY_CP - YY_BP)",
  88. +" := Wide_Wide_String (YY_Ch_Buf.Data (YY_BP .. YY_CP - 1));",
  89. +"",
  90. +" begin",
  91. +" return Aux;",
  92. +" end YYText;",
  93. +"",
  94. +" -- returns the length of the matched text",
  95. +" function YYLength return Integer is",
  96. +" begin",
  97. +" return YY_CP - YY_BP;",
  98. +" end YYLength;",
  99. +"",
  100. +" -- done after the current pattern has been matched and before the",
  101. +" -- corresponding action - sets up yytext",
  102. +"",
  103. +" procedure YY_DO_BEFORE_ACTION is",
  104. +" begin",
  105. +" YYText_Ptr := YY_BP;",
  106. +" YY_C_Buf_P := YY_CP;",
  107. +" end YY_DO_BEFORE_ACTION;",
  108. +"",
  109. +" function Previous",
  110. +" (Data : CH_Buf_Type; Index : Integer) return Wide_Wide_Character",
  111. +" is",
  112. +" Aux : constant Integer := Index - 1;",
  113. +"",
  114. +" begin",
  115. +" return Data.Data (Aux);",
  116. +" end Previous;",
  117. +"",
  118. +" procedure Next",
  119. +" (Data : CH_Buf_Type;",
  120. +" Index : in out Integer;",
  121. +" Code : out Wide_Wide_Character) is",
  122. +" begin",
  123. +" Code := Data.Data (Index);",
  124. +" Index := Index + 1;",
  125. +" end Next;"
  126. -- DFA TEMPLATE END
  127. );
  128. DFA_Current_Line : Integer := 1;
  129. IO_Template : constant File_Array :=
  130. (
  131. -- IO TEMPLATE START
  132. +"with Ada.Characters.Wide_Wide_Latin_1;",
  133. +"with Ada.Wide_Wide_Text_IO;",
  134. +"",
  135. +"%%",
  136. +"",
  137. +" User_Input_File : Ada.Wide_Wide_Text_IO.File_Type;",
  138. +" User_Output_File : Ada.Wide_Wide_Text_IO.File_Type;",
  139. +"",
  140. +" Null_In_Input : exception;",
  141. +" Aflex_Internal_Error : exception;",
  142. +" Unexpected_Last_Match : exception;",
  143. +" Pushback_Overflow : exception;",
  144. +" Aflex_Scanner_Jammed : exception;",
  145. +"",
  146. +" type EOB_Action_Type is",
  147. +" (EOB_ACT_RESTART_SCAN,",
  148. +" EOB_ACT_END_OF_FILE,",
  149. +" EOB_ACT_LAST_MATCH);",
  150. +"",
  151. +" YY_END_OF_BUFFER_CHAR : constant Wide_Wide_Character :=",
  152. +" Ada.Characters.Wide_Wide_Latin_1.NUL;",
  153. +" yy_n_chars : integer; -- number of characters read into yy_ch_buf",
  154. +"",
  155. +" -- true when we've seen an EOF for the current input file",
  156. +" yy_eof_has_been_seen : boolean;",
  157. +"",
  158. +"-- UMASS CODES :" ,
  159. +" -- In order to support YY_Get_Token_Line, we need",
  160. +" -- a variable to hold current line.",
  161. +" type String_Ptr is access Wide_Wide_String;",
  162. +"",
  163. +" Saved_Tok_Line1 : String_Ptr := Null;",
  164. +" Line_Number_Of_Saved_Tok_Line1 : Integer := 0;",
  165. +" Saved_Tok_Line2 : String_Ptr := Null;",
  166. +" Line_Number_Of_Saved_Tok_Line2 : Integer := 0;",
  167. +"",
  168. +" -- Aflex will try to get next buffer before it processs the",
  169. +" -- last token. Since now Aflex has been changed to accept",
  170. +" -- one line by one line, the last token in the buffer is",
  171. +" -- always end_of_line ( or end_of_buffer ). So before the",
  172. +" -- end_of_line is processed, next line will be retrieved",
  173. +" -- into the buffer. So we need to maintain two lines,",
  174. +" -- which line will be returned in Get_Token_Line is",
  175. +" -- determined according to the line number. It is the same",
  176. +" -- reason that we can not reinitialize tok_end_col to 0 in",
  177. +" -- Yy_Input, but we must do it in yylex after we process the",
  178. +" -- end_of_line.",
  179. +"",
  180. +" Tok_Begin_Line : Integer := 1;",
  181. +" Tok_End_Line : Integer := 1;",
  182. +" Tok_End_Col : Integer := 0;",
  183. +" Tok_Begin_Col : Integer := 0;",
  184. +" Token_At_End_Of_Line : Boolean := False;",
  185. +" -- Indicates whether or not last matched token is end_of_line.",
  186. +"-- END OF UMASS CODES.",
  187. +"",
  188. +" procedure YY_Input",
  189. +" (Buf : out Unbounded_Character_Array;",
  190. +" Result : out Integer;",
  191. +" Max_Size : Integer);",
  192. +" function YY_Get_Next_Buffer return EOB_Action_Type;",
  193. +" procedure YYUnput (c : Wide_Wide_Character; YY_BP: in out Integer);",
  194. +" procedure Unput (c : Wide_Wide_Character);",
  195. +" function Input return Wide_Wide_Character;",
  196. +" procedure Output (c : Wide_Wide_Character);",
  197. +" function YYWrap return Boolean;",
  198. +" procedure Open_Input (FName : String);",
  199. +" procedure Close_Input;",
  200. +" procedure Create_Output (FName : String := """");",
  201. +" procedure Close_Output;",
  202. +"",
  203. +"-- UMASS CODES :",
  204. +" procedure Yy_Get_Token_Line",
  205. +" (Yy_Line_String : out Wide_Wide_String;",
  206. +" Yy_Line_Length : out Natural);",
  207. +" -- Returnes the entire line in the input, on which the currently",
  208. +" -- matched token resides.",
  209. +"",
  210. +" function Yy_Line_Number return Natural;",
  211. +" -- Returns the line number of the currently matched token.",
  212. +" -- In case a token spans lines, then the line number of the first line",
  213. +" -- is returned.",
  214. +"",
  215. +" function Yy_Begin_Column return Natural;",
  216. +" function Yy_End_Column return Natural;",
  217. +" -- Returns the beginning and ending column positions of the",
  218. +" -- currently mathched token. If the token spans lines then the",
  219. +" -- begin column number is the column number on the first line",
  220. +" -- and the end columne number is the column number on the last line.",
  221. +"",
  222. +"-- END OF UMASS CODES.",
  223. +"",
  224. +"%%",
  225. +"",
  226. +" use Ada.Wide_Wide_Text_IO;",
  227. +"",
  228. +" -- Gets input and stuffs it into 'buf'. number of characters read, or",
  229. +" -- YY_NULL is returned in 'result'.",
  230. +"",
  231. +" procedure YY_Input",
  232. +" (Buf : out Unbounded_Character_Array;",
  233. +" Result : out Integer;",
  234. +" Max_Size : integer)",
  235. +" is",
  236. +" C : Wide_Wide_character;",
  237. +" I : Integer := 1;",
  238. +" Loc : Integer := Buf'First;",
  239. +"-- UMASS CODES :",
  240. +" -- Since buf is an out parameter which is not readable",
  241. +" -- and saved lines is a string pointer which space must",
  242. +" -- be allocated after we know the size, we maintain",
  243. +" -- an extra buffer to collect the input line and",
  244. +" -- save it into the saved line 2.",
  245. +" Temp_Line : Wide_Wide_String (1 .. YY_BUF_SIZE + 2);",
  246. +"-- END OF UMASS CODES.",
  247. +" begin",
  248. +"-- UMASS CODES :",
  249. +" buf := (others => Ada.Characters.Wide_Wide_Latin_1.NUL);",
  250. +" -- Move the saved lines forward.",
  251. +" Saved_Tok_Line1 := Saved_Tok_Line2;",
  252. +" Line_Number_Of_Saved_Tok_Line1 := Line_Number_Of_Saved_Tok_Line2;",
  253. +"",
  254. +"-- END OF UMASS CODES.",
  255. +" if Is_Open (User_Input_File) then",
  256. +" while I <= Max_Size loop",
  257. +" if End_Of_Line (User_Input_File) then",
  258. +" -- Ada ate our newline, put it back on the end.",
  259. +" Buf (Loc) := Ada.Characters.Wide_Wide_Latin_1.LF;",
  260. +" Skip_Line (User_Input_File, 1);",
  261. +"-- UMASS CODES :",
  262. +" -- We try to get one line by one line. So we return",
  263. +" -- here because we saw the end_of_line.",
  264. +" Result := I;",
  265. +" Temp_Line (I) := Ada.Characters.Wide_Wide_Latin_1.LF;",
  266. +" Saved_Tok_Line2 := new String (1 .. I);",
  267. +" Saved_Tok_Line2 (1 .. I) := Temp_Line (1 .. I);",
  268. +" Line_Number_Of_Saved_Tok_Line2 :=",
  269. +" Line_Number_Of_Saved_Tok_Line1 + 1;",
  270. +"",
  271. +" return;",
  272. +"-- END OF UMASS CODES.",
  273. +"",
  274. +" else",
  275. +"-- UCI CODES CHANGED:",
  276. +"-- The following codes are modified. Previous codes is commented out.",
  277. +"-- The purpose of doing this is to make it possible to set Temp_Line",
  278. +"-- in Ayacc-extension specific codes. Definitely, we can read the character",
  279. +"-- into the Temp_Line and then set the buf. But Temp_Line will only",
  280. +"-- be used in Ayacc-extension specific codes which makes this approach impossible.",
  281. +" Get (User_Input_File, C);",
  282. +" Buf (Loc) := C;",
  283. +"-- get(user_input_file, buf(loc));",
  284. +"-- UMASS CODES :",
  285. +" Temp_Line (I) := C;",
  286. +"-- END OF UMASS CODES.",
  287. +" end if;",
  288. +"",
  289. +" Loc := Loc + 1;",
  290. +" I := I + 1;",
  291. +" end loop;",
  292. +" else",
  293. +" while I <= Max_Size loop",
  294. +" if end_of_line then",
  295. +" -- Ada ate our newline, put it back on the end.",
  296. +" Buf (Loc) := Ada.Characters.Wide_Wide_Latin_1.LF;",
  297. +" Skip_Line (1);",
  298. +"-- UMASS CODES :",
  299. +" -- We try to get one line by one line. So we return",
  300. +" -- here because we saw the end_of_line.",
  301. +" Result := I;",
  302. +" Temp_Line (I) := Ada.Characters.Wide_Wide_Latin_1.LF;",
  303. +" Saved_Tok_Line2 := new String (1 .. I);",
  304. +" Saved_Tok_Line2 (1 .. I) := Temp_Line (1 .. I);",
  305. +" Line_Number_Of_Saved_Tok_Line2 :=",
  306. +" Line_Number_Of_Saved_Tok_Line1 + 1;",
  307. +"",
  308. +" return;",
  309. +"-- END OF UMASS CODES.",
  310. +"%%",
  311. +"",
  312. +" else",
  313. +"-- The following codes are modified. Previous codes is commented out.",
  314. +"-- The purpose of doing this is to make it possible to set Temp_Line",
  315. +"-- in Ayacc-extension specific codes. Definitely, we can read the character",
  316. +"-- into the Temp_Line and then set the buf. But Temp_Line will only",
  317. +"-- be used in Ayacc-extension specific codes which makes this approach impossible.",
  318. +" get(c);",
  319. +" buf(loc) := c;",
  320. +"-- get(buf(loc));",
  321. +"-- UMASS CODES :",
  322. +" Temp_Line(i) := c;",
  323. +"-- END OF UMASS CODES.",
  324. +" end if; ",
  325. +"",
  326. +" loc := loc + 1;",
  327. +" i := i + 1;",
  328. +" end loop;",
  329. +" end if; -- for input file being standard input",
  330. +"",
  331. +" result := i - 1; ",
  332. +"-- UMASS CODES :",
  333. +"-- Since we get one line by one line, if we",
  334. +"-- reach here, it means that current line have",
  335. +"-- more that max_size characters. So it is",
  336. +"-- impossible to hold the whole line. We",
  337. +"-- report the warning message and continue.",
  338. +" buf(loc - 1) := Ascii.LF;",
  339. +" if (is_open(user_input_file)) then",
  340. +" skip_line(user_input_file, 1);",
  341. +" else",
  342. +" skip_line(1);",
  343. +" end if;",
  344. +" Temp_Line(i-1) := ASCII.LF;",
  345. +" Saved_Tok_Line2 := new String ( 1 .. i - 1);",
  346. +" Saved_Tok_Line2 ( 1 .. i - 1 ) := Temp_Line ( 1 .. i - 1 );",
  347. +" Line_Number_Of_Saved_Tok_Line2 := Line_Number_Of_Saved_Tok_Line1 + 1;",
  348. +" Put_Line ( ""Input line """,
  349. +" & Integer'Image ( Line_Number_Of_Saved_Tok_Line2 )",
  350. +" & ""has more than """,
  351. +" & Integer'Image ( max_size )",
  352. +" & "" characters, ... truncated."" );",
  353. +"-- END OF UMASS CODES.",
  354. +" exception",
  355. +" when END_ERROR => result := i - 1;",
  356. +" -- when we hit EOF we need to set yy_eof_has_been_seen",
  357. +" yy_eof_has_been_seen := true;",
  358. +"-- UMASS CODES :",
  359. +"-- Processing incomplete line.",
  360. +" if i /= 1 then",
  361. +" -- Current line is not empty but do not have end_of_line.",
  362. +" -- So current line is incomplete line. But we still need",
  363. +" -- to save it.",
  364. +" Saved_Tok_Line2 := new String ( 1 .. i - 1 );",
  365. +" Saved_Tok_Line2 ( 1 .. i - 1 ) := Temp_Line ( 1 .. i - 1 );",
  366. +" Line_Number_Of_Saved_Tok_Line2 := Line_Number_Of_Saved_Tok_Line1 + 1;",
  367. +" end if;",
  368. +"-- END OF UMASS CODES.",
  369. +"end YY_INPUT;",
  370. +"",
  371. +"-- yy_get_next_buffer - try to read in new buffer",
  372. +"--",
  373. +"-- returns a code representing an action",
  374. +"-- EOB_ACT_LAST_MATCH - ",
  375. +"-- EOB_ACT_RESTART_SCAN - restart the scanner",
  376. +"-- EOB_ACT_END_OF_FILE - end of file",
  377. +"",
  378. +"function yy_get_next_buffer return eob_action_type is",
  379. +" dest : integer := 0;",
  380. +" source : integer := yytext_ptr - 1; -- copy prev. char, too",
  381. +" number_to_move : integer;",
  382. +" ret_val : eob_action_type;",
  383. +" num_to_read : integer;",
  384. +"begin ",
  385. +" if ( yy_c_buf_p > yy_n_chars + 1 ) then",
  386. +" raise NULL_IN_INPUT;",
  387. +" end if;",
  388. +"",
  389. +" -- try to read more data",
  390. +"",
  391. +" -- first move last chars to start of buffer",
  392. +" number_to_move := yy_c_buf_p - yytext_ptr;",
  393. +"",
  394. +" for i in 0..number_to_move - 1 loop",
  395. +" yy_ch_buf.data (dest) := yy_ch_buf.data (source);",
  396. +" dest := dest + 1;",
  397. +" source := source + 1;",
  398. +" end loop;",
  399. +" ",
  400. +" if ( yy_eof_has_been_seen ) then",
  401. +" -- don't do the read, it's not guaranteed to return an EOF,",
  402. +" -- just force an EOF",
  403. +"",
  404. +" yy_n_chars := 0;",
  405. +" else",
  406. +" num_to_read := YY_BUF_SIZE - number_to_move - 1;",
  407. +"",
  408. +" if ( num_to_read > YY_READ_BUF_SIZE ) then",
  409. +" num_to_read := YY_READ_BUF_SIZE;",
  410. +" end if;",
  411. +"",
  412. +" -- read in more data",
  413. +" YY_INPUT( yy_ch_buf.data (number_to_move..yy_ch_buf.data'last), yy_n_chars, num_to_read );",
  414. +" end if;",
  415. +" if ( yy_n_chars = 0 ) then",
  416. +" if ( number_to_move = 1 ) then",
  417. +" ret_val := EOB_ACT_END_OF_FILE;",
  418. +" else",
  419. +" ret_val := EOB_ACT_LAST_MATCH;",
  420. +" end if;",
  421. +"",
  422. +" yy_eof_has_been_seen := true;",
  423. +" else",
  424. +" ret_val := EOB_ACT_RESTART_SCAN;",
  425. +" end if;",
  426. +" ",
  427. +" yy_n_chars := yy_n_chars + number_to_move;",
  428. +" yy_ch_buf.data (yy_n_chars) := YY_END_OF_BUFFER_CHAR;",
  429. +" yy_ch_buf.data (yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;",
  430. +"",
  431. +" -- yytext begins at the second character in",
  432. +" -- yy_ch_buf; the first character is the one which",
  433. +" -- preceded it before reading in the latest buffer;",
  434. +" -- it needs to be kept around in case it's a",
  435. +" -- newline, so yy_get_previous_state() will have",
  436. +" -- with '^' rules active",
  437. +"",
  438. +" yytext_ptr := 1;",
  439. +"",
  440. +" return ret_val;",
  441. +"end yy_get_next_buffer;",
  442. +"",
  443. +" procedure YYUnput (C : Wide_Wide_Character; YY_BP: in out Integer) is",
  444. +" number_to_move : Integer;",
  445. +" dest : integer;",
  446. +" source : integer;",
  447. +" tmp_yy_cp : integer;",
  448. +"",
  449. +" begin",
  450. +" tmp_yy_cp := yy_c_buf_p;",
  451. +"",
  452. +" if ( tmp_yy_cp < 2 ) then",
  453. +" -- need to shift things up to make room",
  454. +" number_to_move := yy_n_chars + 2; -- +2 for EOB chars",
  455. +" dest := YY_BUF_SIZE + 2;",
  456. +" source := number_to_move;",
  457. +"",
  458. +" while ( source > 0 ) loop",
  459. +" dest := dest - 1;",
  460. +" source := source - 1;",
  461. +" yy_ch_buf.data (dest) := yy_ch_buf.data (source);",
  462. +" end loop;",
  463. +"",
  464. +" tmp_yy_cp := tmp_yy_cp + dest - source;",
  465. +" yy_bp := yy_bp + dest - source;",
  466. +" yy_n_chars := YY_BUF_SIZE;",
  467. +"",
  468. +" if ( tmp_yy_cp < 2 ) then",
  469. +" raise PUSHBACK_OVERFLOW;",
  470. +" end if;",
  471. +" end if;",
  472. +"",
  473. +" if tmp_yy_cp > yy_bp",
  474. +" and then yy_ch_buf.data (tmp_yy_cp-1) = Ada.Characters.Wide_Wide_Latin_1.LF",
  475. +" then",
  476. +" yy_ch_buf.data (tmp_yy_cp-2) := Ada.Characters.Wide_Wide_Latin_1.LF;",
  477. +" end if;",
  478. +"",
  479. +" tmp_yy_cp := tmp_yy_cp - 1;",
  480. +" yy_ch_buf.data (tmp_yy_cp) := c;",
  481. +"",
  482. +" -- Note: this code is the text of YY_DO_BEFORE_ACTION, only",
  483. +" -- here we get different yy_cp and yy_bp's",
  484. +" yytext_ptr := yy_bp;",
  485. +" yy_c_buf_p := tmp_yy_cp;",
  486. +" end yyunput;",
  487. +"",
  488. +" procedure Unput (C : Wide_Wide_Character) is",
  489. +" begin",
  490. +" YYUnput (C, yy_bp);",
  491. +" end Unput;",
  492. +"",
  493. +" function Input return Wide_Wide_Character is",
  494. +" C : Wide_Wide_Character;",
  495. +" YY_CP : Integer := YY_C_Buf_P;",
  496. +"",
  497. +" begin",
  498. +" if YY_CH_Buf.Data (YY_C_Buf_P) = YY_END_OF_BUFFER_CHAR then",
  499. +" -- need more input",
  500. +"",
  501. +" yytext_ptr := yy_c_buf_p;",
  502. +" yy_c_buf_p := yy_c_buf_p + 1;",
  503. +"",
  504. +" case yy_get_next_buffer is",
  505. +" -- this code, unfortunately, is somewhat redundant with",
  506. +" -- that above",
  507. +"",
  508. +" when EOB_ACT_END_OF_FILE =>",
  509. +" if yywrap then",
  510. +" yy_c_buf_p := yytext_ptr;",
  511. +"",
  512. +" return Ada.Characters.Wide_Wide_Latin_1.NUL;",
  513. +" end if;",
  514. +"",
  515. +" yy_ch_buf.data (0) := Ada.Characters.Wide_Wide_Latin_1.LF;",
  516. +" yy_n_chars := 1;",
  517. +" yy_ch_buf.data (yy_n_chars) := YY_END_OF_BUFFER_CHAR;",
  518. +" yy_ch_buf.data (yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;",
  519. +" yy_eof_has_been_seen := false;",
  520. +" yy_c_buf_p := 1;",
  521. +" yytext_ptr := yy_c_buf_p;",
  522. +"",
  523. +" return Input;",
  524. +"",
  525. +" when EOB_ACT_RESTART_SCAN =>",
  526. +" yy_c_buf_p := yytext_ptr;",
  527. +"",
  528. +" when EOB_ACT_LAST_MATCH =>",
  529. +" raise UNEXPECTED_LAST_MATCH;",
  530. +"",
  531. +" when others => null;",
  532. +" end case;",
  533. +" end if;",
  534. +"",
  535. +" c := yy_ch_buf.data (yy_c_buf_p);",
  536. +" yy_c_buf_p := yy_c_buf_p + 1;",
  537. +"",
  538. +" return C;",
  539. +" end Input;",
  540. +"",
  541. +" procedure Output (C : Wide_Wide_Character) is",
  542. +" begin",
  543. +" if Is_Open (User_Output_File) then",
  544. +" Put (User_Output_File, C);",
  545. +"",
  546. +" else",
  547. +" Put (C);",
  548. +" end if;",
  549. +" end Output;",
  550. +"",
  551. +" -- Default yywrap function - always treat EOF as an EOF",
  552. +"",
  553. +" function YYWrap return Boolean is",
  554. +" begin",
  555. +" return True;",
  556. +" end YYWrap;",
  557. +"",
  558. +" procedure Open_Input (FName : String) is",
  559. +" begin",
  560. +" YY_Init := True;",
  561. +" Open (User_Input_File, In_File, FName, ""wcem=8"");",
  562. +" end Open_Input;",
  563. +"",
  564. +" procedure Create_Output (FName : String := """") is",
  565. +" begin",
  566. +" if fname /= """" then",
  567. +" Create (User_Output_File, Out_File, FName);",
  568. +" end if;",
  569. +" end Create_Output;",
  570. +"",
  571. +" procedure Close_Input is",
  572. +" begin",
  573. +" if Is_Open (User_Input_File) then",
  574. +" Close (User_Input_File);",
  575. +" end if;",
  576. +" end Close_Input;",
  577. +"",
  578. +" procedure Close_Output is",
  579. +" begin",
  580. +" if Is_Open (User_Output_File) then",
  581. +" Close (User_Output_File);",
  582. +" end if;",
  583. +" end Close_Output;",
  584. +"",
  585. +"-- UMASS CODES :",
  586. +"procedure Yy_Get_Token_Line ( Yy_Line_String : out String;",
  587. +" Yy_Line_Length : out Natural ) is",
  588. +"begin",
  589. +" -- Currently processing line is either in saved token line1 or",
  590. +" -- in saved token line2.",
  591. +" if Yy_Line_Number = Line_Number_Of_Saved_Tok_Line1 then",
  592. +" Yy_Line_Length := Saved_Tok_Line1.all'length;",
  593. +" Yy_Line_String ( Yy_Line_String'First .. ( Yy_Line_String'First + Saved_Tok_Line1.all'length - 1 ))",
  594. +" := Saved_Tok_Line1 ( 1 .. Saved_Tok_Line1.all'length );",
  595. +" else",
  596. +" Yy_Line_Length := Saved_Tok_Line2.all'length;",
  597. +" Yy_Line_String ( Yy_Line_String'First .. ( Yy_Line_String'First + Saved_Tok_Line2.all'length - 1 ))",
  598. +" := Saved_Tok_Line2 ( 1 .. Saved_Tok_Line2.all'length );",
  599. +" end if;",
  600. +"end Yy_Get_Token_Line;",
  601. +"",
  602. +"function Yy_Line_Number return Natural is",
  603. +"begin",
  604. +" return Tok_Begin_Line;",
  605. +"end Yy_Line_Number;",
  606. +"",
  607. +"function Yy_Begin_Column return Natural is",
  608. +"begin",
  609. +" return Tok_Begin_Col;",
  610. +"end Yy_Begin_Column;",
  611. +"",
  612. +"function Yy_End_Column return Natural is",
  613. +"begin",
  614. +" return Tok_End_Col;",
  615. +"end Yy_End_Column;",
  616. +"",
  617. +"-- END OF UMASS CODES.",
  618. +""
  619. -- IO TEMPLATE END
  620. );
  621. IO_Current_Line : Integer := 1;
  622. ------------------
  623. -- Template_Out --
  624. ------------------
  625. procedure Template_Out
  626. (Out_File : File_Type;
  627. Current_Template : File_Array;
  628. Line_Number : in out Integer)
  629. is
  630. -- UMASS CODES :
  631. Umass_Codes : Boolean := False;
  632. -- Indicates whether or not current line of the template
  633. -- is the Umass codes.
  634. -- END OF UMASS CODES.
  635. Buf : Unbounded_Wide_Wide_String;
  636. begin
  637. while not (Line_Number > Current_Template'Last) loop
  638. Buf := Current_Template (Line_Number);
  639. Line_Number := Line_Number + 1;
  640. if Length (Buf) >= 2 and then Slice (Buf, 1, 2) = "%%" then
  641. exit;
  642. else
  643. -- UMASS CODES :
  644. -- In the template, the codes between "-- UMASS CODES : " and
  645. -- "-- END OF UMASS CODES." are specific to be used by Ayacc-extension.
  646. -- Ayacc-extension has more power in error recovery. So we
  647. -- generate those codes only when Ayacc_Extension_Flag is True.
  648. if Buf = "-- UMASS CODES :" then
  649. Umass_Codes := True;
  650. end if;
  651. if not Umass_Codes or else Ayacc_Extension_Flag then
  652. Put_Line (Out_File, Buf);
  653. end if;
  654. if Buf = "-- END OF UMASS CODES." then
  655. Umass_Codes := False;
  656. end if;
  657. -- END OF UMASS CODES.
  658. -- UCI CODES commented out :
  659. -- The following line is commented out because it is done in Umass codes.
  660. -- FILE_STRING.PUT_LINE(OUTFILE,BUF);
  661. end if;
  662. end loop;
  663. end Template_Out;
  664. -----------------------
  665. -- Generate_DFA_File --
  666. -----------------------
  667. procedure Generate_DFA_File is
  668. DFA_Out_Spec_File, DFA_Out_Body_File : File_Type;
  669. begin
  670. External_File_Manager.Get_DFA_Spec_File (DFA_Out_Spec_File);
  671. External_File_Manager.Get_DFA_Body_File (DFA_Out_Body_File);
  672. Put_Line (DFA_Out_Spec_File, "package " & Misc.Basename & ".DFA is");
  673. if DDebug then
  674. -- make a scanner that output acceptance information
  675. Put_Line (DFA_Out_Spec_File, "Aflex_Debug : Boolean := True;");
  676. else
  677. Put_Line (DFA_Out_Spec_File, "Aflex_Debug : Boolean := False;");
  678. end if;
  679. Template_Out (DFA_Out_Spec_File, DFA_Template, DFA_Current_Line);
  680. Put_Line (DFA_Out_Spec_File, "end " & Misc.Basename & ".DFA;");
  681. Put_Line (DFA_Out_Body_File, "package body " & Misc.Basename & ".DFA is");
  682. Template_Out (DFA_Out_Body_File, DFA_Template, DFA_Current_Line);
  683. Put_Line (DFA_Out_Body_File, "end " & Misc.Basename & ".DFA;");
  684. end Generate_DFA_File;
  685. ----------------------
  686. -- Generate_IO_File --
  687. ----------------------
  688. procedure Generate_IO_File is
  689. IO_Out_Spec_File, IO_Out_Body_File : File_Type;
  690. begin
  691. External_File_Manager.Get_IO_Spec_File (IO_Out_Spec_File);
  692. External_File_Manager.Get_IO_Body_File (IO_Out_Body_File);
  693. Put (IO_Out_Spec_File, "with " & Misc.Basename & ".DFA;");
  694. Put_Line (IO_Out_Spec_File, " use " & Misc.Basename & ".DFA;");
  695. Template_Out (IO_Out_Spec_File, IO_Template, IO_Current_Line);
  696. Put_Line (IO_Out_Spec_File, "package " & Misc.Basename & ".IO is");
  697. Template_Out (IO_Out_Spec_File, IO_Template, IO_Current_Line);
  698. Put_Line (IO_Out_Spec_File, "end " & Misc.Basename & ".IO;");
  699. Put_Line (IO_Out_Body_File, "package body " & Misc.Basename & ".IO is");
  700. Template_Out (IO_Out_Body_File, IO_Template, IO_Current_Line);
  701. -- If we're generating a scanner for interactive mode we need to generate
  702. -- a YY_INPUT that stops at the end of each line
  703. if Interactive then
  704. Put_Line
  705. (IO_Out_Body_File,
  706. " i := i + 1; -- update counter, miss end of loop");
  707. Put_Line
  708. (IO_Out_Body_File,
  709. " exit; -- in interactive mode return at end of line.");
  710. end if;
  711. Template_Out (IO_Out_Body_File, IO_Template, IO_Current_Line);
  712. Put_Line (IO_Out_Body_File, "end " & Misc.Basename & ".IO;");
  713. end Generate_IO_File;
  714. end Template_Manager;