diff options
| author | Stephen Leake <stephen_leake@stephe-leake.org> | 2023-10-26 10:53:42 -0700 |
|---|---|---|
| committer | Stephen Leake <stephen_leake@stephe-leake.org> | 2023-10-26 10:53:42 -0700 |
| commit | cf8a92cec4df3d6be562ddd2e92f8014974f9c68 (patch) | |
| tree | 5f3fac586569c23a0143090439eb2accdcf97552 | |
| parent | db272eca5c7cce620e19c1040cd97f79e0bd30b4 (diff) | |
| parent | 1c4b099bf1f93cebee523b0ba75ccab6c6c2a2f0 (diff) | |
merge from externals/wisi to externals-release/wisiexternals-release/wisi
69 files changed, 5132 insertions, 2858 deletions
diff --git a/.elpaignore b/.elpaignore new file mode 100644 index 0000000..ce56bc2 --- /dev/null +++ b/.elpaignore @@ -0,0 +1 @@ +alire.toml @@ -6,6 +6,16 @@ Please send wisi bug reports to bug-gnu-emacs@gnu.org, with 'wisi' in the subject. If possible, use M-x report-emacs-bug. +* wisi 4.3.2 +21 Oct 2023 + +** wisi-incremental-parse-enable is now t by default. + +* wisi 4.3.0 +15 Sep 2023 + +** Use WisiToken 4.2.0. + * wisi 4.2.3 26 Jan 2023 @@ -1,4 +1,4 @@ -Emacs wisi package 4.2.2 +Emacs wisi package 4.3.2 The wisi package provides utilities for using generalized error-correcting LR parsers (in external processes) to do indentation, diff --git a/emacs_wisi_common_parse.adb b/emacs_wisi_common_parse.adb index 5fc3877..4bedff3 100644 --- a/emacs_wisi_common_parse.adb +++ b/emacs_wisi_common_parse.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- This program is free software; you can redistribute it and/or -- modify it under terms of the GNU General Public License as diff --git a/emacs_wisi_common_parse.ads b/emacs_wisi_common_parse.ads index a5fb958..d39c1ff 100644 --- a/emacs_wisi_common_parse.ads +++ b/emacs_wisi_common_parse.ads @@ -2,7 +2,7 @@ -- -- Common utilities for Gen_Emacs_Wisi_*_Parse -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- This program is free software; you can redistribute it and/or -- modify it under terms of the GNU General Public License as @@ -37,10 +37,10 @@ package Emacs_Wisi_Common_Parse is -- the implementation of the protocol. -- -- Only changes once per wisi release. Increment as soon as required, - -- record new version in NEWS-wisi.text. If working on a branch and - -- main has already incremented, increment again, in case main is - -- released before branch is merged; leave two "increment protocol" - -- lines in NEWS-wisi.text to indicate the issue. + -- record new version in NEWS. If working on a branch and main has + -- already incremented, increment again, in case main is released + -- before branch is merged; leave two "increment protocol" lines in + -- NEWS to indicate the issue. Prompt : constant String := ";;> "; diff --git a/run_wisi_common_parse.adb b/run_wisi_common_parse.adb index a3ece4c..ab7fc69 100644 --- a/run_wisi_common_parse.adb +++ b/run_wisi_common_parse.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- This program is free software; you can redistribute it and/or -- modify it under terms of the GNU General Public License as @@ -94,7 +94,7 @@ package body Run_Wisi_Common_Parse is Put_Line (" <action_begin_byte> <action_end_byte> [options]"); Put_Line (" or: refactor <refactor_action> <file_name> <edit_begin> [options]"); Put_Line (" or: command_file <command_file_name> [source_file_name]"); - Put_Line ("post_parse_action: {Navigate | Face | Indent}"); + Put_Line ("post_parse_action: {None | Navigate | Face | Indent}"); New_Line; Put_Line ("partial parse params: begin_byte_pos end_byte_pos goal_byte_pos begin_char_pos end_char_pos" & @@ -496,7 +496,6 @@ package body Run_Wisi_Common_Parse is -- Force a dispatching call. Wisi.Parse_Data_Type'Class (Parse_Context.Parser.User_Data.all).Initialize; - Parse_Context.Parser.User_Data.Reset; Parse_Context.Parser.Tree.Lexer.Reset; begin Parse_Context.Parser.Parse (Log_File); @@ -782,7 +781,6 @@ package body Run_Wisi_Common_Parse is for I in 1 .. Cl_Params.Repeat_Count loop begin - Parse_Data.Reset; Parser.Tree.Lexer.Reset; Parser.Parse (Log_File); diff --git a/standard_common.gpr b/standard_common.gpr index 6553e95..0387cfe 100644 --- a/standard_common.gpr +++ b/standard_common.gpr @@ -2,7 +2,7 @@ -- -- Standard settings for all of Stephe's Ada projects. -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- This program is free software; you can redistribute it and/or -- modify it under terms of the GNU General Public License as @@ -67,18 +67,21 @@ project Standard_Common is -- -gnatVa causes some inline procedures to be non-inlineable; -- suppress that warning with -gnatwP. - Base_Debug_Switches := Common_Switches & + Base_Debug_Switches := ( "-O0", -- we don't use -Og because that causes gdb to report incorrect results in some cases in Ada. "-gnatVa", -- validity checks "-gnateE", -- extra info in exceptions "-gnatwaP" -- no warn on Inline - ); + ) & + Common_Switches; -- last because turns of some of -gnatwa case Assertions is when "Build" => - Base_Debug_Switches := Base_Debug_Switches & - ("-gnata"); -- assertions, pre/post-conditions + Base_Debug_Switches := + ("-gnata") & -- assertions, pre/post-conditions + Base_Debug_Switches; + when "Off" => -- Allow turning off assertions with debug on, for execution speed. null; diff --git a/wisi-parse-common.el b/wisi-parse-common.el index c78d244..d565c71 100644 --- a/wisi-parse-common.el +++ b/wisi-parse-common.el @@ -1,6 +1,6 @@ ;;; wisi-parse-common.el --- declarations used by wisi-parse.el, wisi-ada-parse.el, and wisi.el -*- lexical-binding:t -*- ;; -;; Copyright (C) 2014, 2015, 2017 - 2022 Free Software Foundation, Inc. +;; Copyright (C) 2014, 2015, 2017 - 2023 Free Software Foundation, Inc. ;; ;; Author: Stephen Leake <stephen_leake@member.fsf.org> ;; @@ -22,7 +22,7 @@ ;;; Code: (require 'cl-lib) -(defcustom wisi-incremental-parse-enable nil +(defcustom wisi-incremental-parse-enable t "If non-nil, use incremental parse when possible." :type 'boolean :group 'wisi @@ -69,7 +69,7 @@ can be dumped to a file via the tree query dump-prev." ) (cl-defstruct (wisi--parse-error-repair) - pos ;; position (integer) in buffer where insert/delete is done. + pos ;; position (integer or marker) in buffer where insert/delete is done. inserted ;; list of token IDs that were inserted before pos deleted ;; list of token IDs that were deleted after pos deleted-region ;; buffer (cons FIRST LAST) region deleted @@ -240,6 +240,11 @@ The value is a list (source-buffer (font-lock-begin region font-lock attempted to fontify while the parser was busy.") +(defvar wisi-parse-full-read-only nil + ;; Only one buffer can be doing a full parse. + "Non-nil if `wisi-parse-full-active is t and the buffer was +originally read-only.") + (cl-defgeneric wisi-parse-incremental (parser parser-action &key full nowait) "Incrementally parse current buffer. PARSER-ACTION (one of `wisi-post-parse-actions') is used to @@ -291,8 +296,12 @@ have been previously parsed by `wisi-parse-current' or backend. - ancestor: ARGS are a buffer position and a list of ids. Return - the wisi-tree-node for the ancestor of the terminal at that pos - that is one of the ids, or nil if no such ancestor. + the wisi-tree-node for the first ancestor of the terminal at + that pos that is one of the ids, or nil if no such ancestor. To + handle LR lists, if the parent of the result is the same as the + result, return the parent (iteratively); this returns the root + of the list. The char-region does not contain trailing + non-grammar. - parent: ARGS are (node-address n). Return the wisi-tree-node for the nth parent of the node, or nil if no such parent. diff --git a/wisi-process-parse.el b/wisi-process-parse.el index 210f19f..60bbdaa 100644 --- a/wisi-process-parse.el +++ b/wisi-process-parse.el @@ -151,7 +151,9 @@ Otherwise add PARSER to `wisi-process--alist', return it." (wisi-parse-log-message wisi-parser-shared "parse--filter found prompt - initial full")) (if (buffer-live-p (car wisi-parse-full-active)) (with-current-buffer (car wisi-parse-full-active) - (read-only-mode -1) + (if wisi-parse-full-read-only + (setq wisi-parse-full-read-only nil) + (read-only-mode -1)) (let ((region (cdr wisi-parse-full-active))) (font-lock-flush (max (point-min) (car region)) (min (point-max) (cdr region)))) @@ -556,6 +558,10 @@ PARSER will respond with one or more Query messages." ;; sexp is [Indent line-number line-begin-char-pos indent] ;; see `wisi-process-parse--execute' (let ((pos (aref sexp 2))) + (when (< 0 wisi-debug) + (unless (= (aref sexp 1) (line-number-at-pos pos)) + (error "indent: line/pos mismatch at %d" pos))) + (with-silent-modifications (when (< (point-min) pos) (put-text-property @@ -626,8 +632,8 @@ PARSER will respond with one or more Query messages." (file-name (if (buffer-file-name) (file-name-nondirectory (buffer-file-name)) ""))) ;; file-name can be nil during vc-resolve-conflict - (when (not name-1-pos) - (setq name-1-pos name-2-pos) + (when (or (not name-1-pos) (= 0 name-1-pos)) + (setq name-1-pos (min name-2-pos (point-max))) (setq name-2-pos 0)) (when (not name-2-pos) @@ -635,15 +641,15 @@ PARSER will respond with one or more Query messages." (push (make-wisi--parse-error :pos (copy-marker name-1-pos) - :pos-2 (copy-marker name-2-pos) + :pos-2 (when (< 0 name-2-pos) (copy-marker name-2-pos)) :message - (format - (concat "%s:%d:%d: %s" - (when (> 0 name-2-pos) " %s:%d:%d")) - file-name (line-number-at-pos name-1-pos t) (funcall column-at-pos name-1-pos) - (aref sexp 4) - (when (> 0 name-2-pos) - file-name (line-number-at-pos name-2-pos t) (funcall column-at-pos name-2-pos)))) + (concat + (format "%s:%d:%d: %s" + file-name (line-number-at-pos name-1-pos t) (funcall column-at-pos name-1-pos) + (aref sexp 4)) + (when (< 0 name-2-pos) + (format " %s:%d:%d" + file-name (line-number-at-pos name-2-pos t) (funcall column-at-pos name-2-pos))))) (wisi-parser-local-parse-errors wisi-parser-local)) )) @@ -667,19 +673,20 @@ PARSER will respond with one or more Query messages." (edit-pos (aref (aref sexp i) 1)) (err (wisi-process-parse--find-err error-pos (wisi-parser-local-parse-errors wisi-parser-local)))) (when err - (cl-nsubst - (push - (make-wisi--parse-error-repair - :pos (copy-marker edit-pos) - :inserted (mapcar (lambda (id) (aref token-table id)) (aref (aref sexp i) 2)) - :deleted (mapcar (lambda (id) (aref token-table id)) (aref (aref sexp i) 3)) - :deleted-region (aref (aref sexp i) 4)) - (wisi--parse-error-repair err)) ;; new - err ;; old - (wisi-parser-local-parse-errors wisi-parser-local) ;; tree - :test (lambda (old _el) - (= (wisi--parse-error-pos old) - (wisi--parse-error-pos err))))) + (with-no-warnings ;; byte-compiler complains that "result of cl-nsubst is not used", but it's not useful! + (cl-nsubst + (push + (make-wisi--parse-error-repair + :pos (copy-marker edit-pos) + :inserted (mapcar (lambda (id) (aref token-table id)) (aref (aref sexp i) 2)) + :deleted (mapcar (lambda (id) (aref token-table id)) (aref (aref sexp i) 3)) + :deleted-region (aref (aref sexp i) 4)) + (wisi--parse-error-repair err)) ;; new + err ;; old + (wisi-parser-local-parse-errors wisi-parser-local) ;; tree + :test (lambda (old _el) + (= (wisi--parse-error-pos old) + (wisi--parse-error-pos err)))))) ))) )) @@ -837,7 +844,15 @@ Source buffer is current." ;; the process to die. (setf (wisi-process--parser-busy parser) t) (wisi-parse-log-message parser "kill process") - (kill-process (wisi-process--parser-process parser))) + (let ((process (wisi-process--parser-process parser))) + (kill-process process) + (while (process-live-p process) + (accept-process-output + process + wisi-process-time-out + nil ;; milliseconds + nil) ;; just-this-one + ))) (setf (wisi-process--parser-busy parser) nil)) (cl-defun wisi-process-parse--prepare (parser parse-action &key nowait) @@ -917,7 +932,7 @@ Source buffer is current." (source-buffer (wisi-process--parser-source-buffer parser)) log-start) (defvar w32-pipe-read-delay) - (condition-case err + (condition-case-unless-debug err (let* ((process (wisi-process--parser-process parser)) (w32-pipe-read-delay 0) ;; fastest subprocess read response @@ -1199,6 +1214,7 @@ Source buffer is current." ((and full nowait) (set-process-filter (wisi-process--parser-process parser) #'wisi-process-parse--filter) (setq wisi-parse-full-active (cons (current-buffer) (cons (point-min) (point-max)))) + (setq wisi-parse-full-read-only buffer-read-only) (read-only-mode 1) (wisi-process-parse--send-incremental-parse parser full)) (t @@ -1506,19 +1522,18 @@ prompt for it." (string-equal (match-string 2) source-file)) (goto-char (match-end 0)) (looking-at " \\([0-9]+\\) \\([0-9]+\\)") - (let ((label (string-to-number (match-string 1))) - (pos (match-string 2))) + (let* ((label (string-to-number (match-string 1))) + (pos (match-string 2)) + (rest-of-line (buffer-substring (match-end 2) (line-end-position)))) (set-buffer cmd-buffer) (goto-char (point-max)) - (insert "-- query_tree " - (cl-ecase label - (0 "node ") - (1 "containing_statement ") - (2 "ancestor ") - (3 "parent ") - (4 "child ") - (5 "print ")) - pos "\n\n") + (cl-ecase label + (0 (insert "-- query_tree node " pos "\n\n")) + (1 (insert "-- query_tree containing_statement " pos "\n\n")) + (2 (insert "-- query_tree ancestor " pos rest-of-line "\n\n")) + (3 (insert "-- query_tree parent " pos "\n\n")) + (4 (insert "-- query_tree child " pos "\n\n")) + (5 (insert "-- query_tree print " pos "\n\n"))) (set-buffer log-buffer))) ((and (string-equal (match-string 1) "refactor") diff --git a/wisi-run-indent-test.el b/wisi-run-indent-test.el index 0f3090c..5b9e0d8 100644 --- a/wisi-run-indent-test.el +++ b/wisi-run-indent-test.el @@ -1,6 +1,6 @@ ;;; wisi-run-indent-test.el --- utils for automating indentation and casing tests -*- lexical-binding: t; -*- ;; -;; Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +;; Copyright (C) 2018 - 2023 Free Software Foundation, Inc. ;; ;; This file is part of GNU Emacs. ;; @@ -222,11 +222,8 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END EDIT-BEGIN)") (defun run-test-here () "Run an indentation and casing test on the current buffer." (interactive) - (when wisi-incremental-parse-enable - ;; wait for the parser to finish the initial parse - (wisi-wait-parser)) - (condition-case err + (condition-case-unless-debug err (progn (setq indent-tabs-mode nil) @@ -372,9 +369,11 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END EDIT-BEGIN)") (length last-result) (length expected-result))))) - (let ((i 0)) + (let ((i 0) + (fail nil)) (while (< i (length expected-result)) (unless (equal (nth i expected-result) (nth i last-result)) + (setq fail t) (setq error-count (1+ error-count)) (push (line-number-at-pos) error-lines) (message @@ -386,7 +385,10 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END EDIT-BEGIN)") (nth i last-result) (nth i expected-result)) ))) - (setq i (1+ i))))) + (setq i (1+ i))) + (unless fail + (setq pass-count (1+ pass-count)) + (message (format "test passes %s:%d:\n" (buffer-file-name) (line-number-at-pos)))))) ((string= (match-string 1) "_SKIP_UNLESS") (looking-at ".*$") @@ -408,7 +410,9 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END EDIT-BEGIN)") (t (setq error-count (1+ error-count)) (push (line-number-at-pos) error-lines) - (error (concat "Unexpected EMACS test command " (match-string 1)))))) + (error (concat "error: Unexpected EMACS test command " (match-string 1))))) + + ) (let ((msg (format "%s:%d tests passed %d" (buffer-file-name) (line-number-at-pos (point)) pass-count))) @@ -517,7 +521,7 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END EDIT-BEGIN)") (let ((dir default-directory)) ;; Always wait for initial full parse to complete. - (setq wisi-parse-full-background nil) + (setq-default wisi-parse-full-background nil) (find-file file-name) ;; sets default-directory @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -859,7 +859,7 @@ package body Wisi is overriding function Copy_Augmented (User_Data : in Parse_Data_Type; - Augmented : in Syntax_Trees.Augmented_Class_Access) + Augmented : in not null Syntax_Trees.Augmented_Class_Access) return Syntax_Trees.Augmented_Class_Access is Old_Aug : constant Augmented_Access := Augmented_Access (Augmented); @@ -1970,6 +1970,15 @@ package body Wisi is return; end if; + if Query.Label = Ancestor then + -- Handle LR list; return list root. + loop + exit when Tree.Parent (Result) = Invalid_Node_Access or else + Tree.ID (Tree.Parent (Result)) /= Tree.ID (Result); + Result := Tree.Parent (Result); + end loop; + end if; + Char_Region := Tree.Char_Region (Result, Trailing_Non_Grammar => False); when Containing_Statement => @@ -2197,8 +2206,12 @@ package body Wisi is (case Item.Status.Label is when WisiToken.Syntax_Trees.In_Parse_Actions.Ok => "", when WisiToken.Syntax_Trees.In_Parse_Actions.Error => - Safe_Pos (Tree.Child (Error_Node, Item.Status.Begin_Name))'Image & - Safe_Pos (Tree.Child (Error_Node, Item.Status.End_Name))'Image & " """ & + (if Item.Status.Begin_Name = 0 + then " 0" + else Safe_Pos (Tree.Child (Error_Node, Item.Status.Begin_Name))'Image) & + (if Item.Status.End_Name = 0 + then " 0" + else Safe_Pos (Tree.Child (Error_Node, Item.Status.End_Name))'Image) & " """ & (case WisiToken.Syntax_Trees.In_Parse_Actions.Error'(Item.Status.Label) is when Missing_Name_Error => "missing", when Extra_Name_Error => "extra", @@ -10,7 +10,7 @@ -- -- [3] wisi-process-parse.el - defines elisp/process API -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -122,7 +122,7 @@ package Wisi is overriding function Copy_Augmented (User_Data : in Parse_Data_Type; - Augmented : in WisiToken.Syntax_Trees.Augmented_Class_Access) + Augmented : in not null WisiToken.Syntax_Trees.Augmented_Class_Access) return WisiToken.Syntax_Trees.Augmented_Class_Access; overriding @@ -170,7 +170,7 @@ package Wisi is -- -- If ID is Invalid_Token_ID, and the token at Index is a -- nonterminal, the first token in that nonterminal must have a - -- navigate cache; an error is reported by Motion_Action if not. + -- navigate cache; Motion_Action silently fails if not. end record; package Index_ID_Vectors is new Ada.Containers.Vectors (Ada.Containers.Count_Type, Index_ID); @@ -7,7 +7,7 @@ ;; Keywords: parser ;; indentation ;; navigation -;; Version: 4.2.2 +;; Version: 4.3.2 ;; package-requires: ((emacs "25.3") (seq "2.20")) ;; URL: https://stephe-leake.org/ada/wisitoken.html ;; @@ -883,7 +883,7 @@ Run the parser first if needed." (when (get-buffer-window wisi-error-buffer) (delete-window (get-buffer-window wisi-error-buffer))))) - (condition-case err + (condition-case-unless-debug err (save-excursion (cond (partial-parse-p @@ -29,7 +29,7 @@ developing GNU and promoting software freedom.'' @node Top @top Top -Wisi Version 4.2 +Wisi Version 4.3 @end ifnottex @menu @@ -304,9 +304,9 @@ amount. When all productions in a parse tree have been processed, the indent has been computed for all lines. Indent actions specify a delta indent for each token in a -production. If the token is a nonterminal, it can contain multiple -lines of text; the delta indent applies to the lines where the first -token on the line is contained by the nonterminal. +production. If the token is a nonterminal that contains multiple lines +of text, the delta indent applies to the lines where the first token +on the line is contained by the nonterminal. When a delta indent is applied to the indent for a line, it is either added or ignored. We call the token whose delta indent is being @@ -396,7 +396,7 @@ thus all tokens in the production must be labeled. This can improve readability in a long production. When the grammar file uses EBNF meta-syntax, implicit labels are -automatically generated for all tokens, unless they are explicitly +automatically generated for all tokens that are not explicitly labeled; this allows keeping track of which optional tokens are left out when the production is converted to BNF internally. diff --git a/wisitoken-bnf-generate.adb b/wisitoken-bnf-generate.adb index 9c45c28..fa5f128 100644 --- a/wisitoken-bnf-generate.adb +++ b/wisitoken-bnf-generate.adb @@ -54,7 +54,7 @@ is use Ada.Text_IO; First : Boolean := True; begin - Put_Line (Standard_Error, "version 4.1"); -- matches release version in Docs/wisitoken.html + Put_Line (Standard_Error, "version 4.2.1"); -- matches release version in Docs/wisitoken.html Put_Line (Standard_Error, "wisitoken-bnf-generate [options] {wisi grammar file}"); Put_Line (Standard_Error, "Generate source code implementing a parser for the grammar."); New_Line (Standard_Error); @@ -116,7 +116,6 @@ is Put_Line (Standard_Error, " 2 - more diagnostics to standard out, ignore unused tokens, unknown conflicts"); Put_Line (Standard_Error, " --generate ...: override grammar file %generate directive"); Put_Line (Standard_Error, " --output_bnf : output translated EBNF source to <grammar file name base>_bnf.wy"); - Put_Line (Standard_Error, " --suffix <string>; appended to grammar file name"); Put_Line (Standard_Error, " --ignore_conflicts; ignore excess/unknown conflicts"); Put_Line (Standard_Error, " --test_main; generate standalone main program for running the generated parser, modify file names"); @@ -124,12 +123,12 @@ is Enable_Trace_Help; end Put_Usage; - Language_Name : Ada.Strings.Unbounded.Unbounded_String; -- The language the grammar defines - Output_File_Name_Root : Ada.Strings.Unbounded.Unbounded_String; - Suffix : Ada.Strings.Unbounded.Unbounded_String; - Output_BNF : Boolean := False; - Ignore_Conflicts : Boolean := False; - Test_Main : Boolean := False; + Language_Name : Ada.Strings.Unbounded.Unbounded_String; -- The language the grammar defines + Grammar_File_Name_Base : Ada.Strings.Unbounded.Unbounded_String; + Need_Gen_Alg_In_Actions_Name : Boolean := False; + Output_BNF : Boolean := False; + Ignore_Conflicts : Boolean := False; + Test_Main : Boolean := False; Command_Generate_Set : Generate_Set_Access; -- override grammar file declarations @@ -141,10 +140,9 @@ is procedure Use_Input_File (File_Name : in String) is - use Ada.Strings.Unbounded; use Ada.Text_IO; begin - Output_File_Name_Root := +Ada.Directories.Base_Name (File_Name) & Suffix; + Grammar_File_Name_Base := +Ada.Directories.Base_Name (File_Name); Grammar_Parser.Tree.Lexer.Reset_With_File (File_Name); @@ -239,11 +237,6 @@ begin Output_BNF := True; Arg_Next := Arg_Next + 1; - elsif Argument (Arg_Next) = "--suffix" then - Arg_Next := Arg_Next + 1; - Suffix := +Argument (Arg_Next); - Arg_Next := Arg_Next + 1; - elsif Argument (Arg_Next) = "--test_main" then Arg_Next := Arg_Next + 1; Test_Main := True; @@ -310,29 +303,22 @@ begin declare Time_Start : constant Ada.Calendar.Time := Ada.Calendar.Clock; - Tree : WisiToken.Syntax_Trees.Tree renames Grammar_Parser.Tree; begin Syntax_Trees.Copy_Tree - (Source => Tree, + (Source => Grammar_Parser.Tree, Destination => BNF_Tree, User_Data => Input_Data'Unchecked_Access); - if Trace_Generate_EBNF > Detail then - Ada.Text_IO.Put_Line ("EBNF tree:"); - BNF_Tree.Print_Tree; - end if; - WisiToken_Grammar_Editing.Translate_EBNF_To_BNF (BNF_Tree, Input_Data); if Trace_Generate_EBNF > Detail then Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("BNF tree:"); - BNF_Tree.Print_Tree; + BNF_Tree.Print_Tree (Augmented => True); end if; if Output_BNF then - -- FIXME: if %if is present, it can change the bnf tree; output one for each tuple. - WisiToken_Grammar_Editing.Print_Source (-Output_File_Name_Root & "_bnf.wy", BNF_Tree, Input_Data); + WisiToken_Grammar_Editing.Print_Source (-Grammar_File_Name_Base & "_bnf.wy", BNF_Tree, Input_Data); end if; if Trace_Time then @@ -355,19 +341,15 @@ begin use all type Ada.Containers.Count_Type; use all type WisiToken_Grammar_Runtime.Action_Phase; begin - Input_Data.User_Parser := Parser; - Input_Data.User_Lexer := Lexer; -- Specifying the parser and lexer can change the parsed grammar, due -- to %if {parser | lexer}. - Input_Data.Reset; -- only resets Other data - - Input_Data.Phase := Phase; + Input_Data.Reset (Lexer, Parser, Phase); case Phase is when Meta => if Trace_Generate > Outline then - Trace.Put_Line ("post-parse grammar file META"); + Trace.Put_Line ("post-parse main grammar tree META"); end if; Grammar_Parser.Execute_Actions; @@ -381,36 +363,24 @@ begin end case; when Other => - case Valid_Generate_Algorithm'(Parser) is - when LR_Generate_Algorithm | Packrat_Generate_Algorithm => - -- IMPROVEME: for now, Packrat requires a BNF tree; eventually, it - -- will use the EBNF tree. + if Input_Data.Meta_Syntax = EBNF_Syntax and BNF_Tree.Is_Empty then + Translate_To_BNF; + end if; - if Input_Data.Meta_Syntax = EBNF_Syntax and BNF_Tree.Is_Empty then - Translate_To_BNF; + if BNF_Tree.Is_Empty then + if Trace_Generate > Outline then + Trace.Put_Line ("post-parse main grammar tree OTHER"); end if; - if BNF_Tree.Is_Empty then - if Trace_Generate > Outline then - Trace.Put_Line ("post-parse grammar file OTHER, main tree"); - end if; - - Grammar_Parser.Execute_Actions; - else - if Trace_Generate > Outline then - Trace.Put_Line ("post-parse grammar file OTHER, bnf tree"); - end if; - - WisiToken.Parse.Execute_Actions - (BNF_Tree, Grammar_Parser.Productions, Input_Data'Unchecked_Access); + Grammar_Parser.Execute_Actions; + else + if Trace_Generate > Outline then + Trace.Put_Line ("post-parse bnf grammar tree OTHER"); end if; - when External => - null; - - when Tree_Sitter => - null; - end case; + WisiToken.Parse.Execute_Actions + (BNF_Tree, Grammar_Parser.Productions, Input_Data'Unchecked_Access); + end if; if Input_Data.Rule_Count = 0 or Input_Data.Tokens.Rules.Length = 0 then raise WisiToken.Grammar_Error with "no rules"; @@ -428,6 +398,8 @@ begin -- Get the generate tuples Parse_Check (None, None, WisiToken_Grammar_Runtime.Meta); + Need_Gen_Alg_In_Actions_Name := Input_Data.If_Lexer_Present; + if Command_Generate_Set = null then if Input_Data.Generate_Set = null then raise User_Error with @@ -447,211 +419,246 @@ begin (if Command_Generate_Set = null then False else Command_Generate_Set'Length > 1); for Tuple of Generate_Set.all loop - if Trace_Generate > Outline then - Trace.New_Line; - Trace.Put_Line ("process tuple " & Image (Tuple)); - end if; - - case Tuple.Gen_Alg is - when None | External => - if Input_Data.Meta_Syntax = EBNF_Syntax and BNF_Tree.Is_Empty then - -- 'none' is used in unit tests to test bnf translation. - Translate_To_BNF; + declare + -- We could use a cached Generate_Data if not + -- (Input_Data.If_Lexer_Present or Input_Data.If_Parser_Present), but + -- that would not save much time, and would complicate this logic. We + -- do cache Recursions. + Generate_Data : WisiToken.BNF.Generate_Utils.Generate_Data_Access; + Packrat_Data : WisiToken.Generate.Packrat.Data_Access; + begin + if Trace_Generate > Outline then + Trace.New_Line; + Trace.Put_Line ("process tuple " & Image (Tuple)); end if; + case Tuple.Gen_Alg is + when None | External => + if Input_Data.Meta_Syntax = EBNF_Syntax and BNF_Tree.Is_Empty then + -- 'none' is used in unit tests to test bnf translation. + Translate_To_BNF; + end if; - when Tree_Sitter => - Parse_Check - (Lexer => Tuple.Lexer, - Parser => Tuple.Gen_Alg, - Phase => WisiToken_Grammar_Runtime.Other); - - declare - use WisiToken.Generate.Tree_Sitter; + when Tree_Sitter => + Parse_Check + (Lexer => Tuple.Lexer, + Parser => Tuple.Gen_Alg, + Phase => WisiToken_Grammar_Runtime.Other); + + -- Generate_Data.Grammar is built from BNF_Tree; if we are generating + -- actions, the check in Eliminate_Empty_Productions ensures that is + -- the same as TS_Tree. + Generate_Data := new WisiToken.BNF.Generate_Utils.Generate_Data' + (WisiToken.BNF.Generate_Utils.Initialize + (Input_Data'Unchecked_Access, Grammar_Parser.Tree.Lexer.File_Name, Ignore_Conflicts)); + + declare + use WisiToken.Generate.Tree_Sitter; + TS_Tree : Syntax_Trees.Tree; + begin + Syntax_Trees.Copy_Tree + (Source => Grammar_Parser.Tree, + Destination => TS_Tree, + User_Data => Input_Data'Unchecked_Access); - procedure Translate (Tree : in out Syntax_Trees.Tree) - is begin if Trace_Generate > Outline then - Ada.Text_IO.New_Line; - Ada.Text_IO.Put_Line ("output tree_sitter grammar"); + Trace.Put_Line ("post-parse tree_sitter grammar tree OTHER"); end if; - Eliminate_Empty_Productions (Input_Data, Tree); + -- FIXME: something is screwing up augmented; if we don't clear it + -- here, finalizing the other two trees crashes on a double free of + -- some augmented. + TS_Tree.Clear_Augmented; + + Eliminate_Empty_Productions (Input_Data, TS_Tree, No_Empty => Tuple.Out_Lang /= None); Print_Tree_Sitter (Input_Data, - Tree, - Tree.Lexer, - Output_File_Name => -Output_File_Name_Root & ".js", + TS_Tree, + TS_Tree.Lexer, + Output_File_Name => -Grammar_File_Name_Base & ".js", Language_Name => -Language_Name); if WisiToken.Generate.Error then -- FIXME: support --warning=error raise WisiToken.Grammar_Error with "errors during translating grammar to tree-sitter: aborting"; end if; - end Translate; - begin - Translate (Grammar_Parser.Tree); + end; - Create_Test_Main (-Output_File_Name_Root); - end; + when LR_Packrat_Generate_Algorithm => + Parse_Check + (Lexer => Tuple.Lexer, + Parser => Tuple.Gen_Alg, + Phase => WisiToken_Grammar_Runtime.Other); - when LR_Packrat_Generate_Algorithm => - Parse_Check - (Lexer => Tuple.Lexer, - Parser => Tuple.Gen_Alg, - Phase => WisiToken_Grammar_Runtime.Other); + Generate_Data := new WisiToken.BNF.Generate_Utils.Generate_Data' + (WisiToken.BNF.Generate_Utils.Initialize + (Input_Data'Unchecked_Access, Grammar_Parser.Tree.Lexer.File_Name, Ignore_Conflicts)); - declare - use all type WisiToken.Parse.LR.Parse_Table_Ptr; - use Ada.Real_Time; - - Time_Start : Time; - Time_End : Time; - - -- We could use a cached Generate_Data if not - -- (Input_Data.If_Lexer_Present or Input_Data.If_Parser_Present), but - -- that would not save much time, and would complicate this logic. We - -- do cache Recursions. - Generate_Data : aliased WisiToken.BNF.Generate_Utils.Generate_Data := - WisiToken.BNF.Generate_Utils.Initialize - (Input_Data'Unchecked_Access, Grammar_Parser.Tree.Lexer.File_Name, Ignore_Conflicts); - - Packrat_Data : WisiToken.Generate.Packrat.Data - (Generate_Data.Descriptor.First_Terminal, Generate_Data.Descriptor.First_Nonterminal, - Generate_Data.Descriptor.Last_Nonterminal); - - Parse_Table_File_Name : constant String := - (if Tuple.Gen_Alg in LALR .. Packrat_Proc - then -Output_File_Name_Root & "_" & To_Lower (Tuple.Gen_Alg'Image) & + declare + use all type WisiToken.Parse.LR.Parse_Table_Ptr; + use Ada.Real_Time; + + Parse_Table_File_Name : constant String := -Grammar_File_Name_Base & + "_" & To_Lower (Tuple.Gen_Alg'Image) & (if Input_Data.If_Lexer_Present then "_" & Lexer_Image (Input_Data.User_Lexer).all - else "") & - ".parse_table" - else ""); - - procedure Parse_Table_Append_Stats - is - Parse_Table_File : File_Type; - begin - Open (Parse_Table_File, Append_File, Parse_Table_File_Name); - Set_Output (Parse_Table_File); - Generate_Data.Parser_State_Count := - Generate_Data.LR_Parse_Table.State_Last - Generate_Data.LR_Parse_Table.State_First + 1; - WisiToken.BNF.Generate_Utils.Put_Stats (Input_Data, Generate_Data); - Set_Output (Standard_Output); - Close (Parse_Table_File); - end Parse_Table_Append_Stats; - - begin - if not Lexer_Done (Input_Data.User_Lexer) then - Lexer_Done (Input_Data.User_Lexer) := True; - case Input_Data.User_Lexer is - when re2c_Lexer => - WisiToken.BNF.Output_Ada_Common.Create_re2c_File - (Input_Data, Tuple, Generate_Data, -Output_File_Name_Root); - when others => - null; - end case; - end if; - - case LR_Packrat_Generate_Algorithm'(Tuple.Gen_Alg) is - when LALR => + else "") & ".parse_table"; - Time_Start := Clock; + Time_Start : Time; + Time_End : Time; - if Generate_Data.Grammar (Generate_Data.Descriptor.Accept_ID).LHS = Invalid_Token_ID then + procedure Parse_Table_Append_Stats + is + Parse_Table_File : File_Type; + begin + Open (Parse_Table_File, Append_File, Parse_Table_File_Name); + Set_Output (Parse_Table_File); + Generate_Data.Parser_State_Count := + Generate_Data.LR_Parse_Table.State_Last - Generate_Data.LR_Parse_Table.State_First + 1; + WisiToken.BNF.Generate_Utils.Put_Stats (Input_Data, Generate_Data.all); + Set_Output (Standard_Output); + Close (Parse_Table_File); + end Parse_Table_Append_Stats; + + function To_McKenzie return WisiToken.Parse.LR.McKenzie_Param_Type + is begin + return Generate_Utils.To_McKenzie_Param (Generate_Data.all, Input_Data.McKenzie_Recover); + exception + when E : Not_Found => WisiToken.Generate.Put_Error (WisiToken.Generate.Error_Message (Grammar_Parser.Tree.Lexer.File_Name, 1, - "%start token not specified or not found; no LALR parse table generated")); - else - if Trace_Generate > Outline then - Trace.Put_Line ("generate LALR parse table"); - end if; + "In some %mckenzie_*; " & Ada.Exceptions.Exception_Message (E))); + return WisiToken.Parse.LR.Default_McKenzie_Param; + end To_McKenzie; - Generate_Data.LR_Parse_Table := WisiToken.Generate.LR.LALR_Generate.Generate - (Generate_Data.Grammar, - Generate_Data.Descriptor.all, - Grammar_Parser.Tree.Lexer.File_Name, - Input_Data.Language_Params.Error_Recover, - Generate_Data.Conflicts, - Generate_Utils.To_McKenzie_Param (Generate_Data, Input_Data.McKenzie_Recover), - Input_Data.Max_Parallel, - Parse_Table_File_Name, - Include_Extra => Test_Main, - Ignore_Conflicts => Ignore_Conflicts, - Recursion_Strategy => Input_Data.Language_Params.Recursion_Strategy, - Use_Cached_Recursions => not (Input_Data.If_Lexer_Present or Input_Data.If_Parser_Present), - Recursions => Cached_Recursions); - - if WisiToken.Trace_Time then - Time_End := Clock; - - Put_Line - (Standard_Error, - "LALR " & Lexer_Image (Tuple.Lexer).all & " generate time:" & - Duration'Image (To_Duration (Time_End - Time_Start))); - end if; - - if Parse_Table_File_Name /= "" then - Parse_Table_Append_Stats; - end if; + begin + if not Lexer_Done (Input_Data.User_Lexer) then + Lexer_Done (Input_Data.User_Lexer) := True; + case Input_Data.User_Lexer is + when re2c_Lexer => + WisiToken.BNF.Output_Ada_Common.Create_re2c_File + (Input_Data, Tuple, Generate_Data.all, -Grammar_File_Name_Base); + when others => + null; + end case; end if; - when LR1 => - Time_Start := Clock; + case LR_Packrat_Generate_Algorithm'(Tuple.Gen_Alg) is + when LALR => + + Time_Start := Clock; + + if Generate_Data.Grammar (Generate_Data.Descriptor.Accept_ID).LHS = Invalid_Token_ID then + WisiToken.Generate.Put_Error + (WisiToken.Generate.Error_Message + (Grammar_Parser.Tree.Lexer.File_Name, 1, + "%start token not specified or not found; no LALR parse table generated")); + else + if Trace_Generate > Outline then + Trace.Put_Line ("generate LALR parse table"); + + if Trace_Generate > Detail or Trace_Generate_Conflicts > Detail then + Trace.New_Line; + Trace.Put_Line ("Tokens:"); + WisiToken.Put_Tokens (Generate_Data.Descriptor.all); + Trace.Put_Line ("Precedences:"); + WisiToken.Put (Input_Data.Precedence_Lists, Input_Data.Precedence_Map); + Trace.Put_Line ("grammar:"); + WisiToken.Productions.Put (Generate_Data.Grammar, Generate_Data.Descriptor.all); + Trace.New_Line; + if Trace_Generate > Extra or Trace_Generate_Conflicts > Extra then + Trace.Put_Line ("tree:"); + Grammar_Parser.Tree.Print_Tree; + Trace.New_Line; + end if; + end if; + end if; - if Generate_Data.Grammar (Generate_Data.Descriptor.Accept_ID).LHS = Invalid_Token_ID then - WisiToken.Generate.Put_Error - (WisiToken.Generate.Error_Message - (Grammar_Parser.Tree.Lexer.File_Name, 1, - "%start token not specified or not found; no LALR parse table generated")); - else - if Trace_Generate > Outline then - Trace.Put_Line ("generate LR1 parse table"); - end if; + Generate_Data.LR_Parse_Table := WisiToken.Generate.LR.LALR_Generate.Generate + (Generate_Data.Grammar, + Input_Data.Precedence_Lists, + Generate_Data.Descriptor.all, + Grammar_Parser.Tree.Lexer.File_Name, + Input_Data.Language_Params.Error_Recover, + Generate_Data.Conflicts, + To_McKenzie, + Input_Data.Max_Parallel, + Parse_Table_File_Name, + Include_Extra => Test_Main, + Ignore_Conflicts => Ignore_Conflicts, + Recursion_Strategy => Input_Data.Language_Params.Recursion_Strategy, + Use_Cached_Recursions => not (Input_Data.If_Lexer_Present or Input_Data.If_Parser_Present), + Recursions => Cached_Recursions); + + if WisiToken.Trace_Time then + Time_End := Clock; + + Put_Line + (Standard_Error, + "LALR " & Lexer_Image (Tuple.Lexer).all & " generate time:" & + Duration'Image (To_Duration (Time_End - Time_Start))); + end if; - Generate_Data.LR_Parse_Table := WisiToken.Generate.LR.LR1_Generate.Generate - (Generate_Data.Grammar, - Generate_Data.Descriptor.all, - Grammar_Parser.Tree.Lexer.File_Name, - Input_Data.Language_Params.Error_Recover, - Generate_Data.Conflicts, - Generate_Utils.To_McKenzie_Param (Generate_Data, Input_Data.McKenzie_Recover), - Input_Data.Max_Parallel, - Parse_Table_File_Name, - Include_Extra => Test_Main, - Ignore_Conflicts => Ignore_Conflicts, - Recursion_Strategy => Input_Data.Language_Params.Recursion_Strategy, - Use_Cached_Recursions => not (Input_Data.If_Lexer_Present or Input_Data.If_Parser_Present), - Recursions => Cached_Recursions); - - if Trace_Time then - Time_End := Clock; - - Put_Line - (Standard_Error, - "LR1 " & Lexer_Image (Tuple.Lexer).all & " generate time:" & - Duration'Image (To_Duration (Time_End - Time_Start))); + Parse_Table_Append_Stats; end if; - if Parse_Table_File_Name /= "" then + when LR1 => + Time_Start := Clock; + + if Generate_Data.Grammar (Generate_Data.Descriptor.Accept_ID).LHS = Invalid_Token_ID then + WisiToken.Generate.Put_Error + (WisiToken.Generate.Error_Message + (Grammar_Parser.Tree.Lexer.File_Name, 1, + "%start token not specified or not found; no LALR parse table generated")); + else + if Trace_Generate > Outline then + Trace.Put_Line ("generate LR1 parse table"); + end if; + + Generate_Data.LR_Parse_Table := WisiToken.Generate.LR.LR1_Generate.Generate + (Generate_Data.Grammar, + Input_Data.Precedence_Lists, + Generate_Data.Descriptor.all, + Grammar_Parser.Tree.Lexer.File_Name, + Input_Data.Language_Params.Error_Recover, + Generate_Data.Conflicts, + To_McKenzie, + Input_Data.Max_Parallel, + Parse_Table_File_Name, + Include_Extra => Test_Main, + Ignore_Conflicts => Ignore_Conflicts, + Recursion_Strategy => Input_Data.Language_Params.Recursion_Strategy, + Use_Cached_Recursions => not (Input_Data.If_Lexer_Present or Input_Data.If_Parser_Present), + Recursions => Cached_Recursions); + + if Trace_Time then + Time_End := Clock; + + Put_Line + (Standard_Error, + "LR1 " & Lexer_Image (Tuple.Lexer).all & " generate time:" & + Duration'Image (To_Duration (Time_End - Time_Start))); + end if; + Parse_Table_Append_Stats; end if; - end if; - when Packrat_Generate_Algorithm => - -- The only significant computation done for Packrat is First, done - -- in Initialize; not worth timing. + when Packrat_Generate_Algorithm => + -- The only significant computation done for Packrat is First, done + -- in Initialize; not worth timing. - Packrat_Data := WisiToken.Generate.Packrat.Initialize - (Grammar_Parser.Tree.Lexer.File_Name, Generate_Data.Grammar, Generate_Data.Source_Line_Map, - Generate_Data.Descriptor.First_Terminal); + Packrat_Data := new WisiToken.Generate.Packrat.Data' + (WisiToken.Generate.Packrat.Initialize + (Grammar_Parser.Tree.Lexer.File_Name, Generate_Data.Grammar, Generate_Data.Source_Line_Map, + Generate_Data.Descriptor.First_Terminal)); - if Parse_Table_File_Name /= "" then declare + -- There is no parse_table for packrat, but it's useful to have a + -- definitive list of tokens and productions (after all %if are + -- processed). Parse_Table_File : File_Type; begin Create (Parse_Table_File, Out_File, Parse_Table_File_Name); @@ -664,59 +671,64 @@ begin Set_Output (Standard_Output); Close (Parse_Table_File); end; - end if; - Packrat_Data.Check_All (Generate_Data.Descriptor.all, Input_Data.Suppress); + Packrat_Data.Check_All (Generate_Data.Descriptor.all, Input_Data.Suppress); + + if WisiToken.Generate.Warning then + WisiToken.Generate.Put_Warning ("warnings during packrat generation"); + end if; + end case; - if WisiToken.Generate.Warning then - WisiToken.Generate.Put_Warning ("warnings during packrat generation"); + if WisiToken.Generate.Error then + raise WisiToken.Grammar_Error with "errors: aborting"; end if; - end case; - if WisiToken.Generate.Error then - raise WisiToken.Grammar_Error with "errors: aborting"; - end if; + case Tuple.Gen_Alg is + when LR_Generate_Algorithm => + pragma Assert + (Generate_Data.LR_Parse_Table /= null and then + Generate_Data.LR_Parse_Table.Error_Recover_Enabled = + Input_Data.Language_Params.Error_Recover); + + if Tuple.Text_Rep then + WisiToken.Generate.LR.Put_Text_Rep + (Generate_Data.LR_Parse_Table.all, + Text_Rep_File_Name (-Grammar_File_Name_Base, Tuple, Input_Data.If_Lexer_Present)); + end if; - case Tuple.Gen_Alg is - when LR_Generate_Algorithm => - pragma Assert - (Generate_Data.LR_Parse_Table /= null and then - Generate_Data.LR_Parse_Table.Error_Recover_Enabled = Input_Data.Language_Params.Error_Recover); + when others => + null; + end case; + end; + end case; - if Tuple.Text_Rep then - WisiToken.Generate.LR.Put_Text_Rep - (Generate_Data.LR_Parse_Table.all, - Text_Rep_File_Name (-Output_File_Name_Root, Tuple, Input_Data.If_Lexer_Present)); - end if; + case Tuple.Out_Lang is + when None => + null; - when others => - null; - end case; + when Ada_Lang => + if Trace_Generate > Outline then + Trace.Put_Line ("output Ada"); + end if; - case Tuple.Out_Lang is - when Ada_Lang => - if Trace_Generate > Outline then - Trace.Put_Line ("output Ada"); - end if; + WisiToken.BNF.Output_Ada + (Input_Data, Grammar_Parser.Tree.Lexer.File_Name, -Grammar_File_Name_Base, Generate_Data.all, + Packrat_Data, Tuple, Test_Main, Multiple_Tuples, Need_Gen_Alg_In_Actions_Name); - WisiToken.BNF.Output_Ada - (Input_Data, Grammar_Parser.Tree.Lexer.File_Name, -Output_File_Name_Root, Generate_Data, - Packrat_Data, Tuple, Test_Main, Multiple_Tuples); + when Ada_Emacs_Lang => + if Trace_Generate > Outline then + Trace.Put_Line ("output Ada for Emacs"); + end if; + WisiToken.BNF.Output_Ada_Emacs + (Input_Data, Grammar_Parser.Tree.Lexer.File_Name, -Grammar_File_Name_Base, Generate_Data.all, + Packrat_Data, Tuple, Test_Main, Multiple_Tuples, Need_Gen_Alg_In_Actions_Name, -Language_Name); - when Ada_Emacs_Lang => - if Trace_Generate > Outline then - Trace.Put_Line ("output Ada for Emacs"); - end if; - WisiToken.BNF.Output_Ada_Emacs - (Input_Data, Grammar_Parser.Tree.Lexer.File_Name, -Output_File_Name_Root, Generate_Data, - Packrat_Data, Tuple, Test_Main, Multiple_Tuples, -Language_Name); + end case; - end case; - if WisiToken.Generate.Error then - raise WisiToken.Grammar_Error with "errors: aborting"; - end if; - end; - end case; + if WisiToken.Generate.Error then + raise WisiToken.Grammar_Error with "errors: aborting"; + end if; + end; end loop; end; exception diff --git a/wisitoken-bnf-generate_packrat.adb b/wisitoken-bnf-generate_packrat.adb index 2bc59eb..daebc36 100644 --- a/wisitoken-bnf-generate_packrat.adb +++ b/wisitoken-bnf-generate_packrat.adb @@ -6,7 +6,7 @@ -- -- See wisitoken-parse-packrat.ads. -- --- Copyright (C) 2018, 2020 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018, 2020 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -213,7 +213,7 @@ is end Finish; begin - Indent_Wrap_Comment (Productions.Image (Prod.LHS, RHS_Index, RHS.Tokens, Descriptor), Ada_Comment); + Indent_Wrap_Comment (Productions.Image (Prod.LHS, RHS_Index, RHS, Descriptor), Ada_Comment); Indent_Line ("Pos := Last_Pos;"); Indent_Line ("Next_Pos := Tree.Stream_Next (Tree.Shared_Stream, Pos);"); diff --git a/wisitoken-bnf-generate_utils.adb b/wisitoken-bnf-generate_utils.adb index 3b089c1..b831577 100644 --- a/wisitoken-bnf-generate_utils.adb +++ b/wisitoken-bnf-generate_utils.adb @@ -2,7 +2,7 @@ -- -- see spec -- --- Copyright (C) 2014, 2015, 2017 - 2022 All Rights Reserved. +-- Copyright (C) 2014, 2015, 2017 - 2023 All Rights Reserved. -- -- This program is free software; you can redistribute it and/or -- modify it under terms of the GNU General Public License as @@ -117,8 +117,10 @@ package body WisiToken.BNF.Generate_Utils is Data.Grammar.Set_First_Last (Descriptor.First_Nonterminal, Descriptor.Last_Nonterminal); Data.Source_Line_Map.Set_First_Last (Descriptor.First_Nonterminal, Descriptor.Last_Nonterminal); - Data.Action_Names := new Names_Array_Array (Descriptor.First_Nonterminal .. Descriptor.Last_Nonterminal); - Data.Check_Names := new Names_Array_Array (Descriptor.First_Nonterminal .. Descriptor.Last_Nonterminal); + Data.Post_Parse_Action_Names := new Names_Array_Array + (Descriptor.First_Nonterminal .. Descriptor.Last_Nonterminal); + Data.In_Parse_Action_Names := new Names_Array_Array + (Descriptor.First_Nonterminal .. Descriptor.Last_Nonterminal); pragma Assert (Descriptor.Accept_ID = Descriptor.First_Nonterminal); @@ -144,13 +146,13 @@ package body WisiToken.BNF.Generate_Utils is for Rule of Data.Tokens.Rules loop declare - RHS_Index : Natural := 0; - RHSs : WisiToken.Productions.RHS_Arrays.Vector; - LHS : Token_ID; -- not initialized for exception handler - Action_Names : Names_Array (0 .. Integer (Rule.Right_Hand_Sides.Length) - 1); - Action_All_Empty : Boolean := True; - Check_Names : Names_Array (0 .. Integer (Rule.Right_Hand_Sides.Length) - 1); - Check_All_Empty : Boolean := True; + RHS_Index : Natural := 0; + RHSs : WisiToken.Productions.RHS_Arrays.Vector; + LHS : Token_ID; -- not initialized for exception handler + Post_Parse_Action_Names : Names_Array (0 .. Integer (Rule.Right_Hand_Sides.Length) - 1); + Post_Parse_Action_All_Empty : Boolean := True; + In_Parse_Action_Names : Names_Array (0 .. Integer (Rule.Right_Hand_Sides.Length) - 1); + In_Parse_Action_All_Empty : Boolean := True; begin LHS := Find_Token_ID (Data, -Rule.Left_Hand_Side); @@ -174,15 +176,21 @@ package body WisiToken.BNF.Generate_Utils is end loop; end if; RHSs (RHS_Index) := - (Tokens => Tokens, Post_Parse_Action => null, In_Parse_Action => null, Recursion => <>); - if Length (Right_Hand_Side.Action) > 0 then - Action_All_Empty := False; - Action_Names (RHS_Index) := new String' + (Tokens => Tokens, + Post_Parse_Action => null, + In_Parse_Action => null, + Recursion => <>, + Associativity => Right_Hand_Side.Associativity, + Precedence => Right_Hand_Side.Precedence); + + if Length (Right_Hand_Side.Post_Parse_Action) > 0 then + Post_Parse_Action_All_Empty := False; + Post_Parse_Action_Names (RHS_Index) := new String' (-Rule.Left_Hand_Side & '_' & WisiToken.Trimmed_Image (RHS_Index)); end if; - if Length (Right_Hand_Side.Check) > 0 then - Check_All_Empty := False; - Check_Names (RHS_Index) := new String' + if Length (Right_Hand_Side.In_Parse_Action) > 0 then + In_Parse_Action_All_Empty := False; + In_Parse_Action_Names (RHS_Index) := new String' (-Rule.Left_Hand_Side & '_' & WisiToken.Trimmed_Image (RHS_Index) & "_check"); end if; @@ -197,13 +205,13 @@ package body WisiToken.BNF.Generate_Utils is RHS_Index := RHS_Index + 1; end loop; - Data.Grammar (LHS) := (LHS, Rule.Optimized_List, RHSs); + Data.Grammar (LHS) := (LHS, Rule.Optimized_List, RHSs, Rule.Precedence); - if not Action_All_Empty then - Data.Action_Names (LHS) := new Names_Array'(Action_Names); + if not Post_Parse_Action_All_Empty then + Data.Post_Parse_Action_Names (LHS) := new Names_Array'(Post_Parse_Action_Names); end if; - if not Check_All_Empty then - Data.Check_Names (LHS) := new Names_Array'(Check_Names); + if not In_Parse_Action_All_Empty then + Data.In_Parse_Action_Names (LHS) := new Names_Array'(In_Parse_Action_Names); end if; exception @@ -293,9 +301,11 @@ package body WisiToken.BNF.Generate_Utils is To_Grammar (Result, Grammar_File_Name, -Input_Data.Language_Params.Start_Token); Result.Ignore_Conflicts := Ignore_Conflicts; - Result.Conflicts := To_Conflicts - ((Result.Tokens, Descriptor_Access_Constant (Result.Descriptor)), Ignore_Conflicts, Input_Data.Conflicts, - Grammar_File_Name); + if Input_Data.User_Parser in LR_Generate_Algorithm then + Result.Conflicts := To_Conflicts + ((Result.Tokens, Descriptor_Access_Constant (Result.Descriptor)), Ignore_Conflicts, Input_Data.Conflicts, + Grammar_File_Name); + end if; if WisiToken.Generate.Error then raise WisiToken.Grammar_Error with "errors during initializing grammar: aborting"; @@ -350,10 +360,10 @@ package body WisiToken.BNF.Generate_Utils is end if; end if; - Input_Data.Reset; - Input_Data.Phase := WisiToken_Grammar_Runtime.Other; - Input_Data.User_Parser := Generate_Algorithm; - Input_Data.User_Lexer := Lexer; + Input_Data.Reset + (Phase => WisiToken_Grammar_Runtime.Other, + User_Parser => Generate_Algorithm, + User_Lexer => Lexer); Grammar_Parser.Execute_Actions; -- populates Input_Data.Tokens @@ -865,6 +875,9 @@ package body WisiToken.BNF.Generate_Utils is (Error_Message (Source_File_Name, Item.Source_Line, Ada.Exceptions.Exception_Message (E))); end if; + + when SAL.Duplicate_Key => + Put_Error (Error_Message (Source_File_Name, Item.Source_Line, "duplicate conflict")); end; end loop; return Result; @@ -935,8 +948,8 @@ package body WisiToken.BNF.Generate_Utils is New_Line; Put_Line (Integer'Image (Input_Data.Rule_Count) & " rules," & - Integer'Image (Input_Data.Action_Count) & " user actions," & - Integer'Image (Input_Data.Check_Count) & " checks," & + Integer'Image (Input_Data.Post_Parse_Action_Count) & " post_parse actions," & + Integer'Image (Input_Data.In_Parse_Action_Count) & " in_parse actions," & WisiToken.State_Index'Image (Generate_Data.Parser_State_Count) & " states"); end Put_Stats; diff --git a/wisitoken-bnf-generate_utils.ads b/wisitoken-bnf-generate_utils.ads index 7379308..6744f37 100644 --- a/wisitoken-bnf-generate_utils.ads +++ b/wisitoken-bnf-generate_utils.ads @@ -3,7 +3,7 @@ -- Utilities for translating input file structures to WisiToken -- structures needed for LALR.Generate. -- --- Copyright (C) 2014, 2015, 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2014, 2015, 2017 - 2023 Free Software Foundation, Inc. -- -- The WisiToken package is free software; you can redistribute it -- and/or modify it under terms of the GNU General Public License as @@ -40,12 +40,11 @@ package WisiToken.BNF.Generate_Utils is Descriptor : WisiToken.Descriptor_Access; Grammar : WisiToken.Productions.Prod_Arrays.Vector; - Action_Names : Names_Array_Array_Access; - Check_Names : Names_Array_Array_Access; - -- Names of subprograms for each grammar semantic action and check; - -- non-null only if there is an action or check in the grammar. + Post_Parse_Action_Names : Names_Array_Array_Access; + In_Parse_Action_Names : Names_Array_Array_Access; + -- Names of subprograms for each grammar post_parse and in_parse + -- action; non-null only if there is an action in the grammar. - Start_ID : WisiToken.Token_ID; Source_Line_Map : WisiToken.Productions.Source_Line_Maps.Vector; -- The following fields are LR specific; so far, it's not worth @@ -56,6 +55,7 @@ package WisiToken.BNF.Generate_Utils is LR_Parse_Table : WisiToken.Parse.LR.Parse_Table_Ptr; Parser_State_Count : WisiToken.Unknown_State_Index := 0; end record; + type Generate_Data_Access is access Generate_Data; function Initialize (Input_Data : in WisiToken_Grammar_Runtime.User_Data_Access; diff --git a/wisitoken-bnf-output_ada.adb b/wisitoken-bnf-output_ada.adb index 6069c84..9882a5f 100644 --- a/wisitoken-bnf-output_ada.adb +++ b/wisitoken-bnf-output_ada.adb @@ -4,7 +4,7 @@ -- parameters, and a parser for that grammar. The grammar parser -- actions must be Ada. -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- The WisiToken package is free software; you can redistribute it -- and/or modify it under terms of the GNU General Public License as @@ -27,19 +27,21 @@ with WisiToken.BNF.Generate_Packrat; with WisiToken.BNF.Generate_Utils; with WisiToken.BNF.Output_Ada_Common; use WisiToken.BNF.Output_Ada_Common; with WisiToken.Generate.Packrat; +with WisiToken.Generate.Tree_Sitter; with WisiToken_Grammar_Runtime; procedure WisiToken.BNF.Output_Ada - (Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; - Grammar_File_Name : in String; - Output_File_Name_Root : in String; - Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data; - Packrat_Data : in WisiToken.Generate.Packrat.Data; - Tuple : in Generate_Tuple; - Test_Main : in Boolean; - Multiple_Tuples : in Boolean) + (Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; + Grammar_File_Name : in String; + Output_File_Name_Root : in String; + Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data; + Packrat_Data : in WisiToken.Generate.Packrat.Data_Access; + Tuple : in Generate_Tuple; + Test_Main : in Boolean; + Multiple_Tuples : in Boolean; + Need_Gen_Alg_In_Actions_Name : in Boolean) is - Common_Data : Output_Ada_Common.Common_Data := WisiToken.BNF.Output_Ada_Common.Initialize - (Input_Data, Tuple, Grammar_File_Name, Output_File_Name_Root, Check_Interface => False); + Common_Data : constant Output_Ada_Common.Common_Data := WisiToken.BNF.Output_Ada_Common.Initialize + (Input_Data, Tuple, Grammar_File_Name, Check_Interface => False); Gen_Alg_Name : constant String := (if Test_Main or Multiple_Tuples @@ -57,8 +59,8 @@ is end Symbol_Regexp; procedure Create_Ada_Actions_Body - (Action_Names : not null access WisiToken.Names_Array_Array; - Check_Names : not null access WisiToken.Names_Array_Array; + (Post_Parse_Action_Names : not null access WisiToken.Names_Array_Array; + In_Parse_Action_Names : not null access WisiToken.Names_Array_Array; Label_Count : in Ada.Containers.Count_Type; Package_Name : in String) is @@ -67,15 +69,14 @@ is use Generate_Utils; use WisiToken.Generate; - File_Name : constant String := Output_File_Name_Root & "_actions.adb"; - User_Data_Regexp : constant Regexp := Compile (Symbol_Regexp ("User_Data"), Case_Sensitive => False); Tree_Regexp : constant Regexp := Compile (Symbol_Regexp ("Tree"), Case_Sensitive => False); Nonterm_Regexp : constant Regexp := Compile (Symbol_Regexp ("Nonterm"), Case_Sensitive => False); Body_File : File_Type; begin - Create (Body_File, Out_File, File_Name); + Create (Body_File, Out_File, To_Lower (Package_Name) & ".adb"); + Set_Output (Body_File); Indent := 1; Put_File_Header (Ada_Comment, Use_Tuple => True, Tuple => Tuple); @@ -88,7 +89,7 @@ is -- because some declared labels are not actually used in actions. The -- user will have to add 'with SAL;' in a code declaration. - if Input_Data.Check_Count > 0 then + if Input_Data.In_Parse_Action_Count > 0 then -- For Match_Names etc Indent_Line ("with WisiToken.In_Parse_Actions; use WisiToken.In_Parse_Actions;"); New_Line; @@ -100,7 +101,7 @@ is Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Actions_Body_Pre)); - -- generate Action and Check subprograms. + -- generate Post_Parse_Action and In_Parse_Action subprograms. for Rule of Input_Data.Tokens.Rules loop -- No need for a Token_Cursor here, since we only need the @@ -149,12 +150,12 @@ is begin for RHS of Rule.Right_Hand_Sides loop - if Length (RHS.Action) > 0 then + if Length (RHS.Post_Parse_Action) > 0 then declare - Line : constant String := -RHS.Action; + Line : constant String := -RHS.Post_Parse_Action; -- Actually multiple lines; we assume the formatting is adequate. - Name : constant String := Action_Names (LHS_ID)(RHS_Index).all; + Name : constant String := Post_Parse_Action_Names (LHS_ID)(RHS_Index).all; Unref_User_Data : Boolean := True; Unref_Tree : Boolean := True; @@ -212,11 +213,11 @@ is end; end if; - if Length (RHS.Check) > 0 then + if Length (RHS.In_Parse_Action) > 0 then declare use Ada.Strings.Fixed; - Line : constant String := -RHS.Check; - Name : constant String := Check_Names (LHS_ID)(RHS_Index).all; + Line : constant String := -RHS.In_Parse_Action; + Name : constant String := In_Parse_Action_Names (LHS_ID)(RHS_Index).all; Unref_Tree : constant Boolean := 0 = Index (Line, "Tree"); Unref_Nonterm : constant Boolean := 0 = Index (Line, "Nonterm"); Unref_Tokens : constant Boolean := 0 = Index (Line, "Tokens"); @@ -287,12 +288,12 @@ is is use WisiToken.Generate; - File_Name : constant String := To_Lower (Main_Package_Name) & ".adb"; - re2c_Package_Name : constant String := -Common_Data.Lower_File_Name_Root & "_re2c_c"; + -- This is lowercase to match the C name. + re2c_Package_Name : constant String := Output_File_Name_Root & "_re2c_c"; Body_File : File_Type; begin - Create (Body_File, Out_File, File_Name); + Create (Body_File, Out_File, To_Lower (Main_Package_Name) & ".adb"); Set_Output (Body_File); Indent := 1; @@ -348,13 +349,13 @@ is LR_Create_Create_Parser (Actions_Package_Name, Common_Data, Generate_Data); when Packrat_Gen => - WisiToken.BNF.Generate_Packrat (Packrat_Data, Generate_Data); + WisiToken.BNF.Generate_Packrat (Packrat_Data.all, Generate_Data); Create_Create_Productions (Generate_Data); - Packrat_Create_Create_Parser (Actions_Package_Name, Common_Data, Generate_Data, Packrat_Data); + Packrat_Create_Create_Parser (Actions_Package_Name, Common_Data, Generate_Data, Packrat_Data.all); when Packrat_Proc => Create_Create_Productions (Generate_Data); - Packrat_Create_Create_Parser (Actions_Package_Name, Common_Data, Generate_Data, Packrat_Data); + Packrat_Create_Create_Parser (Actions_Package_Name, Common_Data, Generate_Data, Packrat_Data.all); when External => External_Create_Create_Grammar (Generate_Data); @@ -368,7 +369,7 @@ is Set_Output (Standard_Output); end Create_Ada_Main_Body; - procedure Create_Ada_Test_Main (Main_Package_Name : in String) + procedure Create_LR_Test_Main (Main_Package_Name : in String) is use WisiToken.Generate; @@ -394,11 +395,9 @@ is Default_Language_Runtime_Package : constant String := "WisiToken.Parse.LR.McKenzie_Recover." & File_Name_To_Ada (Output_File_Name_Root); - File_Name : constant String := To_Lower (Unit_Name) & ".ads"; - File : File_Type; begin - Create (File, Out_File, File_Name); + Create (File, Out_File, To_Lower (Unit_Name) & ".ads"); Set_Output (File); Indent := 1; @@ -409,7 +408,7 @@ is Put_Line ("with " & Main_Package_Name & ";"); if Common_Data.Generate_Algorithm in LR_Generate_Algorithm and - Input_Data.Language_Params.Error_Recover and + Input_Data.Language_Params.Error_Recover and Input_Data.Language_Params.Use_Language_Runtime then declare @@ -425,6 +424,9 @@ is end if; Put_Line ("procedure " & Unit_Name & " is new " & Generic_Package_Name); + -- Just "Put" would be nicer here, but then we'd have to worry about + -- not outputing the leading spaces in the following. It's just a + -- test main. Put_Line (" ("); case Common_Data.Generate_Algorithm is when LR_Generate_Algorithm => @@ -450,7 +452,7 @@ is end case; Close (File); Set_Output (Standard_Output); - end Create_Ada_Test_Main; + end Create_LR_Test_Main; begin case Tuple.Interface_Kind is @@ -464,29 +466,43 @@ begin declare Main_Package_Name : constant String := File_Name_To_Ada (Output_File_Name_Root & Gen_Alg_Name) & "_Main"; - Actions_Package_Name : constant String := File_Name_To_Ada (Output_File_Name_Root) & "_Actions"; + Actions_Package_Name : constant String := File_Name_To_Ada (Output_File_Name_Root) & + (if Need_Gen_Alg_In_Actions_Name + then "_" & Generate_Algorithm_Image (Tuple.Gen_Alg).all + else "") & + "_Actions"; begin - if Input_Data.Action_Count > 0 or Input_Data.Check_Count > 0 then - -- Some WisiToken tests have no actions or checks. + if Input_Data.Post_Parse_Action_Count > 0 or Input_Data.In_Parse_Action_Count > 0 then + -- Some WisiToken tests have no post_parse or in_parse actions. Create_Ada_Actions_Body - (Generate_Data.Action_Names, Generate_Data.Check_Names, Input_Data.Label_Count, Actions_Package_Name); + (Generate_Data.Post_Parse_Action_Names, Generate_Data.In_Parse_Action_Names, Input_Data.Label_Count, + Actions_Package_Name); end if; - Create_Ada_Actions_Spec - (Output_File_Name_Root & "_actions.ads", Actions_Package_Name, Input_Data, Common_Data, Generate_Data); + Create_Ada_Actions_Spec (Actions_Package_Name, Input_Data, Common_Data, Generate_Data); - if Tuple.Gen_Alg = External then + case Tuple.Gen_Alg is + when None => + null; + + when External => Create_External_Main_Spec (Main_Package_Name, Tuple, Input_Data); Create_Ada_Main_Body (Actions_Package_Name, Main_Package_Name, Input_Data); - else + + when LR_Generate_Algorithm | Packrat_Generate_Algorithm => Create_Ada_Main_Body (Actions_Package_Name, Main_Package_Name, Input_Data); - Create_Ada_Main_Spec (To_Lower (Main_Package_Name) & ".ads", Main_Package_Name, Input_Data, Common_Data); + Create_Ada_Main_Spec (Main_Package_Name, Input_Data, Common_Data); if Test_Main then - Create_Ada_Test_Main (Main_Package_Name); + Create_LR_Test_Main (Main_Package_Name); end if; - end if; + + when Tree_Sitter => + -- FIXME: generate *_tree_sitter_main + WisiToken.Generate.Tree_Sitter.Create_Test_Main (Output_File_Name_Root); + + end case; end; exception diff --git a/wisitoken-bnf-output_ada_common.adb b/wisitoken-bnf-output_ada_common.adb index 853b690..651036f 100644 --- a/wisitoken-bnf-output_ada_common.adb +++ b/wisitoken-bnf-output_ada_common.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -86,11 +86,10 @@ package body WisiToken.BNF.Output_Ada_Common is -- Public subprograms in alphabetical order procedure Create_Ada_Actions_Spec - (Output_File_Name : in String; - Package_Name : in String; - Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; - Common_Data : in Output_Ada_Common.Common_Data; - Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data) + (Package_Name : in String; + Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; + Common_Data : in Output_Ada_Common.Common_Data; + Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data) is use Generate_Utils; @@ -99,7 +98,7 @@ package body WisiToken.BNF.Output_Ada_Common is Paren_Done : Boolean := False; Cursor : Token_Cursor := First (Generate_Data); begin - Create (Spec_File, Out_File, Output_File_Name); + Create (Spec_File, Out_File, To_Lower (Package_Name) & ".ads"); Set_Output (Spec_File); Indent := 1; @@ -110,10 +109,10 @@ package body WisiToken.BNF.Output_Ada_Common is Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Copyright_License)); New_Line; - if not (Input_Data.Action_Count > 0 or Input_Data.Check_Count > 0) then + if not (Input_Data.Post_Parse_Action_Count > 0 or Input_Data.In_Parse_Action_Count > 0) then Put_Line ("with WisiToken;"); end if; - if Input_Data.Action_Count > 0 or Input_Data.Check_Count > 0 then + if Input_Data.Post_Parse_Action_Count > 0 or Input_Data.In_Parse_Action_Count > 0 then Put_Line ("with WisiToken.Syntax_Trees;"); end if; Put_Raw_Code (Ada_Comment, Input_Data.Raw_Code (Actions_Spec_Context)); @@ -200,7 +199,7 @@ package body WisiToken.BNF.Output_Ada_Common is end if; - for Name_List of Generate_Data.Action_Names.all loop + for Name_List of Generate_Data.Post_Parse_Action_Names.all loop if Name_List /= null then for Name of Name_List.all loop if Name /= null then @@ -213,7 +212,7 @@ package body WisiToken.BNF.Output_Ada_Common is end if; end loop; - for Name_List of Generate_Data.Check_Names.all loop + for Name_List of Generate_Data.In_Parse_Action_Names.all loop if Name_List /= null then for Name of Name_List.all loop if Name /= null then @@ -240,8 +239,7 @@ package body WisiToken.BNF.Output_Ada_Common is end Create_Ada_Actions_Spec; procedure Create_Ada_Main_Spec - (Output_File_Name : in String; - Main_Package_Name : in String; + (Main_Package_Name : in String; Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; Common_Data : in Output_Ada_Common.Common_Data) is @@ -300,7 +298,7 @@ package body WisiToken.BNF.Output_Ada_Common is raise SAL.Programmer_Error; end if; - Create (Spec_File, Out_File, Output_File_Name); + Create (Spec_File, Out_File, To_Lower (Main_Package_Name) & ".ads"); Set_Output (Spec_File); Indent := 1; @@ -383,10 +381,9 @@ package body WisiToken.BNF.Output_Ada_Common is Tuple : in Generate_Tuple; Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type) is - File_Name : constant String := To_Lower (Main_Package_Name) & ".ads"; Spec_File : File_Type; begin - Create (Spec_File, Out_File, File_Name); + Create (Spec_File, Out_File, To_Lower (Main_Package_Name) & ".ads"); Set_Output (Spec_File); Indent := 1; @@ -648,9 +645,9 @@ package body WisiToken.BNF.Output_Ada_Common is end Create_LR_Parser_Table; procedure LR_Create_Create_Parse_Table - (Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; - Common_Data : in out Output_Ada_Common.Common_Data; - Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data) + (Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; + Common_Data : in Output_Ada_Common.Common_Data; + Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data) is Table : WisiToken.Parse.LR.Parse_Table_Ptr renames Generate_Data.LR_Parse_Table; begin @@ -706,9 +703,9 @@ package body WisiToken.BNF.Output_Ada_Common is end LR_Create_Create_Parse_Table; procedure LR_Create_Create_Parser - (Actions_Package_Name : in String; - Common_Data : in out Output_Ada_Common.Common_Data; - Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data) + (Actions_Package_Name : in String; + Common_Data : in Output_Ada_Common.Common_Data; + Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data) is Parser_Type : constant String := "WisiToken.Parse.LR.Parser" & @@ -765,10 +762,10 @@ package body WisiToken.BNF.Output_Ada_Common is end LR_Create_Create_Parser; procedure Packrat_Create_Create_Parser - (Actions_Package_Name : in String; - Common_Data : in out Output_Ada_Common.Common_Data; - Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data; - Packrat_Data : in WisiToken.Generate.Packrat.Data) + (Actions_Package_Name : in String; + Common_Data : in Output_Ada_Common.Common_Data; + Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data; + Packrat_Data : in WisiToken.Generate.Packrat.Data) is Descriptor : WisiToken.Descriptor renames Generate_Data.Descriptor.all; @@ -841,7 +838,7 @@ package body WisiToken.BNF.Output_Ada_Common is Indent := Indent - 3; Indent_Line ("begin"); Indent := Indent + 3; - WisiToken.BNF.Generate_Grammar (Generate_Data.Grammar, Generate_Data.Action_Names.all); + WisiToken.BNF.Generate_Grammar (Generate_Data.Grammar, Generate_Data.Post_Parse_Action_Names.all); Indent_Line ("return Parser : WisiToken.Parse.Packrat.Procedural.Parser (" & @@ -873,7 +870,7 @@ package body WisiToken.BNF.Output_Ada_Common is Indent := Indent + 3; Indent_Line ("return Grammar : WisiToken.Productions.Prod_Arrays.Vector do"); Indent := Indent + 3; - WisiToken.BNF.Generate_Grammar (Generate_Data.Grammar, Generate_Data.Action_Names.all); + WisiToken.BNF.Generate_Grammar (Generate_Data.Grammar, Generate_Data.Post_Parse_Action_Names.all); Indent := Indent - 3; Indent_Line ("end return;"); Indent := Indent - 3; @@ -906,8 +903,8 @@ package body WisiToken.BNF.Output_Ada_Common is Actions_Present := True; end if; - if Generate_Data.Check_Names (P.LHS) /= null or - Generate_Data.Action_Names (P.LHS) /= null + if Generate_Data.In_Parse_Action_Names (P.LHS) /= null or + Generate_Data.Post_Parse_Action_Names (P.LHS) /= null then Indent_Line ("Result (" & Trimmed_Image (P.LHS) & ").RHSs.Set_First_Last (" & @@ -915,7 +912,7 @@ package body WisiToken.BNF.Output_Ada_Common is Trimmed_Image (P.RHSs.Last_Index) & ");"); for J in P.RHSs.First_Index .. P.RHSs.Last_Index loop - if Generate_Data.Check_Names (P.LHS) = null then + if Generate_Data.In_Parse_Action_Names (P.LHS) = null then Indent_Line ("Result (" & Trimmed_Image (P.LHS) & ").RHSs (" & Trimmed_Image (J) & ").In_Parse_Action := null;"); @@ -923,11 +920,11 @@ package body WisiToken.BNF.Output_Ada_Common is Actions_Present := True; Indent_Line ("Result (" & Trimmed_Image (P.LHS) & ").RHSs (" & Trimmed_Image (J) & ").In_Parse_Action := " & - (if Generate_Data.Check_Names (P.LHS)(J) = null then "null" - else Generate_Data.Check_Names (P.LHS)(J).all & "'Access") & + (if Generate_Data.In_Parse_Action_Names (P.LHS)(J) = null then "null" + else Generate_Data.In_Parse_Action_Names (P.LHS)(J).all & "'Access") & ";"); end if; - if Generate_Data.Action_Names (P.LHS) = null then + if Generate_Data.Post_Parse_Action_Names (P.LHS) = null then Indent_Line ("Result (" & Trimmed_Image (P.LHS) & ").RHSs (" & Trimmed_Image (J) & ").Post_Parse_Action := null;"); @@ -936,8 +933,8 @@ package body WisiToken.BNF.Output_Ada_Common is Indent_Line ("Result (" & Trimmed_Image (P.LHS) & ").RHSs (" & Trimmed_Image (J) & ").Post_Parse_Action := " & - (if Generate_Data.Action_Names (P.LHS)(J) = null then "null" - else Generate_Data.Action_Names (P.LHS)(J).all & "'Access") & + (if Generate_Data.Post_Parse_Action_Names (P.LHS)(J) = null then "null" + else Generate_Data.Post_Parse_Action_Names (P.LHS)(J).all & "'Access") & ";"); end if; end loop; @@ -1349,9 +1346,8 @@ package body WisiToken.BNF.Output_Ada_Common is Close (File); declare + -- This is lowercase to match the C file. Ada_Name : constant String := Output_File_Name_Root & "_re2c_c"; - -- Output_File_Name_Root is the file name of the grammar file - - -- assume it is a legal Ada name. begin Create (File, Out_File, Output_File_Name_Root & "_re2c_c.ads"); Set_Output (File); @@ -1447,7 +1443,7 @@ package body WisiToken.BNF.Output_Ada_Common is Kind (Generate_Data, I) = "comment-one-line" or Kind (Generate_Data, I) = "string-double-one-line" or Kind (Generate_Data, I) = "string-single-one-line" - -- comment-one-line, strings do not always contain a new_line, but + -- comment-one-line strings do not always contain a new_line, but -- the preconditions in WisiToken.Lexer guarantee it does if we ask -- for Line_Begin_Char_Pos from one. then @@ -2105,7 +2101,6 @@ package body WisiToken.BNF.Output_Ada_Common is (Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; Tuple : in Generate_Tuple; Grammar_File_Name : in String; - Output_File_Root : in String; Check_Interface : in Boolean) return Common_Data is begin @@ -2132,8 +2127,6 @@ package body WisiToken.BNF.Output_Ada_Common is end if; Data.Text_Rep := Tuple.Text_Rep; - - Data.Lower_File_Name_Root := +To_Lower (Output_File_Root); end return; end Initialize; diff --git a/wisitoken-bnf-output_ada_common.ads b/wisitoken-bnf-output_ada_common.ads index 005cfdc..10a4d72 100644 --- a/wisitoken-bnf-output_ada_common.ads +++ b/wisitoken-bnf-output_ada_common.ads @@ -2,7 +2,7 @@ -- -- Types and operations shared by Ada and Ada_Emacs outputs. -- --- Copyright (C) 2017, 2018, 2020 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017, 2018, 2020 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -31,30 +31,25 @@ package WisiToken.BNF.Output_Ada_Common is Output_Language : Ada_Output_Language; Interface_Kind : Valid_Interface; Text_Rep : Boolean; - - Lower_File_Name_Root : Standard.Ada.Strings.Unbounded.Unbounded_String; end record; function Initialize (Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; Tuple : in Generate_Tuple; Grammar_File_Name : in String; - Output_File_Root : in String; Check_Interface : in Boolean) return Common_Data; function File_Name_To_Ada (File_Name : in String) return String; procedure Create_Ada_Actions_Spec - (Output_File_Name : in String; - Package_Name : in String; - Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; - Common_Data : in Output_Ada_Common.Common_Data; - Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data); + (Package_Name : in String; + Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; + Common_Data : in Output_Ada_Common.Common_Data; + Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data); procedure Create_Ada_Main_Spec - (Output_File_Name : in String; - Main_Package_Name : in String; + (Main_Package_Name : in String; Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; Common_Data : in Output_Ada_Common.Common_Data) with Pre => Common_Data.Generate_Algorithm /= External; @@ -65,23 +60,23 @@ package WisiToken.BNF.Output_Ada_Common is Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type); procedure LR_Create_Create_Parse_Table - (Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; - Common_Data : in out Output_Ada_Common.Common_Data; - Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data); + (Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; + Common_Data : in Output_Ada_Common.Common_Data; + Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data); -- If not Common_Data.Text_Rep, includes LR parse table in generated -- source. Otherwise, includes call to LR.Get_Text_Rep; caller must -- call Put_Text_Rep to create file. procedure LR_Create_Create_Parser - (Actions_Package_Name : in String; - Common_Data : in out Output_Ada_Common.Common_Data; - Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data); + (Actions_Package_Name : in String; + Common_Data : in Output_Ada_Common.Common_Data; + Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data); procedure Packrat_Create_Create_Parser - (Actions_Package_Name : in String; - Common_Data : in out Output_Ada_Common.Common_Data; - Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data; - Packrat_Data : in WisiToken.Generate.Packrat.Data); + (Actions_Package_Name : in String; + Common_Data : in Output_Ada_Common.Common_Data; + Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data; + Packrat_Data : in WisiToken.Generate.Packrat.Data); procedure External_Create_Create_Grammar (Generate_Data : in WisiToken.BNF.Generate_Utils.Generate_Data); diff --git a/wisitoken-bnf-output_ada_emacs.adb b/wisitoken-bnf-output_ada_emacs.adb index 7d386ae..0dd2ed7 100644 --- a/wisitoken-bnf-output_ada_emacs.adb +++ b/wisitoken-bnf-output_ada_emacs.adb @@ -12,7 +12,7 @@ -- If run in an Emacs dynamically loaded module, the parser actions -- call the elisp actions directly. -- --- Copyright (C) 2012 - 2015, 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2012 - 2015, 2017 - 2023 Free Software Foundation, Inc. -- -- The WisiToken package is free software; you can redistribute it -- and/or modify it under terms of the GNU General Public License as @@ -28,6 +28,7 @@ pragma License (Modified_GPL); +with Ada.Assertions; with Ada.Exceptions; with Ada.Strings.Fixed; with Ada.Strings.Maps; @@ -39,15 +40,16 @@ with WisiToken.BNF.Output_Elisp_Common; use WisiToken.BNF.Output_Elisp_Common; with WisiToken.Generate.Packrat; with WisiToken_Grammar_Runtime; procedure WisiToken.BNF.Output_Ada_Emacs - (Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; - Grammar_File_Name : in String; - Output_File_Name_Root : in String; - Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data; - Packrat_Data : in WisiToken.Generate.Packrat.Data; - Tuple : in Generate_Tuple; - Test_Main : in Boolean; - Multiple_Tuples : in Boolean; - Language_Name : in String) + (Input_Data : in WisiToken_Grammar_Runtime.User_Data_Type; + Grammar_File_Name : in String; + Output_File_Name_Root : in String; + Generate_Data : aliased in WisiToken.BNF.Generate_Utils.Generate_Data; + Packrat_Data : in WisiToken.Generate.Packrat.Data_Access; + Tuple : in Generate_Tuple; + Test_Main : in Boolean; + Multiple_Tuples : in Boolean; + Need_Gen_Alg_In_Actions_Name : in Boolean; + Language_Name : in String) is use all type Ada.Containers.Count_Type; @@ -56,8 +58,8 @@ is Blank_Set : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.To_Set (" "); Numeric : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.To_Set ("0123456789"); - Common_Data : Output_Ada_Common.Common_Data := WisiToken.BNF.Output_Ada_Common.Initialize - (Input_Data, Tuple, Grammar_File_Name, Output_File_Name_Root, Check_Interface => True); + Common_Data : constant Output_Ada_Common.Common_Data := WisiToken.BNF.Output_Ada_Common.Initialize + (Input_Data, Tuple, Grammar_File_Name, Check_Interface => True); Gen_Alg_Name : constant String := (if Test_Main or Multiple_Tuples @@ -159,17 +161,23 @@ is end Split_Sexp; procedure Create_Ada_Action - (Name : in String; - RHS : in RHS_Type; - Prod_ID : in WisiToken.Production_ID; - Unsplit_Lines : in Ada.Strings.Unbounded.Unbounded_String; - Labels : in String_Arrays.Vector; - Empty : out Boolean; - Check : in Boolean) + (Name : in String; + RHS : in RHS_Type; + Prod_ID : in WisiToken.Production_ID; + Unsplit_Lines : in Ada.Strings.Unbounded.Unbounded_String; + Rule : in BNF.Rule_Type; + Empty : out Boolean; + In_Parse_Action : in Boolean) is - -- Create Action (if Check = False; Lines must be RHS.Action) or - -- Check (if Check = True; Lines must be RHS.Check) subprogram named - -- Name for RHS. + use all type SAL.Base_Peek_Type; + + -- Create Post_Parse_Action (if In_Parse_Action = False; Lines must + -- be RHS.Action) or In_Parse_Action (if In_Parse_Action = True; + -- Lines must be RHS.In_Parse_Action) subprogram named Name for RHS. + -- + -- Labels is collection of all labels used in any RHS in the nonterm; + -- _not_ in RHS token order. RHS.Tokens(I).Label contains explicit + -- and automatic token labels. use Ada.Strings; use Ada.Strings.Fixed; @@ -184,38 +192,72 @@ is Space_Paren_Set : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.To_Set ("])") or Blank_Set; - Navigate_Lines : String_Lists.List; - Face_Line : Unbounded_String; - Indent_Action_Line : Unbounded_String; - Check_Line : Unbounded_String; + Navigate_Lines : String_Lists.List; + Face_Line : Unbounded_String; + Indent_Action_Line : Unbounded_String; + In_Parse_Action_Line : Unbounded_String; - Label_Needed : array (Labels.First_Index .. Labels.Last_Index) of Boolean := (others => False); + Label_Needed : array (Rule.Labels.First_Index .. Rule.Labels.Last_Index) of Boolean := (others => False); Nonterm_Needed : Boolean := False; - Last_Token_Index : Base_Identifier_Index := 0; - function Next_Token_Label return String - is begin - -- Only called from Indent_Params when RHS.Auto_Token_Labels is True. - Last_Token_Index := @ + 1; - return "T" & Trimmed_Image (Last_Token_Index); - end Next_Token_Label; + function Find_RHS (RHS_Index : in Natural) return RHS_Lists.Cursor + is + use RHS_Lists; + Result : Cursor := Rule.Right_Hand_Sides.First; + begin + for I in 1 .. RHS_Index loop + Next (Result); + end loop; + return Result; + end Find_RHS; + + EBNF_RHS : RHS_Type renames RHS_Lists.Element (Find_RHS (RHS.EBNF_RHS_Index)); function Get_Label (Token_Param : in String; Integer : in Boolean := False) return String - is begin + is + function Finish (Label : in String; Force_Integer : in Boolean) return String + is (if Force_Integer + then "Integer (" & Label & ")" + else Label); + + begin if RHS.Auto_Token_Labels then - return - (if Integer - then "Integer (T" & Token_Param & ")" - else "T" & Token_Param); + if 0 = Index (Token_Param, Numeric, Outside) then + -- Token_param is an integer token index, not a label + begin + declare + Index : constant Positive_Index_Type := Positive_Index_Type'Value (Token_Param); + Label : constant String := -EBNF_RHS.Tokens (Index).Label; + begin + if Label'Length = 0 then + return Finish (Token_Param, Force_Integer => False); + else + return Finish (Label, Force_Integer => Integer); + end if; + end; + exception + when Ada.Assertions.Assertion_Error | Constraint_Error => + Put_Error + (Error_Message + (Grammar_File_Name, RHS.Source_Line, + "token index '" & Token_Param & "' not in range" & EBNF_RHS.Tokens.First_Index'Image & + " .." & EBNF_RHS.Tokens.Last_Index'Image)); + return ""; + end; + else + -- Token_Param is a label + return Finish (Token_Param, Force_Integer => Integer); + end if; else - return Token_Param; + return Finish + (Token_Param, Force_Integer => Integer and then (0 /= Index (Token_Param, Numeric, Outside))); end if; end Get_Label; procedure Mark_Label_Used (Label : in String) is begin - for I in Labels.First_Index .. Labels.Last_Index loop - if Label = Labels (I) then + for I in Rule.Labels.First_Index .. Rule.Labels.Last_Index loop + if Label = Rule.Labels (I) then Label_Needed (I) := True; end if; end loop; @@ -241,8 +283,8 @@ is return False; end if; - for I in Labels.First_Index .. Labels.Last_Index loop - if Label = Labels (I) then + for I in Rule.Labels.First_Index .. Rule.Labels.Last_Index loop + if Label = Rule.Labels (I) then Label_Needed (I) := True; return True; end if; @@ -252,7 +294,7 @@ is function Find_Token_Index (I : in Base_Identifier_Index) return SAL.Base_Peek_Type is - Rule_Label : constant String := -Labels (I); + Rule_Label : constant String := -Rule.Labels (I); begin for I in RHS.Tokens.First_Index .. RHS.Tokens.Last_Index loop if Length (RHS.Tokens (I).Label) > 0 and then @@ -585,7 +627,7 @@ is is -- If N is non-empty, it is the first arg in wisi-indent-action*, followed by ','. -- - -- Params is a vector, one item for each token in Tokens. Each item is one of: + -- Params is a vector, one item for each token in EBNF tokens. Each item is one of: -- -- - an integer; copy to output -- @@ -596,6 +638,11 @@ is -- - a vector with two elements [code_indent comment_indent]; convert to Indent_Pair. -- -- - a cons of a token label with any of the above. + -- + -- When EBNF is converted to BNF, one ENBF RHS is typically expanded + -- to several RHS, each missing some tokens. However, the action + -- still has indent parameters for all of the original tokens. They + -- are matched by the token labels. use Ada.Strings.Maps; use Ada.Containers; @@ -777,7 +824,7 @@ is Declared_Args_Last := Declared_Args'Last; end if; - Declared_Arg_Count := Count_Type'Value + Declared_Arg_Count := Count_Type'Value (Declared_Args (Declared_Args_First .. Declared_Args_Last)); Get_Next_Token_Arg; @@ -900,16 +947,25 @@ is end if; end Ensure_Indent_Param; - Param_Label_Count : Ada.Containers.Count_Type := 0; + RHS_Token_Index : SAL.Base_Peek_Type := RHS.Tokens.First_Index; -- Index of current token in current RHS. - procedure One_Param (Label : in String := "") + Param_Index : SAL.Base_Peek_Type := 1; -- Index of current indent parameter. + + procedure One_Param (Skip : in Boolean; Label : in String := "") + -- If not Skip, current indent param is for a token actually in RHS; add it to + -- Param_List. + -- + -- If Skip, current indent param is not in RHS; parse the param but + -- don't add it. + -- + -- Label is non-"" only for recursive calls. is Pair : String_Pair_Type; begin - if Label = "" then - if RHS.Auto_Token_Labels then - Pair.Name := +Next_Token_Label; - end if; + if Skip then + Pair.Name := +""; + elsif Label = "" then + Pair.Name := RHS.Tokens (RHS_Token_Index).Label; else Pair.Name := +Label; end if; @@ -922,14 +978,12 @@ is begin if Label_Last > 0 then -- cons; manual label - pragma Assert (not RHS.Auto_Token_Labels); declare Label : constant String := Params (Last + 1 .. Label_Last); begin Last := Index_Non_Blank (Params, Label_Last + 3); - One_Param (Label); + One_Param (Skip, Label); end; - Param_Label_Count := @ + 1; if Params (Last) /= ')' then Put_Error @@ -941,7 +995,9 @@ is else -- function Pair.Value := +"(False, " & Ensure_Indent_Param (Expression (Last)) & ')'; - Param_List.Append (Pair); + if not Skip then + Param_List.Append (Pair); + end if; end if; end; @@ -950,8 +1006,9 @@ is Pair.Value := +"(True, " & Ensure_Indent_Param (Expression (Last + 1)); Pair.Value := @ & ", " & Ensure_Indent_Param (Expression (Last + 1)) & ')'; - Param_List.Append (Pair); - + if not Skip then + Param_List.Append (Pair); + end if; if Params (Last) /= ']' then Put_Error (Error_Message @@ -962,7 +1019,9 @@ is when others => -- integer or symbol Pair.Value := +"(False, " & Ensure_Indent_Param (Expression (Last)) & ')'; - Param_List.Append (Pair); + if not Skip then + Param_List.Append (Pair); + end if; end case; end One_Param; @@ -978,25 +1037,51 @@ is exit when Params (Last) = ']'; - One_Param; + if RHS_Token_Index > EBNF_RHS.Tokens.Last_Index then + Put_Error + (Error_Message + (Grammar_File_Name, RHS.Source_Line, Image (Prod_ID, Generate_Data.Descriptor.all)) & + " extra indent parameters"); + exit; + end if; + if RHS.Orig_EBNF_RHS or else + (RHS_Token_Index <= RHS.Tokens.Last_Index and then + RHS.Tokens (RHS_Token_Index).Orig_Token_Index = Param_Index) + then + One_Param (Skip => False); + RHS_Token_Index := @ + 1; + else + One_Param (Skip => True); + end if; + Param_Index := @ + 1; + end loop; - -- Now we have Param_List; match it against RHS.Tokens and create Result. + if RHS.Orig_EBNF_RHS and Param_Index < EBNF_RHS.Tokens.Last_Index then + Put_Error + (Error_Message + (Grammar_File_Name, RHS.Source_Line, Image (Prod_ID, Generate_Data.Descriptor.all)) & + " missing indent parameters"); + end if; - if RHS.Auto_Token_Labels or Param_Label_Count = Param_List.Length then - -- All tokens are either manually or automatically labeled, and if - -- manual then all parameters are manually labeled, and we can detect - -- extra params in edited RHS. + if RHS.Auto_Token_Labels then + -- If the original RHS had any EBNF, all tokens are either manually + -- or automatically labeled and RHS.Auto_Token_Labels is true. + -- Otherwise RHS.Auto_Token_Labels is False. declare use String_Pair_Lists; - use all type SAL.Base_Peek_Type; Token_I : Positive_Index_Type := RHS.Tokens.First_Index; Param_Cur : String_Pair_Lists.Cursor := Param_List.First; - Param_I : Positive_Index_Type := RHS.Tokens.First_Index; - - Nil_Indent : constant String := "(False, (Simple, (Label => None)))"; begin + if not Has_Element (Param_Cur) then + Put_Error + (Error_Message + (Grammar_File_Name, + RHS.Source_Line, "empty param_list")); + raise SAL.Programmer_Error; + end if; + loop exit when Token_I > RHS.Tokens.Last_Index or not Has_Element (Param_Cur); @@ -1004,59 +1089,36 @@ is Token_Label : constant String := -RHS.Tokens (Token_I).Label; Param_Label : constant String := -Element (Param_Cur).Name; begin - if Token_Label = Param_Label then - Result := Result & (if Need_Comma then ", " else "") & Param_Label & " => " & - Element (Param_Cur).Value; - - Mark_Label_Used (Token_Label); - - Need_Comma := True; + if Token_Label'Length = 0 and then Param_Label'Length = 0 then + Put_Error + (Error_Message + (Grammar_File_Name, RHS.Source_Line, Image (Prod_ID, Generate_Data.Descriptor.all)) & + " missing or misplaced indent label"); + end if; - Token_I := @ + 1; - Next (Param_Cur); - Param_I := @ + 1; + -- IMPROVEME: if there is a manual param label, verify that there is + -- a matching token label. + Result := Result & + (if Need_Comma then ", " else "") & + (if Token_Label'Length > 0 then Token_Label else Param_Label) & " => " & + Element (Param_Cur).Value; - elsif RHS.Auto_Token_Labels and - (Token_Label'Length > 0 and then Token_Label (1) /= 'T') and - Token_I = Param_I - then - Result := Result & (if Need_Comma then ", " else "") & Token_Label & " => " & Nil_Indent; - Mark_Label_Used (Token_Label); - Need_Comma := True; + Mark_Label_Used (Token_Label); - Token_I := @ + 1; - Next (Param_Cur); - Param_I := @ + 1; + Need_Comma := True; - else - Next (Param_Cur); - Param_I := @ + 1; - end if; + Token_I := @ + 1; + Next (Param_Cur); end; end loop; - - if (not RHS.Edited_Token_List or Prod_ID.RHS = 0) and then - (Token_I /= RHS.Tokens.Last_Index + 1 or Has_Element (Param_Cur)) - then - -- We don't check 'Has_Element (Param_Cur)' when edited_token_list - -- and RHS_Index /= 0, because we expect to have more params than - -- tokens. RHS_Index = 0 always has all optional tokens. - if RHS.Auto_Token_Labels then - Put_Error - (Error_Message - (Grammar_File_Name, RHS.Source_Line, Image (Prod_ID, Generate_Data.Descriptor.all)) & - (if Token_I <= RHS.Tokens.Last_Index then " missing" else " extra") & " indent parameters"); - else - Put_Error - (Error_Message - (Grammar_File_Name, RHS.Source_Line, Image (Prod_ID, Generate_Data.Descriptor.all) & - ": missing or extra indent parameter, or missing token label")); - end if; - end if; end; else - -- No labels; assume Param_List is correct. + -- No auto labels; ignore manual labels and assume Param_List is + -- correct. IMPROVEME: We could check that manual labels match + -- between the RHS and the action. IMPROVEME: if all specified params + -- have manual labels, allow indent for remaining tokens to default + -- to nil. for Pair of Param_List loop Result := Result & (if Need_Comma then ", " else "") & Pair.Value; Need_Comma := True; @@ -1065,7 +1127,7 @@ is Nonterm_Needed := True; if Param_List.Length = 1 then - Result := Prefix & "1 => " & Result; + Result := Prefix & (if RHS.Auto_Token_Labels then "" else "1 => ") & Result; else Result := Prefix & Result; end if; @@ -1108,16 +1170,33 @@ is Label_Second : constant String := Get_Label (Params (Second + 1 .. Params'Last - 1)); Label_Used_First : constant Boolean := Label_Used (Label_First); Label_Used_Second : constant Boolean := Label_Used (Label_Second); + + Result : Unbounded_String := +" (Tree, Tokens, "; begin - if Label_Used_First and Label_Used_Second then - return " (Tree, Tokens, " & - Label_First & ", " & Label_Second & ", " & - (if Length (Input_Data.Language_Params.End_Names_Optional_Option) > 0 - then -Input_Data.Language_Params.End_Names_Optional_Option - else "False") & ")"; + -- Match_Names accepts 0 for absent token + + if Label_Used_First then + Append (Result, Label_First); else - return ""; + Append (Result, "0"); end if; + Append (Result, ", "); + + if Label_Used_Second then + Append (Result, Label_Second); + else + Append (Result, "0"); + end if; + Append (Result, ", "); + + if Length (Input_Data.Language_Params.End_Names_Optional_Option) > 0 then + Append (Result, -Input_Data.Language_Params.End_Names_Optional_Option); + else + Append (Result, "False"); + end if; + Append (Result, ")"); + + return -Result; end Match_Names_Params; function Language_Action_Params (Params : in String; Action_Name : in String) return String @@ -1185,18 +1264,18 @@ is end if; end Assert_Indent_Empty; - procedure Assert_Check_Empty + procedure Assert_In_Parse_Action_Empty is begin - if Length (Check_Line) > 0 then + if Length (In_Parse_Action_Line) > 0 then Put_Error (Error_Message - (Grammar_File_Name, RHS.Source_Line, "multiple check actions")); + (Grammar_File_Name, RHS.Source_Line, "multiple in_parse actions")); end if; - end Assert_Check_Empty; + end Assert_In_Parse_Action_Empty; begin -- wisi action/check functions, in same order as typically used in - -- .wy files; Navigate, Face, Indent, Check. + -- .wy files; Navigate, Face, Indent, actions. if Elisp_Name = "wisi-statement-action" then declare Params : constant String := Statement_Params (Line (Last + 1 .. Line'Last)); @@ -1286,16 +1365,16 @@ is Label : constant String := Get_Label (Line (Last + 1 .. Line'Last - 1)); begin if Label_Used (Label) then - Assert_Check_Empty; + Assert_In_Parse_Action_Empty; Nonterm_Needed := True; - Check_Line := +"return " & Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) & + In_Parse_Action_Line := +"return " & Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) & " (Tree, Nonterm, Tokens, " & Label & ");"; end if; end; elsif Elisp_Name = "wisi-merge-names" then - Assert_Check_Empty; - Check_Line := +"return " & Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) & + Assert_In_Parse_Action_Empty; + In_Parse_Action_Line := +"return " & Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) & Merge_Names_Params (Line (Last + 1 .. Line'Last)) & ";"; elsif Elisp_Name = "wisi-match-names" then @@ -1303,16 +1382,17 @@ is Params : constant String := Match_Names_Params (Line (Last + 1 .. Line'Last)); begin if Params'Length > 0 then - Assert_Check_Empty; - Check_Line := +"return " & Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) & + Assert_In_Parse_Action_Empty; + In_Parse_Action_Line := +"return " & Elisp_Name_To_Ada (Elisp_Name, False, Trim => 5) & Params & ";"; end if; end; elsif Elisp_Name = "wisi-terminate-partial-parse" then - Assert_Check_Empty; + Assert_In_Parse_Action_Empty; Nonterm_Needed := True; - Check_Line := +"return Terminate_Partial_Parse (Tree, Partial_Parse_Active, Partial_Parse_Byte_Goal, " & + In_Parse_Action_Line := + +"return Terminate_Partial_Parse (Tree, Partial_Parse_Active, Partial_Parse_Byte_Goal, " & "Recover_Active, Nonterm);"; elsif Input_Data.Tokens.Actions.Contains (+Elisp_Name) then @@ -1370,12 +1450,23 @@ is Put_Error (Error_Message (Grammar_File_Name, RHS.Source_Line, Ada.Exceptions.Exception_Message (E))); + + when E : others => + Put_Error + (Error_Message + (Grammar_File_Name, RHS.Source_Line, "RHS: '" & Image (RHS.Tokens))); + Put_Error + (Error_Message + (Grammar_File_Name, RHS.Source_Line, "... Sexp: '" & Sexp)); + Put_Error + (Error_Message + (Grammar_File_Name, RHS.Source_Line, "... " & Ada.Exceptions.Exception_Message (E))); + raise; end; end loop; - if Check then - -- In an in-parse check action - if Length (Check_Line) = 0 then + if In_Parse_Action then + if Length (In_Parse_Action_Line) = 0 then Empty := True; -- don't output a spec for this. else @@ -1388,10 +1479,10 @@ is Indent_Line (" Recover_Active : in Boolean)"); Indent_Line (" return WisiToken.Syntax_Trees.In_Parse_Actions.Status"); declare - Unref_Tree : constant Boolean := 0 = Index (Check_Line, "Tree"); - Unref_Nonterm : constant Boolean := 0 = Index (Check_Line, "Nonterm"); - Unref_Tokens : constant Boolean := 0 = Index (Check_Line, "Tokens"); - Unref_Recover : constant Boolean := 0 = Index (Check_Line, "Recover_Active"); + Unref_Tree : constant Boolean := 0 = Index (In_Parse_Action_Line, "Tree"); + Unref_Nonterm : constant Boolean := 0 = Index (In_Parse_Action_Line, "Nonterm"); + Unref_Tokens : constant Boolean := 0 = Index (In_Parse_Action_Line, "Tokens"); + Unref_Recover : constant Boolean := 0 = Index (In_Parse_Action_Line, "Recover_Active"); Need_Comma : Boolean := False; begin if Unref_Tree or Unref_Nonterm or Unref_Tokens or Unref_Recover or @@ -1425,7 +1516,7 @@ is for I in Label_Needed'Range loop if Label_Needed (I) then Indent_Line - (-Labels (I) & " : constant SAL.Peek_Type :=" & + (-Rule.Labels (I) & " : constant SAL.Peek_Type :=" & SAL.Peek_Type'Image (Find_Token_Index (I)) & ";"); end if; end loop; @@ -1437,7 +1528,7 @@ is end if; end; Indent := Indent + 3; - Indent_Line (-Check_Line); + Indent_Line (-In_Parse_Action_Line); end if; else -- In an action @@ -1460,7 +1551,7 @@ is for I in Label_Needed'Range loop if Label_Needed (I) then Indent_Line - (-Labels (I) & " : constant SAL.Peek_Type :=" & + (-Rule.Labels (I) & " : constant SAL.Peek_Type :=" & SAL.Peek_Type'Image (Find_Token_Index (I)) & ";"); end if; end loop; @@ -1513,7 +1604,7 @@ is is begin for Rule of Input_Data.Tokens.Rules loop for RHS of Rule.Right_Hand_Sides loop - for Sexp of Split_Sexp (-RHS.Action, Grammar_File_Name, RHS.Source_Line) loop + for Sexp of Split_Sexp (-RHS.Post_Parse_Action, Grammar_File_Name, RHS.Source_Line) loop declare Last : constant Integer := Ada.Strings.Fixed.Index (Sexp, Blank_Set); Elisp_Name : constant String := Sexp (Sexp'First + 1 .. Last - 1); @@ -1529,20 +1620,16 @@ is end Any_Motion_Actions; procedure Create_Ada_Actions_Body - (Action_Names : not null access WisiToken.Names_Array_Array; - Check_Names : not null access WisiToken.Names_Array_Array; - Label_Count : in Ada.Containers.Count_Type; - Package_Name : in String) + (Post_Parse_Action_Names : not null access WisiToken.Names_Array_Array; + In_Parse_Action_Names : not null access WisiToken.Names_Array_Array; + Label_Count : in Ada.Containers.Count_Type; + Package_Name : in String) is use Ada.Strings.Unbounded; use Generate_Utils; use WisiToken.Generate; - File_Name : constant String := Output_File_Name_Root & - (case Common_Data.Interface_Kind is - when Process => "_process_actions", - when Module => "_module_actions") & - ".adb"; + File_Name : constant String := To_Lower (Package_Name) & ".adb"; Motion_Actions : constant Boolean := Any_Motion_Actions; @@ -1573,7 +1660,7 @@ is end; end if; - if Input_Data.Check_Count > 0 then + if Input_Data.In_Parse_Action_Count > 0 then Indent_Line ("with WisiToken.In_Parse_Actions; use WisiToken.In_Parse_Actions;"); -- Match_Names etc. end if; case Common_Data.Interface_Kind is @@ -1590,7 +1677,7 @@ is Indent := Indent + 3; New_Line; - if Input_Data.Check_Count > 0 then + if Input_Data.In_Parse_Action_Count > 0 then Indent_Line ("use WisiToken.Syntax_Trees.In_Parse_Actions;"); end if; if Motion_Actions then @@ -1598,35 +1685,43 @@ is end if; New_Line; - -- generate Action and Check subprograms. + -- generate Post_Parse_Action and In_Parse_Action subprograms. for Rule of Input_Data.Tokens.Rules loop -- No need for a Token_Cursor here, since we only need the -- nonterminals. declare LHS_ID : constant WisiToken.Token_ID := Find_Token_ID (Generate_Data, -Rule.Left_Hand_Side); - RHS_Index : Integer := 0; -- Semantic_Action defines RHS_Index as zero-origin + RHS_Index : Integer := 0; Empty : Boolean; begin for RHS of Rule.Right_Hand_Sides loop - if Length (RHS.Action) > 0 then + if Length (RHS.Post_Parse_Action) > 0 then declare - Name : constant String := Action_Names (LHS_ID)(RHS_Index).all; + Name : constant String := Post_Parse_Action_Names (LHS_ID)(RHS_Index).all; begin - Create_Ada_Action (Name, RHS, (LHS_ID, RHS_Index), RHS.Action, Rule.Labels, Empty, Check => False); + Create_Ada_Action + (Name, RHS, (LHS_ID, RHS_Index), RHS.Post_Parse_Action, Rule, Empty, + In_Parse_Action => False); if Empty then - Action_Names (LHS_ID)(RHS_Index) := null; + Post_Parse_Action_Names (LHS_ID)(RHS_Index) := null; end if; + exception + when others => + Put_Error (Error_Message (Grammar_File_Name, RHS.Source_Line, "fatal internal error")); + raise; end; end if; - if Length (RHS.Check) > 0 then + if Length (RHS.In_Parse_Action) > 0 then declare - Name : constant String := Check_Names (LHS_ID)(RHS_Index).all; + Name : constant String := In_Parse_Action_Names (LHS_ID)(RHS_Index).all; begin - Create_Ada_Action (Name, RHS, (LHS_ID, RHS_Index), RHS.Check, Rule.Labels, Empty, Check => True); + Create_Ada_Action + (Name, RHS, (LHS_ID, RHS_Index), RHS.In_Parse_Action, Rule, Empty, + In_Parse_Action => True); if Empty then - Check_Names (LHS_ID)(RHS_Index) := null; + In_Parse_Action_Names (LHS_ID)(RHS_Index) := null; end if; end; end if; @@ -1649,10 +1744,9 @@ is use WisiToken.Generate; use Generate_Utils; - File_Name : constant String := To_Lower (Main_Package_Name) & ".adb"; Body_File : File_Type; begin - Create (Body_File, Out_File, File_Name); + Create (Body_File, Out_File, To_Lower (Main_Package_Name) & ".adb"); Set_Output (Body_File); Indent := 1; @@ -1708,13 +1802,13 @@ is LR_Create_Create_Parser (Actions_Package_Name, Common_Data, Generate_Data); when Packrat_Gen => - WisiToken.BNF.Generate_Packrat (Packrat_Data, Generate_Data); + WisiToken.BNF.Generate_Packrat (Packrat_Data.all, Generate_Data); Create_Create_Productions (Generate_Data); - Packrat_Create_Create_Parser (Actions_Package_Name, Common_Data, Generate_Data, Packrat_Data); + Packrat_Create_Create_Parser (Actions_Package_Name, Common_Data, Generate_Data, Packrat_Data.all); when Packrat_Proc => Create_Create_Productions (Generate_Data); - Packrat_Create_Create_Parser (Actions_Package_Name, Common_Data, Generate_Data, Packrat_Data); + Packrat_Create_Create_Parser (Actions_Package_Name, Common_Data, Generate_Data, Packrat_Data.all); when External => External_Create_Create_Grammar (Generate_Data); @@ -1796,24 +1890,32 @@ is File : File_Type; + File_Name_Root : constant String := Output_File_Name_Root & + "-process" & + (if Need_Gen_Alg_In_Actions_Name + then "-" & To_Lower (Tuple.Gen_Alg'Image) + else ""); + + File_Name : constant String := File_Name_Root & ".el"; + Paren_1_Done : Boolean := False; begin - Create (File, Out_File, Output_File_Name_Root & "-process.el"); + Create (File, Out_File, File_Name); + Set_Output (File); Indent := 1; -- We can't use Put_File_Header here because it does not output the -- file name. Put_Line - (";;; " & Output_File_Name_Root & - "-process.el --- Generated parser support file -*- buffer-read-only:t lexical-binding:t -*-"); + (";;; " & File_Name & " --- Generated parser support file -*- buffer-read-only:t lexical-binding:t -*-"); Put_Command_Line (Elisp_Comment & " ", Use_Tuple => True, Tuple => Tuple); Put_Raw_Code (Elisp_Comment, Input_Data.Raw_Code (Copyright_License)); New_Line; Put_Line ("(require 'wisi-process-parse)"); New_Line; - Indent_Line ("(defconst " & Output_File_Name_Root & "-process-token-table"); + Indent_Line ("(defconst " & File_Name_Root & "-token-table"); Indent_Start (" ["); Indent := Indent + 3; for Cursor in All_Tokens (Generate_Data).Iterate loop @@ -1829,15 +1931,14 @@ is Indent := Indent - 3; New_Line; - Output_Elisp_Common.Indent_Name_Table - (Output_File_Name_Root, "process-face-table", Input_Data.Tokens.Faces); + Output_Elisp_Common.Indent_Name_Table (File_Name_Root, "face-table", Input_Data.Tokens.Faces); -- We need -repair-image for wisi-repair-error New_Line; - Output_Elisp_Common.Indent_Repair_Image (Output_File_Name_Root, "process", Input_Data.Tokens); + Output_Elisp_Common.Indent_Repair_Image (File_Name_Root, "", Input_Data.Tokens); New_Line; - Put_Line ("(provide '" & Output_File_Name_Root & "-process)"); + Put_Line ("(provide '" & File_Name_Root & ")"); Set_Output (Standard_Output); Close (File); @@ -1849,8 +1950,6 @@ is use Generate_Utils; use WisiToken.Generate; - Lower_Package_Name_Root : constant String := To_Lower (File_Name_To_Ada (Output_File_Name_Root)); - function To_ID_Image (Name : in Ada.Strings.Unbounded.Unbounded_String) return String is begin -- Ada 'Val is 0 origin; Token_ID is 1 origin @@ -1894,30 +1993,30 @@ is New_Line; Indent_Line - ("(cl-defstruct (" & Lower_Package_Name_Root & + ("(cl-defstruct (" & Output_File_Name_Root & "-wisi-module-parser (:include wisi-parser)))"); New_Line; - Indent_Line ("(defun " & Lower_Package_Name_Root & "-wisi-module-parser-make (dll-name)"); + Indent_Line ("(defun " & Output_File_Name_Root & "-wisi-module-parser-make (dll-name)"); Indent_Line (" (module-load dll-name)"); - Indent_Line (" (make-" & Lower_Package_Name_Root & "-wisi-module-parser))"); + Indent_Line (" (make-" & Output_File_Name_Root & "-wisi-module-parser))"); New_Line; - Indent_Line ("(defvar " & Lower_Package_Name_Root & "-module-lexer nil)"); + Indent_Line ("(defvar " & Output_File_Name_Root & "-module-lexer nil)"); Indent_Line ("(declare-function " & - Lower_Package_Name_Root & + Output_File_Name_Root & "-wisi-module-parse """ & - Lower_Package_Name_Root & + Output_File_Name_Root & "-wisi-module-parse.c"")"); New_Line; Indent_Line ("(cl-defmethod wisi-parse-current ((parser " & - Lower_Package_Name_Root & + Output_File_Name_Root & "-wisi-module-parser))"); Indent := Indent + 2; - Indent_Line ("(let* ((wisi-lexer " & Lower_Package_Name_Root & "-module-lexer)"); - Indent_Line (" (result (" & Lower_Package_Name_Root & "-wisi-module-parse)))"); + Indent_Line ("(let* ((wisi-lexer " & Output_File_Name_Root & "-module-lexer)"); + Indent_Line (" (result (" & Output_File_Name_Root & "-wisi-module-parse)))"); -- Result is nil for no errors, a string for some error. -- Ada code has already added line:column, but not file name Indent_Line (" (when result"); @@ -1935,8 +2034,7 @@ is is use WisiToken.Generate; - Package_Name_Root : constant String := File_Name_To_Ada (Output_File_Name_Root); - Lower_Package_Name_Root : constant String := To_Lower (Package_Name_Root); + Package_Name_Root : constant String := File_Name_To_Ada (Output_File_Name_Root); File : File_Type; begin @@ -1960,13 +2058,13 @@ is Indent_Line ("""emacs_module_h.ads"","); Indent_Line ("""fasttoken-lexer-wisi_elisp.adb"","); Indent_Line ("""fasttoken-lexer-wisi_elisp.ads"","); - Indent_Line ("""" & Lower_Package_Name_Root & "_module.adb"","); - Indent_Line ("""" & Lower_Package_Name_Root & "_module.ads"""); + Indent_Line ("""" & Output_File_Name_Root & "_module.adb"","); + Indent_Line ("""" & Output_File_Name_Root & "_module.ads"""); Indent := Indent - 3; Indent_Line (" );"); New_Line; Indent_Line ("for Object_Dir use ""libobjsjlj"";"); - Indent_Line ("for Library_Name use """ & Lower_Package_Name_Root & "_wisi_module_parse"";"); + Indent_Line ("for Library_Name use """ & Output_File_Name_Root & "_wisi_module_parse"";"); Indent_Line ("for Library_Dir use ""libsjlj"";"); -- This library is linked with *_wisi_module_parse_wrapper.c to -- make a dynamic library @@ -1982,12 +2080,12 @@ is -- 'Wisi_Module_Parse_Common.Compiler'Default_Switches' includes 'gnatn', but that hangs Indent_Line ("case Wisi_Module_Parse_Common.Build is"); Indent_Line ("when ""Debug"" =>"); - Indent_Line (" for Switches (""" & Lower_Package_Name_Root & "_module.adb"") use"); + Indent_Line (" for Switches (""" & Output_File_Name_Root & "_module.adb"") use"); Indent_Line (" Wisi_Module_Parse_Common.Compiler.Common_Switches &"); Indent_Line (" Wisi_Module_Parse_Common.Compiler.Standard_Style &"); Indent_Line (" (""-O0"");"); Indent_Line ("when ""Normal"" =>"); - Indent_Line (" for Switches (""" & Lower_Package_Name_Root & "_module.adb"") use"); + Indent_Line (" for Switches (""" & Output_File_Name_Root & "_module.adb"") use"); Indent_Line (" Wisi_Module_Parse_Common.Compiler.Common_Switches &"); Indent_Line (" Wisi_Module_Parse_Common.Compiler.Standard_Style &"); Indent_Line (" (""-O2"");"); @@ -2013,7 +2111,7 @@ is Put_Command_Line ("-- ", Use_Tuple => True, Tuple => Tuple); Indent_Line ("aggregate project " & Package_Name_Root & "_Wisi_Module_Parse_Agg is"); Indent_Line (" for Project_Path use (external (""WISI_FASTTOKEN""));"); - Indent_Line (" for Project_files use (""" & Lower_Package_Name_Root & "_wisi_module_parse.gpr"");"); + Indent_Line (" for Project_files use (""" & Output_File_Name_Root & "_wisi_module_parse.gpr"");"); Indent_Line ("end " & Package_Name_Root & "_Wisi_Module_Parse_Agg;"); Set_Output (Standard_Output); Close (File); @@ -2028,22 +2126,22 @@ is Indent_Line ("#include <emacs_module.h>"); Indent_Line ("int plugin_is_GPL_compatible;"); Indent_Line ("extern void adainit(void);"); - Indent_Line ("extern int " & Lower_Package_Name_Root & "_wisi_module_parse_init (emacs_env *env);"); + Indent_Line ("extern int " & Output_File_Name_Root & "_wisi_module_parse_init (emacs_env *env);"); Indent_Line ("/* Parse current buffer, using parser in current module. */"); - Indent_Line ("extern emacs_value " & Lower_Package_Name_Root & "_wisi_module_parse (emacs_env *env);"); + Indent_Line ("extern emacs_value " & Output_File_Name_Root & "_wisi_module_parse (emacs_env *env);"); Indent_Line ("static emacs_value Fparse (emacs_env *env, int nargs, emacs_value args[])"); Indent_Line ("{"); - Indent_Line (" return " & Lower_Package_Name_Root & "_wisi_module_parse (env);"); + Indent_Line (" return " & Output_File_Name_Root & "_wisi_module_parse (env);"); Indent_Line ("}"); New_Line; Indent_Line ("int emacs_module_init (struct emacs_runtime *ert)"); Indent_Line ("{"); Indent_Line (" emacs_env *env = ert->get_environment (ert);"); Indent_Line - (" env->bind_function (env, """ & Lower_Package_Name_Root & + (" env->bind_function (env, """ & Output_File_Name_Root & "-wisi-module-parse"", env->make_function (env, 1, 1, Fparse));"); Indent_Line (" adainit();"); - Indent_Line (" return " & Lower_Package_Name_Root & "_wisi_module_parse_init (env);"); + Indent_Line (" return " & Output_File_Name_Root & "_wisi_module_parse_init (env);"); Indent_Line ("}"); Set_Output (Standard_Output); Close (File); @@ -2053,8 +2151,12 @@ begin declare Actions_Package_Name : constant String := File_Name_To_Ada (Output_File_Name_Root) & (case Common_Data.Interface_Kind is - when Process => "_Process_Actions", - when Module => "_Module_Actions"); + when Process => "_Process", + when Module => "_Module") & + (if Need_Gen_Alg_In_Actions_Name + then "_" & Generate_Algorithm_Image (Tuple.Gen_Alg).all + else "") & + "_Actions"; Main_Package_Name : constant String := File_Name_To_Ada (Output_File_Name_Root) & (case Common_Data.Interface_Kind is @@ -2062,21 +2164,18 @@ begin when Module => "_Module") & Gen_Alg_Name & "_Main"; begin - if Input_Data.Action_Count > 0 or Input_Data.Check_Count > 0 then + if Input_Data.Post_Parse_Action_Count > 0 or Input_Data.In_Parse_Action_Count > 0 then -- We typically have no actions when just getting started with a new language. Create_Ada_Actions_Body - (Generate_Data.Action_Names, Generate_Data.Check_Names, Input_Data.Label_Count, Actions_Package_Name); + (Generate_Data.Post_Parse_Action_Names, Generate_Data.In_Parse_Action_Names, Input_Data.Label_Count, + Actions_Package_Name); end if; Create_Ada_Actions_Spec - (Output_File_Name => Output_File_Name_Root & - (case Common_Data.Interface_Kind is - when Process => "_process_actions.ads", - when Module => "_module_actions.ads"), - Package_Name => Actions_Package_Name, - Input_Data => Input_Data, - Common_Data => Common_Data, - Generate_Data => Generate_Data); + (Package_Name => Actions_Package_Name, + Input_Data => Input_Data, + Common_Data => Common_Data, + Generate_Data => Generate_Data); if Tuple.Gen_Alg = External then Create_External_Main_Spec (Main_Package_Name, Tuple, Input_Data); @@ -2086,13 +2185,13 @@ begin Create_Ada_Main_Body (Actions_Package_Name, Main_Package_Name); Create_Ada_Main_Spec - (Output_File_Name => Output_File_Name_Root & "_" & - To_Lower (Interface_Type'Image (Common_Data.Interface_Kind)) & - To_Lower (Gen_Alg_Name) & "_main.ads", - Main_Package_Name => Main_Package_Name, + (Main_Package_Name => Main_Package_Name, Common_Data => Common_Data, Input_Data => Input_Data); end if; + + -- We can't create a test_main here, because we don't have the wisi + -- package for the actions. end; case Common_Data.Interface_Kind is diff --git a/wisitoken-bnf-output_elisp_common.adb b/wisitoken-bnf-output_elisp_common.adb index a74efd3..e28dec3 100644 --- a/wisitoken-bnf-output_elisp_common.adb +++ b/wisitoken-bnf-output_elisp_common.adb @@ -2,7 +2,7 @@ -- -- See spec -- --- Copyright (C) 2012, 2013, 2015, 2017 - 2019, 2022 Free Software Foundation, Inc. +-- Copyright (C) 2012, 2013, 2015, 2017 - 2019, 2022, 2023 Free Software Foundation, Inc. -- -- This program is free software; you can redistribute it and/or -- modify it under terms of the GNU General Public License as @@ -190,7 +190,7 @@ package body WisiToken.BNF.Output_Elisp_Common is end re2c_To_Elisp; begin - Indent_Line ("(defconst " & Output_File_Root & "-" & Label & "-repair-image"); + Indent_Line ("(defconst " & Output_File_Root & (if Label'Length > 0 then "-" & Label else "") & "-repair-image"); Indent_Line (" '("); Indent := Indent + 3; for Pair of Tokens.Keywords loop diff --git a/wisitoken-bnf-utils.adb b/wisitoken-bnf-utils.adb index 71e340f..7a875ae 100644 --- a/wisitoken-bnf-utils.adb +++ b/wisitoken-bnf-utils.adb @@ -2,7 +2,7 @@ -- -- See spec -- --- Copyright (C) 2012, 2013, 2015, 2017, 2018 Free Software Foundation, Inc. +-- Copyright (C) 2012, 2013, 2015, 2017, 2018, 2023 Free Software Foundation, Inc. -- -- This program is free software; you can redistribute it and/or -- modify it under terms of the GNU General Public License as @@ -26,8 +26,8 @@ package body WisiToken.BNF.Utils is return Item; else return Item - ((if Item (Item'First) = '"' then Item'First + 1 else Item'First) .. - (if Item (Item'Last) = '"' then Item'Last - 1 else Item'Last)); + ((if Item (Item'First) in '"' | ''' then Item'First + 1 else Item'First) .. + (if Item (Item'Last) in '"' | ''' then Item'Last - 1 else Item'Last)); end if; end Strip_Quotes; diff --git a/wisitoken-bnf-utils.ads b/wisitoken-bnf-utils.ads index 6062ff9..0c4e26d 100644 --- a/wisitoken-bnf-utils.ads +++ b/wisitoken-bnf-utils.ads @@ -2,7 +2,7 @@ -- -- Utilities for generating source code from BNF source files -- --- Copyright (C) 2012, 2013, 2015, 2017, 2018 Free Software Foundation, Inc. +-- Copyright (C) 2012, 2013, 2015, 2017, 2018, 2023 Free Software Foundation, Inc. -- -- The WisiToken package is free software; you can redistribute it -- and/or modify it under terms of the GNU General Public License as @@ -21,7 +21,7 @@ pragma License (Modified_GPL); package WisiToken.BNF.Utils is function Strip_Quotes (Item : in String) return String; - -- Remove leading and trailing '"', if any. + -- Remove leading and trailing '"' and ''', if any. function Strip_Parens (Item : in String) return String; -- Remove leading and trailing '()', if any. diff --git a/wisitoken-bnf.adb b/wisitoken-bnf.adb index ee98bf4..7f8eedc 100644 --- a/wisitoken-bnf.adb +++ b/wisitoken-bnf.adb @@ -2,7 +2,7 @@ -- -- see spec -- --- Copyright (C) 2012 - 2015, 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2012 - 2015, 2017 - 2023 Free Software Foundation, Inc. -- -- This program is free software; you can redistribute it and/or -- modify it under terms of the GNU General Public License as @@ -71,11 +71,11 @@ package body WisiToken.BNF is function From_Generate_Env_Var return Generate_Algorithm_Set is - Gen_String : constant String := Ada.Environment_Variables.Value ("GENERATE", "BNF_EBNF"); + Gen_String : constant String := Ada.Environment_Variables.Value ("GENERATE", ""); begin -- GENERATE env var defined in wisitoken_test.gpr if Gen_String = "" then - return (Tree_Sitter => False, others => True); + return (others => True); elsif Gen_String = "BNF_EBNF_Tree_Sitter" then return (others => True); elsif Gen_String = "BNF_EBNF" or @@ -204,6 +204,13 @@ package body WisiToken.BNF is Put_Line (Comment_Syntax); end Put_File_Header; + function Image (Item : in Labeled_Token) return String + is + use Ada.Strings.Unbounded; + begin + return (if Length (Item.Label) > 0 then -Item.Label & "=" else "") & (-Item.Identifier); + end Image; + function Is_Present (List : in WisiToken.BNF.String_Pair_Lists.List; Name : in String) return Boolean is use all type Ada.Strings.Unbounded.Unbounded_String; diff --git a/wisitoken-bnf.ads b/wisitoken-bnf.ads index 5275e2c..0ad32c3 100644 --- a/wisitoken-bnf.ads +++ b/wisitoken-bnf.ads @@ -10,7 +10,7 @@ -- [1] https://en.wikipedia.org/wiki/Backus%E2%80%93Naur_form -- [2] http://www.nongnu.org/ada-mode/wisi/wisi-user_guide.html, (info "(wisi-user_guide)Top") -- --- Copyright (C) 2012 - 2015, 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2012 - 2015, 2017 - 2023 Free Software Foundation, Inc. -- -- The WisiToken package is free software; you can redistribute it -- and/or modify it under terms of the GNU General Public License as @@ -30,9 +30,9 @@ with Ada.Characters.Handling; with Ada.Containers.Doubly_Linked_Lists; with Ada.Containers.Indefinite_Doubly_Linked_Lists; with Ada.Containers.Ordered_Maps; -with Ada.Containers.Vectors; with Ada.Strings.Unbounded; with Ada.Unchecked_Deallocation; +with SAL.Gen_Unbounded_Definite_Vectors.Gen_Image; with WisiToken.Parse.LR; with WisiToken.Syntax_Trees; package WisiToken.BNF is @@ -57,7 +57,7 @@ package WisiToken.BNF is Packrat_Proc => new String'("Packrat_Proc"), External => new String'("External"), Tree_Sitter => new String'("Tree_Sitter")); - -- Suitable for Ada package names. + -- Suitable for Ada package names. For file names, use To_Lower (Gen_Alg'Image). function To_Generate_Algorithm (Item : in String) return Generate_Algorithm; -- Raises User_Error for invalid Item @@ -67,13 +67,14 @@ package WisiToken.BNF is function From_Generate_Env_Var return Generate_Algorithm_Set; - type Output_Language is (Ada_Lang, Ada_Emacs_Lang); + type Output_Language is (None, Ada_Lang, Ada_Emacs_Lang); subtype Ada_Output_Language is Output_Language range Ada_Lang .. Ada_Emacs_Lang; -- _Lang to avoid colliding with the standard package Ada and -- WisiToken packages named *.Ada. In the grammar file, they -- are named by (case insensitive): Output_Language_Image : constant array (Output_Language) of String_Access_Constant := - (Ada_Lang => new String'("Ada"), + (None => new String'("None"), + Ada_Lang => new String'("Ada"), Ada_Emacs_Lang => new String'("Ada_Emacs")); function To_Output_Language (Item : in String) return Output_Language; @@ -110,7 +111,7 @@ package WisiToken.BNF is type Generate_Tuple is record Gen_Alg : Generate_Algorithm := None; - Out_Lang : Output_Language := Ada_Lang; + Out_Lang : Output_Language := None; Lexer : Lexer_Type := None; Interface_Kind : Interface_Type := None; Text_Rep : Boolean := False; @@ -286,32 +287,49 @@ package WisiToken.BNF is package Conflict_Lists is new Ada.Containers.Doubly_Linked_Lists (Conflict); type Labeled_Token is record - Label : Ada.Strings.Unbounded.Unbounded_String; + Label : Ada.Strings.Unbounded.Unbounded_String; + + Orig_Token_Index : SAL.Base_Peek_Type := 0; + -- Index of this token in Orig_EBNF_RHS; 0 if this is that RHS, or if + -- this token is added by translating to BNF. + Identifier : Ada.Strings.Unbounded.Unbounded_String; end record; - package Labeled_Token_Arrays is new Ada.Containers.Vectors (Positive_Index_Type, Labeled_Token); + package Labeled_Token_Arrays is new SAL.Gen_Unbounded_Definite_Vectors + (Positive_Index_Type, Labeled_Token, Default_Element => (others => <>)); -- Index matches Syntax_Trees.Valid_Node_Index_Array, used for Tokens -- in call to post parse grammar action. + function Image (Item : in Labeled_Token) return String; + function Image is new Labeled_Token_Arrays.Gen_Image (Image); + type RHS_Type is record - Tokens : Labeled_Token_Arrays.Vector; - Auto_Token_Labels : Boolean := False; - -- Token labels generated by Translate_EBNF_To_BNF + Associativity : WisiToken.Associativity := WisiToken.None; + Precedence : WisiToken.Base_Precedence_ID := WisiToken.No_Precedence; - Edited_Token_List : Boolean := False; - -- RHS modified by Translate_EBNF_To_BNF; RHS_Index 0 has all tokens. + Tokens : Labeled_Token_Arrays.Vector; + + Orig_EBNF_RHS : Boolean := False; + + EBNF_RHS_Index : Natural := Natural'Last; + -- Index of RHS containing EBNF RHS that this was copied from by + -- Translate_EBNF_To_BNF; used to map tokens in actions. + + Auto_Token_Labels : Boolean := False; + -- True if some token labels generated by Translate_EBNF_To_BNF - Action : Ada.Strings.Unbounded.Unbounded_String; - Check : Ada.Strings.Unbounded.Unbounded_String; - Source_Line : WisiToken.Line_Number_Type := WisiToken.Line_Number_Type'First; + Post_Parse_Action : Ada.Strings.Unbounded.Unbounded_String; + In_Parse_Action : Ada.Strings.Unbounded.Unbounded_String; + Source_Line : WisiToken.Line_Number_Type := WisiToken.Line_Number_Type'First; end record; package RHS_Lists is new Ada.Containers.Doubly_Linked_Lists (RHS_Type, "="); type Rule_Type is record Left_Hand_Side : aliased Ada.Strings.Unbounded.Unbounded_String; + Precedence : WisiToken.Base_Precedence_ID; Right_Hand_Sides : RHS_Lists.List; - Labels : String_Arrays.Vector; + Labels : String_Arrays.Vector; -- All labels used in any RHS Optimized_List : Boolean := False; Source_Line : WisiToken.Line_Number_Type; end record; diff --git a/wisitoken-generate-lr-lalr_generate.adb b/wisitoken-generate-lr-lalr_generate.adb index 358ab85..068c4fd 100644 --- a/wisitoken-generate-lr-lalr_generate.adb +++ b/wisitoken-generate-lr-lalr_generate.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2023 Free Software Foundation, Inc. -- -- This file is part of the WisiToken package. -- @@ -446,6 +446,7 @@ package body WisiToken.Generate.LR.LALR_Generate is procedure Add_Actions (Kernels : in LR1_Items.Item_Set_List; Grammar : in WisiToken.Productions.Prod_Arrays.Vector; + Precedence_Lists : in WisiToken.Precedence_Lists_Arrays.Vector; Has_Empty_Production : in Token_ID_Set; First_Terminal_Sequence : in Token_Sequence_Arrays.Vector; First_Nonterm_Set : in Token_Array_Token_Set; @@ -466,7 +467,8 @@ package body WisiToken.Generate.LR.LALR_Generate is Closure := LR1_Items.Closure (Kernel, Has_Empty_Production, First_Terminal_Sequence, Grammar, Descriptor); Add_Actions - (Closure, Table, Grammar, Descriptor, Declared_Conflicts, Unknown_Conflicts, First_Nonterm_Set, File_Name, + (Closure, Table, Grammar, Precedence_Lists, Descriptor, Declared_Conflicts, Unknown_Conflicts, + First_Nonterm_Set, File_Name, Ignore_Conflicts); end loop; @@ -477,17 +479,18 @@ package body WisiToken.Generate.LR.LALR_Generate is function Generate (Grammar : in out WisiToken.Productions.Prod_Arrays.Vector; + Precedence_Lists : in WisiToken.Precedence_Lists_Arrays.Vector; Descriptor : in WisiToken.Descriptor; Grammar_File_Name : in String; Error_Recover : in Boolean; - Known_Conflicts : in Conflict_Lists.Tree := Conflict_Lists.Empty_Tree; - McKenzie_Param : in McKenzie_Param_Type := Default_McKenzie_Param; - Max_Parallel : in SAL.Base_Peek_Type := 15; - Parse_Table_File_Name : in String := ""; - Include_Extra : in Boolean := False; - Ignore_Conflicts : in Boolean := False; + Known_Conflicts : in Conflict_Lists.Tree := Conflict_Lists.Empty_Tree; + McKenzie_Param : in McKenzie_Param_Type := Default_McKenzie_Param; + Max_Parallel : in SAL.Base_Peek_Type := 15; + Parse_Table_File_Name : in String := ""; + Include_Extra : in Boolean := False; + Ignore_Conflicts : in Boolean := False; Recursion_Strategy : in WisiToken.Recursion_Strategy := Full; - Use_Cached_Recursions : in Boolean := False; + Use_Cached_Recursions : in Boolean := False; Recursions : in out WisiToken.Generate.Recursions) return Parse_Table_Ptr is @@ -506,12 +509,6 @@ package body WisiToken.Generate.LR.LALR_Generate is Recursions_Time : Ada.Calendar.Time; - Minimal_Terminal_Sequences : constant Minimal_Sequence_Array := - Compute_Minimal_Terminal_Sequences (Descriptor, Grammar, Grammar_File_Name); - - Minimal_Terminal_First : constant Token_Array_Token_ID := - Compute_Minimal_Terminal_First (Descriptor, Minimal_Terminal_Sequences); - First_Nonterm_Set : constant Token_Array_Token_Set := WisiToken.Generate.First (Grammar, Has_Empty_Production, Descriptor.First_Terminal); @@ -524,7 +521,7 @@ package body WisiToken.Generate.LR.LALR_Generate is Known_Conflicts_Edit : Conflict_Lists.Tree := Known_Conflicts; begin - if not Use_Cached_Recursions or Recursions = Empty_Recursions then + if Error_Recover and then (not Use_Cached_Recursions or Recursions = Empty_Recursions) then case Recursion_Strategy is when None => null; @@ -537,6 +534,7 @@ package body WisiToken.Generate.LR.LALR_Generate is end case; end if; + Set_Grammar_Recursions (Recursions, Grammar); Recursions_Time := Ada.Calendar.Clock; @@ -603,8 +601,8 @@ package body WisiToken.Generate.LR.LALR_Generate is Table.Max_Parallel := Max_Parallel; Add_Actions - (Kernels, Grammar, Has_Empty_Production, First_Terminal_Sequence, First_Nonterm_Set, Table.all, - Descriptor, Known_Conflicts_Edit, Unknown_Conflicts, Grammar_File_Name, Ignore_Conflicts); + (Kernels, Grammar, Precedence_Lists, Has_Empty_Production, First_Terminal_Sequence, First_Nonterm_Set, + Table.all, Descriptor, Known_Conflicts_Edit, Unknown_Conflicts, Grammar_File_Name, Ignore_Conflicts); if Trace_Time then Table_Time := Ada.Calendar.Clock; @@ -612,20 +610,30 @@ package body WisiToken.Generate.LR.LALR_Generate is ("compute parse table time:" & Duration'Image (Ada.Calendar."-" (Table_Time, Recursions_Time))); end if; - for State in Table.States'Range loop - if Trace_Generate_Minimal_Complete > Extra then - Ada.Text_IO.Put_Line ("Set_Minimal_Complete_Actions:" & State_Index'Image (State)); - end if; - WisiToken.Generate.LR.Set_Minimal_Complete_Actions - (Table.States (State), Kernels (State), Descriptor, Grammar, Nullable, Minimal_Terminal_Sequences, - Minimal_Terminal_First); - end loop; + if Table.Error_Recover_Enabled then + declare + Minimal_Terminal_Sequences : constant Minimal_Sequence_Array := + Compute_Minimal_Terminal_Sequences (Descriptor, Grammar, Grammar_File_Name); - if Trace_Time then - Minimal_Actions_Time := Ada.Calendar.Clock; - Ada.Text_IO.Put_Line - ("compute minimal actions time:" & Duration'Image - (Ada.Calendar."-" (Minimal_Actions_Time, Table_Time))); + Minimal_Terminal_First : constant Token_Array_Token_ID := + Compute_Minimal_Terminal_First (Descriptor, Minimal_Terminal_Sequences); + + begin + for State in Table.States'Range loop + if Trace_Generate_Minimal_Complete > Extra then + Ada.Text_IO.Put_Line ("Set_Minimal_Complete_Actions:" & State_Index'Image (State)); + end if; + WisiToken.Generate.LR.Set_Minimal_Complete_Actions + (Table.States (State), Kernels (State), Descriptor, Grammar, Nullable, Minimal_Terminal_Sequences, + Minimal_Terminal_First); + end loop; + end; + if Trace_Time then + Minimal_Actions_Time := Ada.Calendar.Clock; + Ada.Text_IO.Put_Line + ("compute minimal actions time:" & Duration'Image + (Ada.Calendar."-" (Minimal_Actions_Time, Table_Time))); + end if; end if; if Parse_Table_File_Name /= "" then diff --git a/wisitoken-generate-lr-lalr_generate.ads b/wisitoken-generate-lr-lalr_generate.ads index ce4115b..37d954c 100644 --- a/wisitoken-generate-lr-lalr_generate.ads +++ b/wisitoken-generate-lr-lalr_generate.ads @@ -2,7 +2,7 @@ -- -- Generalized LALR parse table generator. -- --- Copyright (C) 2002 - 2003, 2009 - 2010, 2013 - 2015, 2017 - 2020, 2022 Free Software Foundation, Inc. +-- Copyright (C) 2002 - 2003, 2009 - 2010, 2013 - 2015, 2017 - 2020, 2022, 2023 Free Software Foundation, Inc. -- -- This file is part of the WisiToken package. -- @@ -26,6 +26,7 @@ package WisiToken.Generate.LR.LALR_Generate is function Generate (Grammar : in out WisiToken.Productions.Prod_Arrays.Vector; + Precedence_Lists : in WisiToken.Precedence_Lists_Arrays.Vector; Descriptor : in WisiToken.Descriptor; Grammar_File_Name : in String; Error_Recover : in Boolean; diff --git a/wisitoken-generate-lr-lr1_generate.adb b/wisitoken-generate-lr-lr1_generate.adb index 2226fc2..47166b3 100644 --- a/wisitoken-generate-lr-lr1_generate.adb +++ b/wisitoken-generate-lr-lr1_generate.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- This file is part of the WisiToken package. -- @@ -202,6 +202,7 @@ package body WisiToken.Generate.LR.LR1_Generate is (Item_Sets : in LR1_Items.Item_Set_List; Table : in out Parse_Table; Grammar : in WisiToken.Productions.Prod_Arrays.Vector; + Precedence_Lists : in WisiToken.Precedence_Lists_Arrays.Vector; Descriptor : in WisiToken.Descriptor; Declared_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; Unknown_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; @@ -213,8 +214,8 @@ package body WisiToken.Generate.LR.LR1_Generate is begin for Item_Set of Item_Sets loop Add_Actions - (Item_Set, Table, Grammar, Descriptor, Declared_Conflicts, Unknown_Conflicts, First_Nonterm_Set, File_Name, - Ignore_Conflicts); + (Item_Set, Table, Grammar, Precedence_Lists, Descriptor, Declared_Conflicts, Unknown_Conflicts, + First_Nonterm_Set, File_Name, Ignore_Conflicts); end loop; if Trace_Generate_Table > Outline then @@ -224,24 +225,24 @@ package body WisiToken.Generate.LR.LR1_Generate is function Generate (Grammar : in out WisiToken.Productions.Prod_Arrays.Vector; + Precedence_Lists : in WisiToken.Precedence_Lists_Arrays.Vector; Descriptor : in WisiToken.Descriptor; Grammar_File_Name : in String; Error_Recover : in Boolean; - Known_Conflicts : in Conflict_Lists.Tree := Conflict_Lists.Empty_Tree; - McKenzie_Param : in McKenzie_Param_Type := Default_McKenzie_Param; - Max_Parallel : in SAL.Base_Peek_Type := 15; - Parse_Table_File_Name : in String := ""; - Include_Extra : in Boolean := False; - Ignore_Conflicts : in Boolean := False; - Recursion_Strategy : in WisiToken.Recursion_Strategy := Full; - Use_Cached_Recursions : in Boolean := False; + Known_Conflicts : in Conflict_Lists.Tree := Conflict_Lists.Empty_Tree; + McKenzie_Param : in McKenzie_Param_Type := Default_McKenzie_Param; + Max_Parallel : in SAL.Base_Peek_Type := 15; + Parse_Table_File_Name : in String := ""; + Include_Extra : in Boolean := False; + Ignore_Conflicts : in Boolean := False; + Recursion_Strategy : in WisiToken.Recursion_Strategy := Full; + Use_Cached_Recursions : in Boolean := False; Recursions : in out WisiToken.Generate.Recursions) return Parse_Table_Ptr is - Time_Start : constant Ada.Calendar.Time := Ada.Calendar.Clock; - Add_Actions_Time : Ada.Calendar.Time; - Minimal_Actions_Time : Ada.Calendar.Time; - Collect_Conflict_Time : Ada.Calendar.Time; + Time_Start : constant Ada.Calendar.Time := Ada.Calendar.Clock; + Add_Actions_Time : Ada.Calendar.Time; + Minimal_Actions_Time : Ada.Calendar.Time; Ignore_Unused_Tokens : constant Boolean := WisiToken.Trace_Generate_Table > Detail; Ignore_Unknown_Conflicts : constant Boolean := Ignore_Conflicts or WisiToken.Trace_Generate_Table > Detail; @@ -254,12 +255,6 @@ package body WisiToken.Generate.LR.LR1_Generate is Recursions_Time : Ada.Calendar.Time := Ada.Calendar.Clock; - Minimal_Terminal_Sequences : constant Minimal_Sequence_Array := - Compute_Minimal_Terminal_Sequences (Descriptor, Grammar, Grammar_File_Name); - - Minimal_Terminal_First : constant Token_Array_Token_ID := - Compute_Minimal_Terminal_First (Descriptor, Minimal_Terminal_Sequences); - First_Nonterm_Set : constant Token_Array_Token_Set := WisiToken.Generate.First (Grammar, Has_Empty_Production, Descriptor.First_Terminal); @@ -275,7 +270,7 @@ package body WisiToken.Generate.LR.LR1_Generate is Initial_Item_Sets_Time : constant Ada.Calendar.Time := Ada.Calendar.Clock; begin - if not Use_Cached_Recursions or Recursions = Empty_Recursions then + if Error_Recover and then (not Use_Cached_Recursions or Recursions = Empty_Recursions) then case Recursion_Strategy is when None => null; @@ -285,6 +280,7 @@ package body WisiToken.Generate.LR.LR1_Generate is when Full => Recursions := WisiToken.Generate.Compute_Full_Recursion (Grammar, Descriptor); + end case; end if; @@ -345,8 +341,8 @@ package body WisiToken.Generate.LR.LR1_Generate is Table.Max_Parallel := Max_Parallel; Add_Actions - (Item_Sets, Table.all, Grammar, Descriptor, Known_Conflicts_Edit, Unknown_Conflicts, First_Nonterm_Set, - Grammar_File_Name, Ignore_Conflicts); + (Item_Sets, Table.all, Grammar, Precedence_Lists, Descriptor, Known_Conflicts_Edit, Unknown_Conflicts, + First_Nonterm_Set, Grammar_File_Name, Ignore_Conflicts); if Trace_Time then Add_Actions_Time := Ada.Calendar.Clock; @@ -354,28 +350,46 @@ package body WisiToken.Generate.LR.LR1_Generate is ("add_actions time:" & Duration'Image (Ada.Calendar."-" (Add_Actions_Time, Initial_Item_Sets_Time))); end if; - for State in Table.States'Range loop - if Trace_Generate_Minimal_Complete > Extra then - Ada.Text_IO.Put_Line ("Set_Minimal_Complete_Actions:" & State_Index'Image (State)); - end if; - WisiToken.Generate.LR.Set_Minimal_Complete_Actions - (Table.States (State), - LR1_Items.Filter (Item_Sets (State), Grammar, Descriptor, LR1_Items.In_Kernel'Access), - Descriptor, Grammar, Nullable, Minimal_Terminal_Sequences, Minimal_Terminal_First); - end loop; + if Table.Error_Recover_Enabled then + declare + Minimal_Terminal_Sequences : constant Minimal_Sequence_Array := + Compute_Minimal_Terminal_Sequences (Descriptor, Grammar, Grammar_File_Name); - if Trace_Time then - Minimal_Actions_Time := Ada.Calendar.Clock; - Ada.Text_IO.Put_Line - ("compute minimal actions time:" & Duration'Image - (Ada.Calendar."-" (Minimal_Actions_Time, Add_Actions_Time))); - end if; + Minimal_Terminal_First : constant Token_Array_Token_ID := + Compute_Minimal_Terminal_First (Descriptor, Minimal_Terminal_Sequences); + begin + for State in Table.States'Range loop + if Trace_Generate_Minimal_Complete > Extra then + Ada.Text_IO.Put_Line ("Set_Minimal_Complete_Actions:" & State_Index'Image (State)); + end if; + WisiToken.Generate.LR.Set_Minimal_Complete_Actions + (Table.States (State), + LR1_Items.Filter (Item_Sets (State), Grammar, Descriptor, LR1_Items.In_Kernel'Access), + Descriptor, Grammar, Nullable, Minimal_Terminal_Sequences, Minimal_Terminal_First); + end loop; + + if Trace_Time then + Minimal_Actions_Time := Ada.Calendar.Clock; + Ada.Text_IO.Put_Line + ("compute minimal actions time:" & Duration'Image + (Ada.Calendar."-" (Minimal_Actions_Time, Add_Actions_Time))); + end if; - if Trace_Time then - Collect_Conflict_Time := Ada.Calendar.Clock; - Ada.Text_IO.Put_Line - ("compute conflicts time:" & Duration'Image - (Ada.Calendar."-" (Collect_Conflict_Time, Minimal_Actions_Time))); + if Trace_Generate_Table > Detail then + Ada.Text_IO.New_Line; + Ada.Text_IO.Put_Line ("Has_Empty_Production: " & Image (Has_Empty_Production, Descriptor)); + + Ada.Text_IO.New_Line; + Ada.Text_IO.Put_Line ("Minimal_Terminal_First:"); + for ID in Minimal_Terminal_First'Range loop + Ada.Text_IO.Put_Line + (Image (ID, Descriptor) & " =>" & + (if Minimal_Terminal_First (ID) = Invalid_Token_ID + then "" + else ' ' & Image (Minimal_Terminal_First (ID), Descriptor))); + end loop; + end if; + end; end if; if Parse_Table_File_Name /= "" then @@ -384,21 +398,6 @@ package body WisiToken.Generate.LR.LR1_Generate is Unknown_Conflicts, Descriptor, Include_Extra); end if; - if Trace_Generate_Table > Detail then - Ada.Text_IO.New_Line; - Ada.Text_IO.Put_Line ("Has_Empty_Production: " & Image (Has_Empty_Production, Descriptor)); - - Ada.Text_IO.New_Line; - Ada.Text_IO.Put_Line ("Minimal_Terminal_First:"); - for ID in Minimal_Terminal_First'Range loop - Ada.Text_IO.Put_Line - (Image (ID, Descriptor) & " =>" & - (if Minimal_Terminal_First (ID) = Invalid_Token_ID - then "" - else ' ' & Image (Minimal_Terminal_First (ID), Descriptor))); - end loop; - end if; - Check_Conflicts ("LR1", Unknown_Conflicts, Known_Conflicts_Edit, Grammar_File_Name, Descriptor, Ignore_Unknown_Conflicts); diff --git a/wisitoken-generate-lr-lr1_generate.ads b/wisitoken-generate-lr-lr1_generate.ads index 42004e7..8a9ef02 100644 --- a/wisitoken-generate-lr-lr1_generate.ads +++ b/wisitoken-generate-lr-lr1_generate.ads @@ -7,7 +7,7 @@ -- [dragon] "Compilers Principles, Techniques, and Tools" by Aho, -- Sethi, and Ullman (aka: "The [Red] Dragon Book"). -- --- Copyright (C) 2017 - 2020, 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2020, 2022, 2023 Free Software Foundation, Inc. -- -- This file is part of the WisiToken package. -- @@ -30,6 +30,7 @@ package WisiToken.Generate.LR.LR1_Generate is function Generate (Grammar : in out WisiToken.Productions.Prod_Arrays.Vector; + Precedence_Lists : in WisiToken.Precedence_Lists_Arrays.Vector; Descriptor : in WisiToken.Descriptor; Grammar_File_Name : in String; Error_Recover : in Boolean; diff --git a/wisitoken-generate-lr.adb b/wisitoken-generate-lr.adb index 9a5aa54..2520421 100644 --- a/wisitoken-generate-lr.adb +++ b/wisitoken-generate-lr.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -320,7 +320,7 @@ package body WisiToken.Generate.LR is function Apply_Optimized_List_Conflict (Conflict : in out Parse.LR.Action_Node; - Conflict_Count : in Integer; + Conflict_Count : in out Integer; Grammar : in WisiToken.Productions.Prod_Arrays.Vector; Descriptor : in WisiToken.Descriptor; First_Nonterm_Set : in WisiToken.Token_Array_Token_Set; @@ -328,9 +328,9 @@ package body WisiToken.Generate.LR is return Boolean with Pre => Conflict_Count /= 0 -- If Conflict is due to an optimized_list, it is modified to - -- implement the appropriate conflict resolution, and the function - -- returns True. Otherwize, Conflict is not modified, and the - -- function returns False. + -- implement the appropriate conflict resolution, Conflict_Count is + -- decremented, and the function returns True. Otherwise, Conflict, + -- Conflict_Count are not modified, and the function returns False. is use all type Ada.Containers.Count_Type; @@ -533,11 +533,14 @@ package body WisiToken.Generate.LR is end if; end if; end loop; + if Delete_Count = 0 then return False; + elsif Delete_Count + 1 = Conflict_Count then -- Fully resolved; a pure optimized_list conflict. Do deletes below. null; + else -- Mixed optimized_list and grammar conflicts. FIXME: need test case. -- FIXME: also apply declared resolutions to this conflict. @@ -609,6 +612,7 @@ package body WisiToken.Generate.LR is for I in 1 .. Conflict_Count loop if Delete (I) then Parse.LR.Delete (Conflict, Prev, Temp); + Conflict_Count := @ - 1; else Prev := Temp; Temp := Temp.Next; @@ -707,20 +711,17 @@ package body WisiToken.Generate.LR is end Check_Conflicts; - ---------- - -- Build parse table - function Apply_Declared_Resolution (Conflict : in out Parse.LR.Action_Node; Found : in Conflict_Lists.Cursor; - Conflict_Count : in Integer; + Conflict_Count : in out Integer; Declared_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree) return Boolean with Pre => Conflict.Actions.Next /= null and Found /= Conflict_Lists.No_Element - -- If Conflict is matches a declared %conflict_resolution, it is - -- modified to implement the conflict resolution, and the function - -- returns True. Otherwize, Conflict is not modified, and the - -- function returns False. + -- If Conflict matches a declared %conflict_resolution, it is + -- modified to implement the conflict resolution, conflict_Count is + -- decremented, and the function returns True. Otherwise, Conflict, + -- Conflict_Count are not modified, and the function returns False. is use Conflict_Lists; Declared : WisiToken.Generate.LR.Conflict renames Declared_Conflicts (Found); @@ -754,6 +755,7 @@ package body WisiToken.Generate.LR is for I in 1 .. Conflict_Count loop if Delete (I) then Parse.LR.Delete (Conflict, Prev, Temp); + Conflict_Count := @ - 1; else Prev := Temp; Temp := Temp.Next; @@ -763,12 +765,140 @@ package body WisiToken.Generate.LR is return True; end Apply_Declared_Resolution; + function Apply_Precedence + (Conflict : in out Parse.LR.Action_Node; + Conflict_Count : in out Integer; + Grammar : in WisiToken.Productions.Prod_Arrays.Vector; + Precedence_Lists : in WisiToken.Precedence_Lists_Arrays.Vector) + return Boolean + with Pre => Conflict.Actions.Next /= null and Conflict_Count > 1 + -- If a precedence relation applies to Conflict, it is modified to + -- implement the precedence resolution, Conflict_Count is + -- decremented, and the function returns True. Otherwise, Conflict, + -- Conflict_Count are not modified, and the function returns False. + is + Found_Precedence : array (1 .. Conflict_Count) of Base_Precedence_ID := (others => No_Precedence); + Delete : array (1 .. Conflict_Count) of Boolean := (others => False); + + Temp : Parse_Action_Node_Ptr := Conflict.Actions; + Prev : Parse_Action_Node_Ptr := null; + + Non_None_Count : Integer := 0; + begin + for I in 1 .. Conflict_Count loop + Found_Precedence (I) := WisiToken.Productions.Get_Precedence (Grammar, Temp.Item.Production); + if Found_Precedence (I) /= No_Precedence then + Non_None_Count := @ + 1; + end if; + + Temp := Temp.Next; + end loop; + + if Non_None_Count <= 1 then + return False; + end if; + + if Conflict_Count > 2 then + raise SAL.Not_Implemented with "generate apply_precedence conflict_count > 2; must do all combinations."; + end if; + + declare + Relation : constant Precedence_Compare_Result := Compare + (Found_Precedence (1), Found_Precedence (2), Precedence_Lists); + begin + case Relation is + when None => + return False; + + when Left => + Delete (2) := True; + + when Right => + Delete (1) := True; + end case; + end; + + Temp := Conflict.Actions; + for I in 1 .. Conflict_Count loop + if Delete (I) then + Parse.LR.Delete (Conflict, Prev, Temp); + Conflict_Count := @ - 1; + else + Prev := Temp; + Temp := Temp.Next; + end if; + end loop; + + return True; + end Apply_Precedence; + + function Apply_Associativity + (Conflict : in out Parse.LR.Action_Node; + Conflict_Count : in out Integer; + Grammar : in WisiToken.Productions.Prod_Arrays.Vector) + return Boolean + with Pre => Conflict.Actions.Next /= null and Conflict_Count > 1 + -- If an associativity attribute applies to Conflict, it is modified to + -- implement the associativity, Conflict_Count is + -- decremented, and the function returns True. Otherwise, Conflict, + -- Conflict_Count are not modified, and the function returns False. + is + Temp : Parse_Action_Node_Ptr := Conflict.Actions; + Prev : Parse_Action_Node_Ptr := null; + + Delete : array (1 .. Conflict_Count) of Boolean := (others => False); + begin + -- See precedence.wy + if Conflict_Count > 2 then + return False; + end if; + + if Temp.Item.Verb /= Shift then + return False; + end if; + + Temp := Temp.Next; + + declare + List_Production : constant Production_ID := Temp.Item.Production; + List_Associativity : constant Associativity := WisiToken.Productions.Get_Associativity + (Grammar, List_Production); + begin + case List_Associativity is + when None => + return False; + + when Left => + -- Keep the reduce production; always second + Delete (1) := True; + + when Right => + -- Keep the shift production; always first + Delete (2) := True; + end case; + end; + + Temp := Conflict.Actions; + for I in 1 .. Conflict_Count loop + if Delete (I) then + Parse.LR.Delete (Conflict, Prev, Temp); + Conflict_Count := @ - 1; + else + Prev := Temp; + Temp := Temp.Next; + end if; + end loop; + + return True; + end Apply_Associativity; + procedure Add_Action (State : in State_Index; Symbol : in Token_ID; Action : in Parse_Action_Rec; Action_List : in out Action_Arrays.Vector; Grammar : in WisiToken.Productions.Prod_Arrays.Vector; + Precedence_Lists : in WisiToken.Precedence_Lists_Arrays.Vector; Descriptor : in WisiToken.Descriptor; Declared_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; Unknown_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; @@ -835,14 +965,12 @@ package body WisiToken.Generate.LR is Conflict_Count := @ + 1; Temp := Temp.Next; end loop; - pragma Assert (Conflict_Count > 0); + pragma Assert (Conflict_Count > 1); if Trace_Generate_Conflicts > Detail then if Trace_Generate_Conflicts > Extra or Conflict_Count > 2 then Ada.Text_IO.Put_Line - ("conflict on " & Image (Matching_Action_Node.Symbol, Descriptor) & - ", length :" & Conflict_Count'Image); - Ada.Text_IO.Put_Line (Image (WY_Conflict, Descriptor)); + ("state" & State'Image & ": " & Image (WY_Conflict, Descriptor)); Put (Ada.Text_IO.Current_Output, Matching_Action_Node.Actions, Descriptor); Ada.Text_IO.New_Line; if Found_Declared /= Conflict_Lists.No_Element then @@ -859,9 +987,9 @@ package body WisiToken.Generate.LR is Put (Ada.Text_IO.Current_Output, Matching_Action_Node.Actions, Descriptor); Ada.Text_IO.New_Line; end if; + end if; - -- FIXME: apply both resolutions to one conflict. Need test case. must update Conflct_Count. - elsif Apply_Optimized_List_Conflict + if Conflict_Count > 1 and then Apply_Optimized_List_Conflict (Matching_Action_Node, Conflict_Count, Grammar, Descriptor, First_Nonterm_Set, File_Name) then if Trace_Generate_Conflicts > Detail then @@ -869,8 +997,28 @@ package body WisiToken.Generate.LR is Put (Ada.Text_IO.Current_Output, Matching_Action_Node.Actions, Descriptor); Ada.Text_IO.New_Line; end if; + end if; - else + if Conflict_Count > 1 and then Apply_Precedence + (Matching_Action_Node, Conflict_Count, Grammar, Precedence_Lists) + then + if Trace_Generate_Conflicts > Detail then + Ada.Text_IO.Put_Line ("... precedence resolved:"); + Put (Ada.Text_IO.Current_Output, Matching_Action_Node.Actions, Descriptor); + Ada.Text_IO.New_Line; + end if; + end if; + + if Conflict_Count > 1 and then Apply_Associativity (Matching_Action_Node, Conflict_Count, Grammar) + then + if Trace_Generate_Conflicts > Detail then + Ada.Text_IO.Put_Line ("... associativity resolved:"); + Put (Ada.Text_IO.Current_Output, Matching_Action_Node.Actions, Descriptor); + Ada.Text_IO.New_Line; + end if; + end if; + + if Conflict_Count > 1 then if Found_Declared = Conflict_Lists.No_Element then declare Found_Unknown : constant Conflict_Lists.Cursor := @@ -916,6 +1064,7 @@ package body WisiToken.Generate.LR is (Closure : in LR1_Items.Item_Set; Table : in out Parse_Table; Grammar : in WisiToken.Productions.Prod_Arrays.Vector; + Precedence_Lists : in WisiToken.Precedence_Lists_Arrays.Vector; Descriptor : in WisiToken.Descriptor; Declared_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; Unknown_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; @@ -938,8 +1087,8 @@ package body WisiToken.Generate.LR is begin if Item.Dot not in Item_Tokens.First_Index .. Item_Tokens.Last_Index then Add_Lookahead_Actions - (State, Item, Table.States (State).Action_List, Grammar, Descriptor, Declared_Conflicts, - Unknown_Conflicts, First_Nonterm_Set, File_Name, Ignore_Conflicts); + (State, Item, Table.States (State).Action_List, Grammar, Precedence_Lists, Descriptor, + Declared_Conflicts, Unknown_Conflicts, First_Nonterm_Set, File_Name, Ignore_Conflicts); elsif Item_Tokens (Item.Dot) in Descriptor.First_Terminal .. Descriptor.Last_Terminal then @@ -965,7 +1114,8 @@ package body WisiToken.Generate.LR is -- EOF is not pushed on stack in parser, because the action for EOF -- is Accept, not Shift. Table.States (State).Action_List, - Grammar, Descriptor, Declared_Conflicts, Unknown_Conflicts, First_Nonterm_Set, File_Name, + Grammar, Precedence_Lists, Descriptor, Declared_Conflicts, Unknown_Conflicts, + First_Nonterm_Set, File_Name, Ignore_Conflicts); end; else @@ -974,7 +1124,8 @@ package body WisiToken.Generate.LR is (State, Dot_ID, (Shift, P_ID, Goto_State), Table.States (State).Action_List, - Grammar, Descriptor, Declared_Conflicts, Unknown_Conflicts, First_Nonterm_Set, File_Name, + Grammar, Precedence_Lists, Descriptor, Declared_Conflicts, Unknown_Conflicts, + First_Nonterm_Set, File_Name, Ignore_Conflicts); end if; end if; @@ -1007,6 +1158,7 @@ package body WisiToken.Generate.LR is Item : in LR1_Items.Item; Action_List : in out Action_Arrays.Vector; Grammar : in WisiToken.Productions.Prod_Arrays.Vector; + Precedence_Lists : in WisiToken.Precedence_Lists_Arrays.Vector; Descriptor : in WisiToken.Descriptor; Declared_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; Unknown_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; @@ -1029,7 +1181,7 @@ package body WisiToken.Generate.LR is null; else Add_Action - (State, Lookahead, Action, Action_List, Grammar, Descriptor, Declared_Conflicts, + (State, Lookahead, Action, Action_List, Grammar, Precedence_Lists, Descriptor, Declared_Conflicts, Unknown_Conflicts, First_Nonterm_Set, File_Name, Ignore_Conflicts); end if; end if; @@ -1113,7 +1265,7 @@ package body WisiToken.Generate.LR is Error_Message (File_Name => Grammar_File_Name, File_Line => Line_Number_Type'First, - Message => "terminal sequences not resolved:")); + Message => "Compute_Minimal_Terminal_Sequences: terminal sequences not resolved:")); Ada.Text_IO.Put_Line (Ada.Text_IO.Current_Error, @@ -1325,7 +1477,7 @@ package body WisiToken.Generate.LR is -- considering recursion. -- -- Insert_Minimal_Complete_Actions does not need any recursion - -- information at runtim, because we elminate all cases where it + -- information at runtime, because we elminate all cases where it -- might here. -- -- The strategy in Insert_Minimal_Complete_Actions when @@ -1400,7 +1552,7 @@ package body WisiToken.Generate.LR is -- the true Length_After_Dot must be computed at runtime. Recursion -- is not considered, because any other McKensie operation would also -- need to do a reduce to the LHS here. Label is Keep_Always, - -- Minimal_Action is Reduce_Production. + -- Minimal_Action is Reduce. -- -- In state 68 production 115.0, Length_After_Dot is 0 because -- parameter_profile_opt is nullable. We don't ignore recursion in @@ -1931,7 +2083,7 @@ package body WisiToken.Generate.LR is end if; end; - if Include_Extra then + if Include_Extra and Recursions.Recursions.Length > 0 then New_Line; Put_Line ((if Recursions.Full then "Recursions:" else "Partial recursions:")); for I in Recursions.Recursions.First_Index .. Recursions.Recursions.Last_Index loop diff --git a/wisitoken-generate-lr.ads b/wisitoken-generate-lr.ads index b2d34f3..6c99b58 100644 --- a/wisitoken-generate-lr.ads +++ b/wisitoken-generate-lr.ads @@ -2,7 +2,7 @@ -- -- Common utilities for LR parser table generators. -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -122,6 +122,7 @@ package WisiToken.Generate.LR is Action : in Parse_Action_Rec; Action_List : in out Action_Arrays.Vector; Grammar : in WisiToken.Productions.Prod_Arrays.Vector; + Precedence_Lists : in WisiToken.Precedence_Lists_Arrays.Vector; Descriptor : in WisiToken.Descriptor; Declared_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; Unknown_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; @@ -135,6 +136,7 @@ package WisiToken.Generate.LR is (Closure : in LR1_Items.Item_Set; Table : in out Parse_Table; Grammar : in WisiToken.Productions.Prod_Arrays.Vector; + Precedence_Lists : in WisiToken.Precedence_Lists_Arrays.Vector; Descriptor : in WisiToken.Descriptor; Declared_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; Unknown_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; @@ -148,6 +150,7 @@ package WisiToken.Generate.LR is Item : in LR1_Items.Item; Action_List : in out Action_Arrays.Vector; Grammar : in WisiToken.Productions.Prod_Arrays.Vector; + Precedence_Lists : in WisiToken.Precedence_Lists_Arrays.Vector; Descriptor : in WisiToken.Descriptor; Declared_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; Unknown_Conflicts : in out WisiToken.Generate.LR.Conflict_Lists.Tree; diff --git a/wisitoken-generate-packrat.ads b/wisitoken-generate-packrat.ads index 2bb50bc..2363d62 100644 --- a/wisitoken-generate-packrat.ads +++ b/wisitoken-generate-packrat.ads @@ -10,7 +10,7 @@ -- -- See wisitoken-parse-packrat.ads. -- --- Copyright (C) 2018, 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018, 2022, 2023 Free Software Foundation, Inc. -- -- 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 @@ -43,6 +43,7 @@ package WisiToken.Generate.Packrat is Involved : Token_Array_Token_Set (First_Nonterminal .. Last_Nonterminal, First_Nonterminal .. Last_Nonterminal); end record; + type Data_Access is access Data; function Initialize (Source_File_Name : in String; diff --git a/wisitoken-generate-tree_sitter.adb b/wisitoken-generate-tree_sitter.adb index e7ff08e..80f0b51 100644 --- a/wisitoken-generate-tree_sitter.adb +++ b/wisitoken-generate-tree_sitter.adb @@ -1,12 +1,12 @@ -- Abstract : -- --- Translate a wisitoken grammar file to a tree-sitter grammar file. +-- See spec. -- -- References: -- -- [1] tree-sitter grammar: https://tree-sitter.github.io/tree-sitter/creating-parsers#the-grammar-dsl -- --- Copyright (C) 2020 - 2022 Stephen Leake All Rights Reserved. +-- Copyright (C) 2020 - 2023 Stephen Leake All Rights Reserved. -- -- 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 @@ -17,6 +17,7 @@ pragma License (GPL); +with Ada.Strings.Fixed; with Ada.Text_IO; use Ada.Text_IO; with SAL.Gen_Unbounded_Definite_Vectors; with WisiToken.BNF.Output_Ada_Common; @@ -26,16 +27,28 @@ with Wisitoken_Grammar_Actions; use Wisitoken_Grammar_Actions; package body WisiToken.Generate.Tree_Sitter is use WisiToken.Syntax_Trees; + function Is_Possibly_Empty_ID (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access) return Boolean + is (To_Token_Enum (Tree.ID (Node)) in rhs_ID | rhs_item_list_ID | rhs_item_ID); + procedure Eliminate_Empty_Productions - (Data : in out WisiToken_Grammar_Runtime.User_Data_Type; - Tree : in out WisiToken.Syntax_Trees.Tree) + (Data : in out WisiToken_Grammar_Runtime.User_Data_Type; + Tree : in out WisiToken.Syntax_Trees.Tree; + No_Empty : in Boolean) is - Ignore_Lines : Boolean := False; + use all type Ada.Containers.Count_Type; + + Ignore_Lines : Boolean := False; type Empty_Nonterm is record - Name : Ada.Strings.Unbounded.Unbounded_String; + Name : Ada.Strings.Unbounded.Unbounded_String; + -- The nonterm name, for trace messages. + Empty_Node : WisiToken.Syntax_Trees.Node_Access := WisiToken.Syntax_Trees.Invalid_Node_Access; - end record; + -- The first element of an RHS that can be empty. + end record + with Dynamic_Predicate => + Empty_Node = Invalid_Node_Access or else + Is_Possibly_Empty_ID (Tree, Empty_Node); package Empty_Nonterm_Lists is new SAL.Gen_Unbounded_Definite_Vectors (Positive_Index_Type, Empty_Nonterm, Default_Element => (others => <>)); @@ -61,14 +74,16 @@ package body WisiToken.Generate.Tree_Sitter is case To_Token_Enum (Tree.ID (Node)) is when rhs_list_ID => declare + use all type SAL.Base_Peek_Type; RHS_List : constant Constant_List := Creators.Create_List (Tree, Node, +rhs_list_ID, +rhs_ID); begin for RHS of RHS_List loop - if Tree.RHS_Index (RHS) = 0 then + if Tree.Child_Count (RHS) = 0 then return RHS; end if; declare - Empty_Node : constant Node_Access := Can_Be_Empty (Tree.Child (RHS, 1)); + Empty_Node : constant Node_Access := Can_Be_Empty + (Tree.Child (RHS, (if Tree.ID (Tree.Child (RHS, 1)) = +rhs_item_list_ID then 1 else 2))); begin if Empty_Node /= Invalid_Node_Access then return Empty_Node; @@ -99,34 +114,51 @@ package body WisiToken.Generate.Tree_Sitter is when rhs_element_ID => declare - Item : constant Valid_Node_Access := Tree.Find_Descendant (Node, +rhs_item_ID); + Item : constant Valid_Node_Access := Tree.Child (Tree.Find_Descendant (Node, +rhs_item_ID), 1); begin - case Tree.RHS_Index (Item) is - when 0 | 1 => + case To_Token_Enum (Tree.ID (Item)) is + when IDENTIFIER_ID | STRING_LITERAL_SINGLE_ID => return Invalid_Node_Access; - when 2 => + when attribute_ID => -- If the only elements in an rhs_item_list are attributes, the list -- is empty for LR generation purposes. return Item; - when 3 => + when rhs_optional_item_ID => return Item; - when 4 => - case Tree.RHS_Index (Tree.Child (Item, 1)) is - when 0 | 3 | 5 => - return Item; - when 1 | 2 => - return Can_Be_Empty (Tree.Child (Tree.Child (Item, 1), 2)); - when 4 => - return Invalid_Node_Access; - when others => - raise SAL.Programmer_Error; - end case; + when rhs_multiple_item_ID => + declare + use all type SAL.Base_Peek_Type; + First_Child : constant Valid_Node_Access := Tree.Child (Item, 1); + begin + case To_Token_Enum (Tree.ID (First_Child)) is + when LEFT_BRACE_ID => + return + (if Tree.Child_Count (Item) = 3 + then Item + else Invalid_Node_Access); + + when LEFT_PAREN_ID => + return + (if To_Token_Enum (Tree.ID (Tree.Child (Item, 4))) = STAR_ID + then Item + else Invalid_Node_Access); + + when IDENTIFIER_ID => + return + (if To_Token_Enum (Tree.ID (Tree.Child (Item, 2))) = STAR_ID + then Item + else Invalid_Node_Access); + + when others => + raise SAL.Programmer_Error; + end case; + end; - when 5 => - return Can_Be_Empty (Tree.Child (Tree.Child (Item, 1), 2)); + when rhs_group_item_ID => + return Can_Be_Empty (Tree.Child (Item, 2)); when others => raise SAL.Programmer_Error; @@ -135,10 +167,10 @@ package body WisiToken.Generate.Tree_Sitter is when rhs_alternative_list_ID => declare - RHS_Alt_List : constant Constant_List := Creators.Create_List - (Tree, Node, +rhs_alternative_list_ID, +rhs_item_list_ID); + RHS_Alt_List_1 : constant Constant_List := Creators.Create_List + (Tree, Tree.Child (Node, Tree.Child_Count (Node)), +rhs_alternative_list_1_ID, +rhs_item_list_ID); begin - for Item_List of RHS_Alt_List loop + for Item_List of RHS_Alt_List_1 loop declare Empty_Node : constant Node_Access := Can_Be_Empty (Item_List); begin @@ -221,8 +253,11 @@ package body WisiToken.Generate.Tree_Sitter is end case; end; + when rhs_list_ID => + Generate.Put_Error + (Tree.Error_Message (Node, "%if in rhs_list not supported with tree_sitter.")); + when others => - -- FIXME tree-sitter: handle rhs_list %if, %end if null; end case; return; @@ -274,7 +309,7 @@ package body WisiToken.Generate.Tree_Sitter is if Ignore_Lines and Trace_Generate_EBNF > Outline then Ada.Text_IO.Put_Line - ("ignore lines true line" & + ("ignore lines TRUE line" & Tree.Line_Region (Tree.Child (Node, 1), Trailing_Non_Grammar => True).First'Image); end if; @@ -289,14 +324,9 @@ package body WisiToken.Generate.Tree_Sitter is end case; when nonterminal_ID => - -- FIXME tree-sitter: handle %if in rhs_list; need test case - - -- tree-sitter allows the start nonterm of the grammar to be empty. - -- For WisiToken, that's always wisitoken_accept_ID, which is not in - -- the grammar file. So we ignore that case. - declare - Empty_Node : constant Node_Access := Can_Be_Empty (Tree.Child (Node, 3)); + Empty_Node : constant Node_Access := Can_Be_Empty + (Tree.Child (Node, (if Tree.ID (Tree.Child (Node, 3)) = +rhs_list_ID then 3 else 4))); begin if Empty_Node /= Invalid_Node_Access then Empty_Nonterms.Append @@ -309,7 +339,7 @@ package body WisiToken.Generate.Tree_Sitter is Find_Empty_Nodes (Tree.Child (Node, 2)); when others => - raise SAL.Not_Implemented with Image (Tree.ID (Node), Wisitoken_Grammar_Actions.Descriptor); + raise SAL.Not_Implemented with Tree.Image (Node, Node_Numbers => True); end case; end Find_Empty_Nodes; @@ -338,7 +368,7 @@ package body WisiToken.Generate.Tree_Sitter is when rhs_list_ID => -- %if in an rhs_list is not a canonical list element, so we can't - -- use LR_Utils.Delete. + -- use LR_Utils.Delete. Which is why it's not supported. raise SAL.Not_Implemented; when rhs_ID => @@ -356,27 +386,30 @@ package body WisiToken.Generate.Tree_Sitter is end Delete_Node; procedure Make_Non_Empty (Empty_Node : in Valid_Node_Access) - with Pre => To_Token_Enum (Tree.ID (Empty_Node)) in - rhs_ID | rhs_item_list_ID | rhs_item_ID + with Pre => Is_Possibly_Empty_ID (Tree, Empty_Node) + -- Empty_Node is the first item in an RHS that can be empty; change + -- the RHS to be non-empty. is use WisiToken.Syntax_Trees.LR_Utils; use all type SAL.Base_Peek_Type; procedure Make_Non_Empty_RHS_Item (Item : in Valid_Node_Access) - with Pre => Tree.ID (Item) = +rhs_item_ID + with Pre => + Tree.ID (Item) = +rhs_item_ID and + To_Token_Enum (Tree.ID (Tree.Child (Item, 1))) in rhs_optional_item_ID | rhs_multiple_item_ID + -- Edit Item so it cannot be empty. Higher level code promotes the + -- empty case to a higher level nonterm. is Item_Var : Valid_Node_Access := Item; begin - case Tree.RHS_Index (Item) is - when 0 | 1 | 2 => - raise SAL.Programmer_Error; - - when 3 => -- rhs_optional_item + case To_Token_Enum (Tree.ID (Tree.Child (Item, 1))) is + when rhs_optional_item_ID => declare Optional_Item : Valid_Node_Access := Tree.Child (Item, 1); begin - case Tree.RHS_Index (Optional_Item) is - when 0 => + case To_Token_Enum (Tree.ID (Tree.Child (Optional_Item, 1))) is + when LEFT_BRACKET_ID => + Tree.Set_Children (Node => Optional_Item, New_ID => (+rhs_group_item_ID, 0), @@ -387,11 +420,12 @@ package body WisiToken.Generate.Tree_Sitter is Tree.Set_Children (Node => Item_Var, - New_ID => (+rhs_item_ID, 5), + New_ID => (+rhs_item_ID, 4), Children => (1 => Optional_Item)); - when 1 => + when LEFT_PAREN_ID => + Tree.Set_Children (Node => Optional_Item, New_ID => (+rhs_group_item_ID, 0), @@ -399,17 +433,19 @@ package body WisiToken.Generate.Tree_Sitter is Tree.Set_Children (Node => Item_Var, - New_ID => (+rhs_item_ID, 5), + New_ID => (+rhs_item_ID, 4), Children => (1 => Optional_Item)); - when 2 => + when IDENTIFIER_ID => + Tree.Set_Children (Node => Item_Var, New_ID => (+rhs_item_ID, 0), Children => (1 => Tree.Child (Optional_Item, 1))); - when 3 => + when STRING_LITERAL_SINGLE_ID => + Tree.Set_Children (Node => Item_Var, New_ID => (+rhs_item_ID, 1), @@ -420,36 +456,41 @@ package body WisiToken.Generate.Tree_Sitter is end case; end; - when 4 => + when rhs_multiple_item_ID => declare - Multiple_Item : Valid_Node_Access := Tree.Child (Item, 1); + Multiple_Item : Valid_Node_Access := Tree.Child (Item, 1); + First_Child : constant Valid_Node_Access := Tree.Child (Multiple_Item, 1); + First_Child_ID : constant Token_Enum_ID := To_Token_Enum (Tree.ID (First_Child)); begin - case Tree.RHS_Index (Multiple_Item) is - when 0 | 3 | 5 => - Tree.Set_Children - (Multiple_Item, - (+rhs_multiple_item_ID, - (case Tree.RHS_Index (Multiple_Item) is - when 0 => 1, - when 3 => 2, - when 5 => 4, - when others => raise SAL.Programmer_Error)), - (case Tree.RHS_Index (Multiple_Item) is - when 0 | 3 => - (1 => Tree.Child (Multiple_Item, 1), - 2 => Tree.Child (Multiple_Item, 2), - 3 => Tree.Child (Multiple_Item, 3), - 4 => (case Tree.RHS_Index (Multiple_Item) is - when 0 => Tree.Add_Terminal (+MINUS_ID), - when 3 => Tree.Add_Terminal (+PLUS_ID), - when others => raise SAL.Programmer_Error)), - when 5 => (1 => Tree.Child (Multiple_Item, 1)), - when others => raise SAL.Programmer_Error)); + pragma Assert + (case First_Child_ID is + when LEFT_BRACE_ID => Tree.Child_Count (Multiple_Item) = 3, + when LEFT_PAREN_ID => Tree.ID (Tree.Child (Multiple_Item, 4)) = +STAR_ID, + when IDENTIFIER_ID => Tree.ID (Tree.Child (Multiple_Item, 2)) = +STAR_ID, + when others => raise SAL.Programmer_Error); - when others => - raise SAL.Programmer_Error with "make_non_empty_rhs_item " & Tree.Image - (Multiple_Item, RHS_Index => True, Node_Numbers => True); - end case; + Tree.Set_Children + (Node => Multiple_Item, + New_ID => + (LHS => +rhs_multiple_item_ID, + RHS => + (case Tree.RHS_Index (Multiple_Item) is + when 0 => 1, + when 3 => 2, + when 5 => 4, + when others => raise SAL.Programmer_Error)), + Children => + (case Tree.RHS_Index (Multiple_Item) is + when 0 | 3 => + (1 => Tree.Child (Multiple_Item, 1), + 2 => Tree.Child (Multiple_Item, 2), + 3 => Tree.Child (Multiple_Item, 3), + 4 => (case Tree.RHS_Index (Multiple_Item) is + when 0 => Tree.Add_Terminal (+MINUS_ID), + when 3 => Tree.Add_Terminal (+PLUS_ID), + when others => raise SAL.Programmer_Error)), + when 5 => (1 => Tree.Child (Multiple_Item, 1)), + when others => raise SAL.Programmer_Error)); end; when others => @@ -459,23 +500,22 @@ package body WisiToken.Generate.Tree_Sitter is begin case To_Token_Enum (Tree.ID (Empty_Node)) is - when rhs_item_ID => - Make_Non_Empty_RHS_Item (Empty_Node); + when rhs_ID => + -- An empty RHS. + Delete_Node (Empty_Node); when rhs_item_list_ID => - -- Entire item_list can be empty declare - Item_List : constant Constant_List := Creators.Create_List + Item_List : constant Constant_List := Creators.Create_List (Tree, Empty_Node, +rhs_item_list_ID, +rhs_element_ID); + First_Item : constant Valid_Node_Access := Element (Item_List.First); + Item : constant Valid_Node_Access := Tree.Find_Descendant (First_Item, +rhs_item_ID); begin - -- If there is more than one item in the rhs_item_list, we can - -- arbitrarily make the first non-empty. See ada_lite_ebnf.wy - -- handled_sequence_of_statements. - Make_Non_Empty_RHS_Item (Tree.Find_Descendant (Element (Item_List.First), +rhs_item_ID)); + Make_Non_Empty_RHS_Item (Item); end; - when rhs_ID => - Delete_Node (Empty_Node); + when rhs_item_ID => + Make_Non_Empty_RHS_Item (Empty_Node); when others => raise SAL.Programmer_Error; @@ -483,8 +523,12 @@ package body WisiToken.Generate.Tree_Sitter is end Make_Non_Empty; procedure Make_Optional (Name : in String) + -- Convert all occurences of Name in RHS to optional, because it used + -- to be possibly empty. Add edited nonterms to Node_To_Check; they + -- may now be possibly empty. is procedure Find_Nodes (Node : in Valid_Node_Access) + -- Search subtree at Node for Name is use all type SAL.Base_Peek_Type; Node_Var : Node_Access := Node; @@ -495,30 +539,25 @@ package body WisiToken.Generate.Tree_Sitter is when wisitoken_accept_ID => Find_Nodes (Tree.Child (Node, 2)); + when rhs_alternative_list_ID => + Find_Nodes (Tree.Child (Node, Tree.Child_Count (Node))); + when compilation_unit_ID => Find_Nodes (Tree.Child (Node, 1)); - when compilation_unit_list_ID | rhs_alternative_list_ID | rhs_item_list_ID | rhs_list_ID => + when compilation_unit_list_ID | rhs_alternative_list_1_ID | rhs_item_list_ID | rhs_list_ID => declare Children : constant Node_Access_Array := Tree.Children (Node); begin - case Tree.RHS_Index (Node) is - when 0 => - Find_Nodes (Children (1)); - - when 1 => - Find_Nodes (Children (1)); + Find_Nodes (Children (1)); + if Tree.Child_Count (Node) > 1 then Find_Nodes (Children - ((if To_Token_Enum (Tree.ID (Node)) in rhs_list_ID | rhs_alternative_list_ID then 3 else 2))); - - when others => - -- rhs_list can have other rhs_index, but those nodes should have been - -- deleted by now. - raise SAL.Programmer_Error with "Make_Optional.Find_Nodes list: rhs_index" & - Tree.RHS_Index (Node)'Image & " node " & Tree.Image - (Node, Node_Numbers => True); - end case; + (case To_Token_Enum (Tree.ID (Node)) is + when compilation_unit_list_ID | rhs_item_list_ID => 2, + when rhs_alternative_list_1_ID | rhs_list_ID => 3, + when others => raise SAL.Programmer_Error)); + end if; end; when declaration_ID => @@ -538,24 +577,29 @@ package body WisiToken.Generate.Tree_Sitter is Find_Nodes (Tree.Child (Node, 2)); when rhs_item_ID => - case Tree.RHS_Index (Node) is - when 0 | 1 => + case To_Token_Enum (Tree.ID (Tree.Child (Node, 1))) is + when IDENTIFIER_ID => if Name = Get_Text (Tree.Child (Node, 1)) then + -- IMPROVEME: could check if already optional (ie parent is single + -- rhs_item_list contained in single rhs_alternative_list contained + -- in rhs_optional_item), which means the source grammar should be + -- changed. + Nodes_To_Check.Append (Node); declare Child : constant Valid_Node_Access := WisiToken_Grammar_Editing.Add_RHS_Optional_Item (Tree, - RHS_Index => (if Tree.RHS_Index (Node) = 0 then 2 else 3), + RHS_Index => 2, -- IDENTIFIER QUESTION Content => Tree.Child (Node, 1)); begin - Tree.Set_Children (Node_Var, (+rhs_item_ID, 3), (1 => Child)); + Tree.Set_Children (Node_Var, (+rhs_item_ID, 2), (1 => Child)); end; end if; - when 2 => + when STRING_LITERAL_SINGLE_ID => null; - when 3 | 4 | 5 => + when attribute_ID | rhs_optional_item_ID | rhs_multiple_item_ID | rhs_group_item_ID => Find_Nodes (Tree.Child (Node, 1)); when others => @@ -563,19 +607,18 @@ package body WisiToken.Generate.Tree_Sitter is end case; when rhs_multiple_item_ID => - case Tree.RHS_Index (Node) is - when 0 | 1 | 2 | 3 => + case To_Token_Enum (Tree.ID (Tree.Child (Node, 1))) is + when LEFT_BRACE_ID | LEFT_PAREN_ID => Find_Nodes (Tree.Child (Node, 2)); - when 4 => - Nodes_To_Check.Append (Node); - - Tree.Set_Children - (Node_Var, (+rhs_multiple_item_ID, 5), (Tree.Child (Node, 1), Tree.Add_Terminal (+STAR_ID))); + when IDENTIFIER_ID => + if Name = Get_Text (Tree.Child (Node, 1)) and + To_Token_Enum (Tree.ID (Tree.Child (Node, 2))) = STAR_ID + then + Generate.Put_Error + (Tree.Error_Message (Node, "'" & Name & "' is both optional and possibly empty.")); + end if; - when 5 => - -- already optional - null; when others => raise SAL.Programmer_Error; end case; @@ -610,17 +653,33 @@ package body WisiToken.Generate.Tree_Sitter is end Make_Optional; begin + WisiToken_Grammar_Editing.EBNF_Allowed := True; + if Trace_Generate_EBNF > Outline then Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("tree_sitter eliminate empty productions start"); if Trace_Generate_EBNF > Detail then Tree.Print_Tree (Tree.Root); + Ada.Text_IO.New_Line; end if; end if; Find_Empty_Nodes (Tree.Root); -- Also finds %if etc, adds them to Nodes_To_Delete. + if No_Empty and Empty_Nonterms.Length > 0 then + declare + use Ada.Strings.Unbounded; + Empty_Image : Unbounded_String; + begin + for Nonterm of Empty_Nonterms loop + Append (Empty_Image, Nonterm.Name); + Append (Empty_Image, " "); + end loop; + raise Grammar_Error with "Tree_Sitter forbids possibly empty nonterms: " & (-Empty_Image); + end; + end if; + if Trace_Generate_EBNF > Outline then Ada.Text_IO.Put_Line ("nodes to delete:" & Nodes_To_Delete.Length'Image); end if; @@ -628,14 +687,18 @@ package body WisiToken.Generate.Tree_Sitter is for Node of Nodes_To_Delete loop Delete_Node (Node); end loop; + Nodes_To_Delete.Clear; Data.Error_Reported.Clear; - Tree.Validate_Tree - (Data, Data.Error_Reported, - Root => Tree.Root, - Validate_Node => WisiToken_Grammar_Editing.Validate_Node'Access, - Node_Index_Order => True); + if Debug_Mode then + Tree.Validate_Tree + (Data'Unchecked_Access, Data.Error_Reported, + Root => Tree.Root, + Validate_Node => WisiToken_Grammar_Editing.Validate_Node'Access, + Node_Index_Order => True, + Line_Number_Order => False); + end if; if Trace_Generate_EBNF > Outline then Ada.Text_IO.Put_Line ("empty nonterms:"); @@ -646,6 +709,8 @@ package body WisiToken.Generate.Tree_Sitter is end if; for Nonterm of Empty_Nonterms loop + -- IMPROVEME: tree-sitter allows the start nonterm of the grammar to be empty, + -- but no other nonterms may be empty. But we don't find Start_Node until we are in Print_Tree_Sitter. Make_Non_Empty (Nonterm.Empty_Node); end loop; @@ -654,11 +719,13 @@ package body WisiToken.Generate.Tree_Sitter is Ada.Text_IO.New_Line; end if; - Tree.Validate_Tree - (Data, Data.Error_Reported, - Root => Tree.Root, - Validate_Node => WisiToken_Grammar_Editing.Validate_Node'Access, - Node_Index_Order => False); + if Debug_Mode then + Tree.Validate_Tree + (Data'Unchecked_Access, Data.Error_Reported, + Root => Tree.Root, + Validate_Node => WisiToken_Grammar_Editing.Validate_Node'Access, + Node_Index_Order => False); -- Implies Line_Number_Order = False + end if; for Nonterm of Empty_Nonterms loop Make_Optional (-Nonterm.Name); @@ -669,11 +736,13 @@ package body WisiToken.Generate.Tree_Sitter is Ada.Text_IO.New_Line; end if; - Tree.Validate_Tree - (Data, Data.Error_Reported, - Root => Tree.Root, - Validate_Node => WisiToken_Grammar_Editing.Validate_Node'Access, - Node_Index_Order => False); + if Debug_Mode then + Tree.Validate_Tree + (Data'Unchecked_Access, Data.Error_Reported, + Root => Tree.Root, + Validate_Node => WisiToken_Grammar_Editing.Validate_Node'Access, + Node_Index_Order => False); + end if; declare use Valid_Node_Access_Lists; @@ -712,16 +781,18 @@ package body WisiToken.Generate.Tree_Sitter is Ada.Text_IO.New_Line; end if; - Tree.Validate_Tree - (Data, Data.Error_Reported, - Root => Tree.Root, - Validate_Node => WisiToken_Grammar_Editing.Validate_Node'Access, - Node_Index_Order => False); + if Debug_Mode then + Tree.Validate_Tree + (Data'Unchecked_Access, Data.Error_Reported, + Root => Tree.Root, + Validate_Node => WisiToken_Grammar_Editing.Validate_Node'Access, + Node_Index_Order => False); + end if; if Trace_Generate_EBNF > Detail then - Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("tree_sitter eliminate empty productions end"); Tree.Print_Tree (Tree.Root); + Ada.Text_IO.New_Line; end if; end Eliminate_Empty_Productions; @@ -734,7 +805,24 @@ package body WisiToken.Generate.Tree_Sitter is is use all type Ada.Containers.Count_Type; - File : File_Type; + -- We process the EBNF tree, not the grammar description in Data, to + -- take advantage of the higher-level tree_sitter grammar + -- descriptions like 'optional' and 'repeat'. + + -- 'hidden rules' + -- (https://tree-sitter.github.io/tree-sitter/creating-parsers#hiding-rules) + -- are different from 'inline' + -- (https://tree-sitter.github.io/tree-sitter/creating-parsers#the-grammar-dsl); + -- hidden rules are in the parse table, inline are not. The parse + -- action for hidden rules does not create a syntax tree node. We + -- don't support them in the wisi parser generator, because that + -- would mean Undo_Reduce cannot be implemented, which is required + -- for our error recover algorithm. (IMPROVEME: maybe undo_reduce + -- is just more complicated?). + -- + -- For now, we don't use them in the generated tree-sitter grammar, + -- so client code doesn't care whether it's a wisi or tree-sitter + -- parser. Extras : WisiToken.BNF.String_Lists.List; Conflicts : WisiToken.BNF.String_Lists.List; @@ -748,6 +836,13 @@ package body WisiToken.Generate.Tree_Sitter is -- Local bodies + procedure Put_Commented (Text : in WisiToken.BNF.String_Lists.List) + is begin + for Line of Text loop + Put_Line ("// " & Line); + end loop; + end Put_Commented; + function Get_Text (Tree_Index : in Valid_Node_Access) return String is function Strip_Delimiters (Tree_Index : in Valid_Node_Access) return String @@ -796,15 +891,15 @@ package body WisiToken.Generate.Tree_Sitter is procedure Not_Translated (Label : in String; Node : in Valid_Node_Access) is begin - New_Line (File); - Put (File, "// " & Label & ": not translated: " & Node_Access'Image (Node) & ":" & + New_Line; + Put ("// " & Label & ": not translated: " & Node_Access'Image (Node) & ":" & Tree.Image (Node, Children => True)); Put_Line (Current_Error, Tree.Error_Message (Node, - "not translated: " & + Label & ": not translated: " & Tree.Image (Node, RHS_Index => True, @@ -812,50 +907,85 @@ package body WisiToken.Generate.Tree_Sitter is Node_Numbers => True))); end Not_Translated; - procedure Put_RHS_Alternative_List (Node : in Valid_Node_Access; First : in Boolean) - with Pre => Tree.ID (Node) = +rhs_alternative_list_ID + procedure Put_Attr_List (Attr_List : in Valid_Node_Access) + is + Prec : constant WisiToken.Base_Precedence_ID := WisiToken_Grammar_Runtime.Get_Precedence + (Data, Tree, Attr_List); + Assoc : constant WisiToken.Associativity := WisiToken_Grammar_Runtime.Get_Associativity + (Data, Tree, Attr_List); + begin + case Assoc is + when Left => + Put ("prec.left("); + + when Right => + Put ("prec.right("); + + when None => + pragma Assert (Prec /= No_Precedence); + Put ("prec("); + end case; + if Prec /= No_Precedence then + Put ("'" & (-Data.Precedence_Inverse_Map (Prec)) & "', "); + end if; + end Put_Attr_List; + + procedure Put_RHS_Alternative_List_1 (Node : in Valid_Node_Access; First : in Boolean) + with Pre => Tree.ID (Node) = +rhs_alternative_list_1_ID is begin - case Tree.RHS_Index (Node) is - when 0 => - -- If only alternative, don't need "choice()". + case To_Token_Enum (Tree.ID (Tree.Child (Node, 1))) is + when rhs_item_list_ID => + -- Only one alternative, don't need "choice()". Put_RHS_Item_List (Tree.Child (Node, 1), First => True); - when 1 => + when rhs_alternative_list_1_ID => if First then - Put (File, "choice("); + Put ("choice("); end if; - Put_RHS_Alternative_List (Tree.Child (Node, 1), First => False); - Put (File, ", "); + Put_RHS_Alternative_List_1 (Tree.Child (Node, 1), First => False); + Put (", "); Put_RHS_Item_List (Tree.Child (Node, 3), First => True); if First then - Put (File, ")"); + Put (")"); end if; when others => - Not_Translated ("Put_RHS_Alternative_List", Node); + Not_Translated ("Put_RHS_Alternative_List_1", Node); end case; + end Put_RHS_Alternative_List_1; + + procedure Put_RHS_Alternative_List (Node : in Valid_Node_Access) + with Pre => Tree.ID (Node) = +rhs_alternative_list_ID + is + RHS_Alt_List_1 : Valid_Node_Access := Tree.Child (Node, 1); + begin + if Tree.ID (Tree.Child (Node, 1)) = +attribute_list_ID then + Put_Attr_List (Tree.Child (Node, 1)); + RHS_Alt_List_1 := Tree.Child (Node, 2); + end if; + + Put_RHS_Alternative_List_1 (RHS_Alt_List_1, First => True); end Put_RHS_Alternative_List; procedure Put_RHS_Optional_Item (Node : in Valid_Node_Access) with Pre => Tree.ID (Node) = +rhs_optional_item_ID is begin - Put (File, "optional("); - - case Tree.RHS_Index (Node) is - when 0 | 1 => - Put_RHS_Alternative_List (Tree.Child (Node, 2), First => True); - when 2 => - Put (File, "$." & Get_Text (Tree.Child (Node, 1))); - when 3 => - -- STRING_LITERAL_2 - Put (File, Get_Text (Tree.Child (Node, 1))); + Put ("optional("); + + case To_Token_Enum (Tree.ID (Tree.Child (Node, 1))) is + when LEFT_BRACKET_ID | LEFT_PAREN_ID => + Put_RHS_Alternative_List (Tree.Child (Node, 2)); + when IDENTIFIER_ID => + Put ("$." & Get_Text (Tree.Child (Node, 1))); + when STRING_LITERAL_SINGLE_ID => + Put (Get_Text (Tree.Child (Node, 1))); when others => - Not_Translated ("Put_RHS_Optional_Item", Node); + raise SAL.Programmer_Error; end case; - Put (File, ")"); + Put (")"); end Put_RHS_Optional_Item; procedure Put_RHS_Multiple_Item (Node : in Valid_Node_Access) @@ -863,24 +993,24 @@ package body WisiToken.Generate.Tree_Sitter is is begin case Tree.RHS_Index (Node) is when 0 | 3 => - Put (File, "repeat("); - Put_RHS_Alternative_List (Tree.Child (Node, 2), First => True); - Put (File, ")"); + Put ("repeat("); + Put_RHS_Alternative_List (Tree.Child (Node, 2)); + Put (")"); when 1 | 2 => - Put (File, "repeat1("); - Put_RHS_Alternative_List (Tree.Child (Node, 2), First => True); - Put (File, ")"); + Put ("repeat1("); + Put_RHS_Alternative_List (Tree.Child (Node, 2)); + Put (")"); when 4 => - Put (File, "repeat1("); - Put (File, "$." & Get_Text (Tree.Child (Node, 1))); - Put (File, ")"); + Put ("repeat1("); + Put ("$." & Get_Text (Tree.Child (Node, 1))); + Put (")"); when 5 => - Put (File, "repeat("); - Put (File, "$." & Get_Text (Tree.Child (Node, 1))); - Put (File, ")"); + Put ("repeat("); + Put ("$." & Get_Text (Tree.Child (Node, 1))); + Put (")"); when others => Not_Translated ("Put_RHS_Multiple_Item", Node); @@ -890,84 +1020,63 @@ package body WisiToken.Generate.Tree_Sitter is procedure Put_RHS_Group_Item (Node : in Valid_Node_Access) with Pre => Tree.ID (Node) = +rhs_group_item_ID is begin - Put_RHS_Alternative_List (Tree.Child (Node, 2), First => True); + Put_RHS_Alternative_List (Tree.Child (Node, 2)); end Put_RHS_Group_Item; procedure Put_RHS_Item (Node : in Valid_Node_Access) with Pre => Tree.ID (Node) = +rhs_item_ID - is begin - case Tree.RHS_Index (Node) is - when 0 => + is + function Keyword_Name (Decl : in Valid_Node_Access) return String + with Pre => KEYWORD_ID = To_Token_Enum (Tree.ID (Tree.Child (Decl, 2))) + is begin + return Get_Text (Tree.Child (Decl, 3)); + end Keyword_Name; + + begin + case To_Token_Enum (Tree.ID (Tree.Child (Node, 1))) is + when IDENTIFIER_ID => + Put ("$." & Get_Text (Node)); + + when STRING_LITERAL_SINGLE_ID => + -- Case insensitive declare - Ident : constant String := Get_Text (Node); - Decl : constant Node_Access := WisiToken_Grammar_Editing.Find_Declaration (Data, Tree, Ident); + Text : constant String := Get_Text (Node); + + -- Token may be declared with "...", but referenced with '...'. + Decl : constant Node_Access := WisiToken_Grammar_Editing.Find_Declaration_By_Value + (Data, Tree, Text (Text'First + 1 .. Text'Last - 1), Strip_Quotes => True); begin if Decl = Invalid_Node_Access then - Generate.Put_Error (Tree.Error_Message (Node, "decl for '" & Ident & "' not found")); - - elsif Tree.ID (Decl) = +nonterminal_ID then - Put (File, "$." & Get_Text (Tree.Child (Decl, 1))); - + Put ("caseInsensitive(" & Text & ")"); else - case Tree.RHS_Index (Decl) is - when 0 => - case To_Token_Enum (Tree.ID (Tree.Child (Tree.Child (Decl, 2), 1))) is - when KEYWORD_ID => - Put (File, Get_Text (Tree.Child (Decl, 4))); - - when NON_GRAMMAR_ID => - Not_Translated ("put_rhs_item", Node); - - when Wisitoken_Grammar_Actions.TOKEN_ID => - declare - use WisiToken.Syntax_Trees.LR_Utils; - List : constant Constant_List := Creators.Create_List - (Tree, Tree.Child (Decl, 4), +declaration_item_list_ID, +declaration_item_ID); - Item : constant Valid_Node_Access := Tree.Child (Element (List.First), 1); - begin - case To_Token_Enum (Tree.ID (Item)) is - when REGEXP_ID => - Put (File, "$." & Ident); - - when STRING_LITERAL_1_ID | STRING_LITERAL_2_ID => - -- FIXME tree-sitter: STRING_LITERAL_1_ID in regexp is case insensitive; not - -- clear how to do that in tree-sitter. - Put (File, Get_Text (Item)); - - when others => - Not_Translated ("put_rhs_item ident token", Node); - end case; - end; + case To_Token_Enum (Tree.ID (Tree.Child (Decl, 2))) is + when Wisitoken_Grammar_Actions.TOKEN_ID => + -- Assume it's punctuation or similar where case doesn't matter. + Put (Text); - when others => - Not_Translated ("put_rhs_item ident", Node); - end case; + when KEYWORD_ID => + Put ("$." & Keyword_Name (Decl)); when others => - Not_Translated ("put_rhs_item 0", Node); + raise SAL.Programmer_Error; end case; end if; end; - when 1 => - -- STRING_LITERAL_2 - Put (File, Get_Text (Node)); - - when 2 => - -- ignore attribute + when attribute_ID => null; - when 3 => + when rhs_optional_item_ID => Put_RHS_Optional_Item (Tree.Child (Node, 1)); - when 4 => + when rhs_multiple_item_ID => Put_RHS_Multiple_Item (Tree.Child (Node, 1)); - when 5 => + when rhs_group_item_ID => Put_RHS_Group_Item (Tree.Child (Node, 1)); when others => - Not_Translated ("Put_RHS_Item", Node); + raise SAL.Programmer_Error with "node: " & Trimmed_Image (Node); end case; end Put_RHS_Item; @@ -979,11 +1088,12 @@ package body WisiToken.Generate.Tree_Sitter is Put_RHS_Item (Tree.Child (Node, 1)); when 1 => - -- Ignore the label + Put ("field('" & Get_Text (Tree.Child (Node, 1)) & "', "); Put_RHS_Item (Tree.Child (Node, 3)); + Put (")"); when others => - Not_Translated ("Put_RHS_Element", Node); + raise SAL.Programmer_Error; end case; end Put_RHS_Element; @@ -995,14 +1105,14 @@ package body WisiToken.Generate.Tree_Sitter is Put_RHS_Element (Children (1)); else if First then - Put (File, "seq("); + Put ("seq("); end if; Put_RHS_Item_List (Children (1), First => False); - Put (File, ", "); + Put (", "); Put_RHS_Element (Children (2)); if First then - Put (File, ")"); + Put (")"); end if; end if; end Put_RHS_Item_List; @@ -1022,12 +1132,21 @@ package body WisiToken.Generate.Tree_Sitter is when others => Tree.Child (RHS_List, 2))), "empty RHS forbidden by tree-sitter")); - when 1 .. 3 => - Put_RHS_Item_List (Tree.Child (Node, 1), First => True); - -- tree-sitter does not have actions in the grammar + when 1 .. 6 => + if Tree.ID (Tree.Child (Node, 1)) = +attribute_list_ID then + Put_Attr_List (Tree.Child (Node, 1)); + Put_RHS_Item_List (Tree.Child (Node, 2), First => True); + Put (')'); + else + Put_RHS_Item_List (Tree.Child (Node, 1), First => True); + end if; + + -- tree-sitter does not have actions in the grammar. FIXME: output + -- actions map to separate file for Emacs wisi with tree-sitter + -- parser. when others => - Not_Translated ("put_rhs", Node); + raise SAL.Programmer_Error; end case; end Put_RHS; @@ -1042,27 +1161,46 @@ package body WisiToken.Generate.Tree_Sitter is when 1 => if First then - Put (File, "choice("); + Put ("choice("); + Indent := @ + 2; end if; Put_RHS_List (Children (1), First => False); - Put (File, ","); + Put (", "); Put_RHS (Children (3)); if First then - Put (File, ")"); + Put (")"); + Indent := @ - 2; end if; - when 2 .. 4 => - -- Should have been eliminated by Eliminate_Empty_Productions - raise SAL.Programmer_Error with "Print_Tree_Sitter rhs_list %if " & - Tree.Image (Node, Node_Numbers => True); + when 2 .. 6 => + -- Could have been eliminated by Eliminate_Empty_Productions, but that's hard. + Generate.Put_Error + (Tree.Error_Message (Node, "%if in rhs_list not supported with tree_sitter.")); when others => raise SAL.Programmer_Error; end case; end Put_RHS_List; + function String_Regexp (Value : in Valid_Node_Access) return String + with Pre => To_Token_Enum (Tree.ID (Value)) in STRING_LITERAL_DOUBLE_ID | STRING_LITERAL_SINGLE_ID | REGEXP_ID + -- Return a javascript expression for Value + is + use Ada.Strings, Ada.Strings.Fixed; + begin + return + (case To_Token_Enum (Tree.ID (Value)) is + when STRING_LITERAL_DOUBLE_ID | STRING_LITERAL_SINGLE_ID => Get_Text (Value), + + when REGEXP_ID => + -- Value must be '/.../' or 'new RegExp("...")' as needed; not checked here. + Trim (Get_Text (Value), Both), + + when others => raise SAL.Programmer_Error); + end String_Regexp; + procedure Process_Node (Node : in Valid_Node_Access) is begin if Node = Start_Node then @@ -1079,143 +1217,224 @@ package body WisiToken.Generate.Tree_Sitter is Process_Node (Tree.Child (Node, 1)); when compilation_unit_list_ID => - declare - Children : constant Node_Access_Array := Tree.Children (Node); - begin - case To_Token_Enum (Tree.ID (Children (1))) is - when compilation_unit_list_ID => - Process_Node (Children (1)); - Process_Node (Children (2)); - when compilation_unit_ID => - Process_Node (Children (1)); - when others => - raise SAL.Programmer_Error; - end case; - end; + raise SAL.Programmer_Error; when declaration_ID => - raise SAL.Not_Implemented with "FIXME: match current wisitoken_grammar.wy"; - -- case To_Token_Enum (Tree.ID (Tree.Child (Node, 2))) is - -- when Wisitoken_Grammar_Actions.TOKEN_ID | NON_GRAMMAR_ID => - -- -- We need tokens with 'regexp' values because they are not defined - -- -- elsewhere, 'punctuation' tokens for consistent names, and - -- -- 'line-comment' to allow comments. tree-sitter default 'extras' - -- -- handles whitespace and newline, but if we define 'comment', we - -- -- also need 'new-line' and 'whitespace'. - -- declare - -- use Ada.Strings; - -- use Ada.Strings.Fixed; - -- use WisiToken.Syntax_Trees.LR_Utils; - -- Name : constant String := Get_Text (Tree.Child (Node, 3)); - -- Class : constant Token_Enum_ID := To_Token_Enum (Tree.ID (Tree.Child (Tree.Child (Node, 2), 1))); - -- Kind : constant String := - -- (if Class in NON_GRAMMAR_ID | Wisitoken_Grammar_Actions.TOKEN_ID - -- then Get_Text (Tree.Child (Tree.Child (Node, 2), 3)) - -- else "keyword"); - -- List : constant Constant_List := Creators.Create_List - -- (Tree, Tree.Child (Node, 4), +declaration_item_list_ID, +declaration_item_ID); - -- Value : constant Valid_Node_Access := Tree.Child (Element (List.First), 1); - -- -- We are ignoring any repair image - -- begin - -- if Class = NON_GRAMMAR_ID then - -- if Kind = "line-comment" then - -- -- WORKAROUND: tree-sitter 0.16.6 treats rule "token(seq('--', - -- -- /.*/))" correctly for an Ada comment, but not extra "/--.*/". See - -- -- github tree-sitter issue 651 - closed without resolving this - -- -- question, but it does provide a workaround. - -- Put_Line (File, Name & ": $ => token(seq(" & Get_Text (Value) & ", /.*/)),"); - -- Extras.Append ("$." & Name); - -- else - -- Extras.Append ("/" & Trim (Get_Text (Value), Both) & "/"); - -- end if; - - -- elsif Kind = "punctuation" then - -- Put_Line (File, Name & ": $ => " & Get_Text (Value) & ","); - - -- elsif To_Token_Enum (Tree.ID (Value)) = REGEXP_ID then - -- Put_Line (File, Name & ": $ => /" & Trim (Get_Text (Value), Both) & "/,"); - - -- end if; - -- end; - - -- when 1 => - -- -- new-line with no regexp; tree-sitter defaults to DOS, Unix newline. - -- null; - - -- when 2 => - -- -- FIXME tree-sitter: CODE copyright_license - -- null; - - -- when 3 => - -- declare - -- Kind : constant String := Get_Text (Tree.Child (Node, 2)); - -- begin - -- -- FIXME tree-sitter: lexer_regexp - -- if Kind = "conflict" then - -- -- .wy LR format: - -- -- %conflict action LHS [| action LHS]* 'on token' on - -- -- I I+1 - -- -- - -- -- .wy Tree_Sitter format: - -- -- %conflict LHS (LHS)* - -- -- - -- -- .js format: - -- -- [$.LHS, $.LHS, ...] - - -- declare - -- use Ada.Strings.Unbounded; - - -- Tree_Indices : constant Valid_Node_Access_Array := Tree.Get_Terminals (Tree.Child (Node, 3)); - -- Result : Unbounded_String := +"["; - -- begin - -- if Tree_Indices'Length < 3 or else Tree.ID (Tree_Indices (3)) /= +BAR_ID then - -- -- Tree_Sitter format - -- for LHS of Tree_Indices loop - -- Result := @ & "$." & Get_Text (LHS) & ", "; - -- end loop; - - -- else - -- -- LR format - -- declare - -- use all type SAL.Base_Peek_Type; - -- I : SAL.Peek_Type := Tree_Indices'First; - -- begin - -- loop - -- Result := @ & "$." & Get_Text (Tree_Indices (I + 1)) & ", "; - - -- I := I + 2; - -- exit when Tree.ID (Tree_Indices (I)) /= +BAR_ID; - -- I := I + 1; - -- end loop; - -- end; - -- end if; - -- Conflicts.Append (-Result & ']'); - -- end; - -- end if; - -- end; - - -- when 4 => - -- -- %case_insensitive - -- null; - - -- when 5 .. 9 => - -- -- Should have been eliminated by Eliminate_Empty_Productions - -- raise SAL.Programmer_Error with "Print_Tree_Sitter declaration %if " & - -- Tree.Image (Node, Node_Numbers => True); - - -- when others => - -- raise SAL.Programmer_Error; - -- end case; + case To_Token_Enum (Tree.ID (Tree.Child (Node, 2))) is + when Wisitoken_Grammar_Actions.TOKEN_ID | NON_GRAMMAR_ID => + declare + Kind : constant String := Get_Text (Tree.Child (Node, 4)); + Name : constant String := Get_Text (Tree.Child (Node, 6)); + Regexp_String : constant Node_Access := Tree.Child (Node, 7); + Value : constant Node_Access := + (if Regexp_String = Invalid_Node_Access + then Invalid_Node_Access + else Tree.Child (Regexp_String, 1)); + -- We are ignoring any repair image; tree_sitter grammar does not + -- support that. + begin + + if Kind = "comment-new-line" then + if not (To_Token_Enum (Tree.ID (Value)) in + STRING_LITERAL_DOUBLE_ID | STRING_LITERAL_SINGLE_ID) + then + Generate.Put_Error + (Tree.Error_Message + (Node, "string literal required for comment-new-line; found " & + Image (Tree.ID (Value), Tree.Lexer.Descriptor.all))); + else + + -- WORKAROUND: tree-sitter 0.16.6 treats rule "token(seq('--', + -- /.*/))" correctly for an Ada comment, but not extra "/--.*/". See + -- github tree-sitter issue 651 - closed without resolving this + -- question, but it does provide a workaround. + Indent_Line (Name & ": $ => token(seq(" & Get_Text (Value) & ", /.*/)),"); + New_Line; + Extras.Append ("$." & Name); + end if; + + elsif Kind = "comment-one-line" then + -- FIXME: We need to provide an external scanner for this. + raise SAL.Not_Implemented with "comment-one-line not implemented in tree_sitter"; + + elsif Kind = "delimited-text" then + -- FIXME: We need to provide an external scanner for this. + raise SAL.Not_Implemented with "comment-one-line not implemented in tree_sitter"; + + elsif Value = Invalid_Node_Access then + -- new-line with no regexp; tree-sitter defaults to DOS and Unix newline. + null; + + else + -- If the source grammar uses string literals in the nonterminal + -- RHSs, we don't need to define this token. However, some code using + -- this parser may rely on the token names, so we define them to + -- ensure they are the same for wisi and tree-sitter parsers. + Indent_Line (Name & ": $ => " & String_Regexp (Value) & ","); + New_Line; + end if; + end; + + when KEYWORD_ID => + declare + Name : constant String := Get_Text (Tree.Child (Node, 3)); + Value : constant Node_Access := Tree.Child (Tree.Child (Node, 4), 1); + begin + -- Value is a string or regular expression. + case To_Token_Enum (Tree.ID (Value)) is + when STRING_LITERAL_DOUBLE_ID | STRING_LITERAL_SINGLE_ID => + + if To_Token_Enum (Tree.ID (Value)) = STRING_LITERAL_SINGLE_ID or + Data.Language_Params.Case_Insensitive + then + Indent_Line (Name & ": $ => reservedInsensitive(" & Get_Text (Value) & "),"); + + else + -- Case sensitive + -- + -- Wisitoken follows the re2c convention; single quoted strings are + -- case insensitive. See comment at definition of + -- 'reservedInsenstive' below for 'reserved' use. + Indent_Line (Name & ": $ => reserved(" & Get_Text (Value) & "),"); + end if; + + when REGEXP_ID => + Indent_Line (Name & ": $ => " & String_Regexp (Value) & ","); + + when others => + raise SAL.Programmer_Error with "node: " & Trimmed_Image (Node)'Image; + end case; + New_Line; + end; + + when CODE_ID => + declare + Loc_List : constant Syntax_Trees.Valid_Node_Access_Array := + WisiToken_Grammar_Runtime.Get_Code_Location_List (Tree, Node); + begin + if Get_Text (Loc_List (Loc_List'First)) = "copyright_license" then + -- handled in Print_Tree_Sitter top level + null; + else + Generate.Put_Error (Tree.Error_Message (Node, "%code with tree-sitter not supported.")); + end if; + end; + + when CONFLICT_ID => + -- .wy LR format: + -- %conflict action LHS (| action LHS)* 'on token' on + -- I I+1 + -- + -- .wy Tree_Sitter format: + -- %conflict LHS (LHS)* + -- + -- .js format: + -- [$.LHS, $.LHS, ...] + + declare + use Ada.Strings.Unbounded; + + Tree_Indices : constant Valid_Node_Access_Array := Tree.Get_Terminals (Tree.Child (Node, 3)); + Result : Unbounded_String := +"["; + begin + if Tree_Indices'Length < 3 or else Tree.ID (Tree_Indices (3)) /= +BAR_ID then + -- Tree_Sitter format + for LHS of Tree_Indices loop + Result := @ & "$." & Get_Text (LHS) & ", "; + end loop; + + else + -- LR format + declare + use all type SAL.Base_Peek_Type; + I : SAL.Peek_Type := Tree_Indices'First; + begin + loop + Result := @ & "$." & Get_Text (Tree_Indices (I + 1)) & ", "; + + I := I + 3; + exit when I > Tree_Indices'Last; + end loop; + end; + end if; + Conflicts.Append (-Result & ']'); + end; + + when CONFLICT_RESOLUTION_ID => + null; + + when IDENTIFIER_ID => + declare + Kind : constant String := Get_Text (Tree.Child (Node, 2)); + begin + if Kind = "case_insensitive" then + -- The meta phase grammar file parse sets + -- Data.Language_Params.Case_Insensitive. + null; + + elsif Kind = "elisp_action" then + -- Used in generating Action code + null; + + elsif Kind = "elisp_face" then + -- Used in generating Action code + null; + + elsif Kind = "elisp_indent" then + -- Used in generating Action code + null; + + elsif Kind = "generate" then + -- Handled in meta phase grammar parser. + null; + + elsif Kind = "lexer_regexp" then + -- Handled in Print_Tree_Sitter top level + null; + + elsif Kind = "meta_syntax" then + -- Handled in meta phase grammar parser. + null; + + elsif Kind = "precedence" then + -- Handled in Print_Tree_Sitter top level + null; + + elsif Kind = "start" then + -- Handled in Print_Tree_Sitter top level. + null; + + else + Generate.Put_Error + (Tree.Error_Message (Node, "declaration not supported with tree_sitter.")); + end if; + end; + + when IF_ID | ELSIF_ID | END_ID => + -- Should have been eliminated by Eliminate_Empty_Productions + raise SAL.Programmer_Error with "Print_Tree_Sitter declaration %if " & + Tree.Image (Node, Node_Numbers => True); + + when others => + raise SAL.Programmer_Error; + end case; when nonterminal_ID => declare Children : constant Node_Access_Array := Tree.Children (Node); begin - Put (File, Get_Text (Children (1)) & ": $ => "); + Indent_Start (Get_Text (Children (1)) & ": $ => "); - Put_RHS_List (Children (3), First => True); + if Tree.ID (Tree.Child (Node, 2)) = +attribute_list_ID then + Put_Attr_List (Tree.Child (Node, 2)); + Put_RHS_List (Children (4), First => True); + Put (')'); + else + Put_RHS_List (Children (3), First => True); + end if; - Put_Line (File, ","); + Put_Line (","); + New_Line; end; when wisitoken_accept_ID => @@ -1226,58 +1445,176 @@ package body WisiToken.Generate.Tree_Sitter is raise SAL.Not_Implemented with Image (Tree.ID (Node), Wisitoken_Grammar_Actions.Descriptor); end case; end Process_Node; + + use Syntax_Trees.LR_Utils; + Compilation_Unit_List : constant Constant_List := Creators.Create_List + (Tree, Tree.Find_Descendant (Tree.Root, +compilation_unit_list_ID), + +compilation_unit_list_ID, +compilation_unit_ID); + begin if Trace_Generate_EBNF > Outline then - Ada.Text_IO.Put_Line ("translate to tree_sitter"); + Put_Line ("translate to tree_sitter"); end if; - Create (File, Out_File, Output_File_Name); - Put_Line (File, "// generated from " & Tree.Lexer.File_Name & " -*- buffer-read-only:t -*-"); - - Put_Line (File, "module.exports = grammar({"); - Put_Line (File, " name: '" & Language_Name & "',"); + declare + File : File_Type; + begin + Create (File, Out_File, Output_File_Name); + Set_Output (File); - Put_Line (File, " rules: {"); + Indent := 1; + Indent_Line ("// generated from " & Tree.Lexer.File_Name & " -*- buffer-read-only:t js-indent-level:3 -*-"); + New_Line; - -- Start symbol must be the first rule; that's how tree-sitter knows - -- it's the start symbol. accept rule with wisi-eoi is implicit in - -- tree-sitter (as in .wy). - if -Data.Language_Params.Start_Token = "" then - Generate.Put_Error (Generate.Error_Message (Tree.Lexer.File_Name, 1, "%start not specified")); - else - declare - Temp : constant Node_Access := WisiToken_Grammar_Editing.Find_Declaration - (Data, Tree, -Data.Language_Params.Start_Token); - begin - Process_Node (Temp); - Start_Node := Temp; - end; - end if; + for Unit of Compilation_Unit_List loop + declare + Node : constant Valid_Node_Access := Tree.Child (Unit, 1); + begin + if To_Token_Enum (Tree.ID (Node)) = declaration_ID and then + To_Token_Enum (Tree.ID (Tree.Child (Node, 2))) = CODE_ID + then + declare + Loc_List : constant Syntax_Trees.Valid_Node_Access_Array := + WisiToken_Grammar_Runtime.Get_Code_Location_List (Tree, Node); + begin + if Get_Text (Loc_List (Loc_List'First)) = "copyright_license" then + Put_Commented (WisiToken.BNF.Split_Lines (Get_Text (Tree.Child (Node, 4)))); + else + Generate.Put_Error (Tree.Error_Message (Node, "%code with tree-sitter not supported.")); + end if; + end; + exit; + end if; + end; + end loop; - Process_Node (Tree.Root); - Put (File, " }"); + -- First some useful functions + + -- 'word' is reserved in tree-sitter; + -- https://tree-sitter.github.io/tree-sitter/creating-parsers#keywords. + -- + -- However, since we support case insensitive keywords, we can't rely + -- on that mechanism to ignore keywords that are not bounded by word + -- separators. So we use precedence. The only way we can tell if a + -- STRING_LITERAL_SINGLE token in an RHS needs this is to find the + -- declaration for it, and check if it is %keyword. So all reserved + -- keywords must be declared. + + Indent_Line ("const reserved = regex => token(prec(2, new RegExp(regex)));"); + Indent_Line + ("const caseInsensitive = word => word.split('')" & + " .map(letter => `[${letter}${letter.toUpperCase()}]`) .join('');"); + Indent_Line ("const reservedInsensitive = word => alias(reserved(caseInsensitive(word)), word) ;"); + New_Line; + + -- Now any lexer_regexp + for Unit of Compilation_Unit_List loop + declare + Node : constant Valid_Node_Access := Tree.Child (Unit, 1); + begin + if To_Token_Enum (Tree.ID (Node)) = declaration_ID and then + To_Token_Enum (Tree.ID (Tree.Child (Node, 2))) = IDENTIFIER_ID and then + Get_Text (Tree.Child (Node, 2)) = "lexer_regexp" + then + declare + Terminals : constant Valid_Node_Access_Array := Tree.Get_Terminals (Tree.Child (Node, 3)); - if Conflicts.Length > 0 then - Put_Line (File, ","); - Put_Line (File, " conflicts: $ => ["); - for Item of Conflicts loop - Put_Line (File, " " & Item & ","); + Name : constant String := Get_Text (Terminals (1)); + Value : constant Node_Access := Terminals (2); + begin + Put_Line ("const " & Name & " = " & String_Regexp (Value) & ";"); + end; + end if; + end; end loop; - Put (File, " ]"); - end if; - if Extras.Length > 0 then - Put_Line (File, ","); - Put_Line (File, " extras: $ => ["); - for Item of Extras loop - Put_Line (File, " " & Item & ","); + Indent_Line ("module.exports = grammar({"); + Indent := @ + 3; + + Indent_Line ("name: '" & Language_Name & "',"); + New_Line; + + if not Data.Precedence_Lists.Is_Empty then + Indent_Line ("precedences: () => ["); + Indent := @ + 2; + for List of Data.Precedence_Lists loop + Indent_Line ("["); + Indent := @ + 2; + for ID of List loop + Indent_Line ("'" & (-Data.Precedence_Inverse_Map (ID)) & "',"); + end loop; + Indent := @ - 2; + Indent_Line ("],"); + end loop; + Indent := @ - 2; + + Indent_Line ("],"); + New_Line; + end if; + + Indent_Line ("rules: {"); + Indent := @ + 3; + + -- Start symbol must be the first rule; that's how tree-sitter knows + -- it's the start symbol. accept rule with wisi-eoi is implicit in + -- tree-sitter (as in .wy). + if -Data.Language_Params.Start_Token = "" then + Generate.Put_Error (Generate.Error_Message (Tree.Lexer.File_Name, 1, "%start not specified")); + else + declare + Temp : constant Node_Access := WisiToken_Grammar_Editing.Find_Declaration + (Data, Tree, -Data.Language_Params.Start_Token); + begin + Process_Node (Temp); + Start_Node := Temp; + end; + end if; + + -- A grammar typically consists of a large number of + -- compilation_units, each one fairly short. Process_Node is + -- recursive; if we use that to process the compilation_Units, it can + -- overflow the stack (it did for ada_full.wy). So we handle the + -- compilation_Units as a list here, and use recursion for the + -- declarations and nonterms. + for Unit of Compilation_Unit_List loop + Process_Node (Unit); end loop; - Put_Line (File, " ],"); - end if; - Put (File, " }"); - Put_Line (File, ");"); - Close (File); + Put (" }"); + Indent := @ - 3; + + if Conflicts.Length > 0 then + Put_Line (","); + Put_Line (" conflicts: $ => ["); + Indent := @ + 3; + for Item of Conflicts loop + Indent_Line (Item & ","); + end loop; + Put (" ]"); + Indent := @ - 3; + end if; + + if Extras.Length > 0 then + -- Since we have an explicit 'extras', we need to specify space and newline. + Extras.Append ("/\s|\\\r?\n/"); + Put_Line (","); + Put_Line (" extras: $ => ["); + Indent := @ + 3; + for Item of Extras loop + Indent_Line (Item & ","); + end loop; + Put_Line (" ],"); + Indent := @ - 3; + end if; + Put ("}"); + Indent := @ - 3; + pragma Assert (Indent = 1); + + Indent_Line (");"); + Set_Output (Standard_Output); + + Close (File); + end; end Print_Tree_Sitter; procedure Create_Test_Main (Output_File_Name_Root : in String) diff --git a/wisitoken-generate-tree_sitter.ads b/wisitoken-generate-tree_sitter.ads index 3107539..9a5b9c3 100644 --- a/wisitoken-generate-tree_sitter.ads +++ b/wisitoken-generate-tree_sitter.ads @@ -1,8 +1,8 @@ -- Abstract : -- --- WisiToken utilities for using the tree-sitter parser. +-- Translate a wisitoken grammar file to a tree-sitter grammar file. -- --- Copyright (C) 2020, 2021, 2022 Free Software Foundation All Rights Reserved. +-- Copyright (C) 2020 - 2023 Free Software Foundation All Rights Reserved. -- -- 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 @@ -19,10 +19,13 @@ with WisiToken_Grammar_Runtime; package WisiToken.Generate.Tree_Sitter is procedure Eliminate_Empty_Productions - (Data : in out WisiToken_Grammar_Runtime.User_Data_Type; - Tree : in out WisiToken.Syntax_Trees.Tree); - -- Edit Tree to eliminate productions that can be empty, which are - -- forbidden by the tree-sitter generator. + (Data : in out WisiToken_Grammar_Runtime.User_Data_Type; + Tree : in out WisiToken.Syntax_Trees.Tree; + No_Empty : in Boolean); + -- If No_Empty, raise Grammar_Error if Tree has productions that can + -- be empty, which are forbidden by the tree-sitter generator. + -- + -- Otherwise, edit Tree to eliminate productions that can be empty. -- -- Also processes %if, so subsequent passes don't have to. @@ -32,6 +35,8 @@ package WisiToken.Generate.Tree_Sitter is Lexer : in WisiToken.Lexer.Handle; Output_File_Name : in String; Language_Name : in String); + -- Output tree-sitter grammar to Output_File_Name. + -- -- Tree is 'in out' because we use WisiToken.Syntax_Tree.LR_Utils lists. procedure Create_Test_Main (Output_File_Name_Root : in String); diff --git a/wisitoken-in_parse_actions.adb b/wisitoken-in_parse_actions.adb index e9e5d63..70ded77 100644 --- a/wisitoken-in_parse_actions.adb +++ b/wisitoken-in_parse_actions.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -34,14 +34,23 @@ package body WisiToken.In_Parse_Actions is return Syntax_Trees.In_Parse_Actions.Status_Label'Image (Item.Label); when Syntax_Trees.In_Parse_Actions.Error => declare - Begin_Node : constant Valid_Node_Access := Tree.Child (Error_Node, Item.Begin_Name); - End_Node : constant Valid_Node_Access := Tree.Child (Error_Node, Item.End_Name); + use all type SAL.Base_Peek_Type; + Begin_Node : constant Node_Access := + (if Item.Begin_Name = 0 + then Invalid_Node_Access + else Tree.Child (Error_Node, Item.Begin_Name)); + End_Node : constant Node_Access := + (if Item.End_Name = 0 + then Invalid_Node_Access + else Tree.Child (Error_Node, Item.End_Name)); begin return '(' & Syntax_Trees.In_Parse_Actions.Status_Label'Image (Item.Label) & ", " & - Tree.Image (Begin_Node) & "'" & Tree.Lexer.Buffer_Text - (Tree.Byte_Region (Begin_Node, Trailing_Non_Grammar => False)) & "'," & - Tree.Image (End_Node) & "'" & Tree.Lexer.Buffer_Text - (Tree.Byte_Region (End_Node, Trailing_Non_Grammar => False)) & "')"; + (if Item.Begin_Name = 0 then "<absent>" + else Tree.Image (Begin_Node) & "'" & Tree.Lexer.Buffer_Text + (Tree.Byte_Region (Begin_Node, Trailing_Non_Grammar => False))) & "'," & + (if Item.End_Name = 0 then "<absent>" + else Tree.Image (End_Node) & "'" & Tree.Lexer.Buffer_Text + (Tree.Byte_Region (End_Node, Trailing_Non_Grammar => False))) & "')"; end; end case; end Image; @@ -49,22 +58,25 @@ package body WisiToken.In_Parse_Actions is function Match_Names (Tree : in Syntax_Trees.Tree; Tokens : in Syntax_Trees.Recover_Token_Array; - Start_Index : in Positive_Index_Type; - End_Index : in Positive_Index_Type; + Start_Index : in SAL.Base_Peek_Type; + End_Index : in SAL.Base_Peek_Type; End_Optional : in Boolean) return Syntax_Trees.In_Parse_Actions.Status is + use all type SAL.Base_Peek_Type; use Syntax_Trees; begin - if Tree.Contains_Virtual_Terminal (Tokens (Start_Index)) or - Tree.Contains_Virtual_Terminal (Tokens (End_Index)) + if (Start_Index > 0 and then Tree.Contains_Virtual_Terminal (Tokens (Start_Index))) or + (End_Index > 0 and then Tree.Contains_Virtual_Terminal (Tokens (End_Index))) then return (Label => Syntax_Trees.In_Parse_Actions.Ok); end if; declare - Start_Name_Region : constant Buffer_Region := Tree.Name (Tokens (Start_Index)); - End_Name_Region : constant Buffer_Region := Tree.Name (Tokens (End_Index)); + Start_Name_Region : constant Buffer_Region := + (if Start_Index > 0 then Tree.Name (Tokens (Start_Index)) else Null_Buffer_Region); + End_Name_Region : constant Buffer_Region := + (if End_Index > 0 then Tree.Name (Tokens (End_Index)) else Null_Buffer_Region); function Equal return Boolean is diff --git a/wisitoken-in_parse_actions.ads b/wisitoken-in_parse_actions.ads index 49428ff..b70a010 100644 --- a/wisitoken-in_parse_actions.ads +++ b/wisitoken-in_parse_actions.ads @@ -2,7 +2,7 @@ -- -- Grammar in parse action routines. -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -29,13 +29,17 @@ package WisiToken.In_Parse_Actions is function Match_Names (Tree : in Syntax_Trees.Tree; Tokens : in Syntax_Trees.Recover_Token_Array; - Start_Index : in Positive_Index_Type; - End_Index : in Positive_Index_Type; + Start_Index : in SAL.Base_Peek_Type; + End_Index : in SAL.Base_Peek_Type; End_Optional : in Boolean) return Syntax_Trees.In_Parse_Actions.Status; -- Check that buffer text at Tokens (Start_Index).Name matches buffer -- text at Tokens (End_Index).Name. Comparison is controlled by -- Descriptor.Case_Insensitive. + -- + -- Start_, End_Index may be 0; in that case the corresponding token + -- is absent in the production; Match_Names treats it as an empty + -- name. function Propagate_Name (Tree : in Syntax_Trees.Tree; diff --git a/wisitoken-lexer.adb b/wisitoken-lexer.adb index 1d0981b..6d7096c 100644 --- a/wisitoken-lexer.adb +++ b/wisitoken-lexer.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -240,7 +240,7 @@ package body WisiToken.Lexer is return Base_Buffer_Pos is begin for I in To_Buffer_Index (Source, Region.First) .. To_Buffer_Index (Source, Region.Last) loop - if Source.Buffer (I) = ASCII.LF then + if Buffer (Source)(I) = ASCII.LF then return From_Buffer_Index (Source, I); end if; end loop; diff --git a/wisitoken-parse-lr-mckenzie_recover-explore.adb b/wisitoken-parse-lr-mckenzie_recover-explore.adb index ebc5308..1c61409 100644 --- a/wisitoken-parse-lr-mckenzie_recover-explore.adb +++ b/wisitoken-parse-lr-mckenzie_recover-explore.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -47,7 +47,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is if Is_Full (Config.Ops) then Super.Config_Full (Shared, "do_shift ops", Parser_Index); - raise Bad_Config; + raise Invalid_Case; else Append (Config.Ops, Op); end if; @@ -70,7 +70,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is if Config.Stack.Is_Full then Super.Config_Full (Shared, "do_shift stack", Parser_Index); - raise Bad_Config; + raise Invalid_Case; else Config.Stack.Push ((State, (Virtual => True, ID => ID, others => <>))); end if; @@ -290,7 +290,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is if Is_Full (Item.Config.Ops) then Super.Config_Full (Shared, "fast_forward 1", Parser_Index); - raise Bad_Config; + raise Invalid_Case; else declare Next_Node : constant Syntax_Trees.Valid_Node_Access := @@ -361,7 +361,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is else if Is_Full (Item.Config.Ops) then Super.Config_Full (Shared, "check 1", Parser_Index); - raise Bad_Config; + raise Invalid_Case; else declare Next_Node : constant Syntax_Trees.Node_Access := Parse.Peek_Current_First_Sequential_Terminal @@ -456,7 +456,11 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is if Item.Shift_Count = 0 then -- Parse did not process any Deletes from Insert_Delete; Fast_Forward -- did that. So the very first token caused an error, and Config is - -- unchanged. Just set the error. + -- unchanged. Just set the error. FIXME: + -- ada_mode-recover_repair_2.adb language_fixes solution is pure + -- delete; we get here, and should enqueue for another Language_Fixes + -- try. But in other cases fast_forward was a pure no-op. Enqueue in + -- fast_forward if pure delete? Config.Error_Token := Item.Config.Error_Token; Config.In_Parse_Action_Status := (Label => Ok); return Continue; @@ -590,7 +594,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is if Is_Full (New_Config.Ops) then Super.Config_Full (Shared, "push_back 1", Parser_Index); - raise Bad_Config; + raise Invalid_Case; end if; Do_Push_Back (Shared.Tree, New_Config); @@ -693,7 +697,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is if Is_Full (New_Config.Ops) then Super.Config_Full (Shared, "undo_reduce 1", Parser_Index); - raise Bad_Config; + raise Invalid_Case; end if; Unchecked_Undo_Reduce (Super, Shared, New_Config); @@ -866,7 +870,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is is begin if Is_Full (Work) then Super.Config_Full (Shared, "Minimal_Complete_Actions " & Label, Parser_Index); - raise Bad_Config; + raise Invalid_Case; else Add (Work, Item); end if; @@ -894,7 +898,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is Inserted (Inserted_Last) := Action.ID; else Super.Config_Full (Shared, "minimal_do_shift Inserted", Parser_Index); - raise Bad_Config; + raise Invalid_Case; end if; Do_Shift @@ -1343,7 +1347,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is -- Parser to delete it. if Is_Full (Config.Ops) then Super.Config_Full (Shared, "insert quote 2 a " & Label, Parser_Index); - raise Bad_Config; + raise Invalid_Case; end if; Append (Config.Ops, (Delete, Shared.Tree.ID (Node), Index)); @@ -1378,7 +1382,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is begin if Is_Full (Config.Ops) then Super.Config_Full (Shared, "insert quote 2 b " & Label, Parser_Index); - raise Bad_Config; + raise Invalid_Case; end if; pragma Assert (Is_Terminal (Shared.Tree.ID (Stream (To_Delete)), Shared.Tree.Lexer.Descriptor.all)); @@ -1480,7 +1484,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is if not Has_Space (Config.Ops, Ada.Containers.Count_Type (Matching)) then Super.Config_Full (Shared, "insert quote 1 " & Label, Parser_Index); - raise Bad_Config; + raise Invalid_Case; end if; for I in 1 .. Matching loop if not Push_Back_Valid (Super, Shared, Config, Push_Back_Undo_Reduce => False) then @@ -1552,7 +1556,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is if Is_Full (Config.Ops) then Super.Config_Full (Shared, Full_Label, Parser_Index); - raise Bad_Config; + raise Invalid_Case; end if; Item := Config.Stack.Peek; @@ -1600,7 +1604,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is begin if not Has_Space (Config.Ops, Ada.Containers.Count_Type (Last - First + 1)) then Super.Config_Full (Shared, "insert quote 3 " & Label, Parser_Index); - raise Bad_Config; + raise Invalid_Case; end if; Find_First; @@ -2085,7 +2089,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is if Is_Full (New_Config.Ops) then Super.Config_Full (Shared, "delete", Parser_Index); - raise Bad_Config; + raise Invalid_Case; else Append (New_Config.Ops, (Delete, Next_ID, Next_Index)); end if; diff --git a/wisitoken-parse-lr-mckenzie_recover-parse.adb b/wisitoken-parse-lr-mckenzie_recover-parse.adb index 51066b2..d8b8cb5 100644 --- a/wisitoken-parse-lr-mckenzie_recover-parse.adb +++ b/wisitoken-parse-lr-mckenzie_recover-parse.adb @@ -2,7 +2,7 @@ -- -- See spec -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -791,7 +791,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Parse is if Trace_McKenzie > Outline then Put_Line (Tree, Super.Stream (Parser_Index), Trace_Prefix & ": too many conflicts; abandoning"); - raise Bad_Config; + raise Invalid_Case; end if; else if Trace_McKenzie > Detail then diff --git a/wisitoken-parse-lr-mckenzie_recover.adb b/wisitoken-parse-lr-mckenzie_recover.adb index 02356ce..f1cc583 100644 --- a/wisitoken-parse-lr-mckenzie_recover.adb +++ b/wisitoken-parse-lr-mckenzie_recover.adb @@ -2,7 +2,7 @@ -- -- See spec -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -380,6 +380,8 @@ package body WisiToken.Parse.LR.McKenzie_Recover is -- parser recovered from the error. Parser_State.Set_Verb (Shift); + -- We do this now so Parser_State tracks changes to the current error + -- node when we apply ops like Delete. Parser_State.Set_Current_Error_Features (Tree); pragma Assert (Parser_State.Current_Recover_Op = No_Insert_Delete); @@ -828,7 +830,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover is Check (Shared_Parser.Tree.ID (Node), Expected_ID, Shared_Parser.Tree.Lexer.Descriptor.all); end if; if Is_Full (Config.Ops) or Is_Full (Config.Insert_Delete) then - raise Bad_Config; + raise Invalid_Case; end if; Append (Config.Ops, Op); Append (Config.Insert_Delete, Op); @@ -1411,7 +1413,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover is Op : constant Recover_Op := (Insert, ID, Shared_Parser.Tree.Get_Sequential_Index (Before)); begin if Is_Full (Config.Ops) or Is_Full (Config.Insert_Delete) then - raise Bad_Config; + raise Invalid_Case; end if; Append (Config.Ops, Op); Append (Config.Insert_Delete, Op); @@ -1668,6 +1670,11 @@ package body WisiToken.Parse.LR.McKenzie_Recover is Config : in out Configuration; Push_Back_Undo_Reduce : in Boolean) is begin + if Recover_Op_Arrays.Is_Full (Config.Ops) then + -- We don't call Super.Config_Full here, because we don't have Parser_Index. + raise Invalid_Case; + end if; + -- We relax the "don't push back into previous recover" restriction -- for Language_Fixes; see test_mckenzie_recover.adb Missing_Name_5. if not Push_Back_Valid (Super, Shared_Parser, Config, Push_Back_Undo_Reduce => Push_Back_Undo_Reduce) then @@ -1720,7 +1727,9 @@ package body WisiToken.Parse.LR.McKenzie_Recover is Descriptor : WisiToken.Descriptor renames Tree.Lexer.Descriptor.all; Result : Ada.Strings.Unbounded.Unbounded_String := - +" " & Tree.Trimmed_Image (Parser_Label) & ": " & -- leading space for consistency with existing tests. + -- Leading space for consistency with existing tests. Add space to + -- other messages for consistency. + " " & (+Tree.Trimmed_Image (Parser_Label)) & ": " & (if Message'Length > 0 then Message & ":" else ""); begin Result := Result & Natural'Image (Config.Cost); @@ -1832,6 +1841,10 @@ package body WisiToken.Parse.LR.McKenzie_Recover is Prev_State := Goto_For (Table, Prev_State, Tree.ID (C)); end if; if Stack.Is_Full then + -- Stack size is a design constraint, so this could be Invalid_Case. + -- But the required size depends on the nesting level of user code, + -- not the complexity of the error recover config. So it's a serious + -- error to hit it. raise Bad_Config; end if; Stack.Push ((Prev_State, Tree.Get_Recover_Token (C))); diff --git a/wisitoken-parse-lr-mckenzie_recover.ads b/wisitoken-parse-lr-mckenzie_recover.ads index 219c87d..5684621 100644 --- a/wisitoken-parse-lr-mckenzie_recover.ads +++ b/wisitoken-parse-lr-mckenzie_recover.ads @@ -11,7 +11,7 @@ -- [Grune 2008] Parsing Techniques, A Practical Guide, Second -- Edition. Dick Grune, Ceriel J.H. Jacobs. -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -40,9 +40,10 @@ package WisiToken.Parse.LR.McKenzie_Recover is -- programming bug can easily be ignored by abandoning the config. Invalid_Case : exception; - -- Raised to abandon error recover cases that don't apply, when they - -- are not easily abandoned by 'if' or 'case'. We don't use - -- Bad_Config for that, because it is not a programmer error. + -- Raised to abandon error recover cases that don't apply or violate + -- some design constraint like Config.Ops full, when they are not + -- easily abandoned by 'if' or 'case'. We don't use Bad_Config for + -- that, because it is not a programmer error. type Recover_Status is (Fail_Check_Delta, Fail_Enqueue_Limit, Fail_No_Configs_Left, Fail_Programmer_Error, Success); @@ -317,8 +318,8 @@ private Shared_Parser : in out LR.Parser.Parser; Config : in out Configuration; Push_Back_Undo_Reduce : in Boolean); - -- If not Push_Back_Valid, raise Invalid_Case. Otherwise do - -- Push_Back. + -- If not Push_Back_Valid, or if Config.Ops full, raise Invalid_Case. + -- Otherwise do Push_Back. -- -- Normally Push_Back_Valid forbids push_back of an entire -- Undo_Reduce; Language_Fixes may override that by setting diff --git a/wisitoken-parse-lr-parser-parse.adb b/wisitoken-parse-lr-parser-parse.adb index e9cd8f2..75d98ec 100644 --- a/wisitoken-parse-lr-parser-parse.adb +++ b/wisitoken-parse-lr-parser-parse.adb @@ -2,7 +2,7 @@ -- -- see spec. -- --- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -34,10 +34,6 @@ begin Trace.Put_Clock ("start"); end if; - if Shared_Parser.User_Data /= null then - Shared_Parser.User_Data.Reset; - end if; - Shared_Parser.Tree.Lexer.Errors.Clear; Shared_Parser.String_Quote_Checked := Invalid_Line_Number; diff --git a/wisitoken-parse-lr-parser.adb b/wisitoken-parse-lr-parser.adb index 914d08b..72fb4e0 100644 --- a/wisitoken-parse-lr-parser.adb +++ b/wisitoken-parse-lr-parser.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2023 Free Software Foundation, Inc. -- -- This file is part of the WisiToken package. -- @@ -989,14 +989,22 @@ package body WisiToken.Parse.LR.Parser is if Debug_Mode then declare - I : Integer := 1; + Error_Reported : WisiToken.Syntax_Trees.Node_Sets.Set; begin - for Node of Parser_State.Recover_Insert_Delete loop - if not Parser.Tree.In_Tree (Node) then - raise SAL.Programmer_Error with "recover_insert_delete node" & I'Image & " not in tree"; - end if; - I := @ + 1; - end loop; + if Parser.User_Data = null then + Parser.Tree.Validate_Tree + (null, Error_Reported, + Node_Index_Order => not Incremental_Parse, + Validate_Node => Syntax_Trees.Mark_In_Tree'Access); + Parser.Tree.Clear_Augmented; + else + Parser.Tree.Validate_Tree + (Parser.User_Data, Error_Reported, Node_Index_Order => not Incremental_Parse); + end if; + + if Error_Reported.Count /= 0 then + raise WisiToken.Validate_Error with "pre execute_actions: validate_tree failed"; + end if; end; end if; @@ -1011,6 +1019,19 @@ package body WisiToken.Parse.LR.Parser is Parser.Tree.Lexer.Trace.New_Line; end if; + if Debug_Mode then + declare + I : Integer := 1; + begin + for Node of Parser_State.Recover_Insert_Delete loop + if not Parser.Tree.In_Tree (Node) then + raise SAL.Programmer_Error with "recover_insert_delete node" & I'Image & " not in tree"; + end if; + I := @ + 1; + end loop; + end; + end if; + -- ada-mode-recover_33.adb requires calling Insert_Token, -- Delete_Token in lexical order, which is Recover_Insert_Delete -- order. Other use cases would benefit from calling all Delete @@ -1066,22 +1087,18 @@ package body WisiToken.Parse.LR.Parser is Error_Reported : WisiToken.Syntax_Trees.Node_Sets.Set; begin if Parser.User_Data = null then - declare - Dummy : User_Data_Type; - begin - Parser.Tree.Validate_Tree - (Dummy, Error_Reported, - Node_Index_Order => not Incremental_Parse, - Validate_Node => Syntax_Trees.Mark_In_Tree'Access); - end; + Parser.Tree.Validate_Tree + (null, Error_Reported, + Node_Index_Order => not Incremental_Parse, + Validate_Node => Syntax_Trees.Mark_In_Tree'Access); Parser.Tree.Clear_Augmented; else Parser.Tree.Validate_Tree - (Parser.User_Data.all, Error_Reported, Node_Index_Order => not Incremental_Parse); + (Parser.User_Data, Error_Reported, Node_Index_Order => not Incremental_Parse); end if; if Error_Reported.Count /= 0 then - raise WisiToken.Validate_Error with "parser: validate_tree failed"; + raise WisiToken.Validate_Error with "post execute_actions: validate_tree failed"; end if; end; end if; @@ -3442,7 +3459,7 @@ package body WisiToken.Parse.LR.Parser is declare Error_Reported : WisiToken.Syntax_Trees.Node_Sets.Set; begin - Parser.Tree.Validate_Tree (Parser.User_Data.all, Error_Reported, Node_Index_Order => False); + Parser.Tree.Validate_Tree (Parser.User_Data, Error_Reported, Node_Index_Order => False); if Error_Reported.Count /= 0 then if Trace_Incremental_Parse > Outline then Tree.Lexer.Trace.New_Line; diff --git a/wisitoken-parse-lr-parser_no_recover.adb b/wisitoken-parse-lr-parser_no_recover.adb index d1296e9..003ee40 100644 --- a/wisitoken-parse-lr-parser_no_recover.adb +++ b/wisitoken-parse-lr-parser_no_recover.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2023 Free Software Foundation, Inc. -- -- This file is part of the WisiToken package. -- @@ -224,7 +224,6 @@ package body WisiToken.Parse.LR.Parser_No_Recover is use all type KMN_Lists.List; use all type WisiToken.Syntax_Trees.Terminal_Ref; - use all type Syntax_Trees.User_Data_Access; Trace : WisiToken.Trace'Class renames Shared_Parser.Tree.Lexer.Trace.all; @@ -253,10 +252,6 @@ package body WisiToken.Parse.LR.Parser_No_Recover is raise SAL.Programmer_Error; end if; - if Shared_Parser.User_Data /= null then - Shared_Parser.User_Data.Reset; - end if; - Shared_Parser.Tree.Clear; Shared_Parser.Lex_All; diff --git a/wisitoken-parse-lr.ads b/wisitoken-parse-lr.ads index bcc4b2f..aae0c7c 100644 --- a/wisitoken-parse-lr.ads +++ b/wisitoken-parse-lr.ads @@ -9,7 +9,7 @@ -- -- See wisitoken.ads -- --- Copyright (C) 2002, 2003, 2009, 2010, 2013 - 2015, 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2002, 2003, 2009, 2010, 2013 - 2015, 2017 - 2023 Free Software Foundation, Inc. -- -- This file is part of the WisiToken package. -- @@ -69,8 +69,9 @@ package WisiToken.Parse.LR is type Parse_Action_Rec (Verb : Parse_Action_Verbs := Shift) is record Production : Production_ID; - -- The production that produced this action. Used to find kernel - -- items during error recovery. + -- The production that produced this action. Used to find precedence + -- during grammar generation conflict resolution, in_parse actions + -- during parse, and kernel items during error recovery. case Verb is when Shift => diff --git a/wisitoken-parse-packrat-generated.adb b/wisitoken-parse-packrat-generated.adb index 81589db..ff82edf 100644 --- a/wisitoken-parse-packrat-generated.adb +++ b/wisitoken-parse-packrat-generated.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -26,7 +26,6 @@ package body WisiToken.Parse.Packrat.Generated is Pre_Edited : in Boolean := False) is pragma Unreferenced (Log_File, Pre_Edited); - use all type WisiToken.Syntax_Trees.User_Data_Access; use all type Ada.Containers.Count_Type; Trace : WisiToken.Trace'Class renames Parser.Tree.Lexer.Trace.all; Result : Memo_Entry; @@ -42,9 +41,6 @@ package body WisiToken.Parse.Packrat.Generated is Clear (Parser.Derivs); Parser.Tree.Clear; - if Parser.User_Data /= null then - Parser.User_Data.Reset; - end if; Parser.Lex_All; -- Creates Tree.Shared_Stream -- FIXME: ref_count fails in this usage; works in procedural. diff --git a/wisitoken-parse-packrat-procedural.adb b/wisitoken-parse-packrat-procedural.adb index be74ebe..856ad17 100644 --- a/wisitoken-parse-packrat-procedural.adb +++ b/wisitoken-parse-packrat-procedural.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -388,7 +388,6 @@ package body WisiToken.Parse.Packrat.Procedural is is pragma Unreferenced (Log_File, Pre_Edited); use all type Ada.Containers.Count_Type; - use all type WisiToken.Syntax_Trees.User_Data_Access; Trace : WisiToken.Trace'Class renames Parser.Tree.Lexer.Trace.all; Result : Memo_Entry; @@ -407,9 +406,6 @@ package body WisiToken.Parse.Packrat.Procedural is Clear (Parser.Derivs); - if Parser.User_Data /= null then - Parser.User_Data.Reset; - end if; Parser.Lex_All; Result := Apply_Rule diff --git a/wisitoken-parse.adb b/wisitoken-parse.adb index 108df00..c4bbf1c 100644 --- a/wisitoken-parse.adb +++ b/wisitoken-parse.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -218,7 +218,7 @@ package body WisiToken.Parse is when Insert => (if Item.Ins_Node = Invalid_Node_Access then Image (Item.Ins_ID, Tree.Lexer.Descriptor.all) - else Tree.Image (Item.Ins_Node)) & + else Tree.Image (Item.Ins_Node, Node_Numbers => True)) & "," & Item.Ins_Before'Image, when Delete => (if Item.Del_Node = Invalid_Node_Access diff --git a/wisitoken-productions.adb b/wisitoken-productions.adb index 2f1892f..7fdb400 100644 --- a/wisitoken-productions.adb +++ b/wisitoken-productions.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2018, 2020 Free Software Foundation, Inc. +-- Copyright (C) 2018, 2020, 2023 Free Software Foundation, Inc. -- -- This file is part of the WisiToken package. -- @@ -51,14 +51,20 @@ package body WisiToken.Productions is function Image (LHS : in Token_ID; RHS_Index : in Natural; - RHS : in Token_ID_Arrays.Vector; + RHS : in Right_Hand_Side; Descriptor : in WisiToken.Descriptor) return String is use Ada.Strings.Unbounded; Result : Unbounded_String := +Trimmed_Image ((LHS, RHS_Index)) & ": " & Image (LHS, Descriptor) & " <="; begin - for ID of RHS loop + if RHS.Associativity /= None then + Append (Result, " <" & RHS.Associativity'Image & ">"); + end if; + if RHS.Precedence /= No_Precedence then + Append (Result, " <" & Trimmed_Image (RHS.Precedence) & ">"); + end if; + for ID of RHS.Tokens loop Result := Result & ' ' & Image (ID, Descriptor); end loop; return To_String (Result); @@ -70,7 +76,10 @@ package body WisiToken.Productions is begin for P of Grammar loop for R in P.RHSs.First_Index .. P.RHSs.Last_Index loop - Put (Image (P.LHS, R, P.RHSs (R).Tokens, Descriptor)); + if P.Precedence /= No_Precedence then + Put ('<' & P.Precedence'Image & "> "); + end if; + Put (Image (P.LHS, R, P.RHSs (R), Descriptor)); if (for all Item of Grammar (P.LHS).RHSs (R).Recursion => Item = None) then New_Line; else @@ -80,4 +89,30 @@ package body WisiToken.Productions is end loop; end Put; + function Get_Associativity + (Grammar : in Prod_Arrays.Vector; + ID : in Production_ID) + return WisiToken.Associativity + is begin + if Grammar (ID.LHS).RHSs.Is_Empty then + return None; + else + return Grammar (ID.LHS).RHSs (ID.RHS).Associativity; + end if; + end Get_Associativity; + + function Get_Precedence + (Grammar : in Prod_Arrays.Vector; + ID : in Production_ID) + return Base_Precedence_ID + is begin + if Grammar (ID.LHS).RHSs.Is_Empty then + return Grammar (ID.LHS).Precedence; + elsif Grammar (ID.LHS).RHSs (ID.RHS).Precedence /= No_Precedence then + return Grammar (ID.LHS).RHSs (ID.RHS).Precedence; + else + return Grammar (ID.LHS).Precedence; + end if; + end Get_Precedence; + end WisiToken.Productions; diff --git a/wisitoken-productions.ads b/wisitoken-productions.ads index f3412b2..7f1f4cf 100644 --- a/wisitoken-productions.ads +++ b/wisitoken-productions.ads @@ -2,7 +2,7 @@ -- -- Type and operations for building grammar productions. -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- This file is part of the WisiToken package. -- @@ -39,6 +39,9 @@ package WisiToken.Productions is Post_Parse_Action : Syntax_Trees.Post_Parse_Action := null; In_Parse_Action : Syntax_Trees.In_Parse_Actions.In_Parse_Action := null; + + Associativity : WisiToken.Associativity := WisiToken.None; + Precedence : WisiToken.Base_Precedence_ID := WisiToken.No_Precedence; end record with Dynamic_Predicate => (Tokens.Length = 0 or Tokens.First_Index = 1) and @@ -49,9 +52,10 @@ package WisiToken.Productions is (Natural, Right_Hand_Side, Default_Element => (others => <>)); type Instance is record - LHS : Token_ID := Invalid_Token_ID; - Optimized_List : Boolean := False; + LHS : Token_ID := Invalid_Token_ID; + Optimized_List : Boolean := False; RHSs : RHS_Arrays.Vector; + Precedence : WisiToken.Base_Precedence_ID := WisiToken.No_Precedence; end record; package Prod_Arrays is new SAL.Gen_Unbounded_Definite_Vectors @@ -63,16 +67,31 @@ package WisiToken.Productions is return RHS_Arrays.Constant_Reference_Type; function Image - (LHS : in Token_ID; - RHS_Index : in Natural; - RHS : in Token_ID_Arrays.Vector; - Descriptor : in WisiToken.Descriptor) + (LHS : in Token_ID; + RHS_Index : in Natural; + RHS : in Right_Hand_Side; + Descriptor : in WisiToken.Descriptor) return String; -- For comments in generated code, diagnostic messages. procedure Put (Grammar : Prod_Arrays.Vector; Descriptor : in WisiToken.Descriptor); -- Put Image of each production to Ada.Text_IO.Current_Output, for parse_table. + function Get_Associativity + (Grammar : in Prod_Arrays.Vector; + ID : in Production_ID) + return WisiToken.Associativity + with Pre => not Grammar.Is_Empty; + -- Return the associativity that applies to ID. + + function Get_Precedence + (Grammar : in Prod_Arrays.Vector; + ID : in Production_ID) + return Base_Precedence_ID + with Pre => not Grammar.Is_Empty; + -- Return the precedence that applies to ID; the RHS precedence if + -- not No_Precedence, else the LHS precedence. + package Line_Number_Arrays is new SAL.Gen_Unbounded_Definite_Vectors (Natural, Line_Number_Type, Default_Element => Line_Number_Type'First); diff --git a/wisitoken-syntax_trees-lr_utils.adb b/wisitoken-syntax_trees-lr_utils.adb index 1960eaa..76755f4 100644 --- a/wisitoken-syntax_trees-lr_utils.adb +++ b/wisitoken-syntax_trees-lr_utils.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2019 - 2022 Stephen Leake All Rights Reserved. +-- Copyright (C) 2019 - 2023 Stephen Leake All Rights Reserved. -- -- 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 @@ -86,7 +86,8 @@ package body WisiToken.Syntax_Trees.LR_Utils is Result := Child; exit; else - raise SAL.Programmer_Error with "node" & Result'Image & " is not an element of the list"; + raise SAL.Programmer_Error with "node " & Tree.Image (Result, Node_Numbers => True) & + " is not an element of the list at " & Tree.Image (Root, Node_Numbers => True); end if; end; end loop; @@ -650,7 +651,7 @@ package body WisiToken.Syntax_Trees.LR_Utils is Item : Cursor := (if Source_First = No_Element then Source_List.First else Source_First); Last : constant Cursor := (if Source_Last = No_Element then Source_List.Last else Source_Last); begin - for N of Source_List loop + loop exit when not Has_Element (Item); Dest_List.Append (Dest_List.Tree.Copy_Subtree (Item.Node, User_Data)); diff --git a/wisitoken-syntax_trees.adb b/wisitoken-syntax_trees.adb index 4a1e376..7bcbcc3 100644 --- a/wisitoken-syntax_trees.adb +++ b/wisitoken-syntax_trees.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -224,6 +224,11 @@ package body WisiToken.Syntax_Trees is Prev_Terminal.Ref.Node.Following_Deleted.Append (Deleted_Node); + for Node of Deleted_Node.Following_Deleted loop + Prev_Terminal.Ref.Node.Following_Deleted.Append (Node); + end loop; + Deleted_Node.Following_Deleted.Clear; + -- We need to move the non_grammar now, so they are correct for later -- error recover sessions. test_incremental.adb : Edit_String_10 @@ -1919,7 +1924,7 @@ package body WisiToken.Syntax_Trees is function Copy_Augmented (User_Data : in User_Data_Type; - Augmented : in Augmented_Class_Access) + Augmented : in not null Augmented_Class_Access) return Augmented_Class_Access is begin raise SAL.Programmer_Error; @@ -1940,6 +1945,13 @@ package body WisiToken.Syntax_Trees is is use all type Error_Data_Lists.List; New_Node : Node_Access; + Actual_Error_List : constant Error_List_Access := + (if Set_Error_List + then New_Error_List + else + (if Node.Error_List = null + then null + else new Error_Data_Lists.List'(Node.Error_List.all))); begin case Node.Label is when Source_Terminal => @@ -1957,13 +1969,7 @@ package body WisiToken.Syntax_Trees is (if Node.Augmented = null or User_Data = null then null else Copy_Augmented (User_Data.all, Node.Augmented)), - Error_List => - (if Set_Error_List - then New_Error_List - else - (if Node.Error_List = null - then null - else new Error_Data_Lists.List'(Node.Error_List.all))), + Error_List => Actual_Error_List, Non_Grammar => Node.Non_Grammar, Sequential_Index => Node.Sequential_Index, Following_Deleted => Valid_Node_Access_Lists.Empty_List); @@ -1994,7 +2000,7 @@ package body WisiToken.Syntax_Trees is (if Node.Augmented = null or User_Data = null then null else Copy_Augmented (User_Data.all, Node.Augmented)), - Error_List => New_Error_List, + Error_List => Actual_Error_List, Non_Grammar => Node.Non_Grammar, Sequential_Index => Node.Sequential_Index, Insert_Location => Node.Insert_Location); @@ -2012,7 +2018,7 @@ package body WisiToken.Syntax_Trees is (if Node.Augmented = null or User_Data = null then null else Copy_Augmented (User_Data.all, Node.Augmented)), - Error_List => New_Error_List, + Error_List => Actual_Error_List, Non_Grammar => Node.Non_Grammar, Sequential_Index => Node.Sequential_Index, Identifier => Node.Identifier, @@ -2044,7 +2050,7 @@ package body WisiToken.Syntax_Trees is (if Node.Augmented = null or User_Data = null then null else Copy_Augmented (User_Data.all, Node.Augmented)), - Error_List => New_Error_List, + Error_List => Actual_Error_List, Virtual => Node.Virtual, Recover_Conflict => Node.Recover_Conflict, RHS_Index => Node.RHS_Index, @@ -2502,7 +2508,7 @@ package body WisiToken.Syntax_Trees is -- terminal of a nonterm. -- -- So we assume the worst case, and use first/last terminal - -- sequential_index to guide the search when descenting a subtree. + -- sequential_index to guide the search when descending a subtree. Result.Ref.Ref := (Stream, (Cur => Parse_Stream.Stack_Top), Element (Parse_Stream.Stack_Top).Node); Last_Terminal := Result.Ref; @@ -6625,7 +6631,7 @@ package body WisiToken.Syntax_Trees is procedure Mark_In_Tree (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access; - Data : in out User_Data_Type'Class; + Data : in User_Data_Access; Node_Error_Reported : in out Boolean) is pragma Unreferenced (Data, Node_Error_Reported); @@ -7528,6 +7534,10 @@ package body WisiToken.Syntax_Trees is Shared_Link => Tree.Stream_First (Tree.Shared_Stream, Skip_SOI => True).Element.Cur, Elements => <>))) do + -- WORKAROUND: This is broken by gnat 13; ada-mode + -- test/ada_mode-function_2.adb fails with a ref_count error. + Tree.Enable_Ref_Count_Check (Result, Enable => False); + Tree.Next_Stream_Label := @ + 1; end return; end New_Stream; @@ -8039,6 +8049,12 @@ package body WisiToken.Syntax_Trees is Node : in out Node_Access; Parents : in out Node_Stacks.Stack) is + -- WORKAROUND: if the postcondition and this pragma is uncommented, + -- GNAT 13 complains that Tree is referenced in the postcondition; if + -- the postcondition is uncommented and this pragma commented, it + -- complains that it is referenced in the body. previous versions of + -- GNAT did not complain about the postcondition. So we comment out the postcondition + -- pragma Unreferenced (Tree); function Last_Child (Node : in Valid_Node_Access) return Node_Access @@ -8225,7 +8241,9 @@ package body WisiToken.Syntax_Trees is (Tree : in Syntax_Trees.Tree; Root : in Node_Access := Invalid_Node_Access; Line_Numbers : in Boolean := False; - Non_Grammar : in Boolean := False) + Non_Grammar : in Boolean := False; + Augmented : in Boolean := False; + Safe_Only : in Boolean := False) is procedure Print_Node (Node : in Valid_Node_Access; Level : in Integer) is begin @@ -8233,13 +8251,15 @@ package body WisiToken.Syntax_Trees is Tree.Lexer.Trace.Put ("| ", Prefix => False); end loop; Tree.Lexer.Trace.Put - (Image (Tree, Node, Children => False, RHS_Index => True, Node_Numbers => True, - Line_Numbers => Line_Numbers, Non_Grammar => Non_Grammar), - Prefix => False); - - if Node.Augmented /= null then - Tree.Lexer.Trace.Put (Image_Augmented (Node.Augmented.all), Prefix => False); - end if; + (Image (Tree, Node, + Children => False, + RHS_Index => True, + Node_Numbers => True, + Line_Numbers => Line_Numbers, + Non_Grammar => Non_Grammar, + Augmented => Augmented, + Safe_Only => Safe_Only), + Prefix => False); Tree.Lexer.Trace.New_Line; if Node.Label = Nonterm then @@ -9756,14 +9776,14 @@ package body WisiToken.Syntax_Trees is procedure Validate_Tree (Tree : in out Syntax_Trees.Tree; - User_Data : in out User_Data_Type'Class; + User_Data : in User_Data_Access; Error_Reported : in out Node_Sets.Set; Node_Index_Order : in Boolean; Byte_Region_Order : in Boolean := True; + Line_Number_Order : in Boolean := True; Root : in Node_Access := Invalid_Node_Access; Validate_Node : in Syntax_Trees.Validate_Node := null) is - Real_Root : Node_Access; Last_Source_Terminal_Pos : Base_Buffer_Pos := Buffer_Pos'First; @@ -9788,7 +9808,8 @@ package body WisiToken.Syntax_Trees is (Node, Image (Tree, Node, Children => False, - Node_Numbers => True))); + Node_Numbers => True, + Safe_Only => True))); Node_Image_Output := True; end if; @@ -9801,6 +9822,14 @@ package body WisiToken.Syntax_Trees is -- Source_Terminal since that is set by lexer. Node_Index on Virtual -- terminals not checked. + -- For some reason, this loop hangs in some cases + -- (ada_mode-recover_partial_28.adb). it hasn't caught a bug in a + -- while, so we're leaving it out. + -- + -- if not (for some N of Tree.Nodes => N = Node) then + -- Put_Error ("node " & Tree.Image (Node, Node_Numbers => True) & " not in Tree.Nodes"); + -- end if; + if Node = Real_Root then if Node.Parent /= null then Put_Error ("root parent set expecting null"); @@ -9845,7 +9874,12 @@ package body WisiToken.Syntax_Trees is Last_Source_Terminal_Pos := Node.Non_Grammar (Node.Non_Grammar.Last_Index).Byte_Region.Last; if Tree.Lexer.Descriptor.New_Line_ID /= Invalid_Token_ID then for Token of Node.Non_Grammar loop - if Token.Line_Region.First /= Last_Line then + + -- If node_index_order is changed, so is line_number order, but not + -- vice-versa; normally due to %if in grammar, or grammar + -- re-writting. See wisitoken-generate-tree_sitter.adb + if (Line_Number_Order and Node_Index_Order) and then Token.Line_Region.First /= Last_Line + then Put_Error ("line_number missing/out of order"); end if; Last_Line := Token.Line_Region.Last; diff --git a/wisitoken-syntax_trees.ads b/wisitoken-syntax_trees.ads index 796af1a..aa35a07 100644 --- a/wisitoken-syntax_trees.ads +++ b/wisitoken-syntax_trees.ads @@ -364,7 +364,7 @@ package WisiToken.Syntax_Trees is Stream : in Stream_ID; Node : in Valid_Node_Access) return Stream_Node_Ref - with Pre => Tree.Parents_Set, + with Pre => Tree_Parents_Set (Tree), Post => Tree.Valid_Stream_Node (To_Stream_Node_Ref'Result); subtype Terminal_Ref is Stream_Node_Ref @@ -430,7 +430,7 @@ package WisiToken.Syntax_Trees is return Boolean; function To_Stream_Node_Parents (Tree : in Syntax_Trees.Tree; Ref : in Stream_Node_Ref) return Stream_Node_Parents - with Pre => Ref = Invalid_Stream_Node_Ref or else Tree.Parents_Set or else + with Pre => Ref = Invalid_Stream_Node_Ref or else Tree_Parents_Set (Tree) or else (Rooted (Ref) or Ref.Node = Tree.First_Terminal (Get_Node (Ref.Element))), Post => Parents_Valid (To_Stream_Node_Parents'Result); @@ -565,9 +565,6 @@ package WisiToken.Syntax_Trees is type User_Data_Access is access all User_Data_Type'Class; type User_Data_Access_Constant is access constant User_Data_Type'Class; - procedure Reset (User_Data : in out User_Data_Type) is null; - -- Reset to start a new parse. - procedure Initialize_Actions (User_Data : in out User_Data_Type; Tree : in Syntax_Trees.Tree'Class) @@ -589,9 +586,8 @@ package WisiToken.Syntax_Trees is function Copy_Augmented (User_Data : in User_Data_Type; - Augmented : in Augmented_Class_Access) - return Augmented_Class_Access - with Pre => Augmented /= null; + Augmented : in not null Augmented_Class_Access) + return Augmented_Class_Access; -- Default implementation raises SAL.Programmer_Error. function Insert_After @@ -621,7 +617,7 @@ package WisiToken.Syntax_Trees is Tree : in out Syntax_Trees.Tree'Class; Inserted_Token : in Syntax_Trees.Valid_Node_Access) is null - with Pre'Class => Tree.Parents_Set and Tree.Is_Virtual_Terminal (Inserted_Token); + with Pre'Class => Tree_Parents_Set (Tree) and Tree.Is_Virtual_Terminal (Inserted_Token); -- Inserted_Token was inserted in error recovery. Move -- Inserted_Token.Non_Grammar as needed to control which line the -- token is on. @@ -635,7 +631,7 @@ package WisiToken.Syntax_Trees is Prev_Token : in Valid_Node_Access) is null with Pre'Class => - Tree.Parents_Set and + Tree_Parents_Set (Tree) and Tree.Has_Following_Deleted (Prev_Token); -- Prev_Token.Following_Deleted contains tokens that were deleted in -- error recovery; Prev_Token is the non-deleted terminal token @@ -687,8 +683,10 @@ package WisiToken.Syntax_Trees is null; when Error => - Begin_Name : Positive_Index_Type; - End_Name : Positive_Index_Type; + Begin_Name : SAL.Base_Peek_Type; + End_Name : SAL.Base_Peek_Type; + -- Begin, End are 0 if the corresponding token is absent (not just + -- empty) in the production. end case; end record; @@ -732,7 +730,7 @@ package WisiToken.Syntax_Trees is return Stream_ID with Pre => Old_Stream = Invalid_Stream_ID or else - (not Tree.Parents_Set and Tree.Stream_Count > 1 and Tree.Is_Valid (Old_Stream)), + (not Tree_Parents_Set (Tree) and Tree.Stream_Count > 1 and Tree.Is_Valid (Old_Stream)), Post => Tree.Is_Valid (New_Stream'Result); -- Create a new parse stream, initially copied from Old_Stream. @@ -829,7 +827,9 @@ package WisiToken.Syntax_Trees is State : in State_Index; Recover_Conflict : in Boolean) return Rooted_Ref - with Pre => not Tree.Traversing and not Tree.Parents_Set and Tree.Is_Valid (Stream) and Stream /= Tree.Shared_Stream, + with + Pre => not Tree.Traversing and not Tree_Parents_Set (Tree) and Tree.Is_Valid (Stream) and + Stream /= Tree.Shared_Stream, Post => Reduce'Result.Stream = Stream and Tree.Valid_Stream_Node (Reduce'Result); -- Reduce Child_Count tokens on Stream top of stack to a new Nonterm -- node on Stream top of stack. Result points to the new Nonterm @@ -1263,6 +1263,8 @@ package WisiToken.Syntax_Trees is Child_Index : in Positive_Index_Type) return Node_Access with Pre => Tree.Is_Nonterm (Node); + -- Returns Invalid_Node_Access if Child_Index is outside range of + -- Node.Children. function Has_Children (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access) return Boolean with Pre => Tree.Is_Nonterm (Node); @@ -1347,7 +1349,7 @@ package WisiToken.Syntax_Trees is Ref : in Stream_Node_Ref; Trailing_Non_Grammar : in Boolean := False) return WisiToken.Buffer_Region - with Pre => Tree.Parents_Set and Valid_Stream_Node (Tree, Ref); + with Pre => Tree_Parents_Set (Tree) and Valid_Stream_Node (Tree, Ref); -- Return Byte_Region of Ref.Node, using stream to find prev, next -- non_grammar if needed. @@ -1414,7 +1416,7 @@ package WisiToken.Syntax_Trees is Trailing_Non_Grammar : in Boolean) return WisiToken.Line_Region with Pre => Tree.Valid_Stream_Node (Ref) and - (Tree.Parents_Set or else + (Tree_Parents_Set (Tree) or else Rooted (Ref) or else Ref.Node = Tree.First_Terminal (Get_Node (Ref.Element))); -- Same as Line_Region (Ref.Node), using Ref.Stream to find @@ -1427,7 +1429,7 @@ package WisiToken.Syntax_Trees is (Tree : in Syntax_Trees.Tree; Ref : in Stream_Node_Ref) return WisiToken.Buffer_Region - with Pre => Tree.Valid_Stream_Node (Ref) and Tree.Parents_Set; + with Pre => Tree.Valid_Stream_Node (Ref) and Tree_Parents_Set (Tree); function Line_Region (Tree : in Syntax_Trees.Tree; @@ -1495,7 +1497,8 @@ package WisiToken.Syntax_Trees is procedure Set_Augmented (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access; - Value : in Augmented_Class_Access); + Value : in Augmented_Class_Access) + with Pre => Tree.Augmented (Node) = null; -- Value will be deallocated when Tree is finalized. function Augmented @@ -1518,14 +1521,14 @@ package WisiToken.Syntax_Trees is ID : in Token_ID; Max_Parent : in Boolean := False) return Node_Access - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); function Find_Ancestor (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access; IDs : in Token_ID_Array; Max_Parent : in Boolean := False) return Node_Access - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); -- Return the ancestor of Node that contains one of IDs (starting -- search with Node.Parent), or Invalid_Node_Access if none match. -- @@ -1537,7 +1540,7 @@ package WisiToken.Syntax_Trees is Node : in Valid_Node_Access; ID : in Token_ID) return Node_Access - with Pre => Tree.Parents_Set and Tree.Has_Parent (Node); + with Pre => Tree_Parents_Set (Tree) and Tree.Has_Parent (Node); -- Return the sibling of Node that contains ID, or Invalid_Node_Access if -- none match. @@ -1572,10 +1575,10 @@ package WisiToken.Syntax_Trees is Root : in Valid_Node_Access; Descendant : in Valid_Node_Access) return Boolean - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); function Subtree_Root (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access) return Valid_Node_Access - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); -- Return top ancestor of Node. procedure Process_Tree @@ -1596,7 +1599,7 @@ package WisiToken.Syntax_Trees is (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access) return Node_Access - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); -- Return first node before Node that has a non-empty Non_Grammar. -- If Node = Tree.Root or Tree.SOI, return Tree.SOI. -- @@ -1634,7 +1637,7 @@ package WisiToken.Syntax_Trees is (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access) return Valid_Node_Access - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); -- Return first node after Last_Terminal (Node) that has a non-empty -- Non_Grammar. If Node = Tree.Root or Tree.EOI, return Tree.EOI. @@ -1674,7 +1677,7 @@ package WisiToken.Syntax_Trees is Node : in Valid_Node_Access; Start_Line : in Base_Line_Number_Type := Invalid_Line_Number) return New_Line_Ref - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); -- If Node is SOI, returns reference to SOI.Non_Grammar (1). -- Otherwise, return a reference to the first New_Line preceding -- First_Terminal (Node).Byte_Region.First. @@ -1696,7 +1699,7 @@ package WisiToken.Syntax_Trees is (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access) return Line_Number_Type - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); -- Return line at first byte of Node. function Line_At_Node @@ -1721,7 +1724,7 @@ package WisiToken.Syntax_Trees is Trailing_Non_Grammar : in Boolean; Following : in Boolean) return Node_Access - with Pre => (if Following then Tree.Parents_Set else True), + with Pre => (if Following then Tree_Parents_Set (Tree) else True), Post => (if Following then First_Source_Terminal'Result /= Invalid_Node_Access and then @@ -1741,7 +1744,7 @@ package WisiToken.Syntax_Trees is Node : in Valid_Node_Access; Trailing_Non_Grammar : in Boolean) return Node_Access - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); -- Return the next terminal node after Node that can give byte or -- char pos; Invalid_Node_Access if there is no such node. -- @@ -1754,7 +1757,7 @@ package WisiToken.Syntax_Trees is (Tree : in Syntax_Trees.Tree; Ref : in out Stream_Node_Ref; Trailing_Non_Grammar : in Boolean) - with Pre => Valid_Stream_Node (Tree, Ref) and Tree.Parents_Set, + with Pre => Valid_Stream_Node (Tree, Ref) and Tree_Parents_Set (Tree), Post => Tree.Correct_Stream_Node (Ref); -- Update Ref to the next terminal node that can give byte or char -- pos. @@ -1769,14 +1772,14 @@ package WisiToken.Syntax_Trees is Node : in Valid_Node_Access; Trailing_Non_Grammar : in Boolean) return Node_Access - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); function Prev_Source_Terminal (Tree : in Syntax_Trees.Tree; Ref : in Stream_Node_Ref; Trailing_Non_Grammar : in Boolean) return Stream_Node_Ref - with Pre => Valid_Stream_Node (Tree, Ref) and Tree.Parents_Set, + with Pre => Valid_Stream_Node (Tree, Ref) and Tree_Parents_Set (Tree), Post => Tree.Correct_Stream_Node (Prev_Source_Terminal'Result); -- Return the previous terminal node that can give byte or char pos. -- @@ -1888,14 +1891,15 @@ package WisiToken.Syntax_Trees is -- Preceding, preceding element. procedure Prev_Terminal (Tree : in Syntax_Trees.Tree; Node : in out Node_Access) - with Pre => Tree.Parents_Set, + with Pre => Tree_Parents_Set (Tree), Post => Node = Invalid_Node_Access or else Tree.Label (Node) in Terminal_Label; function Prev_Terminal (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access) return Node_Access - with Pre => Tree.Parents_Set, - Post => Prev_Terminal'Result = Invalid_Node_Access or else - Tree.Label (Prev_Terminal'Result) in Terminal_Label; + with Pre => Tree_Parents_Set (Tree); + -- WORKAROUND: See comment in body on why this postcondition is commented out. + -- Post => Prev_Terminal'Result = Invalid_Node_Access or else + -- Tree.Label (Prev_Terminal'Result) in Terminal_Label; -- Return the terminal that is immediately before Node in subtree -- containing Node; Invalid_Node_Access if Node is the first terminal -- in that subtree. @@ -1904,13 +1908,13 @@ package WisiToken.Syntax_Trees is (Tree : in Syntax_Trees.Tree; Ref : in Terminal_Ref) return Terminal_Ref - with Pre => Tree.Parents_Set and Tree.Valid_Terminal (Ref), + with Pre => Tree_Parents_Set (Tree) and Tree.Valid_Terminal (Ref), Post => Tree.Correct_Stream_Node (Prev_Terminal'Result); procedure Prev_Terminal (Tree : in Syntax_Trees.Tree; Ref : in out Terminal_Ref) - with Pre => Tree.Parents_Set and Tree.Valid_Terminal (Ref), + with Pre => Tree_Parents_Set (Tree) and Tree.Valid_Terminal (Ref), Post => Tree.Correct_Stream_Node (Ref); procedure Prev_Terminal @@ -1927,14 +1931,15 @@ package WisiToken.Syntax_Trees is -- invalid_Node_Access. procedure Next_Terminal (Tree : in Syntax_Trees.Tree; Node : in out Node_Access) - with Pre => Tree.Parents_Set, + with Pre => Tree_Parents_Set (Tree), Post => Node = Invalid_Node_Access or else Tree.Label (Node) in Terminal_Label; function Next_Terminal (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access) return Node_Access - with Pre => Tree.Parents_Set, - Post => Next_Terminal'Result = Invalid_Node_Access or else - Tree.Label (Next_Terminal'Result) in Terminal_Label; + with Pre => Tree_Parents_Set (Tree); + -- WORKAROUND: See comment in Prev_Terminal body on why this postcondition is commented out. + -- Post => Next_Terminal'Result = Invalid_Node_Access or else + -- Tree.Label (Next_Terminal'Result) in Terminal_Label; -- Return the terminal that is immediately after Node in subtree -- containing Node; Invalid_Node_Access if Node is the last terminal -- in that subtree. @@ -1942,7 +1947,7 @@ package WisiToken.Syntax_Trees is procedure Next_Terminal (Tree : in Syntax_Trees.Tree; Ref : in out Terminal_Ref) - with Pre => Tree.Parents_Set and Valid_Terminal (Tree, Ref), + with Pre => Tree_Parents_Set (Tree) and Valid_Terminal (Tree, Ref), Post => Correct_Stream_Node (Tree, Ref); -- Update Ref to the next terminal that is after Ref.Node in Stream. -- Continues search in Shared_Stream; will always find EOI. Result is @@ -1964,7 +1969,7 @@ package WisiToken.Syntax_Trees is (Tree : in Syntax_Trees.Tree; Ref : in Terminal_Ref) return Terminal_Ref - with Pre => Tree.Parents_Set and Valid_Terminal (Tree, Ref), + with Pre => Tree_Parents_Set (Tree) and Valid_Terminal (Tree, Ref), Post => Correct_Stream_Node (Tree, Next_Terminal'Result); -- Same as procedure Next_Terminal, but return result. @@ -2026,7 +2031,7 @@ package WisiToken.Syntax_Trees is procedure First_Sequential_Terminal (Tree : in Syntax_Trees.Tree; Ref : in out Stream_Node_Ref) - with Pre => Valid_Stream_Node (Tree, Ref) and Tree.Parents_Set, + with Pre => Valid_Stream_Node (Tree, Ref) and Tree_Parents_Set (Tree), Post => Correct_Stream_Node (Tree, Ref); -- Return first terminal with valid Sequential_Index in Ref.Node or a -- following stream element; continues search in Tree.Shared_Stream. @@ -2078,7 +2083,7 @@ package WisiToken.Syntax_Trees is procedure Next_Sequential_Terminal (Tree : in Syntax_Trees.Tree; Ref : in out Syntax_Trees.Stream_Node_Ref) - with Pre => Valid_Stream_Node (Tree, Ref) and Tree.Parents_Set, + with Pre => Valid_Stream_Node (Tree, Ref) and Tree_Parents_Set (Tree), Post => Correct_Stream_Node (Tree, Ref); procedure Next_Sequential_Terminal @@ -2198,6 +2203,10 @@ package WisiToken.Syntax_Trees is -- not reachable from the root. Call Set_Parents if not -- Tree.Parents_Set. + function Tree_Parents_Set (Tree : in Syntax_Trees.Tree) return Boolean; + -- WORKAROUND: gnat 13 is confused about Tree.Parents_Set in aspects, + -- so we use an unambiguous name. + function Parents_Set (Tree : in Syntax_Trees.Tree) return Boolean; procedure Set_Parents @@ -2247,7 +2256,7 @@ package WisiToken.Syntax_Trees is Node : in Valid_Node_Access; Count : in Positive := 1) return Node_Access - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); -- Return Count parent of Node. function Find_Byte_Pos @@ -2267,7 +2276,7 @@ package WisiToken.Syntax_Trees is Stream : in Stream_ID := Invalid_Stream_ID) return Terminal_Ref with Pre => - Tree.Parents_Set and + Tree_Parents_Set (Tree) and (Start_At /= Invalid_Stream_Node_Ref or Stream /= Invalid_Stream_ID); -- Return the terminal that contains (including non_grammar if -- Trailing_Non_Grammar) or is first after Byte_Pos. @@ -2350,7 +2359,7 @@ package WisiToken.Syntax_Trees is (Tree : in Syntax_Trees.Tree; Line : in Line_Number_Type) return Node_Access - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); -- Return the node under Tree.Root of the first terminal token on -- line Line; Invalid_Node_Access if there are no grammar tokens on -- the line (ie only comment or whitespace), or the line is outside @@ -2412,7 +2421,7 @@ package WisiToken.Syntax_Trees is Tree.Valid_Stream_Node_Parents (Prev_Terminal) and Prev_Terminal.Ref.Stream /= Tree.Shared_Stream and Tree.Label (Prev_Terminal.Ref.Node) = Source_Terminal; - -- Copy Prev_Terminal.Ref.Node, add Deleted_Node to + -- Copy Prev_Terminal.Ref.Node and any ancestors, add Deleted_Node to -- Prev_Terminal.Ref.Node.Following_Deleted. Update Prev_Terminal to -- point to copied node. Move any non_grammar from Deleted_Node to -- Prev_Terminal.Ref.Node. @@ -2518,13 +2527,13 @@ package WisiToken.Syntax_Trees is function First_Recover_Conflict (Tree : in Syntax_Trees.Tree) return Stream_Node_Ref with - Pre => Tree.Parents_Set, + Pre => Tree_Parents_Set (Tree), Post => First_Recover_Conflict'Result = Invalid_Stream_Node_Ref or else Tree.Recover_Conflict (First_Recover_Conflict'Result.Node); -- First recover conflict node in Tree; Invalid_Stream_Node_Ref if none. procedure First_Recover_Conflict (Tree : in Syntax_Trees.Tree; Ref : in out Stream_Node_Ref) - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); -- First recover conflict node at or after Ref; Invalid_Stream_Ref if none. ---------- @@ -2610,7 +2619,7 @@ package WisiToken.Syntax_Trees is procedure Delete_Error (Tree : in out Syntax_Trees.Tree; Error : in out Error_Ref) - with Pre => Tree.Parents_Set and Has_Error (Error); + with Pre => Tree_Parents_Set (Tree) and Has_Error (Error); -- Delete Error from its containing node. Error is updated to next -- error (Invalid_Error_Ref if none). @@ -2659,7 +2668,7 @@ package WisiToken.Syntax_Trees is procedure Delete_Error (Tree : in out Syntax_Trees.Tree; Error : in out Stream_Error_Ref) - with Pre => Tree.Parents_Set and Has_Error (Error); + with Pre => Tree_Parents_Set (Tree) and Has_Error (Error); -- Delete Error from its containing node. Error is updated to next -- error (Invalid_Stream_Error_Ref if none). @@ -2670,7 +2679,7 @@ package WisiToken.Syntax_Trees is Data : in Error_Data'Class; User_Data : in User_Data_Access_Constant) with - Pre => not Tree.Parents_Set and Tree.Contains_Error (Error_Node (Error_Ref), Data), + Pre => not Tree_Parents_Set (Tree) and Tree.Contains_Error (Error_Node (Error_Ref), Data), Post => Tree.Contains_Error (Error_Node (Error_Ref), Data); -- Update error list element matching Data. -- @@ -2702,14 +2711,14 @@ package WisiToken.Syntax_Trees is function Error_Deleted (Error : in Stream_Error_Ref) return Valid_Node_Access_Lists.Cursor; function First_Error (Tree : in Syntax_Trees.Tree) return Error_Ref - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); -- Return first error node in Tree. function First_Error (Tree : in Syntax_Trees.Tree; Stream : in Stream_ID) return Stream_Error_Ref; -- Return first error node in Stream. procedure Next_Error (Tree : in Syntax_Trees.Tree; Error : in out Error_Ref) - with Pre => Tree.Parents_Set and Error /= Invalid_Error_Ref; + with Pre => Tree_Parents_Set (Tree) and Error /= Invalid_Error_Ref; -- Update Error to next error node. procedure Next_Error (Tree : in Syntax_Trees.Tree; Error : in out Stream_Error_Ref) @@ -2717,7 +2726,7 @@ package WisiToken.Syntax_Trees is -- Update Error to next error node. function Error_Count (Tree : in Syntax_Trees.Tree) return Ada.Containers.Count_Type - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); function Error_Count (Tree : in Syntax_Trees.Tree; Stream : in Stream_ID) return Ada.Containers.Count_Type; function Has_Errors (Tree : in Syntax_Trees.Tree) return Boolean; @@ -2824,7 +2833,8 @@ package WisiToken.Syntax_Trees is Expecting : in Boolean := False; Safe_Only : in Boolean := False) return String; - -- If Safe_Only, assume Node is not in tree, so can't use Prev_/Next_ anything. + -- If Safe_Only, assume Node is not in tree or some children were + -- deleted, so can't use Prev_/Next_ anything. function Image (Tree : in Syntax_Trees.Tree; @@ -2893,7 +2903,7 @@ package WisiToken.Syntax_Trees is Node : in Valid_Node_Access; Message : in String) return String - with Pre => Tree.Parents_Set; + with Pre => Tree_Parents_Set (Tree); -- File_Name from Tree.Lexer, line, column from Node function Error_Message @@ -2906,7 +2916,7 @@ package WisiToken.Syntax_Trees is type Validate_Node is access procedure (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access; - Data : in out User_Data_Type'Class; + Data : in User_Data_Access; Node_Error_Reported : in out Boolean); -- Called by Validate_Tree for each node visited; perform checks -- other than parent/child, output error messages to @@ -2920,7 +2930,7 @@ package WisiToken.Syntax_Trees is procedure Mark_In_Tree (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access; - Data : in out User_Data_Type'Class; + Data : in User_Data_Access; Node_Error_Reported : in out Boolean); -- Mark Node as being "in tree". -- @@ -2933,10 +2943,11 @@ package WisiToken.Syntax_Trees is procedure Validate_Tree (Tree : in out Syntax_Trees.Tree; - User_Data : in out User_Data_Type'Class; + User_Data : in User_Data_Access; Error_Reported : in out Node_Sets.Set; Node_Index_Order : in Boolean; Byte_Region_Order : in Boolean := True; + Line_Number_Order : in Boolean := True; Root : in Node_Access := Invalid_Node_Access; Validate_Node : in Syntax_Trees.Validate_Node := null); -- Verify that no children are Invalid_Node_Access. Verify @@ -2955,7 +2966,9 @@ package WisiToken.Syntax_Trees is (Tree : in Syntax_Trees.Tree; Root : in Node_Access := Invalid_Node_Access; Line_Numbers : in Boolean := False; - Non_Grammar : in Boolean := False); + Non_Grammar : in Boolean := False; + Augmented : in Boolean := False; + Safe_Only : in Boolean := False); -- Print tree rooted at Root (default Tree.Root) to -- Tree.Lexer.Trace, for debugging. -- @@ -3187,6 +3200,9 @@ private procedure Free is new Ada.Unchecked_Deallocation (Node, Node_Access); + function Tree_Parents_Set (Tree : in Syntax_Trees.Tree) return Boolean + is (Tree.Parents_Set); + Dummy_Node : constant Node_Access := new Node'(Label => Virtual_Identifier, Child_Count => 0, others => <>); type Token_Array_Var_Ref (Element : not null access WisiToken.Lexer.Token_Arrays.Vector) is record diff --git a/wisitoken-user_guide.texinfo b/wisitoken-user_guide.texinfo index a0b41c5..a77b5e4 100644 --- a/wisitoken-user_guide.texinfo +++ b/wisitoken-user_guide.texinfo @@ -1,6 +1,5 @@ \input texinfo @c Author : Stephen Leake stephen_leake@stephe-leake.org -@c Web : http://stephe-leake.org/ada/opentoken.html @setfilename wisi-generate @settitle WisiToken User Guide @@ -33,7 +32,7 @@ section entitled "GNU Free Documentation License". @contents @node Top -@top WisiToken User Guide version 4.1 +@top WisiToken User Guide version 4.2 @ifnottex @insertcopying @@ -73,7 +72,7 @@ available in the GNU ELPA package @code{wisi}. You will also need to install a lexer generator. WisiToken supports re2c, and other lexers can be added. -re2c is available from @url{http://re2c.org/}; it is also packaged in +re2c is available from @url{https://re2c.org/}; it is also packaged in Mingw64 and Debian. WisiToken requires at least version 1.3. The WisiToken makefile assumes the executable @code{re2c} is in @code{$PATH}. @@ -211,6 +210,9 @@ example: ``Keywords'' are reserved words or symbols in the target language; the lexers recognize them by the given string. +The keyword is case insensisitive if the string delimiters are single +quotes or the @code{case_insensitive} declaration is present. + @node Tokens @subsection Tokens @verbatim @@ -224,7 +226,10 @@ example: @end verbatim The syntax of the regular expression is determined by the lexer -generator. +generator. For @code{tree_sitter}, it is a Javascript expression that +evaluates to a regexp object; @code{/foo/u} or @code{new RegExp +("foo", "u")}. See @url{https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Regular_Expressions/Cheatsheet +} @code{repair_image} is used in error repair information; it should be inserted by an editor at the place of the expected but missing token. @@ -324,7 +329,7 @@ first end delimiter. %token <delimited-text> RAW_CODE "%{" "}%" @end verbatim A token that contains arbitrary text (including new-line), delimited -by the two strings. The arguments provide the comment start and end - +by the two strings. The arguments provide the start and end delimiters - the rest of the regular expression is provided by the generator. The delimiters must be different; this is checked at grammar generation time. @@ -475,6 +480,17 @@ than once, first with two branches, then with one more, etc. This is due to the way conflicts are found during the parse table generation process. +When translating a wisitoken grammar to a tree-sitter grammar, it is +sometimes necessary to express the conflicts differently. In that +case, the syntax is: +@verbatim +%conflict abstract_limited_opt abstract_limited_synchronized_opt +@end verbatim +which translates to one item in the conflicts list: +@verbatim + [$.abstract_limited_opt, $.abstract_limited_synchronized_opt] +@end verbatim + Resolving conflicts in the grammar can be difficult, but leaving them in can increase parse time and cause ambiguous parses. @@ -485,9 +501,9 @@ resolve the conflict. @code{wisitoken-grammar-mode} binds that command to @key{^c .}. @item %conflict_resolution <conflict description> : <resolution> -Declare a conflict resolution. The conflict description is the same as -in a @code{%conflict} declaration; the resolution says which branch of -the conflict to take. +Declare a conflict and a resolution for it. The conflict description +is the same as in a @code{%conflict} declaration; the resolution says +which branch of the conflict to take. Only one kind of resolution is supported: a token name, which must match one of the token names in the conflict description; the branch @@ -511,7 +527,7 @@ code aggree on what they mean. @item %elisp_indent <elisp name> <Ada name> [<arg_count> [token_arg_index]...] Declare elisp and Ada names for an indent variable or function. -When generating Ada code for Emacs, names used in @code{wisi-indent} +When generating Ada code for Emacs, names used in @code{wisi-indent-action} actions that are not recognized are assumed to be elisp and Ada variables, with the Ada name derived from elisp name by replacing @code{-} with @code{_}, and converting to @code{Mixed_Case}. @@ -562,8 +578,8 @@ end loop Get_Inputs; @end verbatim These names are optional in the Ada standard. Making them required -improves error recovery; the recovery algorithm can use matching names -to isolate the error. +improves error recovery; the McKenzie recovery algorithm can use +matching names to isolate the error. @item %escape_delimiter_doubled <token_name> The named token escapes embedded delimiters by doubling them, as for @@ -617,6 +633,12 @@ a parser that is generated by an external program. Translates the grammar file to a tree-sitter grammar file, and generates code that impements the grammar actions. +The grammar should define a nonterminal @code{word}; see +@url{https://tree-sitter.github.io/tree-sitter/creating-parsers#keywords}. + +In addition, if keywords are case insensitive, they must all be +explicitly declared. + @end table @code{<output_language>} determines both what code is generated, and @@ -668,6 +690,11 @@ the generated code to not include the runtime. Some grammars may need no runtime, particularly if they are small grammars intendend to test some generator feature. +@item %precedence <name> ... +Specifies a list of precedence names, and the order relation between +them. All precedence names must be declared in a @code{%precedence} +declaration before being used in a nonterminal. + @item %partial_recursion The error recovery algorithm requires computing the recursion present in the language grammar. For some grammars (such as Java), this is too @@ -688,8 +715,9 @@ message. The supported warnings are: @end itemize @item %lexer_regexp <name> <value> -Declare a named regular expression with name and current lexer -syntax. The name may then occur in another lexer regular expression. +Declare a named regular expression (or fragment) with name and current +lexer syntax. The name may then occur in another lexer regular +expression. @end table @node Nonterminals @@ -739,11 +767,12 @@ rhs_item | '(' rhs {| rhs} ')' ; @end verbatim -Here @code{token} is either defined by a token +Here @code{token} is either an identifier defined by a token declaration, or the token value contained in single quotes. -The second option is an attribute, as defined by ANTLR; these are -ignored in wisitoken. +The second option is an attribute; these are used in wisitoken to +express precedence and associativity, which are used in grammar +conflict resolution. Parentheses are used to group items. @@ -771,6 +800,65 @@ rhs_multiple_item times. ''@{@}-'', ''()+'', and ''token+'' mean the content is present one or more times. +@node Precedence attributes +@c https://github.com/tree-sitter/tree-sitter/pull/939 +@c https://tree-sitter.github.io/tree-sitter/creating-parsers#using-precedence +@c https://github.com/tree-sitter/tree-sitter-javascript/blob/master/grammar.js +Some ambiguous LR grammars can be made non-ambiguous by adding precedence +and/or associativity attributes (these attributes have no meaning for +packrat parsers). Consider an expression grammar that +includes binary add and multiply, and unary negate: + +@example +%precedence unary binary_multiply binary_add + +expression + : primary + | <prec=unary> '-' expression + | <prec=binary_multiply><assoc=left> expression ('*' expression)+ + | <prec=binary_add><assoc=left> expression ('+' expression)+ + ; + +@end example + +Without the attributes, this is ambiguous: the statement @code{1 + 2 * +3} can be parsed as @code{(1 + 2) * 3} or @code{(1 + (2 * +3)}. Similarly @code{1 + -2 + 3} can be parsed as @code{(1 + (-2)) + 3)} or +@code{1 + -(2 + 3)}, etc. + +The @code{%precedence} declaration gives an order for the list of +precedence labels; here unary operations are done before binary, and +multiply before add. More complex grammars may have more than one +@code{%precedence} declaration; there is no order between separate +@code{%precedence} declarations. + +The @code{prec} attribute applies a precedence label to a +production. If the LR parser generation algorithm encounters a +conflict involving productions with precedence labels, the labels are +compared, and the higher precedence production is used. If there is no +higher precedence, either because both productions have the same +label, or the labels are from different precedence declarations, the +conflict is kept, and resolved at runtime via the generalized parser +algorithm. + +This resolves the first example conflict; @code{1 + 2 * 3} is parsed +as @code{(1 + (2 * 3)} because multiply has higher precedence than +add. + +It also resolves the unary minus in the second conflict example; +@code{-2} is always parsed as @code{(-2)} because unary has higher +precendence than the other operators. + +The @code{assoc} attribute is similar; it specifies how to choose +between two productions. It must be applied to a token sequence that +generates a list. @code{assoc=left} says to build the list as +@code{list operator element} (the list is on the left); +@code{assoc=right} says to build the list as @code{element operator +list} (the list is on the right); + +This resolves the second conflict example; @code{1 + -2 + 3} is parsed +as @code{(1 + (-2)) + 3)}. + @node Conditional code @section Conditional code diff --git a/wisitoken-wisi_ada.adb b/wisitoken-wisi_ada.adb index 1178ca8..7a3eb86 100644 --- a/wisitoken-wisi_ada.adb +++ b/wisitoken-wisi_ada.adb @@ -2,7 +2,7 @@ -- -- see spec -- --- Copyright (C) 2013, 2014, 2015, 2017 - 2020, 2022 Free Software Foundation, Inc. +-- Copyright (C) 2013, 2014, 2015, 2017 - 2020, 2022, 2023 Free Software Foundation, Inc. -- -- This file is part of the WisiToken package. -- @@ -47,17 +47,20 @@ package body WisiToken.Wisi_Ada is function "+" (Tokens : in Token_ID_Arrays.Vector; Action : in Syntax_Trees.Post_Parse_Action) return Right_Hand_Side is begin - return (Tokens, Recursion => <>, Post_Parse_Action => Action, In_Parse_Action => null); + return (Tokens, Post_Parse_Action => Action, In_Parse_Action => null, + Recursion => <>, Associativity => <>, Precedence => <>); end "+"; function "+" (Tokens : in Token_ID; Action : in Syntax_Trees.Post_Parse_Action) return Right_Hand_Side is begin - return (Only (Tokens), Recursion => <>, Post_Parse_Action => Action, In_Parse_Action => null); + return (Only (Tokens), Post_Parse_Action => Action, In_Parse_Action => null, + Recursion => <>, Associativity => <>, Precedence => <>); end "+"; function "+" (Action : in Syntax_Trees.Post_Parse_Action) return Right_Hand_Side is begin - return (Tokens => <>, Recursion => <>, Post_Parse_Action => Action, In_Parse_Action => null); + return (Tokens => <>, Post_Parse_Action => Action, In_Parse_Action => null, + Recursion => <>, Associativity => <>, Precedence => <>); end "+"; function Only (Item : in WisiToken.Productions.Right_Hand_Side) return WisiToken.Productions.RHS_Arrays.Vector @@ -79,7 +82,7 @@ package body WisiToken.Wisi_Ada is function "<=" (LHS : in Token_ID; RHSs : in WisiToken.Productions.RHS_Arrays.Vector) return Instance is begin - return (LHS, Optimized_List => False, RHSs => RHSs); + return (LHS, Optimized_List => False, RHSs => RHSs, Precedence => <>); end "<="; function Only (Subject : in Instance) return Prod_Arrays.Vector diff --git a/wisitoken.adb b/wisitoken.adb index 558ce13..112db5b 100644 --- a/wisitoken.adb +++ b/wisitoken.adb @@ -2,7 +2,7 @@ -- -- See spec -- --- Copyright (C) 2009, 2014-2015, 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2009, 2014-2015, 2017 - 2023 Free Software Foundation, Inc. -- -- This file is part of the WisiToken package. -- @@ -349,21 +349,6 @@ package body WisiToken is Trace.New_Line; end Report_Memory; - function Error_Message - (File_Name : in String; - Line : in Base_Line_Number_Type; - Column : in Ada.Text_IO.Count; - Message : in String) - return String - is - use all type Ada.Text_IO.Count; - begin - return File_Name & ":" & - Trimmed_Image (if Line = Invalid_Line_Number then Integer'(0) else Integer (Line)) & ":" & - Trimmed_Image (Integer (Column + 1)) & ": " & - Message; - end Error_Message; - function Image (Item : in Buffer_Region) return String is begin return "(" & Trimmed_Image (Item.First) & " ." & Base_Buffer_Pos'Image (Item.Last) & ")"; @@ -520,6 +505,83 @@ package body WisiToken is Put_Line (Current_Error, "time=n - output times of various operations"); end Enable_Trace_Help; + procedure Put + (Lists : in Precedence_Lists_Arrays.Vector; + Map : in Precedence_Maps.Map) + is + use Ada.Text_IO; + use Precedence_Maps; + begin + Put_Line ("Precedence_IDs:"); + for Cur in Map.Iterate loop + Put_Line (Element (Cur)'Image & ": " & Key (Cur)); + end loop; + + Put_Line ("Precedence relations:"); + for List of Lists loop + for P of List loop + Put (P'Image & " "); + end loop; + New_Line; + end loop; + end Put; + + function Compare + (Left : in Precedence_ID; + Right : in Precedence_ID; + Precedences : in Precedence_Lists_Arrays.Vector) + return Precedence_Compare_Result + is + begin + if Left = Right then + return None; + end if; + + for List of Precedences loop + declare + I : Integer := 0; + Left_Index : Integer := 0; + Right_Index : Integer := 0; + begin + for Prec of List loop + I := @ + 1; + if Left = Prec then + Left_Index := I; + end if; + if Right = Prec then + Right_Index := I; + end if; + end loop; + + if Left_Index /= 0 and Right_Index /= 0 then + if Left_Index < Right_Index then + return WisiToken.Left; + elsif Left_Index > Right_Index then + return WisiToken.Right; + else + return WisiToken.None; + end if; + end if; + end; + end loop; + return None; + end Compare; + + function Error_Message + (File_Name : in String; + Line : in Base_Line_Number_Type; + Column : in Ada.Text_IO.Count; + Message : in String) + return String + is + use all type Ada.Text_IO.Count; + begin + return File_Name & ":" & + Trimmed_Image (if Line = Invalid_Line_Number then Integer'(0) else Integer (Line)) & ":" & + Trimmed_Image (Integer (Column + 1)) & ": " & + Message; + end Error_Message; + function Next_Value (Stream : not null access Ada.Streams.Root_Stream_Type'Class; Delims : in Ada.Strings.Maps.Character_Set) diff --git a/wisitoken.ads b/wisitoken.ads index b8a4b0c..ea86bee 100644 --- a/wisitoken.ads +++ b/wisitoken.ads @@ -26,7 +26,7 @@ -- Efficient and flexible incremental parsing. ACM Transactions on -- Programming Languages and Systems,20(5):980-1013, 1998 -- --- Copyright (C) 2009, 2010, 2013 - 2015, 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2009, 2010, 2013 - 2015, 2017 - 2023 Free Software Foundation, Inc. -- -- This file is part of the WisiToken package. -- @@ -51,7 +51,11 @@ pragma License (Modified_GPL); with Ada.Containers.Doubly_Linked_Lists; +with Ada.Containers.Indefinite_Hashed_Maps; +with Ada.Containers.Vectors; with Ada.Streams; +with Ada.Strings.Equal_Case_Insensitive; +with Ada.Strings.Hash_Case_Insensitive; with Ada.Strings.Maps; with Ada.Strings.Unbounded; with Ada.Text_IO; @@ -414,11 +418,14 @@ package WisiToken is Extreme : constant := 3; -- add ? Trace_McKenzie : Integer := 0; - -- If Trace_McKenzie > 0, Parse prints messages helpful for debugging error recovery. + -- If Trace_McKenzie > 0, Parse prints messages helpful for debugging + -- error recovery. -- -- Outline - error recovery enter/exit -- Detail - add each error recovery configuration -- Extra - add error recovery parse actions + -- + -- See also wisitoken-parse-lr.ads Set_McKenzie_Options. Trace_Lexer : Integer := 0; @@ -499,6 +506,47 @@ package WisiToken is ---------- -- Misc + type Associativity is (Left, Right, None); + + type Base_Precedence_ID is range 0 .. 255; + subtype Precedence_ID is Base_Precedence_ID range 1 .. 255; + No_Precedence : constant Base_Precedence_ID := 0; + + function Trimmed_Image is new SAL.Gen_Trimmed_Image (Base_Precedence_ID); + + type Precedence_List_ID is range 1 .. 255; + + package Precedence_Maps is new Ada.Containers.Indefinite_Hashed_Maps + (Key_Type => String, + Element_Type => Precedence_ID, + Hash => Ada.Strings.Hash_Case_Insensitive, + Equivalent_Keys => Ada.Strings.Equal_Case_Insensitive); + + package Precedence_Inverse_Maps is new Ada.Containers.Vectors + (Index_Type => Precedence_ID, + Element_Type => Ada.Strings.Unbounded.Unbounded_String, + "=" => Ada.Strings.Unbounded."="); + + package Precedence_Lists is new Ada.Containers.Doubly_Linked_Lists (Precedence_ID); + + package Precedence_Lists_Arrays is new Ada.Containers.Vectors + (Precedence_List_ID, Precedence_Lists.List, Precedence_Lists."="); + -- Actual precedence relation is given by order of two Precedence_IDs + -- in a Precedence_List; earlier ID has higher precedence. + + procedure Put + (Lists : in Precedence_Lists_Arrays.Vector; + Map : in Precedence_Maps.Map); + -- Put Lists, Map to Ada.Text_IO.Current_Ouput, for debugging. + + type Precedence_Compare_Result is (Left, Right, None); + + function Compare + (Left : in Precedence_ID; + Right : in Precedence_ID; + Precedences : in Precedence_Lists_Arrays.Vector) + return Precedence_Compare_Result; + type Cache_Version is mod 2**16; type Boolean_Access is access all Boolean; diff --git a/wisitoken_grammar_actions.adb b/wisitoken_grammar_actions.adb index 9c53fba..31668ad 100644 --- a/wisitoken_grammar_actions.adb +++ b/wisitoken_grammar_actions.adb @@ -2,7 +2,7 @@ -- command line: wisitoken-bnf-generate.exe --generate LALR Ada re2c wisitoken_grammar.wy -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- Author: Stephen Leake <stephe-leake@stephe-leake.org> -- @@ -19,7 +19,7 @@ -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License --- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +-- along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. with WisiToken_Grammar_Runtime; use WisiToken_Grammar_Runtime; @@ -130,7 +130,7 @@ package body Wisitoken_Grammar_Actions is Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access) is begin - Start_If (User_Data, Tree, Nonterm); + Add_Declaration (User_Data, Tree, Nonterm); end declaration_11; procedure declaration_12 @@ -165,10 +165,19 @@ package body Wisitoken_Grammar_Actions is Tree : in out WisiToken.Syntax_Trees.Tree; Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access) is + begin + Start_If (User_Data, Tree, Nonterm); + end declaration_15; + + procedure declaration_16 + (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; + Tree : in out WisiToken.Syntax_Trees.Tree; + Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access) + is pragma Unreferenced (Tree, Nonterm); begin End_If (User_Data); - end declaration_15; + end declaration_16; procedure nonterminal_0 (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; @@ -188,6 +197,24 @@ package body Wisitoken_Grammar_Actions is Add_Nonterminal (User_Data, Tree, Nonterm); end nonterminal_1; + procedure nonterminal_2 + (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; + Tree : in out WisiToken.Syntax_Trees.Tree; + Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access) + is + begin + Add_Nonterminal (User_Data, Tree, Nonterm); + end nonterminal_2; + + procedure nonterminal_3 + (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; + Tree : in out WisiToken.Syntax_Trees.Tree; + Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access) + is + begin + Add_Nonterminal (User_Data, Tree, Nonterm); + end nonterminal_3; + procedure rhs_item_1 (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; Tree : in out WisiToken.Syntax_Trees.Tree; @@ -224,15 +251,6 @@ package body Wisitoken_Grammar_Actions is Check_EBNF (User_Data, Tree, Nonterm, 1); end rhs_item_4; - procedure rhs_item_5 - (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; - Tree : in out WisiToken.Syntax_Trees.Tree; - Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access) - is - begin - Check_EBNF (User_Data, Tree, Nonterm, 1); - end rhs_item_5; - procedure rhs_optional_item_3 (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; Tree : in out WisiToken.Syntax_Trees.Tree; diff --git a/wisitoken_grammar_actions.ads b/wisitoken_grammar_actions.ads index f8a7654..50f90ad 100644 --- a/wisitoken_grammar_actions.ads +++ b/wisitoken_grammar_actions.ads @@ -2,7 +2,7 @@ -- command line: wisitoken-bnf-generate.exe --generate LALR Ada re2c PROCESS wisitoken_grammar.wy -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- Author: Stephen Leake <stephe-leake@stephe-leake.org> -- @@ -19,7 +19,7 @@ -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License --- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +-- along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. with WisiToken.Syntax_Trees; package Wisitoken_Grammar_Actions is @@ -28,8 +28,8 @@ package Wisitoken_Grammar_Actions is (First_Terminal => 3, Last_Terminal => 42, First_Nonterminal => 43, - Last_Nonterminal => 66, - SOI_ID => 67, + Last_Nonterminal => 68, + SOI_ID => 69, EOI_ID => 42, Accept_ID => 43, Case_Insensitive => False, @@ -77,8 +77,8 @@ package Wisitoken_Grammar_Actions is new String'("STAR"), new String'("NUMERIC_LITERAL"), new String'("IDENTIFIER"), - new String'("STRING_LITERAL_1"), - new String'("STRING_LITERAL_2"), + new String'("STRING_LITERAL_DOUBLE"), + new String'("STRING_LITERAL_SINGLE"), new String'("Wisi_EOI"), new String'("wisitoken_accept"), new String'("regexp_string"), @@ -94,7 +94,8 @@ package Wisitoken_Grammar_Actions is new String'("semicolon_opt"), new String'("rhs_list"), new String'("rhs"), - new String'("rhs_attribute"), + new String'("attribute"), + new String'("attribute_list"), new String'("rhs_element"), new String'("rhs_item_list"), new String'("rhs_item"), @@ -102,11 +103,12 @@ package Wisitoken_Grammar_Actions is new String'("rhs_optional_item"), new String'("rhs_multiple_item"), new String'("rhs_alternative_list"), + new String'("rhs_alternative_list_1"), new String'("compilation_unit"), new String'("compilation_unit_list"), new String'("Wisi_SOI")), - Terminal_Image_Width => 19, - Image_Width => 21, + Terminal_Image_Width => 21, + Image_Width => 22, Last_Lookahead => 43); type Token_Enum_ID is @@ -150,8 +152,8 @@ package Wisitoken_Grammar_Actions is STAR_ID, NUMERIC_LITERAL_ID, IDENTIFIER_ID, - STRING_LITERAL_1_ID, - STRING_LITERAL_2_ID, + STRING_LITERAL_DOUBLE_ID, + STRING_LITERAL_SINGLE_ID, Wisi_EOI_ID, wisitoken_accept_ID, regexp_string_ID, @@ -167,7 +169,8 @@ package Wisitoken_Grammar_Actions is semicolon_opt_ID, rhs_list_ID, rhs_ID, - rhs_attribute_ID, + attribute_ID, + attribute_list_ID, rhs_element_ID, rhs_item_list_ID, rhs_item_ID, @@ -175,6 +178,7 @@ package Wisitoken_Grammar_Actions is rhs_optional_item_ID, rhs_multiple_item_ID, rhs_alternative_list_ID, + rhs_alternative_list_1_ID, compilation_unit_ID, compilation_unit_list_ID, Wisi_SOI_ID); @@ -251,6 +255,10 @@ package Wisitoken_Grammar_Actions is (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; Tree : in out WisiToken.Syntax_Trees.Tree; Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access); + procedure declaration_16 + (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; + Tree : in out WisiToken.Syntax_Trees.Tree; + Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access); procedure nonterminal_0 (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; Tree : in out WisiToken.Syntax_Trees.Tree; @@ -259,6 +267,14 @@ package Wisitoken_Grammar_Actions is (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; Tree : in out WisiToken.Syntax_Trees.Tree; Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access); + procedure nonterminal_2 + (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; + Tree : in out WisiToken.Syntax_Trees.Tree; + Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access); + procedure nonterminal_3 + (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; + Tree : in out WisiToken.Syntax_Trees.Tree; + Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access); procedure rhs_item_1 (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; Tree : in out WisiToken.Syntax_Trees.Tree; @@ -275,10 +291,6 @@ package Wisitoken_Grammar_Actions is (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; Tree : in out WisiToken.Syntax_Trees.Tree; Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access); - procedure rhs_item_5 - (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; - Tree : in out WisiToken.Syntax_Trees.Tree; - Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access); procedure rhs_optional_item_3 (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; Tree : in out WisiToken.Syntax_Trees.Tree; diff --git a/wisitoken_grammar_editing.adb b/wisitoken_grammar_editing.adb index 8d0ad09..5f23c47 100644 --- a/wisitoken_grammar_editing.adb +++ b/wisitoken_grammar_editing.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -121,9 +121,10 @@ package body WisiToken_Grammar_Editing is end Add_RHS_Item; function Add_RHS_Element - (Tree : in out Syntax_Trees.Tree; - Item : in Valid_Node_Access; - Label : in Identifier_Token := Invalid_Identifier_Token) + (Tree : in out Syntax_Trees.Tree; + Item : in Valid_Node_Access; + Label : in Identifier_Token := Invalid_Identifier_Token; + Augmented : in WisiToken.Syntax_Trees.Augmented_Class_Access := null) return Valid_Node_Access is Label_Node : constant Node_Access := @@ -131,12 +132,17 @@ package body WisiToken_Grammar_Editing is then Invalid_Node_Access else Add_Identifier_Token (Tree, Label)); begin - return Tree.Add_Nonterm + return Result : constant Valid_Node_Access := Tree.Add_Nonterm ((+rhs_element_ID, (if Label = Invalid_Identifier_Token then 0 else 1)), (if Label = Invalid_Identifier_Token then (1 => Item) else (Label_Node, Tree.Add_Terminal (+EQUAL_ID), Item)), - Clear_Parents => False); + Clear_Parents => False) + do + if Augmented /= null then + Tree.Set_Augmented (Result, Augmented); + end if; + end return; end Add_RHS_Element; function Empty_RHS_Item_List @@ -146,7 +152,7 @@ package body WisiToken_Grammar_Editing is return LR_Utils.Creators.Empty_List (Tree, List_ID => +rhs_item_list_ID, - Multi_Element_RHS => 1, + Multi_Element_RHS => 0, Element_ID => +rhs_element_ID, Separator_ID => Invalid_Token_ID); end Empty_RHS_Item_List; @@ -158,15 +164,10 @@ package body WisiToken_Grammar_Editing is with Pre => Tree.ID (List_Element) = +rhs_element_ID is use LR_Utils; - Result : List := Creators.Empty_List - (Tree, - List_ID => +rhs_item_list_ID, - Multi_Element_RHS => 1, - Element_ID => +rhs_element_ID, - Separator_ID => Invalid_Token_ID); begin - Result.Append (List_Element); - return Result; + return Result : List := Empty_RHS_Item_List (Tree) do + Result.Append (List_Element); + end return; end To_RHS_Item_List; function Empty_RHS_List @@ -183,9 +184,9 @@ package body WisiToken_Grammar_Editing is function Add_RHS (Tree : in out Syntax_Trees.Tree; - Item : in Valid_Node_Access; + Attr_List : in WisiToken.Syntax_Trees.Node_Access; + Item_List : in WisiToken.Syntax_Trees.Valid_Node_Access; Auto_Token_Labels : in Boolean; - Edited_Token_List : in Boolean; Post_Parse_Action : in Node_Access := Invalid_Node_Access; In_Parse_Action : in Node_Access := Invalid_Node_Access) return Valid_Node_Access @@ -193,20 +194,60 @@ package body WisiToken_Grammar_Editing is Aug : constant Augmented_Access := new WisiToken_Grammar_Runtime.Augmented' (EBNF => False, Auto_Token_Labels => Auto_Token_Labels, - Edited_Token_List => Edited_Token_List); - - RHS : constant Valid_Node_Access := - (if In_Parse_Action = Invalid_Node_Access - then - (if Post_Parse_Action = Invalid_Node_Access - then Tree.Add_Nonterm ((+rhs_ID, 1), (1 => Item), Clear_Parents => True) - else Tree.Add_Nonterm ((+rhs_ID, 2), (Item, Post_Parse_Action), Clear_Parents => True)) - else - (if Post_Parse_Action = Invalid_Node_Access - then Tree.Add_Nonterm - ((+rhs_ID, 3), (Item, Tree.Add_Terminal (+ACTION_ID), In_Parse_Action), Clear_Parents => True) - else Tree.Add_Nonterm - ((+rhs_ID, 3), (Item, Post_Parse_Action, In_Parse_Action), Clear_Parents => True))); + Orig_EBNF_RHS => False, + EBNF_RHS_Index => <>, + Orig_Token_Index => <>); + + function RHS_Index return Natural + is begin + return + (if In_Parse_Action /= Invalid_Node_Access + then (if Attr_List = Invalid_Node_Access then 5 else 6) + elsif Post_Parse_Action /= Invalid_Node_Access + then (if Attr_List = Invalid_Node_Access then 3 else 4) + else (if Attr_List = Invalid_Node_Access then 1 else 2)); + end RHS_Index; + + function Children return Valid_Node_Access_Array + is + use all type SAL.Base_Peek_Type; + Count : Positive_Index_Type := 1; + Next : Positive_Index_Type := 1; + begin + if Attr_List /= Invalid_Node_Access then + Count := @ + 1; + end if; + + if Post_Parse_Action /= Invalid_Node_Access then + Count := @ + 1; + end if; + + if In_Parse_Action /= Invalid_Node_Access then + Count := @ + 1; + end if; + + return Result : Valid_Node_Access_Array (1 .. Count) := (others => WisiToken.Syntax_Trees.Dummy_Node) + do + if Attr_List /= Invalid_Node_Access then + Result (Next) := Attr_List; + Next := @ + 1; + end if; + + Result (Next) := Item_List; + Next := @ + 1; + + if Post_Parse_Action /= Invalid_Node_Access then + Result (Next) := Post_Parse_Action; + Next := @ + 1; + end if; + + if In_Parse_Action /= Invalid_Node_Access then + Result (Next) := In_Parse_Action; + end if; + end return; + end Children; + + RHS : constant Valid_Node_Access := Tree.Add_Nonterm ((+rhs_ID, RHS_Index), Children, Clear_Parents => True); begin Tree.Set_Augmented (RHS, WisiToken.Syntax_Trees.Augmented_Class_Access (Aug)); return RHS; @@ -230,15 +271,12 @@ package body WisiToken_Grammar_Editing is is begin case To_Token_Enum (Tree.ID (Decl)) is when declaration_ID => - case Tree.RHS_Index (Decl) is - when 0 => - return Get_Text (Data, Tree, Tree.Child (Decl, 3)); - - when 1 => + case To_Token_Enum (Tree.ID (Tree.Child (Decl, 2))) is + when Wisitoken_Grammar_Actions.TOKEN_ID | NON_GRAMMAR_ID => return Get_Text (Data, Tree, Tree.Child (Decl, 6)); - when 3 | 4 => - return Get_Text (Data, Tree, Tree.Child (Decl, 2)); + when KEYWORD_ID => + return Get_Text (Data, Tree, Tree.Child (Decl, 3)); when others => return ""; @@ -268,16 +306,61 @@ package body WisiToken_Grammar_Editing is return Invalid_Node_Access; end Find_Declaration; - EBNF_Allowed : Boolean := True; + function Find_Declaration_By_Value + (Data : in WisiToken_Grammar_Runtime.User_Data_Type; + Tree : in out Syntax_Trees.Tree; + Value : in String; + Strip_Quotes : in Boolean) + return Node_Access + is + use LR_Utils; + use LR_Utils.Creators; + + function Decl_Value (Decl : in Valid_Node_Access) return String + is + Value : constant Node_Access := + (case To_Token_Enum (Tree.ID (Decl)) is + when declaration_ID => + (case To_Token_Enum (Tree.ID (Tree.Child (Decl, 2))) is + when Wisitoken_Grammar_Actions.TOKEN_ID | + NON_GRAMMAR_ID => Tree.Child (Decl, 7), + when KEYWORD_ID => Tree.Child (Decl, 4), + when others => Invalid_Node_Access), + when others => Invalid_Node_Access); + begin + if Value = Invalid_Node_Access then + return ""; + else + return Get_Text (Data, Tree, Value, Strip_Quotes); + end if; + end Decl_Value; + + -- Tree.Root is wisitoken_accept, first child is SOI + List : constant Constant_List := Create_List + (Tree, Tree.Child (Tree.Root, 2), +compilation_unit_list_ID, +compilation_unit_ID); + begin + for N of List loop + declare + Decl : constant Valid_Node_Access := Tree.Child (N, 1); + begin + if Value = Decl_Value (Decl) then + return Decl; + end if; + end; + end loop; + return Invalid_Node_Access; + end Find_Declaration_By_Value; + procedure Validate_Node (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Access; - User_Data : in out Syntax_Trees.User_Data_Type'Class; + User_Data : in WisiToken.Syntax_Trees.User_Data_Access; Node_Error_Reported : in out Boolean) is use Ada.Text_IO; - Data : WisiToken_Grammar_Runtime.User_Data_Type renames WisiToken_Grammar_Runtime.User_Data_Type (User_Data); + Data : WisiToken_Grammar_Runtime.User_Data_Type renames + WisiToken_Grammar_Runtime.User_Data_Access (User_Data).all; procedure Put_Error (Msg : in String) is begin @@ -347,7 +430,7 @@ package body WisiToken_Grammar_Editing is when others => -- The reset are for %if .. %endif, which are supposed to be translated before now. - Put_Error ("unexpected RHS_Index"); + Put_Error ("unexpected RHS_Index" & RHS_Index'Image); end case; when rhs_ID => @@ -367,13 +450,32 @@ package body WisiToken_Grammar_Editing is when 2 => if Tree.Child_Count (Node) /= 2 then Put_Error ("expected child_count 2"); + elsif Tree.ID (Children (1)) /= +attribute_list_ID or + Tree.ID (Children (2)) /= +rhs_item_list_ID + then + Put_Error ("expecting rhs_attribute_list rhs_item_list"); + end if; + + when 3 => + if Tree.Child_Count (Node) /= 2 then + Put_Error ("expected child_count 2"); elsif Tree.ID (Children (1)) /= +rhs_item_list_ID or Tree.ID (Children (2)) /= +ACTION_ID then Put_Error ("expecting rhs_item_list ACTION"); end if; - when 3 => + when 4 => + if Tree.Child_Count (Node) /= 3 then + Put_Error ("expected child_count 3"); + elsif Tree.ID (Children (1)) /= +rhs_item_list_ID or + Tree.ID (Children (2)) /= +rhs_item_list_ID or + Tree.ID (Children (3)) /= +ACTION_ID + then + Put_Error ("expecting rhs_attribute_list rhs_item_list ACTION"); + end if; + + when 5 => if Tree.Child_Count (Node) /= 3 then Put_Error ("expected child_count 3"); elsif Tree.ID (Children (1)) /= +rhs_item_list_ID or @@ -383,13 +485,21 @@ package body WisiToken_Grammar_Editing is Put_Error ("expecting rhs_item_list ACTION ACTION"); end if; + when 6 => + if Tree.Child_Count (Node) /= 4 then + Put_Error ("expected child_count 4"); + elsif Tree.ID (Children (1)) /= +rhs_item_list_ID or + Tree.ID (Children (2)) /= +rhs_item_list_ID or + Tree.ID (Children (3)) /= +ACTION_ID or + Tree.ID (Children (4)) /= +ACTION_ID + then + Put_Error ("expecting rhs_attribute_list rhs_item_list ACTION ACTION"); + end if; + when others => Put_Error ("unexpected RHS_Index"); end case; - when rhs_attribute_ID => - Check_EBNF_Allowed; - when rhs_element_ID => case RHS_Index is when 0 => @@ -416,13 +526,6 @@ package body WisiToken_Grammar_Editing is when rhs_item_list_ID => case RHS_Index is when 0 => - if Tree.Child_Count (Node) /= 1 then - Put_Error ("expected child_count 1"); - elsif Tree.ID (Children (1)) /= +rhs_element_ID then - Put_Error ("expecting rhs_element"); - end if; - - when 1 => if Tree.Child_Count (Node) /= 2 then Put_Error ("expected child_count 2"); elsif Tree.ID (Children (1)) /= +rhs_item_list_ID or @@ -431,6 +534,13 @@ package body WisiToken_Grammar_Editing is Put_Error ("expecting rhs_item_list ELEMENT"); end if; + when 1 => + if Tree.Child_Count (Node) /= 1 then + Put_Error ("expected child_count 1"); + elsif Tree.ID (Children (1)) /= +rhs_element_ID then + Put_Error ("expecting rhs_element"); + end if; + when others => Put_Error ("unexpected RHS_Index"); end case; @@ -447,26 +557,21 @@ package body WisiToken_Grammar_Editing is end if; when 1 => - if Tree.ID (Children (1)) /= +STRING_LITERAL_2_ID then - Put_Error ("expecting STRING_LITERAL_2"); + if Tree.ID (Children (1)) /= +STRING_LITERAL_SINGLE_ID then + Put_Error ("expecting STRING_LITERAL_SINGLE"); end if; when 2 => - if Tree.ID (Children (1)) /= +rhs_attribute_ID then - Put_Error ("expecting rhs_attribute"); - end if; - - when 3 => if Tree.ID (Children (1)) /= +rhs_optional_item_ID then Put_Error ("expecting rhs_optional_item"); end if; - when 4 => + when 3 => if Tree.ID (Children (1)) /= +rhs_multiple_item_ID then Put_Error ("expecting rhs_multiple_item"); end if; - when 5 => + when 4 => if Tree.ID (Children (1)) /= +rhs_group_item_ID then Put_Error ("expecting rhs_group_item"); end if; @@ -518,10 +623,10 @@ package body WisiToken_Grammar_Editing is when 3 => if Children'Length /= 2 or else - (Tree.ID (Children (1)) /= +STRING_LITERAL_2_ID or + (Tree.ID (Children (1)) /= +STRING_LITERAL_SINGLE_ID or Tree.ID (Children (2)) /= +QUESTION_ID) then - Put_Error ("expecting STRING_LITERAL_2 QUESTION"); + Put_Error ("expecting STRING_LITERAL_SINGLE QUESTION"); end if; when others => @@ -594,20 +699,43 @@ package body WisiToken_Grammar_Editing is Check_EBNF_Allowed; case RHS_Index is when 0 => - if Children'Length /= 1 or else - (Tree.ID (Children (1)) /= +rhs_item_list_ID) + if Children'Length /= 2 or else + (Tree.ID (Children (1)) /= +attribute_list_ID or + Tree.ID (Children (2)) /= +rhs_alternative_list_1_ID) then - Put_Error ("expecting rhs_item_list"); + Put_Error ("expecting rhs_attribute_list rhs_alternative_list_1"); end if; when 1 => + if Children'Length /= 1 or else + (Tree.ID (Children (1)) /= +rhs_alternative_list_1_ID) + then + Put_Error ("expecting rhs_alternative_list_1"); + end if; + + when others => + Put_Error ("unexpected RHS_Index"); + end case; + + when rhs_alternative_list_1_ID => + Check_EBNF_Allowed; + case RHS_Index is + when 0 => if Children'Length /= 3 or else - (Tree.ID (Children (1)) /= +rhs_alternative_list_ID or + (Tree.ID (Children (1)) /= +rhs_alternative_list_1_ID or Tree.ID (Children (2)) /= +BAR_ID or Tree.ID (Children (3)) /= +rhs_item_list_ID) then - Put_Error ("expecting rhs_alternative_list BAR rhs_item_list"); + Put_Error ("expecting rhs_alternative_list_1 BAR rhs_item_list"); end if; + + when 1 => + if Children'Length /= 1 or else + (Tree.ID (Children (1)) /= +rhs_item_list_ID) + then + Put_Error ("expecting rhs_item_list"); + end if; + when others => Put_Error ("unexpected RHS_Index"); end case; @@ -683,37 +811,35 @@ package body WisiToken_Grammar_Editing is end Next_Nonterm_Name; function Needs_Token_Labels (RHS : in Valid_Node_Access) return Boolean + with Pre => Tree.ID (RHS) = +rhs_ID is - Has_EBNF : Boolean := False; - Has_Manual_Label : Boolean := False; + Has_EBNF : Boolean := False; - procedure Any_EBNF_Manual_Label + procedure Any_EBNF (Tree : in out Syntax_Trees.Tree; Node : in Valid_Node_Access) - is begin - Has_Manual_Label := Has_Manual_Label or - (Tree.ID (Node) = +rhs_element_ID and then Tree.RHS_Index (Node) = 1); - + is + pragma Unreferenced (Tree); + begin Has_EBNF := Has_EBNF or EBNF_Nodes.Contains (Node); -- Not every ebnf node requires auto-labels (ie literal tokens), but -- it's not easy to tell from here. - end Any_EBNF_Manual_Label; + end Any_EBNF; begin - case Tree.RHS_Index (RHS) is - when 0 | 1 => + if Tree.Child_Count (RHS) = 0 then return False; - when 2 | 3 => - Tree.Process_Tree (Any_EBNF_Manual_Label'Unrestricted_Access, RHS); - return Has_EBNF and not Has_Manual_Label; + elsif Tree.ID (Tree.Child (RHS, Tree.Child_Count (RHS))) = +ACTION_ID then + Tree.Process_Tree (Any_EBNF'Unrestricted_Access, RHS); + return Has_EBNF; - when others => - raise SAL.Programmer_Error; - end case; + else + return False; + end if; end Needs_Token_Labels; - Last_Token_Index : Integer := 0; + Last_Token_Index : SAL.Base_Peek_Type := 0; function Next_Token_Label (Prefix : in String := "T") return WisiToken.Identifier_Index is begin @@ -731,7 +857,10 @@ package body WisiToken_Grammar_Editing is end Next_Token_Label; procedure Add_Token_Labels (RHS : in Valid_Node_Access) - with Pre => Tree.ID (RHS) = +rhs_ID + with Pre => + Tree.ID (RHS) = +rhs_ID and + (Tree.Child_Count (RHS) > 0 and then + To_Token_Enum (Tree.ID (Tree.Child (RHS, Tree.Child_Count (RHS)))) = ACTION_ID) is use LR_Utils; @@ -744,20 +873,56 @@ package body WisiToken_Grammar_Editing is Tree.Set_Children (Element, (+rhs_element_ID, 1), (Ident, Equal, Tree.Child (Element, 1))); end Add_Token_Label; + procedure Add_Orig_Token_Index (Element : in Valid_Node_Access) + with Pre => Tree.ID (Element) = +rhs_element_ID + is + Aug : Augmented_Access := Augmented_Access (Tree.Augmented (Element)); + begin + if Aug = null then + Aug := new WisiToken_Grammar_Runtime.Augmented' + (Orig_Token_Index => Last_Token_Index, + others => <>); + Tree.Set_Augmented (Element, WisiToken.Syntax_Trees.Augmented_Class_Access (Aug)); + else + Aug.Orig_Token_Index := Last_Token_Index; + end if; + end Add_Orig_Token_Index; + procedure Add_Token_Labels_1 (Node : in Valid_Node_Access) - with Pre => To_Token_Enum (Tree.ID (Node)) in rhs_alternative_list_ID | rhs_item_list_ID + with Pre => + To_Token_Enum (Tree.ID (Node)) in rhs_alternative_list_ID | rhs_alternative_list_1_ID | rhs_item_list_ID is begin case To_Token_Enum (Tree.ID (Node)) is when rhs_alternative_list_ID => + case To_Token_Enum (Tree.ID (Tree.Child (Node, 1))) is + when rhs_alternative_list_1_ID => + Add_Token_Labels_1 (Tree.Child (Node, 1)); + + when attribute_list_ID => + Add_Token_Labels_1 (Tree.Child (Node, 2)); + + when others => + raise SAL.Programmer_Error; + end case; + + when rhs_alternative_list_1_ID => + -- Translate_RHS_Optional_Item creates one new RHS for each + -- alternative, so they all start with the same token index. See + -- subprograms.wy iterator_specification ['in' | 'of']. declare + Init_Index : constant SAL.Base_Peek_Type := Last_Token_Index; Alt_List : constant Constant_List := Creators.Create_List - (Tree, Node, +rhs_alternative_list_ID, +rhs_item_list_ID); + (Tree, Node, +rhs_alternative_list_1_ID, +rhs_item_list_ID); begin for Item_List of Alt_List loop + Last_Token_Index := Init_Index; Add_Token_Labels_1 (Item_List); end loop; end; + when attribute_list_ID => + null; + when rhs_item_list_ID => declare RHS_Item_List : constant Constant_List := Creators.Create_List @@ -766,93 +931,117 @@ package body WisiToken_Grammar_Editing is for Cur in RHS_Item_List.Iterate_Constant loop declare Element : Valid_Node_Access := WisiToken.Syntax_Trees.LR_Utils.Element (Cur); - Item : constant Valid_Node_Access := Tree.Child (Element, 1); + Item : constant Valid_Node_Access := Tree.Child (Element, Tree.Child_Count (Element)); begin - case Tree.RHS_Index (Item) is - when 0 | 1 => - Add_Token_Label (Element); + if Tree.Child_Count (Element) = 3 then + -- Already has a manual label; preserve it, and preserve + -- auto label numbering. + Last_Token_Index := @ + 1; + Add_Orig_Token_Index (Element); - when 2 => - null; - - when 3 => - declare - Opt_Item : constant Valid_Node_Access := Tree.Child (Item, 1); - begin - case Tree.RHS_Index (Opt_Item) is - when 0 | 1 => - Add_Token_Labels_1 (Tree.Child (Opt_Item, 2)); - - when 2 | 3 => - Add_Token_Label (Element); - when others => - raise SAL.Programmer_Error; - end case; - end; - - when 4 => - declare - Mult_Item : constant Valid_Node_Access := Tree.Child (Item, 1); - begin - case Tree.RHS_Index (Mult_Item) is - when 0 .. 3 => - declare - Content_List : constant Constant_List := Creators.Create_List - (Tree, Tree.Child (Mult_Item, 2), +rhs_alternative_list_ID, +rhs_item_list_ID); - begin - if Content_List.Count = 1 then - Add_Token_Label (Element); - else - Add_Token_Labels_1 (Tree.Child (Mult_Item, 2)); - end if; - end; - - when 4 .. 5 => - Add_Token_Label (Element); - when others => - raise SAL.Programmer_Error; - end case; - end; - - when 5 => - -- rhs_group_item - Add_Token_Labels_1 (Tree.Child (Tree.Child (Item, 1), 2)); - - when others => - raise SAL.Programmer_Error; - end case; + else + -- Element has no manual label; add next auto one. + + case To_Token_Enum (Tree.ID (Tree.Child (Item, 1))) is + when IDENTIFIER_ID | STRING_LITERAL_SINGLE_ID => + Add_Token_Label (Element); + Add_Orig_Token_Index (Element); + + when rhs_optional_item_ID => + declare + Opt_Item : constant Valid_Node_Access := Tree.Child (Item, 1); + begin + case Tree.RHS_Index (Opt_Item) is + when 0 | 1 => + Add_Token_Labels_1 (Tree.Child (Opt_Item, 2)); + + when 2 | 3 => + Add_Token_Label (Element); + Add_Orig_Token_Index (Element); + + when others => + raise SAL.Programmer_Error; + end case; + end; + + when rhs_multiple_item_ID => + declare + Mult_Item : constant Valid_Node_Access := Tree.Child (Item, 1); + begin + case Tree.RHS_Index (Mult_Item) is + when 0 .. 3 => + -- If there is only one rhs_element in the multiple_item, it will be + -- replaced by a list nonterm; the label must be on that. See + -- subprograms.wy compilation_unit. IMPROVEME: there are probably + -- other cases like this. + declare + RHS_Alt_List : constant Valid_Node_Access := Tree.Child (Mult_Item, 2); + RHS_Alt_List_1 : constant Valid_Node_Access := Tree.Child + (RHS_Alt_List, Tree.Child_Count (RHS_Alt_List)); + Content_List : constant Constant_List := Creators.Create_List + (Tree, RHS_Alt_List_1, +rhs_alternative_list_1_ID, +rhs_item_list_ID); + begin + if Content_List.Count = 1 then + Add_Token_Label (Element); + Add_Orig_Token_Index (Element); + + else + Add_Token_Labels_1 (Tree.Child (Mult_Item, 2)); + end if; + end; + + when 4 .. 5 => + Add_Token_Label (Element); + Add_Orig_Token_Index (Element); + + when others => + raise SAL.Programmer_Error; + end case; + end; + + when rhs_group_item_ID => + -- The group is either replaced by a nonterm (label the nonterm), or + -- expanded in a list of RHS (apply the label here; it is copied in + -- Translate_RHS_Group_Item). ada_annex_p.wy object_declaration, + -- subtype_declaration. + Add_Token_Label (Element); + Add_Orig_Token_Index (Element); + + when others => + raise SAL.Programmer_Error; + end case; + end if; end; end loop; end; when others => - raise SAL.Programmer_Error; + raise SAL.Programmer_Error with "Add_Token_Labels_1 " & Tree.Image (Node, Node_Numbers => True); end case; end Add_Token_Labels_1; + + Aug : Augmented_Access := Augmented_Access (Tree.Augmented (RHS)); begin if Trace_Generate_EBNF > Outline then Ada.Text_IO.Put_Line ("add token labels " & Tree.Image (RHS, Node_Numbers => True)); end if; - case Tree.RHS_Index (RHS) is - when 0 | 1 => - null; + if Aug = null then + Aug := new WisiToken_Grammar_Runtime.Augmented' + (Orig_EBNF_RHS => True, + Auto_Token_Labels => True, + others => <>); + Tree.Set_Augmented (RHS, WisiToken.Syntax_Trees.Augmented_Class_Access (Aug)); + else + Aug.Auto_Token_Labels := True; + end if; - when 2 | 3 => - declare - Aug : Augmented_Access := Augmented_Access (Tree.Augmented (RHS)); - begin - if Aug = null then - Aug := new WisiToken_Grammar_Runtime.Augmented'(Auto_Token_Labels => True, others => <>); - Tree.Set_Augmented (RHS, WisiToken.Syntax_Trees.Augmented_Class_Access (Aug)); - else - Aug.Auto_Token_Labels := True; - end if; - Add_Token_Labels_1 (Tree.Child (RHS, 1)); - -- Labels in actions will be applied in wisitoken-bnf-output_ada_emacs.adb - end; - when others => - raise SAL.Programmer_Error; - end case; + Add_Token_Labels_1 + (Tree.Child + (RHS, + (if To_Token_Enum (Tree.ID (Tree.Child (RHS, 1))) = rhs_item_list_ID + then 1 + else 2))); + -- Labels in actions will be applied in wisitoken-bnf-output_ada_emacs.adb end Add_Token_Labels; function Nonterm_Content_Equal @@ -860,6 +1049,7 @@ package body WisiToken_Grammar_Editing is List : in LR_Utils.Constant_List'Class; Node : in Valid_Node_Access) return Boolean + -- Ignores attributes. is pragma Unreferenced (List); begin @@ -869,14 +1059,18 @@ package body WisiToken_Grammar_Editing is -- (compilation_unit_1, (111 . 128)) -- | (nonterminal_0, (111 . 128)) -- | | 7;(IDENTIFIER, (111 . 128)) + -- | | [attribute_list] -- | | (COLON) -- | | (rhs_list_1, (111 . 128)) -- | | | ... declare - RHS_List_1 : constant Node_Access := Tree.Child (Tree.Child (Node, 1), 3); + Nonterm : constant Valid_Node_Access := Tree.Child (Node, 1); + RHS_List : constant Node_Access := Tree.Child + (Nonterm, + (if Tree.ID (Tree.Child (Nonterm, 3)) = +rhs_list_ID then 3 else 4)); begin - if RHS_List_1 /= Invalid_Node_Access and then - Target = Get_Text (Data, Tree, RHS_List_1) + if RHS_List /= Invalid_Node_Access and then + Target = Get_Text (Data, Tree, RHS_List) then return True; end if; @@ -899,19 +1093,31 @@ package body WisiToken_Grammar_Editing is end Find_Nonterminal; function Tree_Add_Nonterminal - (Child_1 : in Valid_Node_Access; - Child_2 : in Valid_Node_Access; - Child_3 : in Valid_Node_Access; - Child_4 : in Valid_Node_Access) + (Identifier : in Valid_Node_Access; + Attr_List : in Node_Access; + Colon : in Valid_Node_Access; + RHS_List : in Valid_Node_Access; + Semicolon : in Valid_Node_Access) return Valid_Node_Access + with Pre => + (Tree.Label (Identifier) in Terminal_Label and + Is_Terminal (Tree.ID (Identifier), Tree.Lexer.Descriptor.all)) and + (Attr_List = Invalid_Node_Access or else Tree.ID (Attr_List) = +attribute_list_ID) and + Tree.ID (Colon) = +COLON_ID and + Tree.ID (RHS_List) = +rhs_list_ID and + Tree.ID (Semicolon) in +SEMICOLON_ID | +semicolon_opt_ID is begin - -- Work around GNAT error about arbitrary evaluation order in - -- aggregates (no error about the arbitrary order in subprogram - -- parameter_assocation_lists!). - return Tree.Add_Nonterm - (Production => (+nonterminal_ID, 0), - Children => (Child_1, Child_2, Child_3, Child_4), - Clear_Parents => False); + if Attr_List = Invalid_Node_Access then + return Tree.Add_Nonterm + (Production => (+nonterminal_ID, 0), + Children => (Identifier, Colon, RHS_List, Semicolon), + Clear_Parents => False); + else + return Tree.Add_Nonterm + (Production => (+nonterminal_ID, 1), + Children => (Identifier, Attr_List, Colon, RHS_List, Semicolon), + Clear_Parents => False); + end if; end Tree_Add_Nonterminal; function Duplicate @@ -952,32 +1158,62 @@ package body WisiToken_Grammar_Editing is (RHS_List : in out LR_Utils.List; New_RHS_Item_List : in Valid_Node_Access; After : in Valid_Node_Access; + Orig_EBNF_RHS : in Boolean; Auto_Token_Labels : in Boolean) with Pre => RHS_List.List_ID = +rhs_list_ID and RHS_List.Element_ID = +rhs_ID and Tree.ID (New_RHS_Item_List) = +rhs_item_list_ID and Tree.ID (After) = +rhs_ID and RHS_List.Contains (After) + -- Insert in RHS_List a new RHS containing New_RHS_Item_List, after + -- After. Attributes and Actions are copied from After. is - Child_3 : constant Valid_Node_Access := - (if Tree.RHS_Index (After) = 3 - then Tree.Copy_Subtree (Tree.Child (After, 3), Data_Access) - else Dummy_Node); + Attr_List : constant Node_Access := + (if Tree.ID (Tree.Child (After, 1)) = +attribute_list_ID + then Tree.Copy_Subtree (Tree.Child (After, 1), Data_Access) + else Invalid_Node_Access); + + Action_1 : constant Valid_Node_Access := + (if Attr_List = Invalid_Node_Access then + (if Tree.Child_Count (After) >= 2 + then Tree.Copy_Subtree (Tree.Child (After, 2), Data_Access) + else Dummy_Node) + else + (if Tree.Child_Count (After) >= 3 + then Tree.Copy_Subtree (Tree.Child (After, 3), Data_Access) + else Dummy_Node)); + + Action_2 : constant Valid_Node_Access := + (if Attr_List = Invalid_Node_Access then + (if Tree.Child_Count (After) >= 3 + then Tree.Copy_Subtree (Tree.Child (After, 3), Data_Access) + else Dummy_Node) + else + (if Tree.Child_Count (After) >= 4 + then Tree.Copy_Subtree (Tree.Child (After, 4), Data_Access) + else Dummy_Node)); RHS : constant Valid_Node_Access := Tree.Add_Nonterm (Production => (+rhs_ID, Tree.RHS_Index (After)), Children => - (case Tree.RHS_Index (After) is - when 1 => (1 => New_RHS_Item_List), - when 2 => (New_RHS_Item_List, Tree.Copy_Subtree (Tree.Child (After, 2), Data_Access)), - when 3 => (New_RHS_Item_List, - Tree.Copy_Subtree (Tree.Child (After, 2), Data_Access), - Child_3), - when others => raise SAL.Programmer_Error), + (if Attr_List = Invalid_Node_Access then + (case Tree.Child_Count (After) is + when 1 => (1 => New_RHS_Item_List), + when 2 => (New_RHS_Item_List, Action_1), + when 3 => (New_RHS_Item_List, Action_1, Action_2), + when others => raise SAL.Programmer_Error) + else + (case Tree.Child_Count (After) is + when 2 => (Attr_List, New_RHS_Item_List), + when 3 => (Attr_List, New_RHS_Item_List, Action_1), + when 4 => (Attr_List, New_RHS_Item_List, Action_1, Action_2), + when others => raise SAL.Programmer_Error)), Clear_Parents => True); Aug : constant Augmented_Access := new WisiToken_Grammar_Runtime.Augmented' (EBNF => False, Auto_Token_Labels => Auto_Token_Labels, - Edited_Token_List => True); + Orig_EBNF_RHS => Orig_EBNF_RHS, + EBNF_RHS_Index => <>, + Orig_Token_Index => <>); begin Tree.Set_Augmented (RHS, WisiToken.Syntax_Trees.Augmented_Class_Access (Aug)); @@ -996,8 +1232,7 @@ package body WisiToken_Grammar_Editing is rhs_optional_item_ID | rhs_multiple_item_ID | rhs_group_item_ID | - rhs_attribute_ID | - STRING_LITERAL_2_ID + STRING_LITERAL_SINGLE_ID then if Trace_Generate_EBNF > Outline then Ada.Text_IO.Put_Line ("new EBNF node " & Tree.Image (Node, Node_Numbers => True)); @@ -1019,19 +1254,23 @@ package body WisiToken_Grammar_Editing is rhs_optional_item_ID | rhs_multiple_item_ID | rhs_group_item_ID | - rhs_attribute_ID | - STRING_LITERAL_2_ID + STRING_LITERAL_SINGLE_ID then if EBNF_Nodes.Contains (Node) then -- Node is original, not copied if Trace_Generate_EBNF > Outline then - Ada.Text_IO.Put_Line ("erase original deleted EBNF node" & Trimmed_Image (Get_Node_Index (Node))); + Ada.Text_IO.Put_Line ("erase original deleted EBNF node " & Trimmed_Image (Get_Node_Index (Node))); end if; EBNF_Nodes.Delete (Node); else Copied_EBNF_Nodes.Delete (Node); end if; end if; + exception + when SAL.Not_Found => + Ada.Text_IO.Put_Line + ("delete requested for node " & Trimmed_Image (Get_Node_Index (Node)) & ": not found."); + raise SAL.Programmer_Error; end Erase_Deleted_Node; begin Tree.Process_Tree (Erase_Deleted_Node'Access, Node); @@ -1122,7 +1361,7 @@ package body WisiToken_Grammar_Editing is List_ID => +rhs_item_list_ID, Element_ID => +rhs_element_ID, Separator_ID => Invalid_Token_ID, - Multi_Element_RHS => 1); + Multi_Element_RHS => 0); Skip_Last := Skip_Last - 1; end if; @@ -1130,7 +1369,7 @@ package body WisiToken_Grammar_Editing is when rhs_element_ID => declare List_Node : Valid_Node_Access := Tree.Find_Ancestor - (Skip_Node, (+rhs_ID, +rhs_alternative_list_ID)); + (Skip_Node, (+rhs_ID, +rhs_alternative_list_1_ID)); begin if Result.Skips'Length = 0 and then @@ -1141,7 +1380,7 @@ package body WisiToken_Grammar_Editing is exit; end if; - List_Node := List_Root (Tree, List_Node, +rhs_alternative_list_ID); + List_Node := List_Root (Tree, List_Node, +rhs_alternative_list_1_ID); Skip_Node := Tree.Find_Ancestor (Skip_Node, +rhs_element_ID); Search_For := +rhs_item_list_ID; @@ -1159,10 +1398,10 @@ package body WisiToken_Grammar_Editing is (Label => Nested, Element => Skip_Node, List_Root => List_Node, - List_ID => +rhs_alternative_list_ID, + List_ID => +rhs_alternative_list_1_ID, Element_ID => +rhs_item_list_ID, Separator_ID => +BAR_ID, - Multi_Element_RHS => 1); + Multi_Element_RHS => 0); Skip_Last := Skip_Last - 1; end if; @@ -1192,7 +1431,7 @@ package body WisiToken_Grammar_Editing is Result.Start_Element_ID := +rhs_element_ID; Result.Start_Separator_ID := Invalid_Token_ID; - Result.Start_Multi_Element_RHS := 1; + Result.Start_Multi_Element_RHS := 0; Result.Skips (Skip_Last) := (Skip, Last_Skip_Node); @@ -1205,7 +1444,7 @@ package body WisiToken_Grammar_Editing is end; end Find_Skips; - Container : Valid_Node_Access := Tree.Find_Ancestor (B, (+rhs_ID, +rhs_alternative_list_ID)); + Container : Valid_Node_Access := Tree.Find_Ancestor (B, (+rhs_ID, +rhs_alternative_list_1_ID)); Container_ID : WisiToken.Token_ID := Tree.ID (Container); Container_List : LR_Utils.List := @@ -1218,8 +1457,8 @@ package body WisiToken_Grammar_Editing is Separator_ID => +BAR_ID) else Create_List (Tree, - Root => List_Root (Tree, Container, +rhs_alternative_list_ID), - List_ID => +rhs_alternative_list_ID, + Root => List_Root (Tree, Container, +rhs_alternative_list_1_ID), + List_ID => +rhs_alternative_list_1_ID, Element_ID => +rhs_item_list_ID, Separator_ID => +BAR_ID)); @@ -1227,7 +1466,7 @@ package body WisiToken_Grammar_Editing is if Trace_Generate_EBNF > Extra then Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("Insert_Optional_RHS start: " & Get_Text (Data, Tree, Container)); - Tree.Print_Tree (Container); + Tree.Print_Tree (Container, Augmented => True); end if; declare @@ -1249,7 +1488,7 @@ package body WisiToken_Grammar_Editing is -- We can't insert an empty rhs_item_list into an -- rhs_alterative_list, so we insert an empty rhs. - if Container_ID = +rhs_alternative_list_ID then + if Container_ID = +rhs_alternative_list_1_ID then Container := Tree.Find_Ancestor (B, +rhs_ID); @@ -1280,6 +1519,7 @@ package body WisiToken_Grammar_Editing is (Container_List, New_RHS_AC, After => Container, + Orig_EBNF_RHS => False, Auto_Token_Labels => Get_RHS_Auto_Token_Labels (B)); end if; end if; @@ -1300,7 +1540,9 @@ package body WisiToken_Grammar_Editing is Aug : constant Augmented_Access := new WisiToken_Grammar_Runtime.Augmented' (EBNF => False, Auto_Token_Labels => Get_RHS_Auto_Token_Labels (B), - Edited_Token_List => True); + Orig_EBNF_RHS => False, + EBNF_RHS_Index => <>, + Orig_Token_Index => <>); begin loop After := List_Root (Tree, Tree.Find_Ancestor (After, +rhs_item_list_ID), +rhs_item_list_ID); @@ -1328,12 +1570,12 @@ package body WisiToken_Grammar_Editing is if Container_ID = +rhs_ID then Ada.Text_IO.Put_Line ("Insert_Optional_RHS old rhs, new rhs: " & Get_Text (Data, Tree, Container_List.Root)); - Tree.Print_Tree (Container_List.Root); + Tree.Print_Tree (Container_List.Root, Augmented => True); else Ada.Text_IO.Put_Line ("Insert_Optional_RHS edited rhs_alternative_list: " & Get_Text (Data, Tree, Tree.Parent (Container_List.Root))); - Tree.Print_Tree (Tree.Parent (Container_List.Root)); + Tree.Print_Tree (Tree.Parent (Container_List.Root), Augmented => True); end if; end if; end if; @@ -1396,7 +1638,7 @@ package body WisiToken_Grammar_Editing is ("new " & Label & ":" & Trimmed_Image (Get_Node_Index (Comp_Unit)) & ": '" & Get_Text (Data, Tree, Unit) & "'"); if Trace_Generate_EBNF > Extra then - Tree.Print_Tree (Comp_Unit); + Tree.Print_Tree (Comp_Unit, Augmented => True); end if; end if; end Add_Compilation_Unit; @@ -1413,13 +1655,13 @@ package body WisiToken_Grammar_Editing is -- Post_Parse_Action, _2 are not copied. is RHS_Item_List : constant Valid_Node_Access := Tree.Add_Nonterm - ((+rhs_item_list_ID, 0), (1 => RHS_Element), Clear_Parents => True); + ((+rhs_item_list_ID, 1), (1 => RHS_Element), Clear_Parents => True); RHS : constant Valid_Node_Access := Add_RHS (Tree, - RHS_Item_List, - Auto_Token_Labels, - Edited_Token_List => True, + Attr_List => Invalid_Node_Access, + Item_List => RHS_Item_List, + Auto_Token_Labels => Auto_Token_Labels, Post_Parse_Action => Post_Parse_Action, In_Parse_Action => In_Parse_Action); begin @@ -1433,26 +1675,35 @@ package body WisiToken_Grammar_Editing is In_Parse_Action : in Node_Access := Invalid_Node_Access) return Valid_Node_Access with Pre => Tree.ID (Content) = +rhs_alternative_list_ID - -- Convert Content to an rhs_list; Content is edited. + -- Return a new rhs_list constructed by editing Content. + -- Caller is responsible for promoting attribute_list in Content to + -- the nonterm attribute_list; result rhs's have null attr_list. -- - -- Post_Parse_Action, _2 are not copied for the first RHS; they are copied + -- Actions are not copied for the first RHS; they are copied -- for any more. is - Node : Valid_Node_Access := Content; - Copy_Actions : Boolean := False; + Node : Valid_Node_Access := Tree.Child (Content, Tree.Child_Count (Content)); + pragma Assert (Tree.ID (Node) = +rhs_alternative_list_1_ID); + + Result : constant Valid_Node_Access := Node; + + Copy_Actions : Boolean := False; begin loop - exit when Tree.RHS_Index (Node) = 0; + exit when Tree.Child_Count (Node) = 1; -- only one RHS left -- current tree: - -- rhs_alternative_list : Node - -- | rhs_alternative_list: Node.Child (1) - -- | | ... - -- | BAR: Node.child (2) - -- | rhs_item_list: Node.Child (3) - - -- new tree: - -- rhs_list: Node + -- rhs_alternative_list : Content + -- | rhs_attribute_list : Attr_List + -- | rhs_alternative_list_1: Node + -- | | rhs_alternative_list_1: Node.Child(1) + -- | | | ... + -- | | BAR: Node.child (2) + -- | | rhs_item_list: Node.Child (3) + + -- new tree for 1 RHS: + -- rhs_list: Content + -- | rhs_attribute_list : Attr_List -- | rhs_alternative_list: keep Node.Child (1) -- | | ... -- | BAR: keep @@ -1480,8 +1731,10 @@ package body WisiToken_Grammar_Editing is else declare RHS : constant Valid_Node_Access := Add_RHS - (Tree, Tree.Child (Node, 3), Auto_Token_Labels, - Edited_Token_List => True, + (Tree, + Attr_List => Invalid_Node_Access, + Item_List => Tree.Child (Node, 3), + Auto_Token_Labels => Auto_Token_Labels, Post_Parse_Action => (if Copy_Actions then Tree.Copy_Subtree (Post_Parse_Action, Data_Access) else Post_Parse_Action), In_Parse_Action => @@ -1502,18 +1755,23 @@ package body WisiToken_Grammar_Editing is end loop; -- current tree: - -- rhs_alternative_list : Node - -- | rhs_item_list: Node.Child (1) + -- rhs_alternative_list : Content + -- | rhs_attribute_list : Content.Child (1) or not present + -- | rhs_alternative_list_1 : Content.child (last) + -- | | edited above -- new tree: -- rhs_list: Node -- | rhs: new - -- | | rhs_item_list: Node.Child (1) + -- | | rhs_attribute_list : Content.Child (1) or not present + -- | | rhs_item_list: Node.Child (last) declare RHS : constant Valid_Node_Access := Add_RHS - (Tree, Tree.Child (Node, 1), Auto_Token_Labels, - Edited_Token_List => True, + (Tree, + Attr_List => Invalid_Node_Access, + Item_List => Tree.Child (Node, Tree.Child_Count (Node)), + Auto_Token_Labels => Auto_Token_Labels, Post_Parse_Action => (if Copy_Actions then Tree.Copy_Subtree (Post_Parse_Action, Data_Access) else Post_Parse_Action), In_Parse_Action => @@ -1522,7 +1780,7 @@ package body WisiToken_Grammar_Editing is Tree.Set_Children (Node, (+rhs_list_ID, 0), (1 => RHS)); end; - return Content; + return Result; end Convert_RHS_Alternative; procedure New_Nonterminal @@ -1535,25 +1793,25 @@ package body WisiToken_Grammar_Editing is -- -- We don't copy actions to a new nonterminal; they will not make sense. is - Child_1 : constant Valid_Node_Access := Tree.Add_Identifier (+IDENTIFIER_ID, New_Identifier); + Identifier : constant Valid_Node_Access := Tree.Add_Identifier (+IDENTIFIER_ID, New_Identifier); - Child_2 : constant Valid_Node_Access := Tree.Add_Terminal (+COLON_ID); + Colon : constant Valid_Node_Access := Tree.Add_Terminal (+COLON_ID); - Child_3 : constant Valid_Node_Access := + RHS_List : constant Valid_Node_Access := (case To_Token_Enum (Tree.ID (Content)) is when rhs_element_ID => To_RHS_List (Content, Get_RHS_Auto_Token_Labels (Content)), when rhs_alternative_list_ID => Convert_RHS_Alternative (Content, Get_RHS_Auto_Token_Labels (Content)), when others => raise SAL.Programmer_Error); - Child_4 : constant Valid_Node_Access := Tree.Add_Nonterm + Semicolon : constant Valid_Node_Access := Tree.Add_Nonterm ((+semicolon_opt_ID, 0), (1 => Tree.Add_Terminal (+SEMICOLON_ID)), Clear_Parents => True); New_Nonterm : constant Valid_Node_Access := Tree.Add_Nonterm (Production => (+nonterminal_ID, 0), - Children => (Child_1, Child_2, Child_3, Child_4), + Children => (Identifier, Colon, RHS_List, Semicolon), Clear_Parents => True); -- Child_3 can be Content begin Add_Compilation_Unit (Label & New_Identifier'Image, New_Nonterm); @@ -1573,23 +1831,33 @@ package body WisiToken_Grammar_Editing is if Data.User_Parser in WisiToken.BNF.LR_Generate_Algorithm and Data.Language_Params.Error_Recover then -- FIXME: these should have different labels? need test case RHS_Item_List_3.Append - (Add_RHS_Element (Tree, Add_RHS_Item (Tree, Add_Identifier_Token (Tree, List_Name)), Label)); + (Add_RHS_Element + (Tree, + Add_RHS_Item (Tree, Add_Identifier_Token (Tree, List_Name)), + Label, + Augmented => new WisiToken_Grammar_Runtime.Augmented'(Orig_Token_Index => 0, others => <>))); if Separator /= Invalid_Identifier_Token then RHS_Item_List_3.Append (Add_RHS_Element - (Tree, Add_RHS_Item (Tree, Add_Identifier_Token (Tree, Separator)), Label)); + (Tree, Add_RHS_Item (Tree, Add_Identifier_Token (Tree, Separator)), + Label, + Augmented => new WisiToken_Grammar_Runtime.Augmented'(Orig_Token_Index => 0, others => <>))); end if; RHS_Item_List_3.Append - (Add_RHS_Element (Tree, Add_RHS_Item (Tree, Add_Identifier_Token (Tree, List_Name)), Label)); + (Add_RHS_Element + (Tree, + Add_RHS_Item (Tree, Add_Identifier_Token (Tree, List_Name)), + Label, + Augmented => new WisiToken_Grammar_Runtime.Augmented'(Orig_Token_Index => 0, others => <>))); RHS_List.Append (Add_RHS (Tree, - RHS_Item_List_3.Root, + Attr_List => Invalid_Node_Access, + Item_List => RHS_Item_List_3.Root, Auto_Token_Labels => Auto_Token_Labels, - Edited_Token_List => True, Post_Parse_Action => Invalid_Node_Access, In_Parse_Action => Invalid_Node_Access)); end if; @@ -1598,6 +1866,7 @@ package body WisiToken_Grammar_Editing is procedure New_Nonterminal_List (List_Nonterm : in Identifier_Token; + Attr_List : in Node_Access; RHS_Item_List_1_Root : in Valid_Node_Access; Separator : in Identifier_Token; Auto_Token_Labels : in Boolean) @@ -1625,25 +1894,42 @@ package body WisiToken_Grammar_Editing is RHS_Item_List_2.Append (Tree.Copy_Subtree (Element, Data_Access)); end loop; - RHS_List.Append (Add_RHS (Tree, RHS_Item_List_1.Root, Auto_Token_Labels, Edited_Token_List => True)); - RHS_List.Append (Add_RHS (Tree, RHS_Item_List_2.Root, Auto_Token_Labels, Edited_Token_List => True)); + RHS_List.Append + (Add_RHS + (Tree, + Attr_List => Invalid_Node_Access, + Item_List => RHS_Item_List_1.Root, + Auto_Token_Labels => Auto_Token_Labels)); + + RHS_List.Append + (Add_RHS + (Tree, + Attr_List => Invalid_Node_Access, + Item_List => RHS_Item_List_2.Root, + Auto_Token_Labels => Auto_Token_Labels)); - Maybe_Optimized_List (RHS_List, List_Nonterm, Separator, Auto_Token_Labels); + Maybe_Optimized_List + (RHS_List => RHS_List, + List_Name => List_Nonterm, + Separator => Separator, + Auto_Token_Labels => Auto_Token_Labels); Add_Compilation_Unit ("canonical list", Tree_Add_Nonterminal - (Child_1 => Add_Identifier_Token (Tree, List_Nonterm), - Child_2 => Tree.Add_Terminal (+COLON_ID), - Child_3 => RHS_List.Root, - Child_4 => Tree.Add_Nonterm + (Identifier => Add_Identifier_Token (Tree, List_Nonterm), + Attr_List => Attr_List, + Colon => Tree.Add_Terminal (+COLON_ID), + RHS_List => RHS_List.Root, + Semicolon => Tree.Add_Nonterm ((+semicolon_opt_ID, 0), - (1 => Tree.Add_Terminal (+SEMICOLON_ID)), + (1 => Tree.Add_Terminal (+SEMICOLON_ID)), Clear_Parents => False))); end New_Nonterminal_List; procedure New_Nonterminal_List (List_Nonterm : in Identifier_Token; + Attr_List : in Node_Access; List_Element : in Identifier_Token; Separator : in Identifier_Token; Auto_Token_Labels : in Boolean) @@ -1651,6 +1937,7 @@ package body WisiToken_Grammar_Editing is -- Add a nonterminal declaration for a canonical list: -- -- foo_list ;; List_Nonterm + -- <attributes> -- : foo ;; List_Element -- | foo_list separator foo ;; List_Nonterm Separator List_Element @@ -1661,7 +1948,7 @@ package body WisiToken_Grammar_Editing is RHS_Item_List_1.Append (Add_RHS_Element (Tree, Add_RHS_Item (Tree, Add_Identifier_Token (Tree, List_Element)))); - New_Nonterminal_List (List_Nonterm, RHS_Item_List_1.Root, Separator, Auto_Token_Labels); + New_Nonterminal_List (List_Nonterm, Attr_List, RHS_Item_List_1.Root, Separator, Auto_Token_Labels); end New_Nonterminal_List; function List_Matches @@ -1670,7 +1957,7 @@ package body WisiToken_Grammar_Editing is Element_Content : in String) return Node_Access with Pre => Element_Content'Length > 0 - -- Return True if the declaration at N is a nonterminal for a + -- Return the name node if the declaration N is a nonterminal for a -- canonical list matching Separator_Content, Element_Content, -- possibly optimized. is @@ -1680,13 +1967,14 @@ package body WisiToken_Grammar_Editing is declare -- Target List_Nonterm is: -- - -- list_nonterm + -- list_nonterm [<attr>] -- : element -- | list_nonterm separator? element - -- | list_nonterm list_nonterm + -- [| list_nonterm list_nonterm] -- -- nonterminal: N -- | IDENTIFIER : Name_Node + -- [| attr_list : Attr_List] -- | COLON -- | rhs_list: RHS_List -- | | rhs_list: @@ -1696,8 +1984,14 @@ package body WisiToken_Grammar_Editing is -- | | rhs: ... list_nonterm separator? list_element Name_Node : constant Node_Access := Tree.Child (N, 1); + Attr_List : constant Node_Access := + (if Tree.ID (Tree.Child (N, 2)) = +attribute_list_ID + then Tree.Child (N, 2) + else Invalid_Node_Access); RHS_List : constant Constant_List := Creators.Create_List - (Tree, Tree.Child (N, 3), +rhs_list_ID, +rhs_ID); + (Tree, + Tree.Child (N, (if Attr_List = Invalid_Node_Access then 3 else 4)), + +rhs_list_ID, +rhs_ID); Iter : constant Constant_Iterator := RHS_List.Iterate_Constant; begin if RHS_List.Count in 2 | 3 then @@ -1806,12 +2100,18 @@ package body WisiToken_Grammar_Editing is when rhs_item_list_ID => pragma Assert (Separator_Ident_Tok = Invalid_Identifier_Token); - New_Nonterminal_List (List_Nonterm_Name, Element, Separator_Ident_Tok, Auto_Token_Labels); + New_Nonterminal_List + (List_Nonterm_Name, + Attr_List => Invalid_Node_Access, + RHS_Item_List_1_Root => Element, + Separator => Separator_Ident_Tok, + Auto_Token_Labels => Auto_Token_Labels); when rhs_element_ID => New_Nonterminal_List (List_Nonterm => List_Nonterm_Name, + Attr_List => Invalid_Node_Access, List_Element => To_Identifier_Token (Tree.Find_Descendant (Element, +rhs_item_ID), Tree), Separator => Separator_Ident_Tok, @@ -1821,6 +2121,7 @@ package body WisiToken_Grammar_Editing is New_Nonterminal_List (List_Nonterm => List_Nonterm_Name, + Attr_List => Invalid_Node_Access, List_Element => To_Identifier_Token (Element, Tree), Separator => Separator_Ident_Tok, Auto_Token_Labels => Auto_Token_Labels); @@ -1852,6 +2153,7 @@ package body WisiToken_Grammar_Editing is end Copy_Non_Grammar; procedure Translate_RHS_Group_Item (Node : in Valid_Node_Access) + with Pre => Tree.ID (Node) = +rhs_group_item_ID is -- Current tree: -- @@ -1862,58 +2164,295 @@ package body WisiToken_Grammar_Editing is -- | | | rhs_alternative_list: Child (Node, 2) -- | | | RIGHT_PAREN - RHS : constant Valid_Node_Access := Tree.Find_Ancestor (Node, +rhs_ID); - Has_Actions : constant Boolean := Tree.RHS_Index (RHS) in 2 .. 3; - Element_Content : constant String := Get_Text (Data, Tree, Tree.Child (Node, 2)); - Right_Paren_Node : constant Valid_Node_Access := Tree.Child (Node, 3); - Found_Unit : constant Node_Access := - (if Has_Actions then Invalid_Node_Access - else Find_Nonterminal - (Element_Content, Nonterm_Content_Equal'Unrestricted_Access)); - New_Ident : Base_Identifier_Index := Invalid_Identifier_Index; + -- If Node contains a simple alternative list, and is not contained + -- in a nested alternative list, expand it into a list of RHSs. + -- Otherwise replace it by a nonterminal. ada_ebnf.wy + -- subtype_declaration. + + use LR_Utils; + use LR_Utils.Creators; + + RHS : constant Valid_Node_Access := Tree.Find_Ancestor (Node, +rhs_ID); + Has_Actions : constant Boolean := +ACTION_ID = + Tree.ID (Tree.Child (RHS, Tree.Child_Count (RHS))); + + function Is_Simple (List_Node : in Valid_Node_Access) return Boolean + with Pre => Tree.ID (List_Node) = +rhs_alternative_list_ID + is begin + if Tree.ID (Tree.Find_Ancestor (Node, (+rhs_ID, +rhs_alternative_list_ID))) = +rhs_alternative_list_ID then + -- Nested. + return False; + end if; + + if +attribute_list_ID = Tree.ID (Tree.Child (List_Node, 1)) then + -- We assume these do not map to the alternatives individually. + return False; + end if; + + declare + Alt_List : constant Constant_List := Create_List + (Tree, Tree.Child (List_Node, Tree.Child_Count (List_Node)), + +rhs_alternative_list_1_ID, +rhs_item_list_ID); + begin + for Item_List_Node of Alt_List loop + declare + Item_List : constant Constant_List := Create_List + (Tree, Item_List_Node, +rhs_item_list_ID, +rhs_element_ID); + begin + if Item_List.Count /= 1 then + return False; + end if; + declare + El : constant Valid_Node_Access := Element (Item_List.First); + Item : constant Valid_Node_Access := Tree.Child (El, Tree.Child_Count (El)); + begin + if not (To_Token_Enum (Tree.ID (Tree.Child (Item, 1))) in + IDENTIFIER_ID | STRING_LITERAL_SINGLE_ID) + then + return False; + end if; + end; + end; + end loop; + end; + return True; + end Is_Simple; begin - if Found_Unit = Invalid_Node_Access then - New_Ident := Next_Nonterm_Name; - New_Nonterminal ("group item", New_Ident, Tree.Child (Node, 2)); - else + if Is_Simple (Tree.Child (Node, 2)) then + -- Expand into a list of RHSs. + -- + -- IMPROVEME: Much of this is similar to Translate_RHS_Optional_Item; + -- factor out common parts. + -- + -- Source looks like: + -- + -- | A (B) C + -- + -- B contains a simple rhs_alternative_list. + -- + -- For each alternative in B, splice together rhs_item_lists A, + -- B_i, C, copying A, C on all after the first: + -- | A B_i C + -- + -- current tree: + -- + -- rhs_list: + -- | rhs: + -- | | rhs_item_list + -- | | | rhs_item_list + -- | | ... + -- | | | | | rhs_element: A.last + -- | | | | | | rhs_item: + -- | | | | rhs_element: + -- | | | | | rhs_item: contains + -- | | | | | | rhs_group_item: B + -- | | | | | | | LEFT_PAREN: B.Children (1) + -- | | | | | | | rhs_alternative_list: B.Children (2) + -- | | | | | | | RIGHT_PAREN: B.Children (3) + -- | | | rhs_element: C.first + -- | | | | rhs_item: + -- ... + + -- tests: ada_ebnf.wy subtype_declaration, java_expressions_antlr.wy + -- expression, java_ebnf.wy expression, python_ebnf.wy testlist_comp, + -- dictorsetmaker + if Trace_Generate_EBNF > Extra then + Ada.Text_IO.Put_Line ("... simple"); + end if; + declare - Name_Node : constant Node_Access := Tree.Child (Tree.Child (Found_Unit, 1), 1); + B : Valid_Node_Access renames Node; -- same as Translate_RHS_Optional_Item + + Group_Label : constant Node_Access := + (if +IDENTIFIER_ID = Tree.ID (Tree.Child (Tree.Parent (Node, 2), 1)) + then Tree.Child (Tree.Parent (Node, 2), 1) + else Invalid_Node_Access); + -- We assume this label maps to the alternatives. + + RHS_List : LR_Utils.List := Create_From_Element + (Tree, RHS, + List_ID => +rhs_list_ID, + Element_ID => +rhs_ID, + Separator_ID => +BAR_ID); + + RHS_Cur : Cursor := RHS_List.Find (RHS); + + ABC_List : List := Create_From_Element + (Tree, Tree.Parent (B, 2), + List_ID => +rhs_item_list_ID, + Element_ID => +rhs_element_ID, + Separator_ID => Invalid_Token_ID); + + ABC_Iter : constant Iterator := ABC_List.Iterate; + + ABC_B_Cur : constant Cursor := ABC_List.To_Cursor (Tree.Parent (B, 2)); + ABC_A_Last : constant Cursor := ABC_Iter.Previous (ABC_B_Cur); + ABC_C_First : constant Cursor := ABC_Iter.Next (ABC_B_Cur); + + B_Alt_List : constant Valid_Node_Access := Tree.Child (B, 2); + B_Alternative_List : constant Constant_List := Create_List + (Tree, Tree.Child (B_Alt_List, Tree.Child_Count (B_Alt_List)), + +rhs_alternative_list_1_ID, +rhs_item_list_ID); begin - case Tree.Label (Name_Node) is - when Source_Terminal => - New_Ident := New_Identifier (Get_Text (Data, Tree, Name_Node)); - when Virtual_Identifier => - New_Ident := Tree.Identifier (Name_Node); - when others => - WisiToken.Syntax_Trees.LR_Utils.Raise_Programmer_Error ("translate_rhs_group_item", Tree, Name_Node); - end case; + for B_Item_List_Root of reverse B_Alternative_List loop + declare + B_Item_List_List : constant Constant_List := Create_List + (Tree, B_Item_List_Root, +rhs_item_list_ID, +rhs_element_ID); + + B_El : constant Valid_Node_Access := Element (B_Item_List_List.First); + + New_ABC : List := Empty_List (ABC_List); + + function Is_Orig_EBNF_RHS return Boolean + is begin + -- Consider subprograms.wy iteration_scheme, which has a nested + -- rhs_optional_item. Translating the nested optional gives an + -- rhs_alternative_list with two elements, which are copied to two + -- RHSs when translating the outer optional item; the first has all + -- the tokens (and thus Orig_EBNF_RHS is True), the second is missing + -- some (and thus Orig_EBNF_RHS is False). + if B_Item_List_Root /= Element (First (B_Alternative_List)) then + return False; + end if; + + if Tree.Augmented (RHS) = null then + -- This is an edited RHS with some optional left out. + return False; + else + return WisiToken_Grammar_Runtime.Augmented + (Tree.Augmented (RHS).all).Orig_EBNF_RHS; + end if; + end Is_Orig_EBNF_RHS; + begin + if Has_Element (ABC_A_Last) then + Copy (Source_List => ABC_List, + Source_Last => ABC_A_Last, + Dest_List => New_ABC, + User_Data => Data_Access); + end if; + + declare + -- Use appropriate label for B item. + + function Create_New_B_El return Valid_Node_Access + with Post => Tree.ID (Create_New_B_El'Result) = +rhs_element_ID + is begin + if +IDENTIFIER_ID = Tree.ID (Tree.Child (B_El, 1)) -- Already has a label; preserve it. + or Group_Label = Invalid_Node_Access -- No label + then + return Tree.Copy_Subtree (B_El, User_Data => Data_Access); + + else + -- Add group label + declare + New_B_Item : constant Valid_Node_Access := Tree.Copy_Subtree + (Tree.Child (B_El, 1), User_Data => Data_Access); + Containing_El : constant Valid_Node_Access := Tree.Find_Ancestor (B, +rhs_element_ID); + + begin + -- Copy Orig_Token_Index from parent rhs_element + return Add_RHS_Element + (Tree, New_B_Item, To_Identifier_Token (Group_Label, Tree), + Augmented => + (if Tree.Augmented (Containing_El) = null + then null + else new WisiToken_Grammar_Runtime.Augmented' + (Orig_Token_Index => Augmented_Access_Constant + (Tree.Augmented (Containing_El)).Orig_Token_Index, + others => <>))); + end; + end if; + end Create_New_B_El; + + begin + New_ABC.Append (Create_New_B_El); + end; + + if Has_Element (ABC_C_First) then + Copy (ABC_List, Source_First => ABC_C_First, Dest_List => New_ABC, User_Data => Data_Access); + end if; + + Insert_RHS + (RHS_List, + New_ABC.Root, + After => Element (RHS_Cur), + Orig_EBNF_RHS => Is_Orig_EBNF_RHS, + Auto_Token_Labels => Get_RHS_Auto_Token_Labels (B)); + + Record_Copied_EBNF_Nodes (New_ABC.Root); + end; + end loop; + + Erase_Deleted_EBNF_Nodes (Element (RHS_Cur)); + -- This includes B, so we don't do 'Clear_EBNF_Node (B)'. + + RHS_List.Delete (RHS_Cur); + + if Trace_Generate_EBNF > Extra then + declare + Nonterm : constant Valid_Node_Access := Tree.Find_Ancestor (RHS_List.Root, +nonterminal_ID); + begin + Ada.Text_IO.New_Line; + Ada.Text_IO.Put_Line ("edited group item containing nonterm:"); + Ada.Text_IO.Put_Line (Get_Text (Data, Tree, Nonterm)); + Tree.Print_Tree (Nonterm, Augmented => True); + end; + end if; end; - Erase_Deleted_EBNF_Nodes (Tree.Child (Node, 2)); - end if; - declare - Ident_Node : constant Node_Access := Tree.Add_Identifier (+IDENTIFIER_ID, New_Ident); - Element_Node : Valid_Node_Access := Tree.Parent (Node, 2); - Item_Node : Valid_Node_Access := Tree.Parent (Node, 1); - begin - Tree.Set_Children (Item_Node, (+rhs_item_ID, 0), (1 => Ident_Node)); - Copy_Non_Grammar (Right_Paren_Node, Ident_Node); + else + if Trace_Generate_EBNF > Extra then + Ada.Text_IO.Put_Line ("... not simple"); + end if; + + -- Create or find a nonterm for the content, replace the group item by + -- the nonterm name. + declare + Element_Content : constant String := Get_Text (Data, Tree, Tree.Child (Node, 2)); + Right_Paren_Node : constant Valid_Node_Access := Tree.Child (Node, 3); + Found_Unit : constant Node_Access := + (if Has_Actions then Invalid_Node_Access + else Find_Nonterminal + (Element_Content, Nonterm_Content_Equal'Unrestricted_Access)); + New_Ident : Base_Identifier_Index := Invalid_Identifier_Index; + begin + if Found_Unit = Invalid_Node_Access then + New_Ident := Next_Nonterm_Name; + New_Nonterminal ("group item", New_Ident, Tree.Child (Node, 2)); + else + declare + Name_Node : constant Node_Access := Tree.Child (Tree.Child (Found_Unit, 1), 1); + begin + case Tree.Label (Name_Node) is + when Source_Terminal => + New_Ident := New_Identifier (Get_Text (Data, Tree, Name_Node)); + when Virtual_Identifier => + New_Ident := Tree.Identifier (Name_Node); + when others => + WisiToken.Syntax_Trees.LR_Utils.Raise_Programmer_Error + ("translate_rhs_group_item", Tree, Name_Node); + end case; + end; + Erase_Deleted_EBNF_Nodes (Tree.Child (Node, 2)); + end if; - if Get_RHS_Auto_Token_Labels (RHS) then declare - Label : constant Valid_Node_Access := Tree.Add_Identifier - (+IDENTIFIER_ID, Next_Token_Label ("G")); - Equal : constant Valid_Node_Access := Tree.Add_Terminal (+EQUAL_ID); + Ident_Node : constant Node_Access := Tree.Add_Identifier (+IDENTIFIER_ID, New_Ident); + Item_Node : Valid_Node_Access := Tree.Parent (Node, 1); begin - Tree.Set_Children (Element_Node, (+rhs_element_ID, 1), (Label, Equal, Item_Node)); - end; - end if; - end; + Tree.Set_Children (Item_Node, (+rhs_item_ID, 0), (1 => Ident_Node)); + Copy_Non_Grammar (Right_Paren_Node, Ident_Node); - Clear_EBNF_Node (Node); + -- Add_Token_Labels has already set the right label. ada_annex_p.wy + -- object_declaration. + end; + end; + Clear_EBNF_Node (Node); + end if; end Translate_RHS_Group_Item; procedure Translate_RHS_Multiple_Item (B : in Valid_Node_Access) + with Pre => Tree.ID (B) = +rhs_multiple_item_ID is -- We have one of: -- @@ -1923,6 +2462,7 @@ package body WisiToken_Grammar_Editing is -- | a ( b ) * c -- | a b+ c -- | a b* c + -- | e (a b* c) f -- -- where a and/or c can be empty. Replace it with a new canonical -- list nonterminal: @@ -1937,6 +2477,10 @@ package body WisiToken_Grammar_Editing is -- -- and a second RHS if it can be empty: -- | a c + -- | e (a c) f + + -- FIXME: this assumes left associativity; implement right when we + -- find a test case. -- Current tree: -- @@ -1955,7 +2499,7 @@ package body WisiToken_Grammar_Editing is -- | rhs_item: Parent (B, 1) -- | | rhs_multiple_item: B -- | | | IDENTIFIER - -- | | | PLUS | STAR + -- | | | [PLUS | STAR] use LR_Utils; use LR_Utils.Creators; @@ -1969,20 +2513,40 @@ package body WisiToken_Grammar_Editing is Parent_RHS_Item : Valid_Node_Access := Tree.Parent (B); List_Nonterm_Name : Identifier_Token := Invalid_Identifier_Token; - B_Alt_List_List : constant Constant_List := + B_Attr_List : constant Node_Access := (case Tree.RHS_Index (B) is when 0 .. 3 => - Create_List (Tree, Tree.Child (B, 2), +rhs_alternative_list_ID, +rhs_item_list_ID), - when others => Invalid_List (Tree)); - -- The rhs_alternative_list of the rhs_multiple_item. + (if Tree.ID (Tree.Child (Tree.Child (B, 2), 1)) = +attribute_list_ID + then Tree.Child (Tree.Child (B, 2), 1) else Invalid_Node_Access), + + when others => Invalid_Node_Access); + + B_Alt_List : constant Node_Access := + -- The rhs_alternative_list_1 node of the rhs_multiple_item. + (case Tree.RHS_Index (B) is + when 0 .. 3 => Tree.Child (Tree.Child (B, 2), (if B_Attr_List = Invalid_Node_Access then 1 else 2)), + when others => Invalid_Node_Access); + + B_Alt_List_List : constant Constant_List := + (if B_Alt_List /= Invalid_Node_Access then + Create_List (Tree, B_Alt_List, +rhs_alternative_list_1_ID, +rhs_item_list_ID) + else Invalid_List (Tree)); B_Alt_List_Item_List : List := + -- The first rhs_item_list of the rhs_multiple_item. (if B_Alt_List_List.Is_Invalid then Invalid_List (Tree) else Create_List (Tree, Element (B_Alt_List_List.First), +rhs_item_list_ID, +rhs_element_ID, Separator_ID => Invalid_Token_ID)); - -- The first rhs_item_list of the rhs_multiple_item. + + RHS_0 : constant Valid_Node_Access := Tree.Find_Ancestor (B, +rhs_ID); + -- The top level RHS containing this multiple_item; any attributes on + -- this RHS apply to the new nonterm. + + RHS_0_Attr_List : constant Node_Access := + (if Tree.ID (Tree.Child (RHS_0, 1)) = +attribute_list_ID + then Tree.Child (RHS_0, 1) else Invalid_Node_Access); Container_List_Root : Node_Access := Invalid_Node_Access; -- Updated by Insert_Optional_RHS. @@ -1997,8 +2561,9 @@ package body WisiToken_Grammar_Editing is -- -- SwitchLabels : SwitchLabel {SwitchLabel} -- - -- where B is the rhs_multiple_item containing "(',' - -- enumConstant)*" or "{SwitchLabel}". + -- where B is the rhs_multiple_item containing "(',' enumConstant)*" + -- or "{SwitchLabel}". SwitchLabels is a named list; enumConstant is + -- unnamed. -- -- The tokens may have labels. -- @@ -2006,24 +2571,34 @@ package body WisiToken_Grammar_Editing is -- reducing to enumConstants and reducing to the introduced nonterm -- list. -- - -- Alternately, the no separator case can be: + -- Alternately, the no separator case can be one of: -- -- enumConstants : enumConstant+ ; + -- (']' ('[' ']')* c) from java_ebnf.wy + -- + -- Here enumConstants is named, the java_ebnf.wy case is unnamed. In + -- the java_ebnf.wy case, '[' looks like a separator, but is not; + -- fortunately, that distinction does not matter for our purposes. -- -- Handling this no separator case specially does not eliminate any -- conflicts, but it does reduce the number of added nonterminals, -- and keeps the names simpler. List_Nonterm_Decl : constant Valid_Node_Access := Tree.Find_Ancestor (B, +nonterminal_ID); - RHS_List_Root : constant Valid_Node_Access := Tree.Child (List_Nonterm_Decl, 3); + + List_Nonterm_RHS_List_Index : constant SAL.Peek_Type := + (if Tree.ID (Tree.Child (List_Nonterm_Decl, 2)) = +attribute_list_ID then 4 else 3); + + RHS_List_Root : constant Valid_Node_Access := Tree.Child + (List_Nonterm_Decl, List_Nonterm_RHS_List_Index); RHS_List : List := Create_List (Tree, RHS_List_Root, +rhs_list_ID, +rhs_ID, Separator_ID => +BAR_ID); RHS : constant Valid_Node_Access := Tree.Find_Ancestor (B, (+rhs_ID, +rhs_alternative_list_ID)); - -- If rhs_ID, the RHS containing the canonical list candidate. - -- If rhs_alternative_list_ID, an unnamed canonical list candidate + -- If rhs_ID, the RHS containing the named canonical list candidate (= RHS_0) (ie a { b } c). + -- If rhs_alternative_list_ID, an unnamed canonical list candidate (ie (a b* c) ). RHS_Item_List_Root : constant Valid_Node_Access := List_Root (Tree, Tree.Find_Ancestor (B, +rhs_item_list_ID), +rhs_item_list_ID); @@ -2037,18 +2612,17 @@ package body WisiToken_Grammar_Editing is Element_2 : constant Cursor := RHS_Item_List_List.To_Cursor (Tree.Parent (B, 2)); -- The rhs_element containing the rhs_multiple_item - Element_1 : constant Node_Access := - (if Tree.RHS_Index (B) in 4 .. 5 - then Invalid_Node_Access - else Element (RHS_Item_List_Iter.Previous (Element_2))); - -- The rhs_element containing the first list element + Element_1 : constant Node_Access := Element (RHS_Item_List_Iter.Previous (Element_2)); + -- If there is a separator, the rhs_element containing the first list + -- (after 'a'); invalid if a is not present and there is no separator. - Can_Be_Empty : constant Boolean := Element_1 = Invalid_Node_Access and Tree.RHS_Index (B) in 0 | 3 | 5; + Can_Be_Empty : constant Boolean := Element_1 = Invalid_Node_Access and + To_Token_Enum (Tree.ID (Tree.Child (B, Tree.Child_Count (B)))) in RIGHT_BRACE_ID | STAR_ID; procedure Do_Simple_Named (List_Elements : in Valid_Node_Access) with Pre => To_Token_Enum (Tree.ID (List_Elements)) in rhs_element_ID | rhs_item_list_ID | IDENTIFIER_ID is - pragma Assert (Tree.ID (RHS) = +rhs_ID); + pragma Assert (Tree.ID (RHS) = +rhs_ID and RHS = RHS_0); -- The existing nonterminal declaration is one of: -- @@ -2123,18 +2697,21 @@ package body WisiToken_Grammar_Editing is when rhs_element_ID => To_RHS_Item_List (Tree, List_Elements), when rhs_item_list_ID => Creators.Create_List (Tree, List_Elements, +rhs_item_list_ID, +rhs_element_ID, Invalid_Token_ID), - when IDENTIFIER_ID => Empty_List (Tree, +rhs_item_list_ID, 1, +rhs_element_ID, Invalid_Token_ID), + when IDENTIFIER_ID => Empty_RHS_Item_List (Tree), when others => raise SAL.Programmer_Error); RHS_Item_List_2 : List := (if B_Alt_List_Item_List.Is_Invalid - then Empty_List (Tree, +rhs_item_list_ID, 1, +rhs_element_ID, Invalid_Token_ID) + then Empty_RHS_Item_List (Tree) else B_Alt_List_Item_List); New_RHS_List : List := Empty_RHS_List (Tree); + -- The edited RHS list. The original RHS list is removed from the tree. - Post_Parse_Action : constant Node_Access := Tree.Child (RHS, 2); -- deleted by first Add_RHS - In_Parse_Action : constant Node_Access := Tree.Child (RHS, 3); + Post_Parse_Action : constant Node_Access := Tree.Child + (RHS, (if RHS_0_Attr_List = Invalid_Node_Access then 2 else 3)); -- deleted by first Add_RHS + In_Parse_Action : constant Node_Access := Tree.Child + (RHS, (if RHS_0_Attr_List = Invalid_Node_Access then 3 else 4)); Auto_Token_Labels : constant Boolean := Get_RHS_Auto_Token_Labels (RHS); Label : constant Identifier_Token := @@ -2157,46 +2734,66 @@ package body WisiToken_Grammar_Editing is if Tree.ID (List_Elements) = +IDENTIFIER_ID then RHS_Item_List_1.Append (Add_RHS_Element - (Tree, Add_RHS_Item (Tree, Tree.Copy_Subtree (List_Elements, Data_Access)), Label)); - - RHS_Item_List_2.Append (Add_RHS_Element (Tree, Add_RHS_Item (Tree, List_Elements))); + (Tree, + Add_RHS_Item (Tree, Tree.Copy_Subtree (List_Elements, Data_Access)), + Label, + Augmented => + (if Tree.Augmented (Element (Element_2)) = null + then null + else Copy_Augmented (Data, Tree.Augmented (Element (Element_2)))))); + + RHS_Item_List_2.Append + (Add_RHS_Element + (Tree, + Add_RHS_Item (Tree, List_Elements), + Label, + Augmented => + (if Tree.Augmented (Element (Element_2)) = null + then null + else Copy_Augmented (Data, Tree.Augmented (Element (Element_2)))))); end if; New_RHS_List.Append (Add_RHS - (Tree, RHS_Item_List_1.Root, + (Tree, + Attr_List => Invalid_Node_Access, + Item_List => RHS_Item_List_1.Root, Auto_Token_Labels => Get_RHS_Auto_Token_Labels (B), - Edited_Token_List => True, - Post_Parse_Action => Post_Parse_Action, - In_Parse_Action => In_Parse_Action)); + Post_Parse_Action => Tree.Copy_Subtree (Post_Parse_Action, Data_Access), + In_Parse_Action => Tree.Copy_Subtree (In_Parse_Action, Data_Access))); RHS_Item_List_2.Prepend - (Add_RHS_Element (Tree, Add_RHS_Item (Tree, Add_Identifier_Token (Tree, List_Name)), Label)); + (Add_RHS_Element + (Tree, + Add_RHS_Item (Tree, Add_Identifier_Token (Tree, List_Name)), + Label => Invalid_Identifier_Token, + Augmented => new WisiToken_Grammar_Runtime.Augmented'(Orig_Token_Index => 0, others => <>))); New_RHS_List.Append (Add_RHS (Tree, - RHS_Item_List_2.Root, + Attr_List => Invalid_Node_Access, + Item_List => RHS_Item_List_2.Root, Auto_Token_Labels => Get_RHS_Auto_Token_Labels (B), - Edited_Token_List => True, Post_Parse_Action => Tree.Copy_Subtree (Post_Parse_Action, Data_Access), In_Parse_Action => Tree.Copy_Subtree (In_Parse_Action, Data_Access))); Maybe_Optimized_List (New_RHS_List, List_Name, Separator_Token, Auto_Token_Labels => Get_RHS_Auto_Token_Labels (B), - Label => Label); + Label => Invalid_Identifier_Token); if Can_Be_Empty then Add_Compilation_Unit ("canonical list", Tree_Add_Nonterminal - (Child_1 => Add_Identifier_Token (Tree, List_Name), - Child_2 => Tree.Add_Terminal (+COLON_ID), - Child_3 => New_RHS_List.Root, - Child_4 => Tree.Add_Nonterm + (Identifier => Add_Identifier_Token (Tree, List_Name), + Attr_List => B_Attr_List, + Colon => Tree.Add_Terminal (+COLON_ID), + RHS_List => New_RHS_List.Root, + Semicolon => Tree.Add_Nonterm ((+semicolon_opt_ID, 0), - (1 => Tree.Add_Terminal (+SEMICOLON_ID)), + (1 => Tree.Add_Terminal (+SEMICOLON_ID)), Clear_Parents => False))); Tree.Replace_Child @@ -2208,7 +2805,7 @@ package body WisiToken_Grammar_Editing is (Tree, Add_Identifier_Token (Tree, List_Name)), Label), Old_Child => Element (Element_2), - Old_Child_New_Parent => Invalid_Node_Access); + Old_Child_New_Parent => Invalid_Node_Access); -- This goes on RHS_List, _not_ New_RHS_List. RHS_List.Append (Empty_RHS (Tree)); @@ -2216,7 +2813,7 @@ package body WisiToken_Grammar_Editing is else Tree.Replace_Child (Parent => List_Nonterm_Decl, - Child_Index => 3, + Child_Index => List_Nonterm_RHS_List_Index, Old_Child => RHS_List_Root, New_Child => New_RHS_List.Root, Old_Child_New_Parent => Invalid_Node_Access); @@ -2227,7 +2824,7 @@ package body WisiToken_Grammar_Editing is if Trace_Generate_EBNF > Extra then Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("Simple_Named Canonical_List edited nonterm:"); - Tree.Print_Tree (List_Nonterm_Decl); + Tree.Print_Tree (List_Nonterm_Decl, Augmented => True); end if; end Do_Simple_Named; @@ -2244,10 +2841,8 @@ package body WisiToken_Grammar_Editing is if Element_1 = Invalid_Node_Access then Has_Separator := False; else - if Tree.RHS_Index (B) in 4 .. 5 then - Has_Separator := False; - - elsif B_Alt_List_Item_List.Count in 1 .. 2 and then + if not B_Alt_List_List.Is_Invalid and then + B_Alt_List_Item_List.Count in 1 .. 2 and then Get_Item_Text (Data, Tree, Element_1) = Get_Item_Text (Data, Tree, Element (B_Alt_List_Item_List.Last)) then @@ -2276,7 +2871,7 @@ package body WisiToken_Grammar_Editing is return; end if; - if (RHS_List.Count = 1 and Tree.ID (RHS) = +rhs_ID and Tree.RHS_Index (RHS) = 1) and then + if (RHS_List.Count = 1 and Tree.ID (RHS) = +rhs_ID) and then ((RHS_Item_List_List.Count = 1 and (B_Alt_List_List.Is_Invalid or else B_Alt_List_Item_List.Count = 1)) or (RHS_Item_List_List.Count = 2 and Element_2 = RHS_Item_List_List.Last)) @@ -2284,7 +2879,9 @@ package body WisiToken_Grammar_Editing is Simple_Named := True; end if; - if Tree.RHS_Index (B) in 4 .. 5 and not Simple_Named then + if not (To_Token_Enum (Tree.ID (Tree.Child (B, 1))) in LEFT_BRACE_ID | LEFT_PAREN_ID) and + not Simple_Named + then -- Handled below return; end if; @@ -2322,23 +2919,14 @@ package body WisiToken_Grammar_Editing is end if; declare - pragma Assert - (Element_1 = Invalid_Node_Access or else Tree.ID - (case Tree.RHS_Index (Element_1) is - when 0 => Tree.Child (Tree.Child (Element_1, 1), 1), - when 1 => Tree.Child (Tree.Child (Element_1, 3), 1), - when others => raise SAL.Programmer_Error) - = +IDENTIFIER_ID); - -- So we can use it as a nonterm name. If the source text has a - -- terminal literal (see java_ebnf.wy arrayCreatorRest), it should - -- have been translated to a token name by now. - List_Nonterm_String : constant String := - (if Has_Separator + (if B_Alt_List_Item_List.Is_Invalid + then Get_Text (Data, Tree, Tree.Child (B, 1)) + elsif Has_Separator then Get_Item_Text (Data, Tree, Element_1) & "_" & Get_Item_Text (Data, Tree, Separator_Node) elsif Element_1 /= Invalid_Node_Access then Get_Item_Text (Data, Tree, Element_1) & "_" & - Get_Item_Text (Data, Tree, Element (B_Alt_List_Item_List.First)) + Get_Item_Text (Data, Tree, Element (B_Alt_List_Item_List.First)) else Get_Item_Text (Data, Tree, Element (B_Alt_List_Item_List.First)) & (if B_Alt_List_Item_List.Count = 1 then "" @@ -2351,7 +2939,9 @@ package body WisiToken_Grammar_Editing is Element => (if Element_1 /= Invalid_Node_Access then Tree.Find_Descendant (Element_1, +rhs_item_ID) - else B_Alt_List_Item_List.Root), + elsif not B_Alt_List_Item_List.Is_Invalid + then B_Alt_List_Item_List.Root + else Tree.Child (B, 1)), Separator => Separator_Node, Auto_Token_Labels => Get_RHS_Auto_Token_Labels (B)); @@ -2398,6 +2988,12 @@ package body WisiToken_Grammar_Editing is end Find_List_Nonterminal_2; begin + if RHS_0_Attr_List /= Invalid_Node_Access then + if Get_Associativity (Data, Tree, RHS_0_Attr_List) = WisiToken.Right then + raise SAL.Not_Implemented with "right assoc not implemented for rhs_multiple_item"; + end if; + end if; + -- Check if this is a recognized pattern Check_Canonical_List; if Done then @@ -2469,10 +3065,15 @@ package body WisiToken_Grammar_Editing is then New_Identifier (List_Nonterm_Name_String) else Next_Nonterm_Name ("list"))); - New_Nonterminal ("canonical list element", List_Element_Name, Tree.Child (B, 2)); + New_Nonterminal + (Label => "canonical list element", + New_Identifier => List_Element_Name, + Content => Tree.Child (B, 2)); + New_Nonterminal_List (List_Nonterm_Name, - To_Identifier_Token (List_Element_Name), + Attr_List => RHS_0_Attr_List, + List_Element => To_Identifier_Token (List_Element_Name), Separator => Invalid_Identifier_Token, Auto_Token_Labels => Get_RHS_Auto_Token_Labels (B)); end; @@ -2518,13 +3119,14 @@ package body WisiToken_Grammar_Editing is Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("Translate_RHS_Multiple_Item edited: " & Get_Text (Data, Tree, Item)); if Trace_Generate_EBNF > Extra then - Tree.Print_Tree (Item); + Tree.Print_Tree (Item, Augmented => True); end if; end; end if; end Translate_RHS_Multiple_Item; procedure Translate_RHS_Optional_Item (B : in Valid_Node_Access) + with Pre => Tree.ID (B) = +rhs_optional_item_ID is -- Source looks like: -- @@ -2587,7 +3189,7 @@ package body WisiToken_Grammar_Editing is else Create_List (Tree, Root => Container_List_Root, - List_ID => +rhs_alternative_list_ID, + List_ID => +rhs_alternative_list_1_ID, Element_ID => +rhs_item_list_ID, Separator_ID => +BAR_ID)); @@ -2608,9 +3210,10 @@ package body WisiToken_Grammar_Editing is ABC_A_Last : constant Cursor := ABC_Iter.Previous (ABC_B_Cur); ABC_C_First : constant Cursor := ABC_Iter.Next (ABC_B_Cur); + B_Alt_List : constant Valid_Node_Access := Tree.Child (B, 2); B_Alternative_List : constant Constant_List := Create_List - (Tree, Tree.Child (B, 2), +rhs_alternative_list_ID, +rhs_item_list_ID); - + (Tree, Tree.Child (B_Alt_List, Tree.Child_Count (B_Alt_List)), + +rhs_alternative_list_1_ID, +rhs_item_list_ID); begin -- An alternate design would be to splice together the existing A, -- B_i, C; but it's too hard to get all the parent updates right. @@ -2621,6 +3224,55 @@ package body WisiToken_Grammar_Editing is (Tree, Alt, +rhs_item_list_ID, +rhs_element_ID); New_ABC : List := Empty_List (ABC_List); + + function Is_Orig_EBNF_RHS return Boolean + is begin + -- Consider subprograms.wy iteration_scheme, which has a nested + -- rhs_optional_item. Translating the nested optional gives an + -- rhs_alternative_list with two elements, which are copied to two + -- RHSs when translating the outer optional item; the first has all + -- the tokens (and thus Orig_EBNF_RHS is True), the second is missing + -- some (and thus Orig_EBNF_RHS is False). + if Alt /= Element (First (B_Alternative_List)) then + return False; + end if; + + if Container_List.Element_ID = +rhs_ID then + -- If B originally contained literal alternatives (ie uses '|'), then + -- mapping the token indices to an action is not possible. But if B + -- contained nested optional items, leading to multiple alternatives + -- that are simple edits of the original, then mapping is possible. + -- That's too complex to check for here, and nested optional is + -- common in Ada, so we don't try to check; we assume testing will + -- identify cases where mapping doesn't work. See subprograms.wy + -- iteration_Scheme. + declare + RHS_Node : constant Valid_Node_Access := Element (Container_Cur); + begin + if Tree.Augmented (RHS_Node) = null then + -- This is an edited RHS with some optional left out. + return False; + else + return WisiToken_Grammar_Runtime.Augmented + (Tree.Augmented (RHS_Node).all).Orig_EBNF_RHS; + end if; + end; + else + -- B is nested in an alternatives list, so + -- mapping the token indices to an action is not possible. + declare + RHS : constant Valid_Node_Access := Element (Container_Cur); + begin + if Tree.ID (Tree.Child (RHS, Tree.Child_Count (RHS))) = +ACTION_ID then + WisiToken.Generate.Put_Error + (Tree.Error_Message + (RHS, "complex optional item with action; can't map token indices to action")); + end if; + end; + return False; + end if; + end Is_Orig_EBNF_RHS; + begin if Has_Element (ABC_A_Last) then Copy (Source_List => ABC_List, @@ -2640,6 +3292,7 @@ package body WisiToken_Grammar_Editing is (Container_List, New_ABC.Root, After => Element (Container_Cur), + Orig_EBNF_RHS => Is_Orig_EBNF_RHS, Auto_Token_Labels => Get_RHS_Auto_Token_Labels (B)); else Container_List.Insert (New_ABC.Root, After => Container_Cur); @@ -2676,7 +3329,7 @@ package body WisiToken_Grammar_Editing is end; when 3 => - -- | STRING_LITERAL_2 QUESTION + -- | STRING_LITERAL_SINGLE QUESTION declare Parent_Var : Node_Access := Tree.Parent (B); begin @@ -2692,7 +3345,7 @@ package body WisiToken_Grammar_Editing is if WisiToken.Trace_Generate_EBNF > Detail then Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("Translate_RHS_Optional_Item edited:"); - Tree.Print_Tree (Container_List_Root); + Tree.Print_Tree (Container_List_Root, Augmented => True); end if; end Translate_RHS_Optional_Item; @@ -2735,7 +3388,7 @@ package body WisiToken_Grammar_Editing is return False; elsif To_Token_Enum (Tree.ID (Value_Node)) in - IDENTIFIER_ID | REGEXP_ID | STRING_LITERAL_1_ID | STRING_LITERAL_2_ID and then + IDENTIFIER_ID | REGEXP_ID | STRING_LITERAL_DOUBLE_ID | STRING_LITERAL_SINGLE_ID and then Target = Get_Text (Data, Tree, Value_Node, Strip_Quotes => True) then case Tree.Label (Name_Node) is @@ -2807,7 +3460,7 @@ package body WisiToken_Grammar_Editing is declare Keyword : constant Valid_Node_Access := Tree.Add_Identifier (+KEYWORD_ID, Keyword_Ident); Value_Literal : constant Valid_Node_Access := Tree.Add_Identifier - (+STRING_LITERAL_1_ID, New_Identifier ('"' & Value & '"')); + (+STRING_LITERAL_DOUBLE_ID, New_Identifier ('"' & Value & '"')); Regexp_String : constant Valid_Node_Access := Tree.Add_Nonterm ((+regexp_string_ID, 1), (1 => Value_Literal), @@ -2846,18 +3499,6 @@ package body WisiToken_Grammar_Editing is -- All handled by New_Nonterminal* raise SAL.Programmer_Error; - when rhs_attribute_ID => - -- Just delete it - declare - use LR_Utils; - RHS_Item_List : List := Creators.Create_From_Element - (Tree, Tree.Parent (Node, 2), +rhs_item_list_ID, +rhs_element_ID, Invalid_Token_ID); - Element : Cursor := RHS_Item_List.To_Cursor (Tree.Parent (Node, 2)); - begin - RHS_Item_List.Delete (Element); - end; - Clear_EBNF_Node (Node); - when rhs_group_item_ID => Translate_RHS_Group_Item (Node); @@ -2867,7 +3508,7 @@ package body WisiToken_Grammar_Editing is when rhs_optional_item_ID => Translate_RHS_Optional_Item (Node); - when STRING_LITERAL_2_ID => + when STRING_LITERAL_SINGLE_ID => Translate_Token_Literal (Node); when others => @@ -2889,6 +3530,51 @@ package body WisiToken_Grammar_Editing is end if; end Process_Node; + procedure Set_EBNF_RHS_Index (Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access) + is + use LR_Utils; + + RHS_List : constant Constant_List := Creators.Create_List + (Tree, + Tree.Child (Nonterm, (if Tree.ID (Tree.Child (Nonterm, 3)) = +rhs_list_ID then 3 else 4)), + +rhs_list_ID, +rhs_ID); + + RHS_Index : Natural := 0; + EBNF_RHS_Index : Natural := 0; + begin + for RHS of RHS_List loop + if Tree.Augmented (RHS) = null then + -- This is an unedited RHS, with no EBNF or auto token labels. + declare + Aug : constant Augmented_Access := new WisiToken_Grammar_Runtime.Augmented' + (EBNF => False, + Auto_Token_Labels => False, + Orig_EBNF_RHS => True, + EBNF_RHS_Index => RHS_Index, + Orig_Token_Index => <>); + begin + Tree.Set_Augmented (RHS, WisiToken.Syntax_Trees.Augmented_Class_Access (Aug)); + EBNF_RHS_Index := RHS_Index; + end; + + else + -- Either the first RHS, or an edited RHS. + declare + Aug : WisiToken_Grammar_Runtime.Augmented renames WisiToken_Grammar_Runtime.Augmented + (Tree.Augmented (RHS).all); + begin + if Aug.Orig_EBNF_RHS then + EBNF_RHS_Index := RHS_Index; + end if; + + Aug.EBNF_RHS_Index := EBNF_RHS_Index; + end; + end if; + + RHS_Index := @ + 1; + end loop; + end Set_EBNF_RHS_Index; + procedure Check_Original_Copied_EBNF is use Ada.Text_IO; @@ -2912,7 +3598,7 @@ package body WisiToken_Grammar_Editing is Put_Line (Current_Error, Tree.Error_Message (N, Tree.Image (N, Node_Numbers => True))); Put_Line (Current_Error, - "... Copied_EBNF not in tree; in root" & Trimmed_Image (Get_Node_Index (Subtree_Root))); + "... Copied_EBNF not in tree; in root " & Trimmed_Image (Get_Node_Index (Subtree_Root))); WisiToken.Generate.Error := True; Error_Present := True; end if; @@ -2920,15 +3606,20 @@ package body WisiToken_Grammar_Editing is if Error_Present then Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("tree:"); - Tree.Print_Tree; + Tree.Print_Tree (Augmented => True); end if; end Check_Original_Copied_EBNF; begin EBNF_Allowed := True; + if Trace_Generate_EBNF > Detail then + Ada.Text_IO.Put_Line ("EBNF tree:"); + Tree.Print_Tree (Augmented => True); + end if; + if Debug_Mode then Tree.Validate_Tree - (Data, Data.Error_Reported, + (Data'Unchecked_Access, Data.Error_Reported, Root => Tree.Root, Validate_Node => Validate_Node'Access, Node_Index_Order => True, @@ -2937,7 +3628,7 @@ package body WisiToken_Grammar_Editing is if Data.Error_Reported.Count > 0 then Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("initial invalid tree:"); - Tree.Print_Tree (Line_Numbers => True, Non_Grammar => True); + Tree.Print_Tree (Line_Numbers => True, Non_Grammar => True, Augmented => True, Safe_Only => True); end if; end if; @@ -2955,6 +3646,10 @@ package body WisiToken_Grammar_Editing is Tree.Process_Tree (Process_Node'Access); end; + if Trace_Generate_EBNF > Outline then + Ada.Text_IO.Put_Line ("EBNF node count:" & EBNF_Nodes.Count'Image); + end if; + -- Apply labels if needed, so they are consistent in copied RHS declare use LR_Utils; @@ -2971,7 +3666,9 @@ package body WisiToken_Grammar_Editing is if Tree.ID (Nonterm) = +nonterminal_ID then declare RHS_List : constant Constant_List := Creators.Create_List - (Tree, Tree.Child (Nonterm, 3), +rhs_list_ID, +rhs_ID); + (Tree, + Tree.Child (Nonterm, (if Tree.ID (Tree.Child (Nonterm, 3)) = +rhs_list_ID then 3 else 4)), + +rhs_list_ID, +rhs_ID); begin for RHS of RHS_List loop Last_Token_Index := 0; @@ -2991,7 +3688,7 @@ package body WisiToken_Grammar_Editing is -- no longer valid. We've reused name tokens, so byte_region_order is -- not valid. Tree.Validate_Tree - (Data, Data.Error_Reported, + (Data'Unchecked_Access, Data.Error_Reported, Root => Tree.Root, Validate_Node => Validate_Node'Access, Node_Index_Order => False, @@ -2999,7 +3696,7 @@ package body WisiToken_Grammar_Editing is if Data.Error_Reported.Count /= 0 then Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("invalid tree after Add_Token_Labels:"); - Tree.Print_Tree; + Tree.Print_Tree (Augmented => True, Safe_Only => True); end if; end if; @@ -3037,15 +3734,15 @@ package body WisiToken_Grammar_Editing is if Debug_Mode then Tree.Validate_Tree - (Data, Data.Error_Reported, + (Data'Unchecked_Access, Data.Error_Reported, Root => Tree.Root, Validate_Node => Validate_Node'Access, Node_Index_Order => False, Byte_Region_Order => False); if Data.Error_Reported.Count /= 0 then Ada.Text_IO.New_Line; - Ada.Text_IO.Put_Line ("invalid tree after translate one node:"); - Tree.Print_Tree; + Ada.Text_IO.Put_Line ("invalid tree:"); + Tree.Print_Tree (Augmented => True, Safe_Only => True); end if; Check_Original_Copied_EBNF; end if; @@ -3099,7 +3796,7 @@ package body WisiToken_Grammar_Editing is if Debug_Mode then Tree.Validate_Tree - (Data, Data.Error_Reported, + (Data'Unchecked_Access, Data.Error_Reported, Root => Tree.Root, Validate_Node => Validate_Node'Access, Node_Index_Order => False, @@ -3107,7 +3804,7 @@ package body WisiToken_Grammar_Editing is if Data.Error_Reported.Count /= 0 then Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("invalid tree after translate copied node:"); - Tree.Print_Tree; + Tree.Print_Tree (Augmented => True, Safe_Only => True); end if; Check_Original_Copied_EBNF; end if; @@ -3117,6 +3814,19 @@ package body WisiToken_Grammar_Editing is end loop; declare + use LR_Utils; + use LR_Utils.Creators; + List : constant Constant_List := Create_List + (Tree, Tree.Child (Tree.Root, 2), +compilation_unit_list_ID, +compilation_unit_ID); + begin + for Unit of List loop + if Tree.ID (Tree.Child (Unit, 1)) = +nonterminal_ID then + Set_EBNF_RHS_Index (Tree.Child (Unit, 1)); + end if; + end loop; + end; + + declare use Ada.Text_IO; begin for Node of Copied_EBNF_Nodes loop @@ -3136,7 +3846,7 @@ package body WisiToken_Grammar_Editing is EBNF_Allowed := False; if Debug_Mode then Tree.Validate_Tree - (Data, Data.Error_Reported, + (Data'Unchecked_Access, Data.Error_Reported, Root => Tree.Root, Validate_Node => Validate_Node'Access, Node_Index_Order => False, @@ -3144,7 +3854,7 @@ package body WisiToken_Grammar_Editing is if Data.Error_Reported.Count /= 0 then Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("invalid tree after Data.EBNF_Allowed False:"); - Tree.Print_Tree; + Tree.Print_Tree (Augmented => True, Safe_Only => True); end if; end if; Data.Meta_Syntax := BNF_Syntax; @@ -3159,9 +3869,9 @@ package body WisiToken_Grammar_Editing is end Translate_EBNF_To_BNF; procedure Print_Source - (File_Name : in String; - Tree : in Syntax_Trees.Tree; - Data : in WisiToken_Grammar_Runtime.User_Data_Type) + (File_Name : in String; + Tree : in out Syntax_Trees.Tree; + Data : in WisiToken_Grammar_Runtime.User_Data_Type) is use Ada.Text_IO; @@ -3217,7 +3927,7 @@ package body WisiToken_Grammar_Editing is begin pragma Assert (Children'Length = 1); case To_Token_Enum (Tree.ID (Children (1))) is - when STRING_LITERAL_1_ID | STRING_LITERAL_2_ID => + when STRING_LITERAL_DOUBLE_ID | STRING_LITERAL_SINGLE_ID => Put (File, ' ' & Get_Text (Data, Tree, Children (1))); when REGEXP_ID => Put (File, " %[" & Get_Text (Data, Tree, Children (1)) & "]%"); @@ -3266,23 +3976,42 @@ package body WisiToken_Grammar_Editing is end if; end Put_Identifier_List; + procedure Put_Attr_List (Attr_List : in Valid_Node_Access) + is + Prec : constant WisiToken.Base_Precedence_ID := WisiToken_Grammar_Runtime.Get_Precedence + (Data, Tree, Attr_List); + Assoc : constant WisiToken.Associativity := WisiToken_Grammar_Runtime.Get_Associativity + (Data, Tree, Attr_List); + begin + case Assoc is + when Left => + Put (File, "<assoc=left>"); + + when Right => + Put (File, "<assoc=right>"); + + when None => + pragma Assert (Prec /= No_Precedence); + null; + end case; + if Prec /= No_Precedence then + Put (File, "<prec=" & (-Data.Precedence_Inverse_Map (Prec)) & ">"); + end if; + end Put_Attr_List; + procedure Put_RHS_Element (Node : in Valid_Node_Access) with Pre => Tree.ID (Node) = +rhs_element_ID is begin - -- We don't raise an exception for errors here; it's easier to debug from the - -- mangled source listing. - case Tree.RHS_Index (Node) is when 0 => Put (File, Get_Text (Data, Tree, Node)); when 1 => - -- Output no spaces around "=" declare Children : constant Node_Access_Array := Tree.Children (Node); begin - Put - (File, Get_Text (Data, Tree, Children (1)) & "=" & Get_Text (Data, Tree, Children (3))); + -- Output no spaces around "=" + Put (File, Get_Text (Data, Tree, Children (1)) & "=" & Get_Text (Data, Tree, Children (3))); end; when others => @@ -3337,30 +4066,33 @@ package body WisiToken_Grammar_Editing is First : in Boolean) with Pre => Tree.ID (Node) = +rhs_ID is + use all type SAL.Base_Peek_Type; Children : constant Node_Access_Array := Tree.Children (Node); + Last : SAL.Base_Peek_Type := Children'First - 1; begin Put (File, (if First then " : " else " | ")); - case Tree.RHS_Index (Node) is - when 0 => + if Tree.Child_Count (Node) = 0 then Put_Comments (Tree.Parent (Node), Force_Comment => ";; empty"); - when 1 .. 3 => - Put_RHS_Item_List (Children (1)); - Put_Comments (Children (1), Force_New_Line => True); + else + if Tree.ID (Tree.Child (Node, 1)) = +attribute_list_ID then + Put_Attr_List (Tree.Child (Node, 1)); + Put (File, " "); + Last := 1; + end if; - if Tree.RHS_Index (Node) > 1 then - Put (File, " %(" & Get_Text (Data, Tree, Children (2)) & ")%"); -- action - Put_Comments (Children (2), Force_New_Line => True); + Last := @ + 1; + Put_RHS_Item_List (Children (Last)); + Put_Comments (Children (Last), Force_New_Line => True); - if Tree.RHS_Index (Node) > 2 then - Put (File, " %(" & Get_Text (Data, Tree, Children (3)) & ")%"); -- check - Put_Comments (Children (3), Force_New_Line => True); + for I in 1 .. 2 loop + Last := @ + 1; + if Last <= Tree.Child_Count (Node) then + Put (File, " %(" & Get_Text (Data, Tree, Children (Last)) & ")%"); + Put_Comments (Children (Last), Force_New_Line => True); end if; - end if; - - when others => - WisiToken.Syntax_Trees.LR_Utils.Raise_Programmer_Error ("Put_RHS", Tree, Node); - end case; + end loop; + end if; exception when SAL.Programmer_Error => raise; @@ -3382,37 +4114,52 @@ package body WisiToken_Grammar_Editing is is Children : constant Node_Access_Array := Tree.Children (Node); begin - case Tree.RHS_Index (Node) is - when 0 => + case To_Token_Enum (Tree.ID (Children (1))) is + when rhs_ID => Put_RHS (Children (1), First); First := False; - when 1 => + + when rhs_list_ID => Put_RHS_List (Children (1), First, Virtual); - Put_RHS (Children (3), First => False); - when 2 => - Put - (File, "%if " & Get_Text (Data, Tree, Children (3)) & " = " & Get_Text - (Data, Tree, Children (4))); - Put_Comments (Node); - when 3 => - Put (File, "%end if"); - Put_Comments (Node); + case To_Token_Enum (Tree.ID (Children (2))) is + when BAR_ID => + Put_RHS (Children (3), First => False); + + when PERCENT_ID => + case To_Token_Enum (Tree.ID (Children (3))) is + when IF_ID | ELSIF_ID => + Put + (File, + (case To_Token_Enum (Tree.ID (Children (3))) is + when IF_ID => "%if", + when ELSIF_ID => "$elsif", + when others => raise SAL.Programmer_Error) & + Get_Text (Data, Tree, Children (4)) & + (case To_Token_Enum (Tree.ID (Children (5))) is + when EQUAL_ID => " = ", + when IN_ID => "in", + when others => raise SAL.Programmer_Error) & + Get_Text (Data, Tree, Children (6))); + Put_Comments (Node); + when END_ID => + Put (File, "%end if"); + Put_Comments (Node); + + when others => + raise SAL.Programmer_Error; + end case; + when others => + raise SAL.Programmer_Error; + end case; when others => - WisiToken.Syntax_Trees.LR_Utils.Raise_Programmer_Error ("Put_RHS_List", Tree, Node); + raise SAL.Programmer_Error; end case; + exception when SAL.Programmer_Error => - raise; - - when E : others => - declare - use Ada.Exceptions; - begin - WisiToken.Syntax_Trees.LR_Utils.Raise_Programmer_Error - ("Put_RHS_List: " & Exception_Name (E) & ": " & Exception_Message (E), Tree, Node); - end; + Syntax_Trees.LR_Utils.Raise_Programmer_Error ("put_rhs_list", Tree, Node); end Put_RHS_List; procedure Process_Node (Node : in Valid_Node_Access) @@ -3478,12 +4225,16 @@ package body WisiToken_Grammar_Editing is then "%conflict " else "%conflict_resolution ")); Put (File, Get_Text (Data, Tree, Children (3))); -- conflict_item_list - Put (File, " on token " & Get_Text (Data, Tree, Children (6))); - if Children'Last = 8 then - Put (File, " : " & Get_Text (Data, Tree, Children (8))); - Put_Comments (Children (8), Force_New_Line => True); - else - Put_Comments (Children (6), Force_New_Line => True); + if Children'Last >= 6 then + -- wisi format + Put (File, " on token " & Get_Text (Data, Tree, Children (6))); + if Children'Last = 8 then + Put (File, " : " & Get_Text (Data, Tree, Children (8))); + Put_Comments (Children (8), Force_New_Line => True); + else + Put_Comments (Children (6), Force_New_Line => True); + end if; + -- else tree_sitter format end if; when IDENTIFIER_ID => @@ -3514,6 +4265,7 @@ package body WisiToken_Grammar_Editing is Put_Comments (Node); when END_ID => + New_Line (File); Put (File, "%end if"); Put_Comments (Node); @@ -3531,16 +4283,26 @@ package body WisiToken_Grammar_Editing is Put (File, Get_Text (Data, Tree, Children (1))); Put_Comments (Children (1), Force_New_Line => True); - Put_RHS_List (Children (3), First, Virtual); + if Tree.ID (Children (2)) = +attribute_list_ID then + Put_Attr_List (Children (2)); + New_Line (File); + Put_RHS_List (Children (4), First, Virtual); + else + Put_RHS_List (Children (3), First, Virtual); + end if; -- We force a terminating ";" here, to speed parsing in _bnf.wy files. - if Tree.RHS_Index (Children (4)) = 1 then + if Tree.RHS_Index (Children (Children'Last)) = 1 then -- Empty Put_Line (File, " ;"); else -- ";" present, including trailing newline, unless virtual. + + -- FIXME: for some reason, this 'put' gets lost if there is a + -- comment. sigh. Changing to 'put_line' keeps the semicolon, but is + -- annoying. Put (File, " ;"); - Put_Comments (Children (4), Force_New_Line => True); + Put_Comments (Children (Children'Last), Force_New_Line => True); end if; end; @@ -3585,10 +4347,9 @@ package body WisiToken_Grammar_Editing is Close (File); exception - when E : SAL.Not_Implemented => + when others => Close (File); - Ada.Text_IO.Put_Line - (Ada.Text_IO.Standard_Error, "Print_Source not implemented: " & Ada.Exceptions.Exception_Message (E)); + raise; end Print_Source; end WisiToken_Grammar_Editing; diff --git a/wisitoken_grammar_editing.ads b/wisitoken_grammar_editing.ads index 7dea2a8..1328e30 100644 --- a/wisitoken_grammar_editing.ads +++ b/wisitoken_grammar_editing.ads @@ -2,7 +2,7 @@ -- -- Utilities for editing wisitoken grammars. -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -85,7 +85,8 @@ package WisiToken_Grammar_Editing is RHS_Index : in Natural; Content : in WisiToken.Syntax_Trees.Valid_Node_Access) return WisiToken.Syntax_Trees.Valid_Node_Access - with Pre => To_Token_Enum (Tree.ID (Content)) in rhs_alternative_list_ID | IDENTIFIER_ID | STRING_LITERAL_2_ID and + with Pre => To_Token_Enum (Tree.ID (Content)) in + rhs_alternative_list_ID | IDENTIFIER_ID | STRING_LITERAL_SINGLE_ID and RHS_Index <= 3, Post => Tree.ID (Add_RHS_Optional_Item'Result) = +rhs_optional_item_ID; @@ -98,13 +99,14 @@ package WisiToken_Grammar_Editing is (Tree : in out WisiToken.Syntax_Trees.Tree; Item : in WisiToken.Syntax_Trees.Valid_Node_Access) return WisiToken.Syntax_Trees.Valid_Node_Access - with Pre => To_Token_Enum (Tree.ID (Item)) in IDENTIFIER_ID | STRING_LITERAL_2_ID, + with Pre => To_Token_Enum (Tree.ID (Item)) in IDENTIFIER_ID | STRING_LITERAL_SINGLE_ID, Post => Tree.ID (Add_RHS_Item'Result) = +rhs_item_ID; function Add_RHS_Element - (Tree : in out WisiToken.Syntax_Trees.Tree; - Item : in WisiToken.Syntax_Trees.Valid_Node_Access; - Label : in Identifier_Token := Invalid_Identifier_Token) + (Tree : in out WisiToken.Syntax_Trees.Tree; + Item : in WisiToken.Syntax_Trees.Valid_Node_Access; + Label : in Identifier_Token := Invalid_Identifier_Token; + Augmented : in WisiToken.Syntax_Trees.Augmented_Class_Access := null) return WisiToken.Syntax_Trees.Valid_Node_Access with Pre => Tree.ID (Item) = +rhs_item_ID, Post => Tree.Production_ID (Add_RHS_Element'Result) = @@ -120,18 +122,22 @@ package WisiToken_Grammar_Editing is function Add_RHS (Tree : in out WisiToken.Syntax_Trees.Tree; - Item : in WisiToken.Syntax_Trees.Valid_Node_Access; + Attr_List : in WisiToken.Syntax_Trees.Node_Access; + Item_List : in WisiToken.Syntax_Trees.Valid_Node_Access; Auto_Token_Labels : in Boolean; - Edited_Token_List : in Boolean; Post_Parse_Action : in WisiToken.Syntax_Trees.Node_Access := WisiToken.Syntax_Trees.Invalid_Node_Access; In_Parse_Action : in WisiToken.Syntax_Trees.Node_Access := WisiToken.Syntax_Trees.Invalid_Node_Access) return WisiToken.Syntax_Trees.Valid_Node_Access - with Pre => Tree.ID (Item) = +rhs_item_list_ID and + with Pre => (Attr_List = WisiToken.Syntax_Trees.Invalid_Node_Access or else + Tree.ID (Attr_List) = +attribute_list_ID) and + Tree.ID (Item_List) = +rhs_item_list_ID and (Post_Parse_Action = WisiToken.Syntax_Trees.Invalid_Node_Access or else - Tree.ID (Post_Parse_Action) = +ACTION_ID) and + Tree.ID (Post_Parse_Action) = +ACTION_ID) and (In_Parse_Action = WisiToken.Syntax_Trees.Invalid_Node_Access or else - Tree.ID (In_Parse_Action) = +ACTION_ID), + Tree.ID (In_Parse_Action) = +ACTION_ID), Post => Tree.ID (Add_RHS'Result) = +rhs_ID; + -- If Post_, In_Parse_Action are non-null, they are moved to the new + -- RHS, not copied. function Find_Declaration (Data : in WisiToken_Grammar_Runtime.User_Data_Type; @@ -142,14 +148,27 @@ package WisiToken_Grammar_Editing is To_Token_Enum (Tree.ID (Find_Declaration'Result)) in declaration_ID | nonterminal_ID; -- Return the node that declares Name, Invalid_Node_Access if none. + function Find_Declaration_By_Value + (Data : in WisiToken_Grammar_Runtime.User_Data_Type; + Tree : in out WisiToken.Syntax_Trees.Tree; + Value : in String; + Strip_Quotes : in Boolean) + return WisiToken.Syntax_Trees.Node_Access + with Post => Find_Declaration_By_Value'Result = WisiToken.Syntax_Trees.Invalid_Node_Access or else + To_Token_Enum (Tree.ID (Find_Declaration_By_Value'Result)) in declaration_ID; + -- Return the node that declares a token with value Value, + -- Invalid_Node_Access if none. + + EBNF_Allowed : Boolean := True; + procedure Validate_Node (Tree : in WisiToken.Syntax_Trees.Tree; Node : in WisiToken.Syntax_Trees.Valid_Node_Access; - User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; + User_Data : in WisiToken.Syntax_Trees.User_Data_Access; Node_Error_Reported : in out Boolean); -- Verify that all nodes match wisitoken_grammar.wy. Data must be of -- type WisiToken_Grammar_Runtime.User_Data_Type. Uses - -- Data.EBNF_Allowed. + -- EBNF_Allowed. -- -- For use with Syntax_Trees.Validate_Tree. @@ -166,9 +185,9 @@ package WisiToken_Grammar_Editing is -- Generator.LR.*_Generate requires a BNF grammar. procedure Print_Source - (File_Name : in String; - Tree : in WisiToken.Syntax_Trees.Tree; - Data : in WisiToken_Grammar_Runtime.User_Data_Type); + (File_Name : in String; + Tree : in out WisiToken.Syntax_Trees.Tree; + Data : in WisiToken_Grammar_Runtime.User_Data_Type); -- Print the wisitoken grammar source represented by Tree, Terminals -- to a new file File_Name. diff --git a/wisitoken_grammar_main.adb b/wisitoken_grammar_main.adb index 4816a20..04ca2f3 100644 --- a/wisitoken_grammar_main.adb +++ b/wisitoken_grammar_main.adb @@ -2,7 +2,7 @@ -- command line: wisitoken-bnf-generate.exe --generate LALR Ada re2c wisitoken_grammar.wy -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- Author: Stephen Leake <stephe-leake@stephe-leake.org> -- @@ -19,7 +19,7 @@ -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License --- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +-- along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. with SAL; with WisiToken.Lexer.re2c; @@ -36,8 +36,8 @@ package body Wisitoken_Grammar_Main is RAW_CODE_ID | REGEXP_ID | ACTION_ID | - STRING_LITERAL_1_ID | - STRING_LITERAL_2_ID => return True; + STRING_LITERAL_DOUBLE_ID | + STRING_LITERAL_SINGLE_ID => return True; when others => return False; end case; end Is_Block_Delimited; @@ -49,8 +49,8 @@ package body Wisitoken_Grammar_Main is when RAW_CODE_ID => return False; when REGEXP_ID => return False; when ACTION_ID => return False; - when STRING_LITERAL_1_ID => return True; - when STRING_LITERAL_2_ID => return True; + when STRING_LITERAL_DOUBLE_ID => return True; + when STRING_LITERAL_SINGLE_ID => return True; when others => return False; end case; end Same_Block_Delimiters; @@ -69,8 +69,8 @@ package body Wisitoken_Grammar_Main is when RAW_CODE_ID => return 2; when REGEXP_ID => return 2; when ACTION_ID => return 2; - when STRING_LITERAL_1_ID => return 1; - when STRING_LITERAL_2_ID => return 1; + when STRING_LITERAL_DOUBLE_ID => return 1; + when STRING_LITERAL_SINGLE_ID => return 1; when others => raise SAL.Programmer_Error; return 0; end case; end Start_Delimiter_Length; @@ -80,8 +80,8 @@ package body Wisitoken_Grammar_Main is case To_Token_Enum (ID) is when COMMENT_ID | - STRING_LITERAL_1_ID | - STRING_LITERAL_2_ID => return 1; + STRING_LITERAL_DOUBLE_ID | + STRING_LITERAL_SINGLE_ID => return 1; when RAW_CODE_ID => return 2; when REGEXP_ID => return 2; when ACTION_ID => return 2; @@ -97,8 +97,8 @@ package body Wisitoken_Grammar_Main is when RAW_CODE_ID => False, when REGEXP_ID => False, when ACTION_ID => False, - when STRING_LITERAL_1_ID => True, - when STRING_LITERAL_2_ID => True, + when STRING_LITERAL_DOUBLE_ID => True, + when STRING_LITERAL_SINGLE_ID => True, when others => raise SAL.Programmer_Error); end New_Line_Is_End_Delimiter; @@ -114,8 +114,8 @@ package body Wisitoken_Grammar_Main is when RAW_CODE_ID => WisiToken.Lexer.Find_String (Source, Token_Start, "}%"), when REGEXP_ID => WisiToken.Lexer.Find_String (Source, Token_Start, "]%"), when ACTION_ID => WisiToken.Lexer.Find_String (Source, Token_Start, ")%"), - when STRING_LITERAL_1_ID => WisiToken.Lexer.Find_String_Or_New_Line (Source, Token_Start, """"), - when STRING_LITERAL_2_ID => WisiToken.Lexer.Find_String_Or_New_Line (Source, Token_Start, """"), + when STRING_LITERAL_DOUBLE_ID => WisiToken.Lexer.Find_String_Or_New_Line (Source, Token_Start, """"), + when STRING_LITERAL_SINGLE_ID => WisiToken.Lexer.Find_String_Or_New_Line (Source, Token_Start, """"), when others => raise SAL.Programmer_Error); end Find_End_Delimiter; @@ -147,8 +147,8 @@ package body Wisitoken_Grammar_Main is (if Inserted then Region.Last elsif Start then Region.Last else Lexer.Find_String (Source, Region.First, ")%")), - when STRING_LITERAL_1_ID => Lexer.Find_New_Line (Source, Region.Last), - when STRING_LITERAL_2_ID => Lexer.Find_New_Line (Source, Region.Last), + when STRING_LITERAL_DOUBLE_ID => Lexer.Find_New_Line (Source, Region.Last), + when STRING_LITERAL_SINGLE_ID => Lexer.Find_New_Line (Source, Region.Last), when others => raise SAL.Programmer_Error); end Find_Scan_End; @@ -166,8 +166,8 @@ package body Wisitoken_Grammar_Main is when RAW_CODE_ID => Lexer.Find_String_Or_New_Line (Source, Region, "}%"), when REGEXP_ID => Lexer.Find_String_Or_New_Line (Source, Region, "]%"), when ACTION_ID => Lexer.Find_String_Or_New_Line (Source, Region, ")%"), - when STRING_LITERAL_1_ID => Lexer.Find_String_Or_New_Line (Source, Region, """"), - when STRING_LITERAL_2_ID => Lexer.Find_String_Or_New_Line (Source, Region, "'"), + when STRING_LITERAL_DOUBLE_ID => Lexer.Find_String_Or_New_Line (Source, Region, """"), + when STRING_LITERAL_SINGLE_ID => Lexer.Find_String_Or_New_Line (Source, Region, "'"), when others => raise SAL.Programmer_Error); end Contains_End_Delimiter; @@ -206,8 +206,8 @@ package body Wisitoken_Grammar_Main is case To_Token_Enum (ID) is when NEW_LINE_ID => return True; when COMMENT_ID => return True; - when STRING_LITERAL_1_ID => return True; - when STRING_LITERAL_2_ID => return True; + when STRING_LITERAL_DOUBLE_ID => return True; + when STRING_LITERAL_SINGLE_ID => return True; when others => return False; end case; end Terminated_By_New_Line; @@ -238,11 +238,11 @@ package body Wisitoken_Grammar_Main is use WisiToken.Parse.LR; Table : constant Parse_Table_Ptr := new Parse_Table (State_First => 0, - State_Last => 145, + State_Last => 162, First_Terminal => 3, Last_Terminal => 42, First_Nonterminal => 43, - Last_Nonterminal => 66); + Last_Nonterminal => 68); begin declare procedure Subr_1 @@ -253,28 +253,32 @@ package body Wisitoken_Grammar_Main is Table.States (0).Goto_List.Set_Capacity (4); Add_Goto (Table.States (0), 48, 3); Add_Goto (Table.States (0), 53, 4); - Add_Goto (Table.States (0), 65, 5); - Add_Goto (Table.States (0), 66, 6); + Add_Goto (Table.States (0), 67, 5); + Add_Goto (Table.States (0), 68, 6); Table.States (1).Action_List.Set_Capacity (10); Add_Action (Table.States (1), 4, (48, 6), 7); Add_Action (Table.States (1), 5, (48, 7), 8); - Add_Action (Table.States (1), 6, (48, 8), 9); - Add_Action (Table.States (1), 7, (48, 15), 10); - Add_Action (Table.States (1), 8, (48, 13), 11); - Add_Action (Table.States (1), 9, (48, 11), 12); + Add_Action (Table.States (1), 6, (48, 9), 9); + Add_Action (Table.States (1), 7, (48, 16), 10); + Add_Action (Table.States (1), 8, (48, 14), 11); + Add_Action (Table.States (1), 9, (48, 12), 12); Add_Action (Table.States (1), 11, (48, 5), 13); Add_Action (Table.States (1), 12, (48, 2), 14); Add_Action (Table.States (1), 16, (48, 0), 15); - Add_Action (Table.States (1), 39, (48, 9), 16); - Table.States (2).Action_List.Set_Capacity (2); + Add_Action (Table.States (1), 39, (48, 10), 16); + Table.States (2).Action_List.Set_Capacity (3); Add_Action (Table.States (2), 21, (53, 0), 17); - Add_Action (Table.States (2), 22, (53, 1), 18); + Add_Action (Table.States (2), 22, (53, 3), 18); + Add_Action (Table.States (2), 28, (57, 0), 19); + Table.States (2).Goto_List.Set_Capacity (2); + Add_Goto (Table.States (2), 57, 20); + Add_Goto (Table.States (2), 58, 21); Table.States (3).Action_List.Set_Capacity (3); - Add_Action (Table.States (3), (30, 39, 42), (65, 0), 1); + Add_Action (Table.States (3), (30, 39, 42), (67, 0), 1); Table.States (4).Action_List.Set_Capacity (3); - Add_Action (Table.States (4), (30, 39, 42), (65, 1), 1); + Add_Action (Table.States (4), (30, 39, 42), (67, 1), 1); Table.States (5).Action_List.Set_Capacity (3); - Add_Action (Table.States (5), (30, 39, 42), (66, 0), 1); + Add_Action (Table.States (5), (30, 39, 42), (68, 1), 1); Table.States (6).Action_List.Set_Capacity (3); Add_Action (Table.States (6), 30, (48, 0), 1); Add_Action (Table.States (6), 39, (53, 0), 2); @@ -282,673 +286,820 @@ package body Wisitoken_Grammar_Main is Table.States (6).Goto_List.Set_Capacity (3); Add_Goto (Table.States (6), 48, 3); Add_Goto (Table.States (6), 53, 4); - Add_Goto (Table.States (6), 65, 19); + Add_Goto (Table.States (6), 67, 22); Table.States (7).Action_List.Set_Capacity (1); - Add_Action (Table.States (7), 39, (49, 0), 20); + Add_Action (Table.States (7), 39, (49, 0), 23); Table.States (7).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (7), 49, 21); + Add_Goto (Table.States (7), 49, 24); Table.States (8).Action_List.Set_Capacity (4); - Add_Action (Table.States (8), 3, (45, 2), 22); - Add_Action (Table.States (8), 14, (45, 1), 23); - Add_Action (Table.States (8), 15, (45, 0), 24); - Add_Action (Table.States (8), 39, (45, 3), 25); - Table.States (8).Goto_List.Set_Capacity (2); - Add_Goto (Table.States (8), 45, 26); - Add_Goto (Table.States (8), 46, 27); + Add_Action (Table.States (8), 3, (45, 2), 25); + Add_Action (Table.States (8), 14, (45, 1), 26); + Add_Action (Table.States (8), 15, (45, 0), 27); + Add_Action (Table.States (8), 39, (45, 3), 28); + Table.States (8).Goto_List.Set_Capacity (3); + Add_Goto (Table.States (8), 45, 29); + Add_Goto (Table.States (8), 46, 30); + Add_Goto (Table.States (8), 49, 31); Table.States (9).Action_List.Set_Capacity (4); - Add_Action (Table.States (9), 3, (45, 2), 22); - Add_Action (Table.States (9), 14, (45, 1), 23); - Add_Action (Table.States (9), 15, (45, 0), 24); - Add_Action (Table.States (9), 39, (45, 3), 25); + Add_Action (Table.States (9), 3, (45, 2), 25); + Add_Action (Table.States (9), 14, (45, 1), 26); + Add_Action (Table.States (9), 15, (45, 0), 27); + Add_Action (Table.States (9), 39, (45, 3), 32); Table.States (9).Goto_List.Set_Capacity (2); - Add_Goto (Table.States (9), 45, 26); - Add_Goto (Table.States (9), 46, 28); + Add_Goto (Table.States (9), 45, 29); + Add_Goto (Table.States (9), 46, 33); Table.States (10).Action_List.Set_Capacity (1); - Add_Action (Table.States (10), 9, (48, 15), 29); + Add_Action (Table.States (10), 9, (48, 16), 34); Table.States (11).Action_List.Set_Capacity (1); - Add_Action (Table.States (11), 39, (48, 13), 30); + Add_Action (Table.States (11), 39, (48, 14), 35); Table.States (12).Action_List.Set_Capacity (1); - Add_Action (Table.States (12), 39, (48, 11), 31); + Add_Action (Table.States (12), 39, (48, 12), 36); Table.States (13).Action_List.Set_Capacity (1); - Add_Action (Table.States (13), 39, (48, 5), 32); + Add_Action (Table.States (13), 39, (48, 5), 37); Table.States (14).Action_List.Set_Capacity (1); - Add_Action (Table.States (14), 28, (48, 2), 33); + Add_Action (Table.States (14), 28, (48, 2), 38); Table.States (15).Action_List.Set_Capacity (1); - Add_Action (Table.States (15), 28, (48, 0), 34); + Add_Action (Table.States (15), 28, (48, 0), 39); Table.States (16).Action_List.Set_Capacity (7); - Add_Action (Table.States (16), 18, (44, 0), 35); - Add_Action (Table.States (16), 30, Reduce, (48, 10), 2); - Add_Action (Table.States (16), 38, (51, 1), 36); - Add_Action (Table.States (16), 39, (51, 0), 37); - Add_Conflict (Table.States (16), 39, (48, 10), 2); - Add_Action (Table.States (16), 40, (44, 1), 38); - Add_Action (Table.States (16), 41, (44, 2), 39); - Add_Action (Table.States (16), 42, Reduce, (48, 10), 2); + Add_Action (Table.States (16), 18, (44, 0), 40); + Add_Action (Table.States (16), 30, Reduce, (48, 11), 2); + Add_Action (Table.States (16), 38, (51, 1), 41); + Add_Action (Table.States (16), 39, (51, 0), 42); + Add_Conflict (Table.States (16), 39, (48, 11), 2); + Add_Action (Table.States (16), 40, (44, 1), 43); + Add_Action (Table.States (16), 41, (44, 2), 44); + Add_Action (Table.States (16), 42, Reduce, (48, 11), 2); Table.States (16).Goto_List.Set_Capacity (3); - Add_Goto (Table.States (16), 44, 40); - Add_Goto (Table.States (16), 51, 41); - Add_Goto (Table.States (16), 52, 42); + Add_Goto (Table.States (16), 44, 45); + Add_Goto (Table.States (16), 51, 46); + Add_Goto (Table.States (16), 52, 47); Table.States (17).Action_List.Set_Capacity (10); Add_Action (Table.States (17), 20, Reduce, (56, 0), 0); - Add_Action (Table.States (17), 25, (63, 0), 43); - Add_Action (Table.States (17), 26, (62, 0), 44); - Add_Action (Table.States (17), 27, (61, 0), 45); - Add_Action (Table.States (17), 28, (57, 0), 46); + Add_Action (Table.States (17), 25, (64, 0), 48); + Add_Action (Table.States (17), 26, (63, 0), 49); + Add_Action (Table.States (17), 27, (62, 0), 50); + Add_Action (Table.States (17), 28, (57, 0), 19); Add_Action (Table.States (17), 30, Reduce, (56, 0), 0); Add_Action (Table.States (17), 36, Reduce, (56, 0), 0); - Add_Action (Table.States (17), 39, (58, 1), 47); + Add_Action (Table.States (17), 39, (59, 1), 51); Add_Conflict (Table.States (17), 39, (56, 0), 0); - Add_Action (Table.States (17), 41, (60, 1), 48); + Add_Action (Table.States (17), 41, (61, 1), 52); Add_Action (Table.States (17), 42, Reduce, (56, 0), 0); - Table.States (17).Goto_List.Set_Capacity (9); - Add_Goto (Table.States (17), 55, 49); - Add_Goto (Table.States (17), 56, 50); - Add_Goto (Table.States (17), 57, 51); - Add_Goto (Table.States (17), 58, 52); - Add_Goto (Table.States (17), 59, 53); - Add_Goto (Table.States (17), 60, 54); - Add_Goto (Table.States (17), 61, 55); - Add_Goto (Table.States (17), 62, 56); - Add_Goto (Table.States (17), 63, 57); + Table.States (17).Goto_List.Set_Capacity (10); + Add_Goto (Table.States (17), 55, 53); + Add_Goto (Table.States (17), 56, 54); + Add_Goto (Table.States (17), 57, 20); + Add_Goto (Table.States (17), 58, 55); + Add_Goto (Table.States (17), 59, 56); + Add_Goto (Table.States (17), 60, 57); + Add_Goto (Table.States (17), 61, 58); + Add_Goto (Table.States (17), 62, 59); + Add_Goto (Table.States (17), 63, 60); + Add_Goto (Table.States (17), 64, 61); Table.States (18).Action_List.Set_Capacity (10); Add_Action (Table.States (18), 20, Reduce, (56, 0), 0); - Add_Action (Table.States (18), 25, (63, 0), 43); - Add_Action (Table.States (18), 26, (62, 0), 44); - Add_Action (Table.States (18), 27, (61, 0), 45); - Add_Action (Table.States (18), 28, (57, 0), 46); + Add_Action (Table.States (18), 25, (64, 0), 48); + Add_Action (Table.States (18), 26, (63, 0), 49); + Add_Action (Table.States (18), 27, (62, 0), 50); + Add_Action (Table.States (18), 28, (57, 0), 19); Add_Action (Table.States (18), 30, Reduce, (56, 0), 0); Add_Action (Table.States (18), 36, Reduce, (56, 0), 0); - Add_Action (Table.States (18), 39, (58, 1), 47); + Add_Action (Table.States (18), 39, (59, 1), 51); Add_Conflict (Table.States (18), 39, (56, 0), 0); - Add_Action (Table.States (18), 41, (60, 1), 48); + Add_Action (Table.States (18), 41, (61, 1), 52); Add_Action (Table.States (18), 42, Reduce, (56, 0), 0); - Table.States (18).Goto_List.Set_Capacity (9); - Add_Goto (Table.States (18), 55, 58); - Add_Goto (Table.States (18), 56, 50); - Add_Goto (Table.States (18), 57, 51); - Add_Goto (Table.States (18), 58, 52); - Add_Goto (Table.States (18), 59, 53); - Add_Goto (Table.States (18), 60, 54); - Add_Goto (Table.States (18), 61, 55); - Add_Goto (Table.States (18), 62, 56); - Add_Goto (Table.States (18), 63, 57); - Table.States (19).Action_List.Set_Capacity (3); - Add_Action (Table.States (19), (30, 39, 42), (66, 1), 2); - Table.States (20).Action_List.Set_Capacity (2); - Add_Action (Table.States (20), (17, 39), (49, 0), 1); - Table.States (21).Action_List.Set_Capacity (2); - Add_Action (Table.States (21), 17, (48, 6), 59); - Add_Action (Table.States (21), 39, (49, 1), 60); - Table.States (22).Action_List.Set_Capacity (1); - Add_Action (Table.States (22), 39, (45, 2), 61); - Table.States (23).Action_List.Set_Capacity (1); - Add_Action (Table.States (23), 39, (45, 1), 62); - Table.States (24).Action_List.Set_Capacity (1); - Add_Action (Table.States (24), 39, (45, 0), 63); - Table.States (25).Action_List.Set_Capacity (2); - Add_Action (Table.States (25), (13, 20), (45, 3), 1); - Table.States (26).Action_List.Set_Capacity (2); - Add_Action (Table.States (26), (13, 20), (46, 0), 1); - Table.States (27).Action_List.Set_Capacity (2); - Add_Action (Table.States (27), 13, (48, 7), 64); - Add_Action (Table.States (27), 20, (46, 1), 65); - Table.States (28).Action_List.Set_Capacity (2); - Add_Action (Table.States (28), 13, (48, 8), 66); - Add_Action (Table.States (28), 20, (46, 1), 65); - Table.States (29).Action_List.Set_Capacity (3); - Add_Action (Table.States (29), (30, 39, 42), (48, 15), 3); + Table.States (18).Goto_List.Set_Capacity (10); + Add_Goto (Table.States (18), 55, 62); + Add_Goto (Table.States (18), 56, 54); + Add_Goto (Table.States (18), 57, 20); + Add_Goto (Table.States (18), 58, 55); + Add_Goto (Table.States (18), 59, 56); + Add_Goto (Table.States (18), 60, 57); + Add_Goto (Table.States (18), 61, 58); + Add_Goto (Table.States (18), 62, 59); + Add_Goto (Table.States (18), 63, 60); + Add_Goto (Table.States (18), 64, 61); + Table.States (19).Action_List.Set_Capacity (1); + Add_Action (Table.States (19), 39, (57, 0), 63); + Table.States (20).Action_List.Set_Capacity (8); + Add_Action (Table.States (20), (21, 22, 25, 26, 27, 28, 39, 41), (58, 1), 1); + Table.States (21).Action_List.Set_Capacity (3); + Add_Action (Table.States (21), 21, (53, 1), 64); + Add_Action (Table.States (21), 22, (53, 2), 65); + Add_Action (Table.States (21), 28, (57, 0), 19); + Table.States (21).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (21), 57, 66); + Table.States (22).Action_List.Set_Capacity (3); + Add_Action (Table.States (22), (30, 39, 42), (68, 0), 2); + Table.States (23).Action_List.Set_Capacity (2); + Add_Action (Table.States (23), (17, 39), (49, 0), 1); + Table.States (24).Action_List.Set_Capacity (2); + Add_Action (Table.States (24), 17, (48, 6), 67); + Add_Action (Table.States (24), 39, (49, 1), 68); + Table.States (25).Action_List.Set_Capacity (1); + Add_Action (Table.States (25), 39, (45, 2), 69); + Table.States (26).Action_List.Set_Capacity (1); + Add_Action (Table.States (26), 39, (45, 1), 70); + Table.States (27).Action_List.Set_Capacity (1); + Add_Action (Table.States (27), 39, (45, 0), 71); + Table.States (28).Action_List.Set_Capacity (5); + Add_Action (Table.States (28), 13, Reduce, (45, 3), 1); + Add_Action (Table.States (28), 20, Reduce, (45, 3), 1); + Add_Action (Table.States (28), 30, Reduce, (49, 0), 1); + Add_Action (Table.States (28), 39, Reduce, (49, 0), 1); + Add_Action (Table.States (28), 42, Reduce, (49, 0), 1); + Table.States (29).Action_List.Set_Capacity (2); + Add_Action (Table.States (29), (13, 20), (46, 0), 1); Table.States (30).Action_List.Set_Capacity (2); - Add_Action (Table.States (30), 10, (48, 14), 67); - Add_Action (Table.States (30), 23, (48, 13), 68); - Table.States (31).Action_List.Set_Capacity (2); - Add_Action (Table.States (31), 10, (48, 12), 69); - Add_Action (Table.States (31), 23, (48, 11), 70); - Table.States (32).Action_List.Set_Capacity (3); - Add_Action (Table.States (32), 18, (44, 0), 35); - Add_Action (Table.States (32), 40, (44, 1), 38); - Add_Action (Table.States (32), 41, (44, 2), 39); - Table.States (32).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (32), 44, 71); - Table.States (33).Action_List.Set_Capacity (1); - Add_Action (Table.States (33), 39, (48, 2), 72); - Table.States (34).Action_List.Set_Capacity (1); - Add_Action (Table.States (34), 39, (48, 0), 73); - Table.States (35).Action_List.Set_Capacity (7); - Add_Action (Table.States (35), (18, 30, 38, 39, 40, 41, 42), (44, 0), 1); - Table.States (36).Action_List.Set_Capacity (7); - Add_Action (Table.States (36), (18, 30, 38, 39, 40, 41, 42), (51, 1), 1); - Table.States (37).Action_List.Set_Capacity (7); - Add_Action (Table.States (37), (18, 30, 38, 39, 40, 41, 42), (51, 0), 1); - Table.States (38).Action_List.Set_Capacity (7); - Add_Action (Table.States (38), (18, 30, 38, 39, 40, 41, 42), (44, 1), 1); - Table.States (39).Action_List.Set_Capacity (7); - Add_Action (Table.States (39), (18, 30, 38, 39, 40, 41, 42), (44, 2), 1); + Add_Action (Table.States (30), 13, (48, 8), 72); + Add_Action (Table.States (30), 20, (46, 1), 73); + Table.States (31).Action_List.Set_Capacity (3); + Add_Action (Table.States (31), 30, Reduce, (48, 7), 3); + Add_Action (Table.States (31), 39, (49, 1), 68); + Add_Conflict (Table.States (31), 39, (48, 7), 3); + Add_Action (Table.States (31), 42, Reduce, (48, 7), 3); + Table.States (32).Action_List.Set_Capacity (2); + Add_Action (Table.States (32), (13, 20), (45, 3), 1); + Table.States (33).Action_List.Set_Capacity (2); + Add_Action (Table.States (33), 13, (48, 9), 74); + Add_Action (Table.States (33), 20, (46, 1), 73); + Table.States (34).Action_List.Set_Capacity (3); + Add_Action (Table.States (34), (30, 39, 42), (48, 16), 3); + Table.States (35).Action_List.Set_Capacity (2); + Add_Action (Table.States (35), 10, (48, 15), 75); + Add_Action (Table.States (35), 23, (48, 14), 76); + Table.States (36).Action_List.Set_Capacity (2); + Add_Action (Table.States (36), 10, (48, 13), 77); + Add_Action (Table.States (36), 23, (48, 12), 78); + Table.States (37).Action_List.Set_Capacity (3); + Add_Action (Table.States (37), 18, (44, 0), 40); + Add_Action (Table.States (37), 40, (44, 1), 43); + Add_Action (Table.States (37), 41, (44, 2), 44); + Table.States (37).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (37), 44, 79); + Table.States (38).Action_List.Set_Capacity (1); + Add_Action (Table.States (38), 39, (48, 2), 80); + Table.States (39).Action_List.Set_Capacity (1); + Add_Action (Table.States (39), 39, (48, 0), 81); Table.States (40).Action_List.Set_Capacity (7); - Add_Action (Table.States (40), (18, 30, 38, 39, 40, 41, 42), (51, 2), 1); + Add_Action (Table.States (40), (18, 30, 38, 39, 40, 41, 42), (44, 0), 1); Table.States (41).Action_List.Set_Capacity (7); - Add_Action (Table.States (41), (18, 30, 38, 39, 40, 41, 42), (52, 0), 1); + Add_Action (Table.States (41), (18, 30, 38, 39, 40, 41, 42), (51, 1), 1); Table.States (42).Action_List.Set_Capacity (7); - Add_Action (Table.States (42), 18, (44, 0), 35); - Add_Action (Table.States (42), 30, Reduce, (48, 9), 3); - Add_Action (Table.States (42), 38, (51, 1), 36); - Add_Action (Table.States (42), 39, (51, 0), 37); - Add_Conflict (Table.States (42), 39, (48, 9), 3); - Add_Action (Table.States (42), 40, (44, 1), 38); - Add_Action (Table.States (42), 41, (44, 2), 39); - Add_Action (Table.States (42), 42, Reduce, (48, 9), 3); - Table.States (42).Goto_List.Set_Capacity (2); - Add_Goto (Table.States (42), 44, 40); - Add_Goto (Table.States (42), 51, 74); - Table.States (43).Action_List.Set_Capacity (6); - Add_Action (Table.States (43), 25, (63, 0), 43); - Add_Action (Table.States (43), 26, (62, 0), 44); - Add_Action (Table.States (43), 27, (61, 0), 45); - Add_Action (Table.States (43), 28, (57, 0), 46); - Add_Action (Table.States (43), 39, (58, 1), 47); - Add_Action (Table.States (43), 41, (60, 1), 48); - Table.States (43).Goto_List.Set_Capacity (8); - Add_Goto (Table.States (43), 57, 51); - Add_Goto (Table.States (43), 58, 52); - Add_Goto (Table.States (43), 59, 75); - Add_Goto (Table.States (43), 60, 54); - Add_Goto (Table.States (43), 61, 55); - Add_Goto (Table.States (43), 62, 56); - Add_Goto (Table.States (43), 63, 57); - Add_Goto (Table.States (43), 64, 76); - Table.States (44).Action_List.Set_Capacity (6); - Add_Action (Table.States (44), 25, (63, 0), 43); - Add_Action (Table.States (44), 26, (62, 0), 44); - Add_Action (Table.States (44), 27, (61, 0), 45); - Add_Action (Table.States (44), 28, (57, 0), 46); - Add_Action (Table.States (44), 39, (58, 1), 47); - Add_Action (Table.States (44), 41, (60, 1), 48); - Table.States (44).Goto_List.Set_Capacity (8); - Add_Goto (Table.States (44), 57, 51); - Add_Goto (Table.States (44), 58, 52); - Add_Goto (Table.States (44), 59, 75); - Add_Goto (Table.States (44), 60, 54); - Add_Goto (Table.States (44), 61, 55); - Add_Goto (Table.States (44), 62, 56); - Add_Goto (Table.States (44), 63, 57); - Add_Goto (Table.States (44), 64, 77); - Table.States (45).Action_List.Set_Capacity (6); - Add_Action (Table.States (45), 25, (63, 0), 43); - Add_Action (Table.States (45), 26, (62, 0), 44); - Add_Action (Table.States (45), 27, (61, 0), 45); - Add_Action (Table.States (45), 28, (57, 0), 46); - Add_Action (Table.States (45), 39, (58, 1), 47); - Add_Action (Table.States (45), 41, (60, 1), 48); - Table.States (45).Goto_List.Set_Capacity (8); - Add_Goto (Table.States (45), 57, 51); - Add_Goto (Table.States (45), 58, 52); - Add_Goto (Table.States (45), 59, 75); - Add_Goto (Table.States (45), 60, 54); - Add_Goto (Table.States (45), 61, 55); - Add_Goto (Table.States (45), 62, 56); - Add_Goto (Table.States (45), 63, 57); - Add_Goto (Table.States (45), 64, 78); - Table.States (46).Action_List.Set_Capacity (1); - Add_Action (Table.States (46), 39, (57, 0), 79); - Table.States (47).Action_List.Set_Capacity (18); - Add_Action (Table.States (47), 19, Reduce, (60, 0), 1); - Add_Action (Table.States (47), 20, Reduce, (60, 0), 1); - Add_Action (Table.States (47), 23, (58, 1), 80); - Add_Action (Table.States (47), 25, Reduce, (60, 0), 1); - Add_Action (Table.States (47), 26, Reduce, (60, 0), 1); - Add_Action (Table.States (47), 27, Reduce, (60, 0), 1); - Add_Action (Table.States (47), 28, Reduce, (60, 0), 1); - Add_Action (Table.States (47), 30, Reduce, (60, 0), 1); - Add_Action (Table.States (47), 31, (63, 4), 81); - Add_Action (Table.States (47), 32, (62, 2), 82); - Add_Action (Table.States (47), 33, Reduce, (60, 0), 1); - Add_Action (Table.States (47), 34, Reduce, (60, 0), 1); - Add_Action (Table.States (47), 35, Reduce, (60, 0), 1); - Add_Action (Table.States (47), 36, Reduce, (60, 0), 1); - Add_Action (Table.States (47), 37, (63, 5), 83); - Add_Action (Table.States (47), 39, Reduce, (60, 0), 1); - Add_Action (Table.States (47), 41, Reduce, (60, 0), 1); - Add_Action (Table.States (47), 42, Reduce, (60, 0), 1); - Table.States (48).Action_List.Set_Capacity (15); - Add_Action (Table.States (48), 19, Reduce, (60, 1), 1); - Add_Action (Table.States (48), 20, Reduce, (60, 1), 1); - Add_Action (Table.States (48), 25, Reduce, (60, 1), 1); - Add_Action (Table.States (48), 26, Reduce, (60, 1), 1); - Add_Action (Table.States (48), 27, Reduce, (60, 1), 1); - Add_Action (Table.States (48), 28, Reduce, (60, 1), 1); - Add_Action (Table.States (48), 30, Reduce, (60, 1), 1); - Add_Action (Table.States (48), 32, (62, 3), 84); - Add_Action (Table.States (48), 33, Reduce, (60, 1), 1); - Add_Action (Table.States (48), 34, Reduce, (60, 1), 1); - Add_Action (Table.States (48), 35, Reduce, (60, 1), 1); - Add_Action (Table.States (48), 36, Reduce, (60, 1), 1); - Add_Action (Table.States (48), 39, Reduce, (60, 1), 1); - Add_Action (Table.States (48), 41, Reduce, (60, 1), 1); - Add_Action (Table.States (48), 42, Reduce, (60, 1), 1); - Table.States (49).Action_List.Set_Capacity (5); - Add_Action (Table.States (49), 20, (55, 1), 85); - Add_Action (Table.States (49), 30, (55, 2), 86); - Add_Conflict (Table.States (49), 30, (54, 1), 0); - Add_Action (Table.States (49), 36, (54, 0), 87); - Add_Action (Table.States (49), 39, Reduce, (54, 1), 0); - Add_Action (Table.States (49), 42, Reduce, (54, 1), 0); - Table.States (49).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (49), 54, 88); - Table.States (50).Action_List.Set_Capacity (5); - Add_Action (Table.States (50), (20, 30, 36, 39, 42), (55, 0), 1); - Table.States (51).Action_List.Set_Capacity (14); - Add_Action (Table.States (51), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (60, 2), 1); + Add_Action (Table.States (42), (18, 30, 38, 39, 40, 41, 42), (51, 0), 1); + Table.States (43).Action_List.Set_Capacity (7); + Add_Action (Table.States (43), (18, 30, 38, 39, 40, 41, 42), (44, 1), 1); + Table.States (44).Action_List.Set_Capacity (7); + Add_Action (Table.States (44), (18, 30, 38, 39, 40, 41, 42), (44, 2), 1); + Table.States (45).Action_List.Set_Capacity (7); + Add_Action (Table.States (45), (18, 30, 38, 39, 40, 41, 42), (51, 2), 1); + Table.States (46).Action_List.Set_Capacity (7); + Add_Action (Table.States (46), (18, 30, 38, 39, 40, 41, 42), (52, 0), 1); + Table.States (47).Action_List.Set_Capacity (7); + Add_Action (Table.States (47), 18, (44, 0), 40); + Add_Action (Table.States (47), 30, Reduce, (48, 10), 3); + Add_Action (Table.States (47), 38, (51, 1), 41); + Add_Action (Table.States (47), 39, (51, 0), 42); + Add_Conflict (Table.States (47), 39, (48, 10), 3); + Add_Action (Table.States (47), 40, (44, 1), 43); + Add_Action (Table.States (47), 41, (44, 2), 44); + Add_Action (Table.States (47), 42, Reduce, (48, 10), 3); + Table.States (47).Goto_List.Set_Capacity (2); + Add_Goto (Table.States (47), 44, 45); + Add_Goto (Table.States (47), 51, 82); + Table.States (48).Action_List.Set_Capacity (6); + Add_Action (Table.States (48), 25, (64, 0), 48); + Add_Action (Table.States (48), 26, (63, 0), 49); + Add_Action (Table.States (48), 27, (62, 0), 50); + Add_Action (Table.States (48), 28, (57, 0), 19); + Add_Action (Table.States (48), 39, (59, 1), 51); + Add_Action (Table.States (48), 41, (61, 1), 52); + Table.States (48).Goto_List.Set_Capacity (10); + Add_Goto (Table.States (48), 57, 20); + Add_Goto (Table.States (48), 58, 83); + Add_Goto (Table.States (48), 59, 56); + Add_Goto (Table.States (48), 60, 84); + Add_Goto (Table.States (48), 61, 58); + Add_Goto (Table.States (48), 62, 59); + Add_Goto (Table.States (48), 63, 60); + Add_Goto (Table.States (48), 64, 61); + Add_Goto (Table.States (48), 65, 85); + Add_Goto (Table.States (48), 66, 86); + Table.States (49).Action_List.Set_Capacity (6); + Add_Action (Table.States (49), 25, (64, 0), 48); + Add_Action (Table.States (49), 26, (63, 0), 49); + Add_Action (Table.States (49), 27, (62, 0), 50); + Add_Action (Table.States (49), 28, (57, 0), 19); + Add_Action (Table.States (49), 39, (59, 1), 51); + Add_Action (Table.States (49), 41, (61, 1), 52); + Table.States (49).Goto_List.Set_Capacity (10); + Add_Goto (Table.States (49), 57, 20); + Add_Goto (Table.States (49), 58, 83); + Add_Goto (Table.States (49), 59, 56); + Add_Goto (Table.States (49), 60, 84); + Add_Goto (Table.States (49), 61, 58); + Add_Goto (Table.States (49), 62, 59); + Add_Goto (Table.States (49), 63, 60); + Add_Goto (Table.States (49), 64, 61); + Add_Goto (Table.States (49), 65, 87); + Add_Goto (Table.States (49), 66, 86); + Table.States (50).Action_List.Set_Capacity (6); + Add_Action (Table.States (50), 25, (64, 0), 48); + Add_Action (Table.States (50), 26, (63, 0), 49); + Add_Action (Table.States (50), 27, (62, 0), 50); + Add_Action (Table.States (50), 28, (57, 0), 19); + Add_Action (Table.States (50), 39, (59, 1), 51); + Add_Action (Table.States (50), 41, (61, 1), 52); + Table.States (50).Goto_List.Set_Capacity (10); + Add_Goto (Table.States (50), 57, 20); + Add_Goto (Table.States (50), 58, 83); + Add_Goto (Table.States (50), 59, 56); + Add_Goto (Table.States (50), 60, 84); + Add_Goto (Table.States (50), 61, 58); + Add_Goto (Table.States (50), 62, 59); + Add_Goto (Table.States (50), 63, 60); + Add_Goto (Table.States (50), 64, 61); + Add_Goto (Table.States (50), 65, 88); + Add_Goto (Table.States (50), 66, 86); + Table.States (51).Action_List.Set_Capacity (17); + Add_Action (Table.States (51), 19, Reduce, (61, 0), 1); + Add_Action (Table.States (51), 20, Reduce, (61, 0), 1); + Add_Action (Table.States (51), 23, (59, 1), 89); + Add_Action (Table.States (51), 25, Reduce, (61, 0), 1); + Add_Action (Table.States (51), 26, Reduce, (61, 0), 1); + Add_Action (Table.States (51), 27, Reduce, (61, 0), 1); + Add_Action (Table.States (51), 30, Reduce, (61, 0), 1); + Add_Action (Table.States (51), 31, (64, 4), 90); + Add_Action (Table.States (51), 32, (63, 2), 91); + Add_Action (Table.States (51), 33, Reduce, (61, 0), 1); + Add_Action (Table.States (51), 34, Reduce, (61, 0), 1); + Add_Action (Table.States (51), 35, Reduce, (61, 0), 1); + Add_Action (Table.States (51), 36, Reduce, (61, 0), 1); + Add_Action (Table.States (51), 37, (64, 5), 92); + Add_Action (Table.States (51), 39, Reduce, (61, 0), 1); + Add_Action (Table.States (51), 41, Reduce, (61, 0), 1); + Add_Action (Table.States (51), 42, Reduce, (61, 0), 1); Table.States (52).Action_List.Set_Capacity (14); - Add_Action (Table.States (52), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (59, 0), 1); - Table.States (53).Action_List.Set_Capacity (11); - Add_Action (Table.States (53), 19, (56, 2), 89); - Add_Action (Table.States (53), 20, Reduce, (56, 1), 1); - Add_Action (Table.States (53), 25, (63, 0), 43); - Add_Action (Table.States (53), 26, (62, 0), 44); - Add_Action (Table.States (53), 27, (61, 0), 45); - Add_Action (Table.States (53), 28, (57, 0), 46); - Add_Action (Table.States (53), 30, Reduce, (56, 1), 1); - Add_Action (Table.States (53), 36, Reduce, (56, 1), 1); - Add_Action (Table.States (53), 39, (58, 1), 47); - Add_Conflict (Table.States (53), 39, (56, 1), 1); - Add_Action (Table.States (53), 41, (60, 1), 48); - Add_Action (Table.States (53), 42, Reduce, (56, 1), 1); - Table.States (53).Goto_List.Set_Capacity (6); - Add_Goto (Table.States (53), 57, 51); - Add_Goto (Table.States (53), 58, 90); - Add_Goto (Table.States (53), 60, 54); - Add_Goto (Table.States (53), 61, 55); - Add_Goto (Table.States (53), 62, 56); - Add_Goto (Table.States (53), 63, 57); - Table.States (54).Action_List.Set_Capacity (14); - Add_Action (Table.States (54), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (58, 0), 1); - Table.States (55).Action_List.Set_Capacity (14); - Add_Action (Table.States (55), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (60, 5), 1); - Table.States (56).Action_List.Set_Capacity (14); - Add_Action (Table.States (56), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (60, 3), 1); - Table.States (57).Action_List.Set_Capacity (14); - Add_Action (Table.States (57), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (60, 4), 1); - Table.States (58).Action_List.Set_Capacity (5); - Add_Action (Table.States (58), 20, (55, 1), 85); - Add_Action (Table.States (58), 30, (55, 2), 86); - Add_Conflict (Table.States (58), 30, (54, 1), 0); - Add_Action (Table.States (58), 36, (54, 0), 87); - Add_Action (Table.States (58), 39, Reduce, (54, 1), 0); - Add_Action (Table.States (58), 42, Reduce, (54, 1), 0); - Table.States (58).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (58), 54, 91); + Add_Action (Table.States (52), 19, Reduce, (61, 1), 1); + Add_Action (Table.States (52), 20, Reduce, (61, 1), 1); + Add_Action (Table.States (52), 25, Reduce, (61, 1), 1); + Add_Action (Table.States (52), 26, Reduce, (61, 1), 1); + Add_Action (Table.States (52), 27, Reduce, (61, 1), 1); + Add_Action (Table.States (52), 30, Reduce, (61, 1), 1); + Add_Action (Table.States (52), 32, (63, 3), 93); + Add_Action (Table.States (52), 33, Reduce, (61, 1), 1); + Add_Action (Table.States (52), 34, Reduce, (61, 1), 1); + Add_Action (Table.States (52), 35, Reduce, (61, 1), 1); + Add_Action (Table.States (52), 36, Reduce, (61, 1), 1); + Add_Action (Table.States (52), 39, Reduce, (61, 1), 1); + Add_Action (Table.States (52), 41, Reduce, (61, 1), 1); + Add_Action (Table.States (52), 42, Reduce, (61, 1), 1); + Table.States (53).Action_List.Set_Capacity (5); + Add_Action (Table.States (53), 20, (55, 1), 94); + Add_Action (Table.States (53), 30, (55, 2), 95); + Add_Conflict (Table.States (53), 30, (54, 1), 0); + Add_Action (Table.States (53), 36, (54, 0), 96); + Add_Action (Table.States (53), 39, Reduce, (54, 1), 0); + Add_Action (Table.States (53), 42, Reduce, (54, 1), 0); + Table.States (53).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (53), 54, 97); + Table.States (54).Action_List.Set_Capacity (5); + Add_Action (Table.States (54), (20, 30, 36, 39, 42), (55, 0), 1); + Table.States (55).Action_List.Set_Capacity (6); + Add_Action (Table.States (55), 25, (64, 0), 48); + Add_Action (Table.States (55), 26, (63, 0), 49); + Add_Action (Table.States (55), 27, (62, 0), 50); + Add_Action (Table.States (55), 28, (57, 0), 19); + Add_Action (Table.States (55), 39, (59, 1), 51); + Add_Action (Table.States (55), 41, (61, 1), 52); + Table.States (55).Goto_List.Set_Capacity (7); + Add_Goto (Table.States (55), 57, 66); + Add_Goto (Table.States (55), 59, 56); + Add_Goto (Table.States (55), 60, 98); + Add_Goto (Table.States (55), 61, 58); + Add_Goto (Table.States (55), 62, 59); + Add_Goto (Table.States (55), 63, 60); + Add_Goto (Table.States (55), 64, 61); end Subr_1; procedure Subr_2 is begin - Table.States (59).Action_List.Set_Capacity (3); - Add_Action (Table.States (59), (30, 39, 42), (48, 6), 4); - Table.States (60).Action_List.Set_Capacity (2); - Add_Action (Table.States (60), (17, 39), (49, 1), 2); - Table.States (61).Action_List.Set_Capacity (2); - Add_Action (Table.States (61), (13, 20), (45, 2), 2); - Table.States (62).Action_List.Set_Capacity (2); - Add_Action (Table.States (62), (13, 20), (45, 1), 2); - Table.States (63).Action_List.Set_Capacity (2); - Add_Action (Table.States (63), (13, 20), (45, 0), 2); - Table.States (64).Action_List.Set_Capacity (1); - Add_Action (Table.States (64), 16, (48, 7), 92); - Table.States (65).Action_List.Set_Capacity (4); - Add_Action (Table.States (65), 3, (45, 2), 22); - Add_Action (Table.States (65), 14, (45, 1), 23); - Add_Action (Table.States (65), 15, (45, 0), 24); - Add_Action (Table.States (65), 39, (45, 3), 25); - Table.States (65).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (65), 45, 93); - Table.States (66).Action_List.Set_Capacity (1); - Add_Action (Table.States (66), 16, (48, 8), 94); - Table.States (67).Action_List.Set_Capacity (1); - Add_Action (Table.States (67), 39, (50, 0), 95); - Table.States (67).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (67), 50, 96); - Table.States (68).Action_List.Set_Capacity (1); - Add_Action (Table.States (68), 39, (48, 13), 97); - Table.States (69).Action_List.Set_Capacity (1); - Add_Action (Table.States (69), 39, (50, 0), 95); - Table.States (69).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (69), 50, 98); - Table.States (70).Action_List.Set_Capacity (1); - Add_Action (Table.States (70), 39, (48, 11), 99); - Table.States (71).Action_List.Set_Capacity (3); - Add_Action (Table.States (71), (30, 39, 42), (48, 5), 4); + Table.States (56).Action_List.Set_Capacity (13); + Add_Action (Table.States (56), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (60, 1), 1); + Table.States (57).Action_List.Set_Capacity (10); + Add_Action (Table.States (57), 19, (56, 3), 99); + Add_Action (Table.States (57), 20, Reduce, (56, 1), 1); + Add_Action (Table.States (57), 25, (64, 0), 48); + Add_Action (Table.States (57), 26, (63, 0), 49); + Add_Action (Table.States (57), 27, (62, 0), 50); + Add_Action (Table.States (57), 30, Reduce, (56, 1), 1); + Add_Action (Table.States (57), 36, Reduce, (56, 1), 1); + Add_Action (Table.States (57), 39, (59, 1), 51); + Add_Conflict (Table.States (57), 39, (56, 1), 1); + Add_Action (Table.States (57), 41, (61, 1), 52); + Add_Action (Table.States (57), 42, Reduce, (56, 1), 1); + Table.States (57).Goto_List.Set_Capacity (5); + Add_Goto (Table.States (57), 59, 100); + Add_Goto (Table.States (57), 61, 58); + Add_Goto (Table.States (57), 62, 59); + Add_Goto (Table.States (57), 63, 60); + Add_Goto (Table.States (57), 64, 61); + Table.States (58).Action_List.Set_Capacity (13); + Add_Action (Table.States (58), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (59, 0), 1); + Table.States (59).Action_List.Set_Capacity (13); + Add_Action (Table.States (59), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (61, 4), 1); + Table.States (60).Action_List.Set_Capacity (13); + Add_Action (Table.States (60), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (61, 2), 1); + Table.States (61).Action_List.Set_Capacity (13); + Add_Action (Table.States (61), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (61, 3), 1); + Table.States (62).Action_List.Set_Capacity (5); + Add_Action (Table.States (62), 20, (55, 1), 94); + Add_Action (Table.States (62), 30, (55, 2), 95); + Add_Conflict (Table.States (62), 30, (54, 1), 0); + Add_Action (Table.States (62), 36, (54, 0), 96); + Add_Action (Table.States (62), 39, Reduce, (54, 1), 0); + Add_Action (Table.States (62), 42, Reduce, (54, 1), 0); + Table.States (62).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (62), 54, 101); + Table.States (63).Action_List.Set_Capacity (1); + Add_Action (Table.States (63), 23, (57, 0), 102); + Table.States (64).Action_List.Set_Capacity (10); + Add_Action (Table.States (64), 20, Reduce, (56, 0), 0); + Add_Action (Table.States (64), 25, (64, 0), 48); + Add_Action (Table.States (64), 26, (63, 0), 49); + Add_Action (Table.States (64), 27, (62, 0), 50); + Add_Action (Table.States (64), 28, (57, 0), 19); + Add_Action (Table.States (64), 30, Reduce, (56, 0), 0); + Add_Action (Table.States (64), 36, Reduce, (56, 0), 0); + Add_Action (Table.States (64), 39, (59, 1), 51); + Add_Conflict (Table.States (64), 39, (56, 0), 0); + Add_Action (Table.States (64), 41, (61, 1), 52); + Add_Action (Table.States (64), 42, Reduce, (56, 0), 0); + Table.States (64).Goto_List.Set_Capacity (10); + Add_Goto (Table.States (64), 55, 103); + Add_Goto (Table.States (64), 56, 54); + Add_Goto (Table.States (64), 57, 20); + Add_Goto (Table.States (64), 58, 55); + Add_Goto (Table.States (64), 59, 56); + Add_Goto (Table.States (64), 60, 57); + Add_Goto (Table.States (64), 61, 58); + Add_Goto (Table.States (64), 62, 59); + Add_Goto (Table.States (64), 63, 60); + Add_Goto (Table.States (64), 64, 61); + Table.States (65).Action_List.Set_Capacity (10); + Add_Action (Table.States (65), 20, Reduce, (56, 0), 0); + Add_Action (Table.States (65), 25, (64, 0), 48); + Add_Action (Table.States (65), 26, (63, 0), 49); + Add_Action (Table.States (65), 27, (62, 0), 50); + Add_Action (Table.States (65), 28, (57, 0), 19); + Add_Action (Table.States (65), 30, Reduce, (56, 0), 0); + Add_Action (Table.States (65), 36, Reduce, (56, 0), 0); + Add_Action (Table.States (65), 39, (59, 1), 51); + Add_Conflict (Table.States (65), 39, (56, 0), 0); + Add_Action (Table.States (65), 41, (61, 1), 52); + Add_Action (Table.States (65), 42, Reduce, (56, 0), 0); + Table.States (65).Goto_List.Set_Capacity (10); + Add_Goto (Table.States (65), 55, 104); + Add_Goto (Table.States (65), 56, 54); + Add_Goto (Table.States (65), 57, 20); + Add_Goto (Table.States (65), 58, 55); + Add_Goto (Table.States (65), 59, 56); + Add_Goto (Table.States (65), 60, 57); + Add_Goto (Table.States (65), 61, 58); + Add_Goto (Table.States (65), 62, 59); + Add_Goto (Table.States (65), 63, 60); + Add_Goto (Table.States (65), 64, 61); + Table.States (66).Action_List.Set_Capacity (8); + Add_Action (Table.States (66), (21, 22, 25, 26, 27, 28, 39, 41), (58, 0), 2); + Table.States (67).Action_List.Set_Capacity (3); + Add_Action (Table.States (67), (30, 39, 42), (48, 6), 4); + Table.States (68).Action_List.Set_Capacity (4); + Add_Action (Table.States (68), (17, 30, 39, 42), (49, 1), 2); + Table.States (69).Action_List.Set_Capacity (2); + Add_Action (Table.States (69), (13, 20), (45, 2), 2); + Table.States (70).Action_List.Set_Capacity (2); + Add_Action (Table.States (70), (13, 20), (45, 1), 2); + Table.States (71).Action_List.Set_Capacity (2); + Add_Action (Table.States (71), (13, 20), (45, 0), 2); Table.States (72).Action_List.Set_Capacity (1); - Add_Action (Table.States (72), 24, (48, 2), 100); - Table.States (73).Action_List.Set_Capacity (1); - Add_Action (Table.States (73), 24, (48, 0), 101); - Table.States (74).Action_List.Set_Capacity (7); - Add_Action (Table.States (74), (18, 30, 38, 39, 40, 41, 42), (52, 1), 2); - Table.States (75).Action_List.Set_Capacity (10); - Add_Action (Table.States (75), 20, Reduce, (64, 0), 1); - Add_Action (Table.States (75), 25, (63, 0), 43); - Add_Action (Table.States (75), 26, (62, 0), 44); - Add_Action (Table.States (75), 27, (61, 0), 45); - Add_Action (Table.States (75), 28, (57, 0), 46); - Add_Action (Table.States (75), 33, Reduce, (64, 0), 1); - Add_Action (Table.States (75), 34, Reduce, (64, 0), 1); - Add_Action (Table.States (75), 35, Reduce, (64, 0), 1); - Add_Action (Table.States (75), 39, (58, 1), 47); - Add_Action (Table.States (75), 41, (60, 1), 48); - Table.States (75).Goto_List.Set_Capacity (6); - Add_Goto (Table.States (75), 57, 51); - Add_Goto (Table.States (75), 58, 90); - Add_Goto (Table.States (75), 60, 54); - Add_Goto (Table.States (75), 61, 55); - Add_Goto (Table.States (75), 62, 56); - Add_Goto (Table.States (75), 63, 57); - Table.States (76).Action_List.Set_Capacity (2); - Add_Action (Table.States (76), 20, (64, 1), 102); - Add_Action (Table.States (76), 33, (63, 0), 103); - Table.States (77).Action_List.Set_Capacity (2); - Add_Action (Table.States (77), 20, (64, 1), 102); - Add_Action (Table.States (77), 34, (62, 0), 104); - Table.States (78).Action_List.Set_Capacity (2); - Add_Action (Table.States (78), 20, (64, 1), 102); - Add_Action (Table.States (78), 35, (61, 0), 105); - Table.States (79).Action_List.Set_Capacity (1); - Add_Action (Table.States (79), 23, (57, 0), 106); - Table.States (80).Action_List.Set_Capacity (6); - Add_Action (Table.States (80), 25, (63, 0), 43); - Add_Action (Table.States (80), 26, (62, 0), 44); - Add_Action (Table.States (80), 27, (61, 0), 45); - Add_Action (Table.States (80), 28, (57, 0), 46); - Add_Action (Table.States (80), 39, (60, 0), 107); - Add_Action (Table.States (80), 41, (60, 1), 48); - Table.States (80).Goto_List.Set_Capacity (5); - Add_Goto (Table.States (80), 57, 51); - Add_Goto (Table.States (80), 60, 108); - Add_Goto (Table.States (80), 61, 55); - Add_Goto (Table.States (80), 62, 56); - Add_Goto (Table.States (80), 63, 57); - Table.States (81).Action_List.Set_Capacity (14); - Add_Action (Table.States (81), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (63, 4), 2); - Table.States (82).Action_List.Set_Capacity (14); - Add_Action (Table.States (82), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (62, 2), 2); - Table.States (83).Action_List.Set_Capacity (14); - Add_Action (Table.States (83), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (63, 5), 2); - Table.States (84).Action_List.Set_Capacity (14); - Add_Action (Table.States (84), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (62, 3), 2); - Table.States (85).Action_List.Set_Capacity (10); - Add_Action (Table.States (85), 20, Reduce, (56, 0), 0); - Add_Action (Table.States (85), 25, (63, 0), 43); - Add_Action (Table.States (85), 26, (62, 0), 44); - Add_Action (Table.States (85), 27, (61, 0), 45); - Add_Action (Table.States (85), 28, (57, 0), 46); - Add_Action (Table.States (85), 30, Reduce, (56, 0), 0); - Add_Action (Table.States (85), 36, Reduce, (56, 0), 0); - Add_Action (Table.States (85), 39, (58, 1), 47); - Add_Conflict (Table.States (85), 39, (56, 0), 0); - Add_Action (Table.States (85), 41, (60, 1), 48); - Add_Action (Table.States (85), 42, Reduce, (56, 0), 0); - Table.States (85).Goto_List.Set_Capacity (8); - Add_Goto (Table.States (85), 56, 109); - Add_Goto (Table.States (85), 57, 51); - Add_Goto (Table.States (85), 58, 52); - Add_Goto (Table.States (85), 59, 53); - Add_Goto (Table.States (85), 60, 54); - Add_Goto (Table.States (85), 61, 55); - Add_Goto (Table.States (85), 62, 56); - Add_Goto (Table.States (85), 63, 57); - Table.States (86).Action_List.Set_Capacity (3); - Add_Action (Table.States (86), 7, (55, 6), 110); - Add_Action (Table.States (86), 8, (55, 4), 111); - Add_Action (Table.States (86), 9, (55, 2), 112); - Table.States (87).Action_List.Set_Capacity (3); - Add_Action (Table.States (87), (30, 39, 42), (54, 0), 1); - Table.States (88).Action_List.Set_Capacity (3); - Add_Action (Table.States (88), (30, 39, 42), (53, 0), 4); - Table.States (89).Action_List.Set_Capacity (6); - Add_Action (Table.States (89), 19, (56, 3), 113); - Add_Action (Table.States (89), 20, Reduce, (56, 2), 2); - Add_Action (Table.States (89), 30, Reduce, (56, 2), 2); - Add_Action (Table.States (89), 36, Reduce, (56, 2), 2); - Add_Action (Table.States (89), 39, Reduce, (56, 2), 2); - Add_Action (Table.States (89), 42, Reduce, (56, 2), 2); - Table.States (90).Action_List.Set_Capacity (14); - Add_Action (Table.States (90), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (59, 1), 2); - Table.States (91).Action_List.Set_Capacity (3); - Add_Action (Table.States (91), (30, 39, 42), (53, 1), 4); - Table.States (92).Action_List.Set_Capacity (2); - Add_Action (Table.States (92), 39, (47, 0), 114); - Add_Action (Table.States (92), 41, (47, 1), 115); - Table.States (92).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (92), 47, 116); - Table.States (93).Action_List.Set_Capacity (2); - Add_Action (Table.States (93), (13, 20), (46, 1), 3); - Table.States (94).Action_List.Set_Capacity (2); - Add_Action (Table.States (94), 39, (47, 0), 114); - Add_Action (Table.States (94), 41, (47, 1), 115); - Table.States (94).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (94), 47, 117); - Table.States (95).Action_List.Set_Capacity (5); - Add_Action (Table.States (95), (20, 30, 36, 39, 42), (50, 0), 1); - Table.States (96).Action_List.Set_Capacity (4); - Add_Action (Table.States (96), 20, (50, 1), 118); - Add_Action (Table.States (96), 30, Reduce, (48, 14), 5); - Add_Action (Table.States (96), 39, Reduce, (48, 14), 5); - Add_Action (Table.States (96), 42, Reduce, (48, 14), 5); + Add_Action (Table.States (72), 16, (48, 8), 105); + Table.States (73).Action_List.Set_Capacity (4); + Add_Action (Table.States (73), 3, (45, 2), 25); + Add_Action (Table.States (73), 14, (45, 1), 26); + Add_Action (Table.States (73), 15, (45, 0), 27); + Add_Action (Table.States (73), 39, (45, 3), 32); + Table.States (73).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (73), 45, 106); + Table.States (74).Action_List.Set_Capacity (1); + Add_Action (Table.States (74), 16, (48, 9), 107); + Table.States (75).Action_List.Set_Capacity (1); + Add_Action (Table.States (75), 39, (50, 0), 108); + Table.States (75).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (75), 50, 109); + Table.States (76).Action_List.Set_Capacity (1); + Add_Action (Table.States (76), 39, (48, 14), 110); + Table.States (77).Action_List.Set_Capacity (1); + Add_Action (Table.States (77), 39, (50, 0), 108); + Table.States (77).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (77), 50, 111); + Table.States (78).Action_List.Set_Capacity (1); + Add_Action (Table.States (78), 39, (48, 12), 112); + Table.States (79).Action_List.Set_Capacity (3); + Add_Action (Table.States (79), (30, 39, 42), (48, 5), 4); + Table.States (80).Action_List.Set_Capacity (1); + Add_Action (Table.States (80), 24, (48, 2), 113); + Table.States (81).Action_List.Set_Capacity (1); + Add_Action (Table.States (81), 24, (48, 0), 114); + Table.States (82).Action_List.Set_Capacity (7); + Add_Action (Table.States (82), (18, 30, 38, 39, 40, 41, 42), (52, 1), 2); + Table.States (83).Action_List.Set_Capacity (6); + Add_Action (Table.States (83), 25, (64, 0), 48); + Add_Action (Table.States (83), 26, (63, 0), 49); + Add_Action (Table.States (83), 27, (62, 0), 50); + Add_Action (Table.States (83), 28, (57, 0), 19); + Add_Action (Table.States (83), 39, (59, 1), 51); + Add_Action (Table.States (83), 41, (61, 1), 52); + Table.States (83).Goto_List.Set_Capacity (8); + Add_Goto (Table.States (83), 57, 66); + Add_Goto (Table.States (83), 59, 56); + Add_Goto (Table.States (83), 60, 84); + Add_Goto (Table.States (83), 61, 58); + Add_Goto (Table.States (83), 62, 59); + Add_Goto (Table.States (83), 63, 60); + Add_Goto (Table.States (83), 64, 61); + Add_Goto (Table.States (83), 66, 115); + Table.States (84).Action_List.Set_Capacity (9); + Add_Action (Table.States (84), 20, Reduce, (66, 1), 1); + Add_Action (Table.States (84), 25, (64, 0), 48); + Add_Action (Table.States (84), 26, (63, 0), 49); + Add_Action (Table.States (84), 27, (62, 0), 50); + Add_Action (Table.States (84), 33, Reduce, (66, 1), 1); + Add_Action (Table.States (84), 34, Reduce, (66, 1), 1); + Add_Action (Table.States (84), 35, Reduce, (66, 1), 1); + Add_Action (Table.States (84), 39, (59, 1), 51); + Add_Action (Table.States (84), 41, (61, 1), 52); + Table.States (84).Goto_List.Set_Capacity (5); + Add_Goto (Table.States (84), 59, 100); + Add_Goto (Table.States (84), 61, 58); + Add_Goto (Table.States (84), 62, 59); + Add_Goto (Table.States (84), 63, 60); + Add_Goto (Table.States (84), 64, 61); + Table.States (85).Action_List.Set_Capacity (1); + Add_Action (Table.States (85), 33, (64, 0), 116); + Table.States (86).Action_List.Set_Capacity (4); + Add_Action (Table.States (86), 20, (66, 0), 117); + Add_Action (Table.States (86), 33, Reduce, (65, 1), 1); + Add_Action (Table.States (86), 34, Reduce, (65, 1), 1); + Add_Action (Table.States (86), 35, Reduce, (65, 1), 1); + Table.States (87).Action_List.Set_Capacity (1); + Add_Action (Table.States (87), 34, (63, 0), 118); + Table.States (88).Action_List.Set_Capacity (1); + Add_Action (Table.States (88), 35, (62, 0), 119); + Table.States (89).Action_List.Set_Capacity (5); + Add_Action (Table.States (89), 25, (64, 0), 48); + Add_Action (Table.States (89), 26, (63, 0), 49); + Add_Action (Table.States (89), 27, (62, 0), 50); + Add_Action (Table.States (89), 39, (61, 0), 120); + Add_Action (Table.States (89), 41, (61, 1), 52); + Table.States (89).Goto_List.Set_Capacity (4); + Add_Goto (Table.States (89), 61, 121); + Add_Goto (Table.States (89), 62, 59); + Add_Goto (Table.States (89), 63, 60); + Add_Goto (Table.States (89), 64, 61); + Table.States (90).Action_List.Set_Capacity (13); + Add_Action (Table.States (90), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (64, 4), 2); + Table.States (91).Action_List.Set_Capacity (13); + Add_Action (Table.States (91), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (63, 2), 2); + Table.States (92).Action_List.Set_Capacity (13); + Add_Action (Table.States (92), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (64, 5), 2); + Table.States (93).Action_List.Set_Capacity (13); + Add_Action (Table.States (93), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (63, 3), 2); + Table.States (94).Action_List.Set_Capacity (10); + Add_Action (Table.States (94), 20, Reduce, (56, 0), 0); + Add_Action (Table.States (94), 25, (64, 0), 48); + Add_Action (Table.States (94), 26, (63, 0), 49); + Add_Action (Table.States (94), 27, (62, 0), 50); + Add_Action (Table.States (94), 28, (57, 0), 19); + Add_Action (Table.States (94), 30, Reduce, (56, 0), 0); + Add_Action (Table.States (94), 36, Reduce, (56, 0), 0); + Add_Action (Table.States (94), 39, (59, 1), 51); + Add_Conflict (Table.States (94), 39, (56, 0), 0); + Add_Action (Table.States (94), 41, (61, 1), 52); + Add_Action (Table.States (94), 42, Reduce, (56, 0), 0); + Table.States (94).Goto_List.Set_Capacity (9); + Add_Goto (Table.States (94), 56, 122); + Add_Goto (Table.States (94), 57, 20); + Add_Goto (Table.States (94), 58, 55); + Add_Goto (Table.States (94), 59, 56); + Add_Goto (Table.States (94), 60, 57); + Add_Goto (Table.States (94), 61, 58); + Add_Goto (Table.States (94), 62, 59); + Add_Goto (Table.States (94), 63, 60); + Add_Goto (Table.States (94), 64, 61); + Table.States (95).Action_List.Set_Capacity (3); + Add_Action (Table.States (95), 7, (55, 6), 123); + Add_Action (Table.States (95), 8, (55, 4), 124); + Add_Action (Table.States (95), 9, (55, 2), 125); + Table.States (96).Action_List.Set_Capacity (3); + Add_Action (Table.States (96), (30, 39, 42), (54, 0), 1); Table.States (97).Action_List.Set_Capacity (3); - Add_Action (Table.States (97), (30, 39, 42), (48, 13), 5); - Table.States (98).Action_List.Set_Capacity (4); - Add_Action (Table.States (98), 20, (50, 1), 118); - Add_Action (Table.States (98), 30, Reduce, (48, 12), 5); - Add_Action (Table.States (98), 39, Reduce, (48, 12), 5); - Add_Action (Table.States (98), 42, Reduce, (48, 12), 5); - Table.States (99).Action_List.Set_Capacity (3); - Add_Action (Table.States (99), (30, 39, 42), (48, 11), 5); - Table.States (100).Action_List.Set_Capacity (1); - Add_Action (Table.States (100), 39, (48, 2), 119); - Table.States (101).Action_List.Set_Capacity (1); - Add_Action (Table.States (101), 39, (48, 0), 120); - Table.States (102).Action_List.Set_Capacity (6); - Add_Action (Table.States (102), 25, (63, 0), 43); - Add_Action (Table.States (102), 26, (62, 0), 44); - Add_Action (Table.States (102), 27, (61, 0), 45); - Add_Action (Table.States (102), 28, (57, 0), 46); - Add_Action (Table.States (102), 39, (58, 1), 47); - Add_Action (Table.States (102), 41, (60, 1), 48); - Table.States (102).Goto_List.Set_Capacity (7); - Add_Goto (Table.States (102), 57, 51); - Add_Goto (Table.States (102), 58, 52); - Add_Goto (Table.States (102), 59, 121); - Add_Goto (Table.States (102), 60, 54); - Add_Goto (Table.States (102), 61, 55); - Add_Goto (Table.States (102), 62, 56); - Add_Goto (Table.States (102), 63, 57); - Table.States (103).Action_List.Set_Capacity (15); - Add_Action (Table.States (103), 19, Reduce, (63, 0), 3); - Add_Action (Table.States (103), 20, Reduce, (63, 0), 3); - Add_Action (Table.States (103), 25, Reduce, (63, 0), 3); - Add_Action (Table.States (103), 26, Reduce, (63, 0), 3); - Add_Action (Table.States (103), 27, Reduce, (63, 0), 3); - Add_Action (Table.States (103), 28, Reduce, (63, 0), 3); - Add_Action (Table.States (103), 29, (63, 1), 122); - Add_Action (Table.States (103), 30, Reduce, (63, 0), 3); - Add_Action (Table.States (103), 33, Reduce, (63, 0), 3); - Add_Action (Table.States (103), 34, Reduce, (63, 0), 3); - Add_Action (Table.States (103), 35, Reduce, (63, 0), 3); - Add_Action (Table.States (103), 36, Reduce, (63, 0), 3); - Add_Action (Table.States (103), 39, Reduce, (63, 0), 3); - Add_Action (Table.States (103), 41, Reduce, (63, 0), 3); - Add_Action (Table.States (103), 42, Reduce, (63, 0), 3); - Table.States (104).Action_List.Set_Capacity (14); - Add_Action (Table.States (104), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (62, 0), 3); - Table.States (105).Action_List.Set_Capacity (17); - Add_Action (Table.States (105), 19, Reduce, (61, 0), 3); - Add_Action (Table.States (105), 20, Reduce, (61, 0), 3); - Add_Action (Table.States (105), 25, Reduce, (61, 0), 3); - Add_Action (Table.States (105), 26, Reduce, (61, 0), 3); - Add_Action (Table.States (105), 27, Reduce, (61, 0), 3); - Add_Action (Table.States (105), 28, Reduce, (61, 0), 3); - Add_Action (Table.States (105), 30, Reduce, (61, 0), 3); - Add_Action (Table.States (105), 31, (63, 2), 123); - Add_Action (Table.States (105), 32, (62, 1), 124); - Add_Action (Table.States (105), 33, Reduce, (61, 0), 3); - Add_Action (Table.States (105), 34, Reduce, (61, 0), 3); - Add_Action (Table.States (105), 35, Reduce, (61, 0), 3); - Add_Action (Table.States (105), 36, Reduce, (61, 0), 3); - Add_Action (Table.States (105), 37, (63, 3), 125); - Add_Action (Table.States (105), 39, Reduce, (61, 0), 3); - Add_Action (Table.States (105), 41, Reduce, (61, 0), 3); - Add_Action (Table.States (105), 42, Reduce, (61, 0), 3); - Table.States (106).Action_List.Set_Capacity (1); - Add_Action (Table.States (106), 39, (57, 0), 126); - Table.States (107).Action_List.Set_Capacity (17); - Add_Action (Table.States (107), 19, Reduce, (60, 0), 1); - Add_Action (Table.States (107), 20, Reduce, (60, 0), 1); - Add_Action (Table.States (107), 25, Reduce, (60, 0), 1); - Add_Action (Table.States (107), 26, Reduce, (60, 0), 1); - Add_Action (Table.States (107), 27, Reduce, (60, 0), 1); - Add_Action (Table.States (107), 28, Reduce, (60, 0), 1); - Add_Action (Table.States (107), 30, Reduce, (60, 0), 1); - Add_Action (Table.States (107), 31, (63, 4), 81); - Add_Action (Table.States (107), 32, (62, 2), 82); - Add_Action (Table.States (107), 33, Reduce, (60, 0), 1); - Add_Action (Table.States (107), 34, Reduce, (60, 0), 1); - Add_Action (Table.States (107), 35, Reduce, (60, 0), 1); - Add_Action (Table.States (107), 36, Reduce, (60, 0), 1); - Add_Action (Table.States (107), 37, (63, 5), 83); - Add_Action (Table.States (107), 39, Reduce, (60, 0), 1); - Add_Action (Table.States (107), 41, Reduce, (60, 0), 1); - Add_Action (Table.States (107), 42, Reduce, (60, 0), 1); - Table.States (108).Action_List.Set_Capacity (14); - Add_Action (Table.States (108), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (58, 1), 3); - Table.States (109).Action_List.Set_Capacity (5); - Add_Action (Table.States (109), (20, 30, 36, 39, 42), (55, 1), 3); - Table.States (110).Action_List.Set_Capacity (1); - Add_Action (Table.States (110), 9, (55, 6), 127); - Table.States (111).Action_List.Set_Capacity (1); - Add_Action (Table.States (111), 39, (55, 4), 128); - Table.States (112).Action_List.Set_Capacity (1); - Add_Action (Table.States (112), 39, (55, 2), 129); - Table.States (113).Action_List.Set_Capacity (5); - Add_Action (Table.States (113), (20, 30, 36, 39, 42), (56, 3), 3); - Table.States (114).Action_List.Set_Capacity (4); - Add_Action (Table.States (114), (21, 30, 39, 42), (47, 0), 1); + Add_Action (Table.States (97), (30, 39, 42), (53, 0), 4); + Table.States (98).Action_List.Set_Capacity (10); + Add_Action (Table.States (98), 19, (56, 4), 126); + Add_Action (Table.States (98), 20, Reduce, (56, 2), 2); + Add_Action (Table.States (98), 25, (64, 0), 48); + Add_Action (Table.States (98), 26, (63, 0), 49); + Add_Action (Table.States (98), 27, (62, 0), 50); + Add_Action (Table.States (98), 30, Reduce, (56, 2), 2); + Add_Action (Table.States (98), 36, Reduce, (56, 2), 2); + Add_Action (Table.States (98), 39, (59, 1), 51); + Add_Conflict (Table.States (98), 39, (56, 2), 2); + Add_Action (Table.States (98), 41, (61, 1), 52); + Add_Action (Table.States (98), 42, Reduce, (56, 2), 2); + Table.States (98).Goto_List.Set_Capacity (5); + Add_Goto (Table.States (98), 59, 100); + Add_Goto (Table.States (98), 61, 58); + Add_Goto (Table.States (98), 62, 59); + Add_Goto (Table.States (98), 63, 60); + Add_Goto (Table.States (98), 64, 61); + Table.States (99).Action_List.Set_Capacity (6); + Add_Action (Table.States (99), 19, (56, 5), 127); + Add_Action (Table.States (99), 20, Reduce, (56, 3), 2); + Add_Action (Table.States (99), 30, Reduce, (56, 3), 2); + Add_Action (Table.States (99), 36, Reduce, (56, 3), 2); + Add_Action (Table.States (99), 39, Reduce, (56, 3), 2); + Add_Action (Table.States (99), 42, Reduce, (56, 3), 2); + Table.States (100).Action_List.Set_Capacity (13); + Add_Action (Table.States (100), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (60, 0), 2); + Table.States (101).Action_List.Set_Capacity (3); + Add_Action (Table.States (101), (30, 39, 42), (53, 3), 4); + Table.States (102).Action_List.Set_Capacity (1); + Add_Action (Table.States (102), 39, (57, 0), 128); + Table.States (103).Action_List.Set_Capacity (5); + Add_Action (Table.States (103), 20, (55, 1), 94); + Add_Action (Table.States (103), 30, (55, 2), 95); + Add_Conflict (Table.States (103), 30, (54, 1), 0); + Add_Action (Table.States (103), 36, (54, 0), 96); + Add_Action (Table.States (103), 39, Reduce, (54, 1), 0); + Add_Action (Table.States (103), 42, Reduce, (54, 1), 0); + Table.States (103).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (103), 54, 129); + Table.States (104).Action_List.Set_Capacity (5); + Add_Action (Table.States (104), 20, (55, 1), 94); + Add_Action (Table.States (104), 30, (55, 2), 95); + Add_Conflict (Table.States (104), 30, (54, 1), 0); + Add_Action (Table.States (104), 36, (54, 0), 96); + Add_Action (Table.States (104), 39, Reduce, (54, 1), 0); + Add_Action (Table.States (104), 42, Reduce, (54, 1), 0); + Table.States (104).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (104), 54, 130); + Table.States (105).Action_List.Set_Capacity (2); + Add_Action (Table.States (105), 39, (47, 0), 131); + Add_Action (Table.States (105), 41, (47, 1), 132); + Table.States (105).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (105), 47, 133); + Table.States (106).Action_List.Set_Capacity (2); + Add_Action (Table.States (106), (13, 20), (46, 1), 3); + Table.States (107).Action_List.Set_Capacity (2); + Add_Action (Table.States (107), 39, (47, 0), 131); + Add_Action (Table.States (107), 41, (47, 1), 132); + Table.States (107).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (107), 47, 134); + Table.States (108).Action_List.Set_Capacity (5); + Add_Action (Table.States (108), (20, 30, 36, 39, 42), (50, 0), 1); + Table.States (109).Action_List.Set_Capacity (4); + Add_Action (Table.States (109), 20, (50, 1), 135); + Add_Action (Table.States (109), 30, Reduce, (48, 15), 5); + Add_Action (Table.States (109), 39, Reduce, (48, 15), 5); + Add_Action (Table.States (109), 42, Reduce, (48, 15), 5); + Table.States (110).Action_List.Set_Capacity (3); + Add_Action (Table.States (110), (30, 39, 42), (48, 14), 5); + Table.States (111).Action_List.Set_Capacity (4); + Add_Action (Table.States (111), 20, (50, 1), 135); + Add_Action (Table.States (111), 30, Reduce, (48, 13), 5); + Add_Action (Table.States (111), 39, Reduce, (48, 13), 5); + Add_Action (Table.States (111), 42, Reduce, (48, 13), 5); + Table.States (112).Action_List.Set_Capacity (3); + Add_Action (Table.States (112), (30, 39, 42), (48, 12), 5); + Table.States (113).Action_List.Set_Capacity (1); + Add_Action (Table.States (113), 39, (48, 2), 136); + Table.States (114).Action_List.Set_Capacity (1); + Add_Action (Table.States (114), 39, (48, 0), 137); Table.States (115).Action_List.Set_Capacity (4); - Add_Action (Table.States (115), (21, 30, 39, 42), (47, 1), 1); - Table.States (116).Action_List.Set_Capacity (3); - Add_Action (Table.States (116), (30, 39, 42), (48, 7), 6); - Table.States (117).Action_List.Set_Capacity (1); - Add_Action (Table.States (117), 21, (48, 8), 130); - Table.States (118).Action_List.Set_Capacity (1); - Add_Action (Table.States (118), 39, (50, 1), 131); - Table.States (119).Action_List.Set_Capacity (6); - Add_Action (Table.States (119), 18, (44, 0), 35); - Add_Action (Table.States (119), 30, Reduce, (48, 4), 6); - Add_Action (Table.States (119), 39, Reduce, (48, 4), 6); - Add_Action (Table.States (119), 40, (44, 1), 38); - Add_Action (Table.States (119), 41, (44, 2), 39); - Add_Action (Table.States (119), 42, Reduce, (48, 4), 6); - Table.States (119).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (119), 44, 132); - Table.States (120).Action_List.Set_Capacity (3); - Add_Action (Table.States (120), 18, (44, 0), 35); - Add_Action (Table.States (120), 40, (44, 1), 38); - Add_Action (Table.States (120), 41, (44, 2), 39); - Table.States (120).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (120), 44, 133); - Table.States (121).Action_List.Set_Capacity (10); - Add_Action (Table.States (121), 20, Reduce, (64, 1), 3); - Add_Action (Table.States (121), 25, (63, 0), 43); - Add_Action (Table.States (121), 26, (62, 0), 44); - Add_Action (Table.States (121), 27, (61, 0), 45); - Add_Action (Table.States (121), 28, (57, 0), 46); - Add_Action (Table.States (121), 33, Reduce, (64, 1), 3); - Add_Action (Table.States (121), 34, Reduce, (64, 1), 3); - Add_Action (Table.States (121), 35, Reduce, (64, 1), 3); - Add_Action (Table.States (121), 39, (58, 1), 47); - Add_Action (Table.States (121), 41, (60, 1), 48); - Table.States (121).Goto_List.Set_Capacity (6); - Add_Goto (Table.States (121), 57, 51); - Add_Goto (Table.States (121), 58, 90); - Add_Goto (Table.States (121), 60, 54); - Add_Goto (Table.States (121), 61, 55); - Add_Goto (Table.States (121), 62, 56); - Add_Goto (Table.States (121), 63, 57); - Table.States (122).Action_List.Set_Capacity (14); - Add_Action (Table.States (122), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (63, 1), 4); - Table.States (123).Action_List.Set_Capacity (14); - Add_Action (Table.States (123), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (63, 2), 4); - Table.States (124).Action_List.Set_Capacity (14); - Add_Action (Table.States (124), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (62, 1), 4); - Table.States (125).Action_List.Set_Capacity (14); - Add_Action (Table.States (125), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (63, 3), 4); - Table.States (126).Action_List.Set_Capacity (1); - Add_Action (Table.States (126), 24, (57, 0), 134); - Table.States (127).Action_List.Set_Capacity (5); - Add_Action (Table.States (127), (20, 30, 36, 39, 42), (55, 6), 4); - Table.States (128).Action_List.Set_Capacity (2); - Add_Action (Table.States (128), 10, (55, 5), 135); - Add_Action (Table.States (128), 23, (55, 4), 136); - Table.States (129).Action_List.Set_Capacity (2); - Add_Action (Table.States (129), 10, (55, 3), 137); - Add_Action (Table.States (129), 23, (55, 2), 138); - Table.States (130).Action_List.Set_Capacity (1); - Add_Action (Table.States (130), 39, (48, 8), 139); - Table.States (131).Action_List.Set_Capacity (5); - Add_Action (Table.States (131), (20, 30, 36, 39, 42), (50, 1), 3); + Add_Action (Table.States (115), 20, (66, 0), 117); + Add_Action (Table.States (115), 33, Reduce, (65, 0), 2); + Add_Action (Table.States (115), 34, Reduce, (65, 0), 2); + Add_Action (Table.States (115), 35, Reduce, (65, 0), 2); + Table.States (116).Action_List.Set_Capacity (14); + Add_Action (Table.States (116), 19, Reduce, (64, 0), 3); + Add_Action (Table.States (116), 20, Reduce, (64, 0), 3); + Add_Action (Table.States (116), 25, Reduce, (64, 0), 3); + Add_Action (Table.States (116), 26, Reduce, (64, 0), 3); + Add_Action (Table.States (116), 27, Reduce, (64, 0), 3); + Add_Action (Table.States (116), 29, (64, 1), 138); + Add_Action (Table.States (116), 30, Reduce, (64, 0), 3); + Add_Action (Table.States (116), 33, Reduce, (64, 0), 3); + Add_Action (Table.States (116), 34, Reduce, (64, 0), 3); + Add_Action (Table.States (116), 35, Reduce, (64, 0), 3); + Add_Action (Table.States (116), 36, Reduce, (64, 0), 3); + Add_Action (Table.States (116), 39, Reduce, (64, 0), 3); + Add_Action (Table.States (116), 41, Reduce, (64, 0), 3); + Add_Action (Table.States (116), 42, Reduce, (64, 0), 3); end Subr_2; procedure Subr_3 is begin - Table.States (132).Action_List.Set_Capacity (6); - Add_Action (Table.States (132), 18, (44, 0), 35); - Add_Action (Table.States (132), 30, Reduce, (48, 3), 7); - Add_Action (Table.States (132), 39, Reduce, (48, 3), 7); - Add_Action (Table.States (132), 40, (44, 1), 38); - Add_Action (Table.States (132), 41, (44, 2), 39); - Add_Action (Table.States (132), 42, Reduce, (48, 3), 7); - Table.States (132).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (132), 44, 140); - Table.States (133).Action_List.Set_Capacity (6); - Add_Action (Table.States (133), 18, (44, 0), 35); - Add_Action (Table.States (133), 30, Reduce, (48, 1), 7); - Add_Action (Table.States (133), 39, Reduce, (48, 1), 7); - Add_Action (Table.States (133), 40, (44, 1), 38); - Add_Action (Table.States (133), 41, (44, 2), 39); - Add_Action (Table.States (133), 42, Reduce, (48, 1), 7); - Table.States (133).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (133), 44, 141); - Table.States (134).Action_List.Set_Capacity (14); - Add_Action (Table.States (134), (19, 20, 25, 26, 27, 28, 30, 33, 34, 35, 36, 39, 41, 42), (57, 0), 5); + Table.States (117).Action_List.Set_Capacity (5); + Add_Action (Table.States (117), 25, (64, 0), 48); + Add_Action (Table.States (117), 26, (63, 0), 49); + Add_Action (Table.States (117), 27, (62, 0), 50); + Add_Action (Table.States (117), 39, (59, 1), 51); + Add_Action (Table.States (117), 41, (61, 1), 52); + Table.States (117).Goto_List.Set_Capacity (6); + Add_Goto (Table.States (117), 59, 56); + Add_Goto (Table.States (117), 60, 139); + Add_Goto (Table.States (117), 61, 58); + Add_Goto (Table.States (117), 62, 59); + Add_Goto (Table.States (117), 63, 60); + Add_Goto (Table.States (117), 64, 61); + Table.States (118).Action_List.Set_Capacity (13); + Add_Action (Table.States (118), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (63, 0), 3); + Table.States (119).Action_List.Set_Capacity (16); + Add_Action (Table.States (119), 19, Reduce, (62, 0), 3); + Add_Action (Table.States (119), 20, Reduce, (62, 0), 3); + Add_Action (Table.States (119), 25, Reduce, (62, 0), 3); + Add_Action (Table.States (119), 26, Reduce, (62, 0), 3); + Add_Action (Table.States (119), 27, Reduce, (62, 0), 3); + Add_Action (Table.States (119), 30, Reduce, (62, 0), 3); + Add_Action (Table.States (119), 31, (64, 2), 140); + Add_Action (Table.States (119), 32, (63, 1), 141); + Add_Action (Table.States (119), 33, Reduce, (62, 0), 3); + Add_Action (Table.States (119), 34, Reduce, (62, 0), 3); + Add_Action (Table.States (119), 35, Reduce, (62, 0), 3); + Add_Action (Table.States (119), 36, Reduce, (62, 0), 3); + Add_Action (Table.States (119), 37, (64, 3), 142); + Add_Action (Table.States (119), 39, Reduce, (62, 0), 3); + Add_Action (Table.States (119), 41, Reduce, (62, 0), 3); + Add_Action (Table.States (119), 42, Reduce, (62, 0), 3); + Table.States (120).Action_List.Set_Capacity (16); + Add_Action (Table.States (120), 19, Reduce, (61, 0), 1); + Add_Action (Table.States (120), 20, Reduce, (61, 0), 1); + Add_Action (Table.States (120), 25, Reduce, (61, 0), 1); + Add_Action (Table.States (120), 26, Reduce, (61, 0), 1); + Add_Action (Table.States (120), 27, Reduce, (61, 0), 1); + Add_Action (Table.States (120), 30, Reduce, (61, 0), 1); + Add_Action (Table.States (120), 31, (64, 4), 90); + Add_Action (Table.States (120), 32, (63, 2), 91); + Add_Action (Table.States (120), 33, Reduce, (61, 0), 1); + Add_Action (Table.States (120), 34, Reduce, (61, 0), 1); + Add_Action (Table.States (120), 35, Reduce, (61, 0), 1); + Add_Action (Table.States (120), 36, Reduce, (61, 0), 1); + Add_Action (Table.States (120), 37, (64, 5), 92); + Add_Action (Table.States (120), 39, Reduce, (61, 0), 1); + Add_Action (Table.States (120), 41, Reduce, (61, 0), 1); + Add_Action (Table.States (120), 42, Reduce, (61, 0), 1); + Table.States (121).Action_List.Set_Capacity (13); + Add_Action (Table.States (121), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (59, 1), 3); + Table.States (122).Action_List.Set_Capacity (5); + Add_Action (Table.States (122), (20, 30, 36, 39, 42), (55, 1), 3); + Table.States (123).Action_List.Set_Capacity (1); + Add_Action (Table.States (123), 9, (55, 6), 143); + Table.States (124).Action_List.Set_Capacity (1); + Add_Action (Table.States (124), 39, (55, 4), 144); + Table.States (125).Action_List.Set_Capacity (1); + Add_Action (Table.States (125), 39, (55, 2), 145); + Table.States (126).Action_List.Set_Capacity (6); + Add_Action (Table.States (126), 19, (56, 6), 146); + Add_Action (Table.States (126), 20, Reduce, (56, 4), 3); + Add_Action (Table.States (126), 30, Reduce, (56, 4), 3); + Add_Action (Table.States (126), 36, Reduce, (56, 4), 3); + Add_Action (Table.States (126), 39, Reduce, (56, 4), 3); + Add_Action (Table.States (126), 42, Reduce, (56, 4), 3); + Table.States (127).Action_List.Set_Capacity (5); + Add_Action (Table.States (127), (20, 30, 36, 39, 42), (56, 5), 3); + Table.States (128).Action_List.Set_Capacity (1); + Add_Action (Table.States (128), 24, (57, 0), 147); + Table.States (129).Action_List.Set_Capacity (3); + Add_Action (Table.States (129), (30, 39, 42), (53, 1), 5); + Table.States (130).Action_List.Set_Capacity (3); + Add_Action (Table.States (130), (30, 39, 42), (53, 2), 5); + Table.States (131).Action_List.Set_Capacity (4); + Add_Action (Table.States (131), (21, 30, 39, 42), (47, 0), 1); + Table.States (132).Action_List.Set_Capacity (4); + Add_Action (Table.States (132), (21, 30, 39, 42), (47, 1), 1); + Table.States (133).Action_List.Set_Capacity (3); + Add_Action (Table.States (133), (30, 39, 42), (48, 8), 6); + Table.States (134).Action_List.Set_Capacity (1); + Add_Action (Table.States (134), 21, (48, 9), 148); Table.States (135).Action_List.Set_Capacity (1); - Add_Action (Table.States (135), 39, (50, 0), 95); - Table.States (135).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (135), 50, 142); - Table.States (136).Action_List.Set_Capacity (1); - Add_Action (Table.States (136), 39, (55, 4), 143); - Table.States (137).Action_List.Set_Capacity (1); - Add_Action (Table.States (137), 39, (50, 0), 95); + Add_Action (Table.States (135), 39, (50, 1), 149); + Table.States (136).Action_List.Set_Capacity (6); + Add_Action (Table.States (136), 18, (44, 0), 40); + Add_Action (Table.States (136), 30, Reduce, (48, 4), 6); + Add_Action (Table.States (136), 39, Reduce, (48, 4), 6); + Add_Action (Table.States (136), 40, (44, 1), 43); + Add_Action (Table.States (136), 41, (44, 2), 44); + Add_Action (Table.States (136), 42, Reduce, (48, 4), 6); + Table.States (136).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (136), 44, 150); + Table.States (137).Action_List.Set_Capacity (3); + Add_Action (Table.States (137), 18, (44, 0), 40); + Add_Action (Table.States (137), 40, (44, 1), 43); + Add_Action (Table.States (137), 41, (44, 2), 44); Table.States (137).Goto_List.Set_Capacity (1); - Add_Goto (Table.States (137), 50, 144); - Table.States (138).Action_List.Set_Capacity (1); - Add_Action (Table.States (138), 39, (55, 2), 145); - Table.States (139).Action_List.Set_Capacity (3); - Add_Action (Table.States (139), (30, 39, 42), (48, 8), 8); - Table.States (140).Action_List.Set_Capacity (3); - Add_Action (Table.States (140), (30, 39, 42), (48, 2), 8); - Table.States (141).Action_List.Set_Capacity (3); - Add_Action (Table.States (141), (30, 39, 42), (48, 0), 8); - Table.States (142).Action_List.Set_Capacity (5); - Add_Action (Table.States (142), 20, (50, 1), 118); - Add_Conflict (Table.States (142), 20, (55, 5), 6); - Add_Action (Table.States (142), 30, Reduce, (55, 5), 6); - Add_Action (Table.States (142), 36, Reduce, (55, 5), 6); - Add_Action (Table.States (142), 39, Reduce, (55, 5), 6); - Add_Action (Table.States (142), 42, Reduce, (55, 5), 6); + Add_Goto (Table.States (137), 44, 151); + Table.States (138).Action_List.Set_Capacity (13); + Add_Action (Table.States (138), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (64, 1), 4); + Table.States (139).Action_List.Set_Capacity (9); + Add_Action (Table.States (139), 20, Reduce, (66, 0), 3); + Add_Action (Table.States (139), 25, (64, 0), 48); + Add_Action (Table.States (139), 26, (63, 0), 49); + Add_Action (Table.States (139), 27, (62, 0), 50); + Add_Action (Table.States (139), 33, Reduce, (66, 0), 3); + Add_Action (Table.States (139), 34, Reduce, (66, 0), 3); + Add_Action (Table.States (139), 35, Reduce, (66, 0), 3); + Add_Action (Table.States (139), 39, (59, 1), 51); + Add_Action (Table.States (139), 41, (61, 1), 52); + Table.States (139).Goto_List.Set_Capacity (5); + Add_Goto (Table.States (139), 59, 100); + Add_Goto (Table.States (139), 61, 58); + Add_Goto (Table.States (139), 62, 59); + Add_Goto (Table.States (139), 63, 60); + Add_Goto (Table.States (139), 64, 61); + Table.States (140).Action_List.Set_Capacity (13); + Add_Action (Table.States (140), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (64, 2), 4); + Table.States (141).Action_List.Set_Capacity (13); + Add_Action (Table.States (141), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (63, 1), 4); + Table.States (142).Action_List.Set_Capacity (13); + Add_Action (Table.States (142), (19, 20, 25, 26, 27, 30, 33, 34, 35, 36, 39, 41, 42), (64, 3), 4); Table.States (143).Action_List.Set_Capacity (5); - Add_Action (Table.States (143), (20, 30, 36, 39, 42), (55, 4), 6); - Table.States (144).Action_List.Set_Capacity (5); - Add_Action (Table.States (144), 20, (50, 1), 118); - Add_Conflict (Table.States (144), 20, (55, 3), 6); - Add_Action (Table.States (144), 30, Reduce, (55, 3), 6); - Add_Action (Table.States (144), 36, Reduce, (55, 3), 6); - Add_Action (Table.States (144), 39, Reduce, (55, 3), 6); - Add_Action (Table.States (144), 42, Reduce, (55, 3), 6); - Table.States (145).Action_List.Set_Capacity (5); - Add_Action (Table.States (145), (20, 30, 36, 39, 42), (55, 2), 6); + Add_Action (Table.States (143), (20, 30, 36, 39, 42), (55, 6), 4); + Table.States (144).Action_List.Set_Capacity (2); + Add_Action (Table.States (144), 10, (55, 5), 152); + Add_Action (Table.States (144), 23, (55, 4), 153); + Table.States (145).Action_List.Set_Capacity (2); + Add_Action (Table.States (145), 10, (55, 3), 154); + Add_Action (Table.States (145), 23, (55, 2), 155); + Table.States (146).Action_List.Set_Capacity (5); + Add_Action (Table.States (146), (20, 30, 36, 39, 42), (56, 6), 4); + Table.States (147).Action_List.Set_Capacity (8); + Add_Action (Table.States (147), (21, 22, 25, 26, 27, 28, 39, 41), (57, 0), 5); + Table.States (148).Action_List.Set_Capacity (1); + Add_Action (Table.States (148), 39, (48, 9), 156); + Table.States (149).Action_List.Set_Capacity (5); + Add_Action (Table.States (149), (20, 30, 36, 39, 42), (50, 1), 3); + Table.States (150).Action_List.Set_Capacity (6); + Add_Action (Table.States (150), 18, (44, 0), 40); + Add_Action (Table.States (150), 30, Reduce, (48, 3), 7); + Add_Action (Table.States (150), 39, Reduce, (48, 3), 7); + Add_Action (Table.States (150), 40, (44, 1), 43); + Add_Action (Table.States (150), 41, (44, 2), 44); + Add_Action (Table.States (150), 42, Reduce, (48, 3), 7); + Table.States (150).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (150), 44, 157); + Table.States (151).Action_List.Set_Capacity (6); + Add_Action (Table.States (151), 18, (44, 0), 40); + Add_Action (Table.States (151), 30, Reduce, (48, 1), 7); + Add_Action (Table.States (151), 39, Reduce, (48, 1), 7); + Add_Action (Table.States (151), 40, (44, 1), 43); + Add_Action (Table.States (151), 41, (44, 2), 44); + Add_Action (Table.States (151), 42, Reduce, (48, 1), 7); + Table.States (151).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (151), 44, 158); + Table.States (152).Action_List.Set_Capacity (1); + Add_Action (Table.States (152), 39, (50, 0), 108); + Table.States (152).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (152), 50, 159); + Table.States (153).Action_List.Set_Capacity (1); + Add_Action (Table.States (153), 39, (55, 4), 160); + Table.States (154).Action_List.Set_Capacity (1); + Add_Action (Table.States (154), 39, (50, 0), 108); + Table.States (154).Goto_List.Set_Capacity (1); + Add_Goto (Table.States (154), 50, 161); + Table.States (155).Action_List.Set_Capacity (1); + Add_Action (Table.States (155), 39, (55, 2), 162); + Table.States (156).Action_List.Set_Capacity (3); + Add_Action (Table.States (156), (30, 39, 42), (48, 9), 8); + Table.States (157).Action_List.Set_Capacity (3); + Add_Action (Table.States (157), (30, 39, 42), (48, 2), 8); + Table.States (158).Action_List.Set_Capacity (3); + Add_Action (Table.States (158), (30, 39, 42), (48, 0), 8); + Table.States (159).Action_List.Set_Capacity (5); + Add_Action (Table.States (159), 20, (50, 1), 135); + Add_Conflict (Table.States (159), 20, (55, 5), 6); + Add_Action (Table.States (159), 30, Reduce, (55, 5), 6); + Add_Action (Table.States (159), 36, Reduce, (55, 5), 6); + Add_Action (Table.States (159), 39, Reduce, (55, 5), 6); + Add_Action (Table.States (159), 42, Reduce, (55, 5), 6); + Table.States (160).Action_List.Set_Capacity (5); + Add_Action (Table.States (160), (20, 30, 36, 39, 42), (55, 4), 6); + Table.States (161).Action_List.Set_Capacity (5); + Add_Action (Table.States (161), 20, (50, 1), 135); + Add_Conflict (Table.States (161), 20, (55, 3), 6); + Add_Action (Table.States (161), 30, Reduce, (55, 3), 6); + Add_Action (Table.States (161), 36, Reduce, (55, 3), 6); + Add_Action (Table.States (161), 39, Reduce, (55, 3), 6); + Add_Action (Table.States (161), 42, Reduce, (55, 3), 6); + Table.States (162).Action_List.Set_Capacity (5); + Add_Action (Table.States (162), (20, 30, 36, 39, 42), (55, 2), 6); end Subr_3; begin Subr_1; @@ -964,8 +1115,8 @@ package body Wisitoken_Grammar_Main is function Create_Productions return WisiToken.Syntax_Trees.Production_Info_Trees.Vector is begin return Result : WisiToken.Syntax_Trees.Production_Info_Trees.Vector do - Result.Set_First_Last (43, 66); - Result (48).RHSs.Set_First_Last (0, 15); + Result.Set_First_Last (43, 68); + Result (48).RHSs.Set_First_Last (0, 16); Result (48).RHSs (0).In_Parse_Action := null; Result (48).RHSs (0).Post_Parse_Action := declaration_0'Access; Result (48).RHSs (1).In_Parse_Action := null; @@ -998,33 +1149,37 @@ package body Wisitoken_Grammar_Main is Result (48).RHSs (14).Post_Parse_Action := declaration_14'Access; Result (48).RHSs (15).In_Parse_Action := null; Result (48).RHSs (15).Post_Parse_Action := declaration_15'Access; - Result (53).RHSs.Set_First_Last (0, 1); + Result (48).RHSs (16).In_Parse_Action := null; + Result (48).RHSs (16).Post_Parse_Action := declaration_16'Access; + Result (53).RHSs.Set_First_Last (0, 3); Result (53).RHSs (0).In_Parse_Action := null; Result (53).RHSs (0).Post_Parse_Action := nonterminal_0'Access; Result (53).RHSs (1).In_Parse_Action := null; Result (53).RHSs (1).Post_Parse_Action := nonterminal_1'Access; - Result (60).RHSs.Set_First_Last (0, 5); - Result (60).RHSs (0).In_Parse_Action := null; - Result (60).RHSs (0).Post_Parse_Action := null; - Result (60).RHSs (1).In_Parse_Action := null; - Result (60).RHSs (1).Post_Parse_Action := rhs_item_1'Access; - Result (60).RHSs (2).In_Parse_Action := null; - Result (60).RHSs (2).Post_Parse_Action := rhs_item_2'Access; - Result (60).RHSs (3).In_Parse_Action := null; - Result (60).RHSs (3).Post_Parse_Action := rhs_item_3'Access; - Result (60).RHSs (4).In_Parse_Action := null; - Result (60).RHSs (4).Post_Parse_Action := rhs_item_4'Access; - Result (60).RHSs (5).In_Parse_Action := null; - Result (60).RHSs (5).Post_Parse_Action := rhs_item_5'Access; - Result (62).RHSs.Set_First_Last (0, 3); - Result (62).RHSs (0).In_Parse_Action := null; - Result (62).RHSs (0).Post_Parse_Action := null; - Result (62).RHSs (1).In_Parse_Action := null; - Result (62).RHSs (1).Post_Parse_Action := null; - Result (62).RHSs (2).In_Parse_Action := null; - Result (62).RHSs (2).Post_Parse_Action := null; - Result (62).RHSs (3).In_Parse_Action := null; - Result (62).RHSs (3).Post_Parse_Action := rhs_optional_item_3'Access; + Result (53).RHSs (2).In_Parse_Action := null; + Result (53).RHSs (2).Post_Parse_Action := nonterminal_2'Access; + Result (53).RHSs (3).In_Parse_Action := null; + Result (53).RHSs (3).Post_Parse_Action := nonterminal_3'Access; + Result (61).RHSs.Set_First_Last (0, 4); + Result (61).RHSs (0).In_Parse_Action := null; + Result (61).RHSs (0).Post_Parse_Action := null; + Result (61).RHSs (1).In_Parse_Action := null; + Result (61).RHSs (1).Post_Parse_Action := rhs_item_1'Access; + Result (61).RHSs (2).In_Parse_Action := null; + Result (61).RHSs (2).Post_Parse_Action := rhs_item_2'Access; + Result (61).RHSs (3).In_Parse_Action := null; + Result (61).RHSs (3).Post_Parse_Action := rhs_item_3'Access; + Result (61).RHSs (4).In_Parse_Action := null; + Result (61).RHSs (4).Post_Parse_Action := rhs_item_4'Access; + Result (63).RHSs.Set_First_Last (0, 3); + Result (63).RHSs (0).In_Parse_Action := null; + Result (63).RHSs (0).Post_Parse_Action := null; + Result (63).RHSs (1).In_Parse_Action := null; + Result (63).RHSs (1).Post_Parse_Action := null; + Result (63).RHSs (2).In_Parse_Action := null; + Result (63).RHSs (2).Post_Parse_Action := null; + Result (63).RHSs (3).In_Parse_Action := null; + Result (63).RHSs (3).Post_Parse_Action := rhs_optional_item_3'Access; end return; end Create_Productions; diff --git a/wisitoken_grammar_main.ads b/wisitoken_grammar_main.ads index 1e7b6f9..c5a6cda 100644 --- a/wisitoken_grammar_main.ads +++ b/wisitoken_grammar_main.ads @@ -2,7 +2,7 @@ -- command line: wisitoken-bnf-generate.exe --generate LALR Ada re2c PROCESS wisitoken_grammar.wy -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- Author: Stephen Leake <stephe-leake@stephe-leake.org> -- @@ -19,7 +19,7 @@ -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License --- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +-- along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. with WisiToken.Syntax_Trees; with WisiToken.Parse.LR.Parser_No_Recover; diff --git a/wisitoken_grammar_re2c.c b/wisitoken_grammar_re2c.c index 712d5eb..23eebce 100644 --- a/wisitoken_grammar_re2c.c +++ b/wisitoken_grammar_re2c.c @@ -4,7 +4,7 @@ // command line: wisitoken-bnf-generate.exe --generate LALR Ada re2c wisitoken_grammar.wy // -// Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +// Copyright (C) 2017 - 2023 Free Software Foundation, Inc. // // Author: Stephen Leake <stephe-leake@stephe-leake.org> // @@ -21,7 +21,7 @@ // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License -// along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +// along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. #include <stddef.h> #include <stdio.h> diff --git a/wisitoken_grammar_re2c_c.ads b/wisitoken_grammar_re2c_c.ads index c9d4c55..5807322 100644 --- a/wisitoken_grammar_re2c_c.ads +++ b/wisitoken_grammar_re2c_c.ads @@ -2,7 +2,7 @@ -- command line: wisitoken-bnf-generate.exe --generate LALR Ada re2c wisitoken_grammar.wy -- --- Copyright (C) 2017 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc. -- -- Author: Stephen Leake <stephe-leake@stephe-leake.org> -- @@ -19,7 +19,7 @@ -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License --- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +-- along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. with Interfaces.C; with WisiToken; diff --git a/wisitoken_grammar_runtime.adb b/wisitoken_grammar_runtime.adb index 6639f88..8972f29 100644 --- a/wisitoken_grammar_runtime.adb +++ b/wisitoken_grammar_runtime.adb @@ -2,7 +2,7 @@ -- -- See spec. -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -113,7 +113,7 @@ package body WisiToken_Grammar_Runtime is function Get_RHS (Data : in out User_Data_Type; - Tree : in Syntax_Trees.Tree; + Tree : in out Syntax_Trees.Tree; Labels : in out WisiToken.BNF.String_Arrays.Vector; Token : in Syntax_Trees.Valid_Node_Access) return WisiToken.BNF.RHS_Type @@ -126,60 +126,108 @@ package body WisiToken_Grammar_Runtime is return RHS : WisiToken.BNF.RHS_Type do RHS.Source_Line := Tree.Line_Region (Token, Trailing_Non_Grammar => True).First; - if Tree.Augmented (Token) /= null then + if Tree.Augmented (Token) = null then + RHS.Orig_EBNF_RHS := True; + else declare Aug : constant Augmented_Access := Augmented_Access (Tree.Augmented (Token)); begin + RHS.Orig_EBNF_RHS := Aug.Orig_EBNF_RHS; + RHS.EBNF_RHS_Index := Aug.EBNF_RHS_Index; RHS.Auto_Token_Labels := Aug.Auto_Token_Labels; - RHS.Edited_Token_List := Aug.Edited_Token_List; end; end if; if Children'Length > 0 then - for I of Tree.Get_IDs (Children (1), +rhs_element_ID) loop - case Tree.RHS_Index (I) is - when 0 => - -- rhs_item - RHS.Tokens.Append - (WisiToken.BNF.Labeled_Token' - (Label => +"", - Identifier => +Get_Text (Data, Tree, Tree.Child (I, 1)))); - - when 1 => - -- IDENTIFIER = rhs_item + declare + use WisiToken.Syntax_Trees; + + Attr_List : Node_Access := Invalid_Node_Access; + RHS_Item_List : Node_Access; + Action_1 : Node_Access := Invalid_Node_Access; + Action_2 : Node_Access := Invalid_Node_Access; + begin + if Tree.ID (Children (1)) = +rhs_item_list_ID then + RHS_Item_List := Children (1); + if Children'Last > 1 then + Action_1 := Children (2); + end if; + if Children'Last > 2 then + Action_2 := Children (3); + end if; + + else + Attr_List := Children (1); + RHS_Item_List := Children (2); + if Children'Last > 2 then + Action_1 := Children (3); + end if; + if Children'Last > 3 then + Action_2 := Children (4); + end if; + end if; + + RHS.Associativity := Get_Associativity (Data, Tree, Attr_List); + RHS.Precedence := Get_Precedence (Data, Tree, Attr_List); + + for I of Tree.Get_IDs (RHS_Item_List, +rhs_element_ID) loop declare - Label : constant String := Get_Text (Data, Tree, Tree.Child (I, 1)); + Orig_Token_Index : constant SAL.Base_Peek_Type := + (if RHS.Orig_EBNF_RHS or Tree.Augmented (I) = null then 0 + else WisiToken_Grammar_Runtime.Augmented (Tree.Augmented (I).all).Orig_Token_Index); begin - RHS.Tokens.Append - (WisiToken.BNF.Labeled_Token' - (Label => +Label, - Identifier => +Get_Text (Data, Tree, Tree.Child (I, 3)))); + -- We don't check for non-zero Orig_Token_Index here; that just + -- indicates it's a new item. See subprograms.wy compilation_unit. - if (for all L of Labels => -L /= Label) then - Labels.Append (+Label); - end if; - end; + case Tree.RHS_Index (I) is + when 0 => - when others => - WisiToken.Syntax_Trees.LR_Utils.Raise_Programmer_Error ("Get_RHS; unimplemented token", Tree, I); - end case; - end loop; + -- rhs_item + RHS.Tokens.Append + (WisiToken.BNF.Labeled_Token' + (Label => +"", + Orig_Token_Index => Orig_Token_Index, + Identifier => +Get_Text (Data, Tree, Tree.Child (I, 1)))); - if Children'Last >= 2 then - declare - Text : constant String := Get_Text (Data, Tree, Children (2)); - begin - if Text'Length > 0 and (for some C of Text => C /= ' ') then - RHS.Action := +Text; - Data.Action_Count := Data.Action_Count + 1; - end if; - end; - end if; + when 1 => + -- IDENTIFIER = rhs_item + declare + Label : constant String := Get_Text (Data, Tree, Tree.Child (I, 1)); + begin + RHS.Tokens.Append + (WisiToken.BNF.Labeled_Token' + (Label => +Label, + Orig_Token_Index => Orig_Token_Index, + Identifier => +Get_Text (Data, Tree, Tree.Child (I, 3)))); + + if (for all L of Labels => -L /= Label) then + Labels.Append (+Label); + end if; + end; - if Children'Last >= 3 then - RHS.Check := +Get_Text (Data, Tree, Children (3)); - Data.Check_Count := Data.Check_Count + 1; - end if; + when others => + WisiToken.Syntax_Trees.LR_Utils.Raise_Programmer_Error + ("Get_RHS; unimplemented token", Tree, I); + end case; + end; + end loop; + + if Action_1 /= Invalid_Node_Access then + declare + Text : constant String := Get_Text (Data, Tree, Action_1); + begin + if Text'Length > 0 and (for some C of Text => C /= ' ') then + RHS.Post_Parse_Action := +Text; + Data.Post_Parse_Action_Count := Data.Post_Parse_Action_Count + 1; + end if; + end; + end if; + + if Action_2 /= Invalid_Node_Access then + RHS.In_Parse_Action := +Get_Text (Data, Tree, Action_2); + Data.In_Parse_Action_Count := Data.In_Parse_Action_Count + 1; + end if; + end; end if; end return; exception @@ -194,7 +242,12 @@ package body WisiToken_Grammar_Runtime is begin WisiToken.Syntax_Trees.LR_Utils.Raise_Programmer_Error ("Get_RHS: " & Exception_Name (E) & ": " & Exception_Message (E), Tree, Token); - raise; -- WORKAROUND; GNAT pro_22.0w-20201222 ignores 'pragma no_return' on Raise_Programmer_Error + + -- WORKAROUND; GNAT pro_22.0w-20201222 ignores 'pragma + -- no_return' on Raise_Programmer_Error; uncomment 'raise' for that + -- compiler. + -- + -- raise; end; end if; end Get_RHS; @@ -250,47 +303,74 @@ package body WisiToken_Grammar_Runtime is overriding function Copy_Augmented (User_Data : in User_Data_Type; - Augmented : in WisiToken.Syntax_Trees.Augmented_Class_Access) + Augmented : in not null WisiToken.Syntax_Trees.Augmented_Class_Access) return WisiToken.Syntax_Trees.Augmented_Class_Access is Old_Aug : WisiToken_Grammar_Runtime.Augmented renames Augmented_Access (Augmented).all; - New_Aug : constant Augmented_Access := new WisiToken_Grammar_Runtime.Augmented' - (Old_Aug.EBNF, Old_Aug.Auto_Token_Labels, Old_Aug.Edited_Token_List); + New_Aug : constant Augmented_Access := new WisiToken_Grammar_Runtime.Augmented'(Old_Aug); begin return WisiToken.Syntax_Trees.Augmented_Class_Access (New_Aug); end Copy_Augmented; - overriding procedure Reset (Data : in out User_Data_Type) + overriding + function Image_Augmented (Item : in Augmented) return String + -- This is for debugging, so it is only updated to match current code + -- when needed for a debugging session. + is + use all type SAL.Base_Peek_Type; + begin + return + "(" & + (if Item.EBNF then "EBNF, " else "") & + (if Item.Auto_Token_Labels then "Auto_Token_Labels, " else "") & + (if Item.Orig_EBNF_RHS then "Orig_EBNF_RHS, " else "") & + (if not Item.Orig_EBNF_RHS and Item.EBNF_RHS_Index /= Natural'Last + then "EBNF_RHS_Index =>" & Item.EBNF_RHS_Index'Image & ", " + else "") & + (if Item.Orig_Token_Index /= 0 then "Orig_Token_Index =>" & Item.Orig_Token_Index'Image & ", " else "") & + ")"; + end Image_Augmented; + + procedure Reset + (Data : in out User_Data_Type; + User_Lexer : in WisiToken.BNF.Lexer_Type; + User_Parser : in WisiToken.BNF.Generate_Algorithm; + Phase : in Action_Phase) is begin - -- Preserve data set in Phase Meta, or by Set_Lexer_Terminals, or by - -- wisitoken-bnf-generate. - - -- Preserve Lexer - -- Preserve User_Lexer - -- Preserve User_Parser - -- Perserve Generate_Set - -- Preserve Meta_Syntax - -- Preserve Phase - -- Preserve Terminals - -- Preserve Non_Grammar - Data.Raw_Code := (others => <>); - Data.Language_Params := - (Case_Insensitive => Data.Language_Params.Case_Insensitive, - Error_Recover => Data.Language_Params.Error_Recover, - others => <>); - Data.Tokens := + Data.User_Parser := User_Parser; + Data.User_Lexer := User_Lexer; + Data.Phase := Phase; + + if Phase = Meta then + WisiToken.BNF.Free (Data.Generate_Set); + Data.EBNF_Ok := False; + Data.Meta_Syntax := Unknown; + Data.Precedence_Map.Clear; + Data.Precedence_Inverse_Map.Clear; + Data.Precedence_Lists.Clear; + end if; + + Data.Raw_Code := (others => <>); + + Data.Language_Params := + (Case_Insensitive => Data.Language_Params.Case_Insensitive, + Error_Recover => Data.Language_Params.Error_Recover, + others => <>); + + Data.Tokens := (Virtual_Identifiers => Data.Tokens.Virtual_Identifiers, - others => <>); + others => <>); + Data.Suppress.Clear; Data.Conflicts.Clear; - Data.McKenzie_Recover := (others => <>); - Data.Rule_Count := 0; - Data.Action_Count := 0; - Data.Check_Count := 0; - Data.Label_Count := 0; - Data.If_Lexer_Present := False; - Data.If_Parser_Present := False; - Data.Ignore_Lines := False; + Data.McKenzie_Recover := (others => <>); + Data.Rule_Count := 0; + Data.Post_Parse_Action_Count := 0; + Data.In_Parse_Action_Count := 0; + Data.Label_Count := 0; + Data.If_Lexer_Present := False; + Data.If_Parser_Present := False; + Data.Ignore_Lines := False; end Reset; overriding procedure Initialize_Actions @@ -420,7 +500,7 @@ package body WisiToken_Grammar_Runtime is end if; for I in 3 .. SAL.Base_Peek_Type (Children'Length) loop declare - Text : constant String := Get_Text (Data, Tree, Children (I)); + Text : constant String := WisiToken.BNF.To_Lower (Get_Text (Data, Tree, Children (I))); begin if Text = "text_rep" then Tuple.Text_Rep := True; @@ -459,6 +539,34 @@ package body WisiToken_Grammar_Runtime is end if; end; end if; + + elsif Kind = "precedence" then + -- Translate_To_BNF needs this done. + declare + use WisiToken.Syntax_Trees.LR_Utils; + Name_List : constant Constant_List := Creators.Create_List + (Tree, Tree.Child (Nonterm, 3), +declaration_item_list_ID, +declaration_item_ID); + P_List : WisiToken.Precedence_Lists.List; + begin + for Item of Name_List loop + declare + Name : constant String := Get_Text (Data, Tree, Item); + Found : constant Precedence_Maps.Cursor := Data.Precedence_Map.Find (Name); + P_ID : WisiToken.Precedence_ID; + begin + if not Precedence_Maps.Has_Element (Found) then + P_ID := 1 + WisiToken.Base_Precedence_ID (Data.Precedence_Map.Length); + Data.Precedence_Map.Insert (Name, P_ID); + Data.Precedence_Inverse_Map.Append (+Name); + else + P_ID := Data.Precedence_Map (Found); + end if; + P_List.Append (P_ID); + end; + end loop; + Data.Precedence_Lists.Append (P_List); + end; + end if; end; when others => @@ -532,41 +640,7 @@ package body WisiToken_Grammar_Runtime is -- identifier_list children = identifier_list IDENTIFIER_ID -- children = identifier_list IDENTIFIER_ID -- children = IDENTIFIER_ID - function Get_Loc_List return Syntax_Trees.Valid_Node_Access_Array - with Pre => Tree.ID (Tree.Child (Nonterm, 3)) = +identifier_list_ID - is - use WisiToken.Syntax_Trees; - Node : Valid_Node_Access := Tree.Child (Nonterm, 3); - Result : Valid_Node_Access_Array (1 .. 3) := (others => Dummy_Node); - First : SAL.Peek_Type := Result'Last + 1; - begin - loop - pragma Assert (Tree.ID (Node) = +identifier_list_ID); - exit when not Tree.Has_Children (Node); - declare - Children : constant Node_Access_Array := Tree.Children (Node); - begin - if Children'Length = 1 then - -- identifier_list : IDENTIFIER - First := First - 1; - Result (First) := Children (1); - exit; - - elsif Children'Length = 2 then - -- identifier_list : identifier_list IDENTIFIER - First := First - 1; - Result (First) := Children (2); - - Node := Children (1); - else - raise SAL.Programmer_Error; - end if; - end; - end loop; - return Result (First .. Result'Last); - end Get_Loc_List; - - Loc_List : constant Syntax_Trees.Valid_Node_Access_Array := Get_Loc_List; + Loc_List : constant Syntax_Trees.Valid_Node_Access_Array := Get_Code_Location_List (Tree, Nonterm); function Get_Loc (Index : in SAL.Peek_Type) return String is (Tree.Lexer.Buffer_Text (Tree.Byte_Region (Loc_List (Index), Trailing_Non_Grammar => False))); @@ -609,7 +683,8 @@ package body WisiToken_Grammar_Runtime is -- % CONFLICT conflict_item_list ON TOKEN on_symbol [: resolution] -- 1 2 3 4 5 6 7 8 -- - -- conflict_item_list : [action] LHS (| [action] LHS)* + -- conflict_item_list : action LHS (| action LHS)* + -- conflict_item_list : LHS* Conflict_Items : constant Syntax_Trees.Valid_Node_Access_Array := Tree.Get_Terminals (Tree.Child (Nonterm, 3)); @@ -815,6 +890,10 @@ package body WisiToken_Grammar_Runtime is elsif Kind = "partial_recursion" then Data.Language_Params.Recursion_Strategy := Partial; + elsif Kind = "precedence" then + -- Done in meta phase + null; + elsif Kind = "start" then Data.Language_Params.Start_Token := +Get_Text (Data, Tree, Tree.Child (Nonterm, 3)); @@ -852,6 +931,11 @@ package body WisiToken_Grammar_Runtime is LHS_Node : constant Valid_Node_Access := Tree.Child (Nonterm, 1); LHS_String : constant String := Get_Text (Data, Tree, LHS_Node); + Attr_List : constant Node_Access := + (if Tree.ID (Tree.Child (Nonterm, 2)) = +attribute_list_ID + then Tree.Child (Nonterm, 2) + else Invalid_Node_Access); + Right_Hand_Sides : WisiToken.BNF.RHS_Lists.List; Labels : WisiToken.BNF.String_Arrays.Vector; @@ -983,7 +1067,9 @@ package body WisiToken_Grammar_Runtime is Data.Rule_Count := Data.Rule_Count + 1; - Get_Right_Hand_Sides (Data, Tree, Right_Hand_Sides, Labels, Tree.Child (Nonterm, 3)); + Get_Right_Hand_Sides + (Data, Tree, Right_Hand_Sides, Labels, Tree.Child + (Nonterm, (if Attr_List = Invalid_Node_Access then 3 else 4))); if WisiToken.BNF.Is_Present (Data.Tokens.Rules, LHS_String) then case Tree.Label (LHS_Node) is @@ -999,14 +1085,22 @@ package body WisiToken_Grammar_Runtime is else Data.Label_Count := Data.Label_Count + Labels.Length; - Data.Tokens.Rules.Append - ((+LHS_String, Right_Hand_Sides, Labels, - Optimized_List => Is_Optimized_List, - Source_Line => - (case Tree.Label (LHS_Node) is - when Source_Terminal => Tree.Line_Region (LHS_Node, Trailing_Non_Grammar => True).First, - when Virtual_Identifier => Line_Number_Type'First, -- IMPROVEME: get line from Right_Hand_Sides - when others => raise SAL.Programmer_Error))); + declare + -- Work around "unspecified order" warning; Tree is 'in out' in Get_Precedence. + Prec : constant WisiToken.Base_Precedence_ID := Get_Precedence (Data, Tree, Attr_List); + begin + Data.Tokens.Rules.Append + ((Left_Hand_Side => +LHS_String, + Precedence => Prec, + Right_Hand_Sides => Right_Hand_Sides, + Labels => Labels, + Optimized_List => Is_Optimized_List, + Source_Line => + (case Tree.Label (LHS_Node) is + when Source_Terminal => Tree.Line_Region (LHS_Node, Trailing_Non_Grammar => True).First, + when Virtual_Identifier => Line_Number_Type'First, -- IMPROVEME: get line from Right_Hand_Sides + when others => raise SAL.Programmer_Error))); + end; end if; end Add_Nonterminal; @@ -1037,6 +1131,80 @@ package body WisiToken_Grammar_Runtime is end case; end Check_EBNF; + function Get_Associativity + (Data : in User_Data_Type; + Tree : in out WisiToken.Syntax_Trees.Tree; + Attr_List : in WisiToken.Syntax_Trees.Node_Access) + return WisiToken.Associativity + is + use WisiToken.Syntax_Trees; + begin + if Attr_List = Invalid_Node_Access then + return WisiToken.None; + else + declare + List : constant LR_Utils.Constant_List := LR_Utils.Creators.Create_List + (Tree => Tree, + Root => Attr_List, + List_ID => +attribute_list_ID, + Element_ID => +attribute_ID); + begin + for Attr of List loop + if Get_Text (Data, Tree, Tree.Child (Attr, 2)) = "assoc" then + declare + Name : constant String := Get_Text (Data, Tree, Tree.Child (Attr, 4)); + begin + return WisiToken.Associativity'Value (Name); + exception + when Constraint_Error => + Put_Error + (Tree.Error_Message + (Attr_List, "invalid associativity name '" & Name & "'; must be 'left' or 'right'")); + end; + end if; + end loop; + end; + return WisiToken.None; + end if; + end Get_Associativity; + + function Get_Precedence + (Data : in User_Data_Type; + Tree : in out WisiToken.Syntax_Trees.Tree; + Attr_List : in WisiToken.Syntax_Trees.Node_Access) + return WisiToken.Base_Precedence_ID + is + use WisiToken.Syntax_Trees; + begin + if Attr_List = Invalid_Node_Access then + return WisiToken.No_Precedence; + else + declare + List : constant LR_Utils.Constant_List := LR_Utils.Creators.Create_List + (Tree => Tree, + Root => Attr_List, + List_ID => +attribute_list_ID, + Element_ID => +attribute_ID); + begin + for Attr of List loop + if Get_Text (Data, Tree, Tree.Child (Attr, 2)) = "prec" then + declare + Name : constant String := Get_Text (Data, Tree, Tree.Child (Attr, 4)); + Found : constant WisiToken.Precedence_Maps.Cursor := Data.Precedence_Map.Find (Name); + begin + if WisiToken.Precedence_Maps.Has_Element (Found) then + return Data.Precedence_Map (Found); + else + Put_Error (Tree.Error_Message (Attr_List, "undeclared precedence name '" & Name & "'")); + end if; + end; + end if; + end loop; + end; + return WisiToken.No_Precedence; + end if; + end Get_Precedence; + function Get_Text (Virtual_Identifiers : in WisiToken.BNF.String_Arrays.Vector; Tree : in WisiToken.Syntax_Trees.Tree; @@ -1054,7 +1222,7 @@ package body WisiToken_Grammar_Runtime is -- Strip delimiters. We don't strip leading/trailing spaces to preserve indent. return Tree.Lexer.Buffer_Text ((Region.First + 2, Region.Last - 2)); - elsif -Tree.ID (Tree_Index) in STRING_LITERAL_1_ID | STRING_LITERAL_2_ID and Strip_Quotes then + elsif -Tree.ID (Tree_Index) in STRING_LITERAL_DOUBLE_ID | STRING_LITERAL_SINGLE_ID and Strip_Quotes then return Tree.Lexer.Buffer_Text ((Region.First + 1, Region.Last - 1)); else return Tree.Lexer.Buffer_Text (Region); @@ -1103,6 +1271,43 @@ package body WisiToken_Grammar_Runtime is end case; end Get_Text; + function Get_Code_Location_List + (Tree : in WisiToken.Syntax_Trees.Tree; + Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access) + return Syntax_Trees.Valid_Node_Access_Array + is + use all type SAL.Base_Peek_Type; + use WisiToken.Syntax_Trees; + Node : Valid_Node_Access := Tree.Child (Nonterm, 3); + Result : Valid_Node_Access_Array (1 .. 3) := (others => Dummy_Node); + First : SAL.Peek_Type := Result'Last + 1; + begin + loop + pragma Assert (Tree.ID (Node) = +identifier_list_ID); + exit when not Tree.Has_Children (Node); + declare + Children : constant Node_Access_Array := Tree.Children (Node); + begin + if Children'Length = 1 then + -- identifier_list : IDENTIFIER + First := First - 1; + Result (First) := Children (1); + exit; + + elsif Children'Length = 2 then + -- identifier_list : identifier_list IDENTIFIER + First := First - 1; + Result (First) := Children (2); + + Node := Children (1); + else + raise SAL.Programmer_Error; + end if; + end; + end loop; + return Result (First .. Result'Last); + end Get_Code_Location_List; + end WisiToken_Grammar_Runtime; -- Local Variables: -- ada-case-strict: nil diff --git a/wisitoken_grammar_runtime.ads b/wisitoken_grammar_runtime.ads index 24fbe23..8b12178 100644 --- a/wisitoken_grammar_runtime.ads +++ b/wisitoken_grammar_runtime.ads @@ -2,7 +2,7 @@ -- -- Runtime utils for wisitoken_grammar.wy actions. -- --- Copyright (C) 2018 - 2022 Free Software Foundation, Inc. +-- Copyright (C) 2018 - 2023 Free Software Foundation, Inc. -- -- 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 @@ -23,6 +23,7 @@ with WisiToken.BNF; with WisiToken.Syntax_Trees; with Wisitoken_Grammar_Actions; package WisiToken_Grammar_Runtime is + use all type WisiToken.Token_ID; use all type WisiToken.Syntax_Trees.Node_Access; use all type Wisitoken_Grammar_Actions.Token_Enum_ID; @@ -41,18 +42,22 @@ package WisiToken_Grammar_Runtime is -- Used to read the user language file; used now in '%if parser' -- statements. - Generate_Set : WisiToken.BNF.Generate_Set_Access; - -- As specified by %generate directives or command line. - Phase : Action_Phase := Meta; -- Determines which actions Execute_Actions executes: -- Meta - meta declarations, like %meta_syntax, %if, %generate -- Other - everything else + Generate_Set : WisiToken.BNF.Generate_Set_Access; + -- As specified by %generate directives or command line. + EBNF_Ok : Boolean := False; -- Set True when don't need to translate EBNF to BNF. - Meta_Syntax : WisiToken_Grammar_Runtime.Meta_Syntax := Unknown; + Meta_Syntax : WisiToken_Grammar_Runtime.Meta_Syntax := Unknown; + Precedence_Map : WisiToken.Precedence_Maps.Map; + Precedence_Inverse_Map : WisiToken.Precedence_Inverse_Maps.Vector; + Precedence_Lists : WisiToken.Precedence_Lists_Arrays.Vector; + Raw_Code : WisiToken.BNF.Raw_Code; Language_Params : WisiToken.BNF.Language_Param_Type; Tokens : aliased WisiToken.BNF.Tokens; @@ -60,14 +65,14 @@ package WisiToken_Grammar_Runtime is Suppress : WisiToken.BNF.String_Pair_Lists.List; -- Declaration name, warning label; suppress warnings. - Conflicts : WisiToken.BNF.Conflict_Lists.List; - McKenzie_Recover : WisiToken.BNF.McKenzie_Recover_Param_Type; - Max_Parallel : SAL.Base_Peek_Type := 15; + Conflicts : WisiToken.BNF.Conflict_Lists.List; + McKenzie_Recover : WisiToken.BNF.McKenzie_Recover_Param_Type; + Max_Parallel : SAL.Base_Peek_Type := 15; - Rule_Count : Integer := 0; - Action_Count : Integer := 0; - Check_Count : Integer := 0; - Label_Count : Ada.Containers.Count_Type := 0; + Rule_Count : Integer := 0; + Post_Parse_Action_Count : Integer := 0; + In_Parse_Action_Count : Integer := 0; + Label_Count : Ada.Containers.Count_Type := 0; If_Lexer_Present : Boolean := False; If_Parser_Present : Boolean := False; @@ -90,24 +95,40 @@ package WisiToken_Grammar_Runtime is -- Valid in an RHS node; True when token labels are generated by -- Translate_EBNF_To_BNF - Edited_Token_List : Boolean := False; - -- Valid in an RHS node; matches Wisitoken.BNF RHS.Edited_Token_List + Orig_EBNF_RHS : Boolean := False; + -- Valid in an rhs node; True if this RHS is either an unedited RHS, + -- or the only edits were to substitute token literals and keep + -- optional items or items from a simple group. This means the token + -- count is the same as in the original, which is used by + -- Output_Ada_Emacs to map tokens to actions. + + EBNF_RHS_Index : Natural := Natural'Last; + -- Valid in an rhs node; Index of RHS containing EBNF RHS that this + -- RHS was copied from. + + Orig_Token_Index : SAL.Base_Peek_Type := 0; + -- Valid in an rhs_element node; index in EBNF_RHS.Tokens that this + -- token was copied from. + end record; type Augmented_Access is access all Augmented; type Augmented_Access_Constant is access constant Augmented; - function Image (Item : in WisiToken.Syntax_Trees.Augmented_Class_Access_Constant) return String - is (Augmented_Access_Constant (Item).EBNF'Image & " " & - Augmented_Access_Constant (Item).Auto_Token_Labels'Image & " " & - Augmented_Access_Constant (Item).Edited_Token_List'Image); + overriding + function Image_Augmented (Item : in Augmented) return String; overriding function Copy_Augmented (User_Data : in User_Data_Type; - Augmented : in WisiToken.Syntax_Trees.Augmented_Class_Access) + Augmented : in not null WisiToken.Syntax_Trees.Augmented_Class_Access) return WisiToken.Syntax_Trees.Augmented_Class_Access; - overriding procedure Reset (Data : in out User_Data_Type); + procedure Reset + (Data : in out User_Data_Type; + User_Lexer : in WisiToken.BNF.Lexer_Type; + User_Parser : in WisiToken.BNF.Generate_Algorithm; + Phase : in Action_Phase); + -- If Phase is Other, preserve data set in phase Meta. overriding procedure Initialize_Actions @@ -143,7 +164,10 @@ package WisiToken_Grammar_Runtime is procedure Add_Nonterminal (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; Tree : in out WisiToken.Syntax_Trees.Tree; - Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access); + Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access) + with Pre => Tree.ID (Nonterm) = +nonterminal_ID; + -- Nonterm is a nonterminal definition in the parsed grammar tree; + -- add it to User_Data.Rules. procedure Check_EBNF (User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class; @@ -154,6 +178,24 @@ package WisiToken_Grammar_Runtime is ---------- -- Visible for WisiToken_Grammar_Editing + function Get_Associativity + (Data : in User_Data_Type; + Tree : in out WisiToken.Syntax_Trees.Tree; + Attr_List : in WisiToken.Syntax_Trees.Node_Access) + return WisiToken.Associativity + with Pre => Attr_List = WisiToken.Syntax_Trees.Invalid_Node_Access or else Tree.ID (Attr_List) = +attribute_list_ID; + -- If Attr_List is an attr_list, return the associativity it specifies; + -- otherwise No_Precedence. + + function Get_Precedence + (Data : in User_Data_Type; + Tree : in out WisiToken.Syntax_Trees.Tree; + Attr_List : in WisiToken.Syntax_Trees.Node_Access) + return WisiToken.Base_Precedence_ID + with Pre => Attr_List = WisiToken.Syntax_Trees.Invalid_Node_Access or else Tree.ID (Attr_List) = +attribute_list_ID; + -- If Attr_List is an attr_list, return the precedence it specifies; + -- otherwise No_Precedence. + function Get_Text (Virtual_Identifiers : in WisiToken.BNF.String_Arrays.Vector; Tree : in WisiToken.Syntax_Trees.Tree; @@ -181,4 +223,12 @@ package WisiToken_Grammar_Runtime is -- Find first descendant of Node that has rhs_item_ID, return source -- text for it. + function Get_Code_Location_List + (Tree : in WisiToken.Syntax_Trees.Tree; + Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Access) + return WisiToken.Syntax_Trees.Valid_Node_Access_Array + with Pre => Tree.ID (Tree.Child (Nonterm, 3)) = +identifier_list_ID; + -- Return location from a %code declaration. + + end WisiToken_Grammar_Runtime; |