[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 671729d 2/2: Update ada-mode to version 5.2.2, wisi to ver
|
From: |
Stephen Leake |
|
Subject: |
[elpa] master 671729d 2/2: Update ada-mode to version 5.2.2, wisi to version 1.1.5 |
|
Date: |
Sun, 9 Jul 2017 14:43:30 -0400 (EDT) |
branch: master
commit 671729dad13c4cbca2f4a35f16243066f6e91eeb
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>
Update ada-mode to version 5.2.2, wisi to version 1.1.5
---
packages/ada-mode/NEWS | 49 +-
packages/ada-mode/README | 68 +-
packages/ada-mode/ada-build.el | 4 +-
packages/ada-mode/ada-fix-error.el | 18 +-
packages/ada-mode/ada-gnat-compile.el | 33 +-
packages/ada-mode/ada-gnat-xref.el | 137 +-
packages/ada-mode/ada-gps.el | 466 ++
packages/ada-mode/ada-grammar-wy.el | 839 ++--
packages/ada-mode/ada-indent-user-options.el | 15 +-
...{ada-mode-compat-24.2.el => ada-mode-compat.el} | 18 +-
packages/ada-mode/ada-mode.el | 266 +-
packages/ada-mode/ada-mode.info | 260 +-
packages/ada-mode/ada-mode.texi | 161 +-
packages/ada-mode/ada-skel.el | 32 +-
packages/ada-mode/ada-wisi-opentoken.el | 14 +-
packages/ada-mode/ada-wisi.el | 628 +--
packages/ada-mode/ada_mode_gps_indent.adb | 303 ++
.../{gpr_query.gpr => ada_mode_gps_indent.gpr} | 40 +-
packages/ada-mode/debug_gps_indent.adb | 84 +
packages/ada-mode/gnat-core.el | 61 +-
packages/ada-mode/gpr-grammar-wy.el | 244 +-
packages/ada-mode/gpr-mode.el | 0
packages/ada-mode/gpr-mode.info | 2 +-
packages/ada-mode/gpr-query.el | 174 +-
packages/ada-mode/gpr_query-process_refresh.adb.gp | 33 +
packages/ada-mode/gpr_query.adb | 26 +-
.../ada-mode/{gpr_query.gpr => gpr_query.gpr.gp} | 3 +
packages/ada-mode/gps_source/ada_analyzer.adb | 4834 ++++++++++++++++++++
packages/ada-mode/gps_source/ada_analyzer.ads | 76 +
packages/ada-mode/gps_source/basic_types.adb | 147 +
packages/ada-mode/gps_source/basic_types.ads | 166 +
packages/ada-mode/gps_source/case_handling.adb | 314 ++
packages/ada-mode/gps_source/case_handling.ads | 124 +
packages/ada-mode/gps_source/config.ads | 34 +
packages/ada-mode/gps_source/generic_stack.adb | 126 +
packages/ada-mode/gps_source/generic_stack.ads | 74 +
packages/ada-mode/gps_source/indent_stack.ads | 32 +
packages/ada-mode/gps_source/language.adb | 1052 +++++
packages/ada-mode/gps_source/language.ads | 864 ++++
packages/ada-mode/gps_source/string_utils.adb | 1364 ++++++
packages/ada-mode/gps_source/string_utils.ads | 353 ++
packages/ada-mode/gps_source/utf8_utils.adb | 313 ++
packages/ada-mode/gps_source/utf8_utils.ads | 101 +
packages/ada-ref-man/README | 7 -
packages/wisi/NEWS | 15 +
packages/wisi/README | 13 +-
packages/wisi/wisi-compile.el | 13 +-
packages/wisi/wisi-parse.el | 2 -
packages/wisi/wisi.el | 142 +-
49 files changed, 12833 insertions(+), 1311 deletions(-)
diff --git a/packages/ada-mode/NEWS b/packages/ada-mode/NEWS
old mode 100644
new mode 100755
index 328c436..e9f0990
--- a/packages/ada-mode/NEWS
+++ b/packages/ada-mode/NEWS
@@ -1,12 +1,51 @@
GNU Emacs Ada mode NEWS -- history of user-visible changes.
-Copyright (C) 2014 Free Software Foundation, Inc.
-See the end of the file for license conditions.
+
+* Ada mode 5.2.2
+9 Jul 2017
-Please send Emacs Ada mode bug reports to address@hidden, with
-'ada-mode' in the subject. If possible, use M-x report-emacs-bug.
+** GNAT GPL 2017 is _not_ supported for gpr_query; GNAT GPL 2016 is
+ supported.
+
+** New option ada-indent-hanging-rel-exp; if non-nil, indent hanging
+ lines relative to start of expression. Otherwise, indent relative
+ to previous line. Default nil.
+
+** xref-ada allows entering an identifier to search for without
+ completion. The search is only in the current file.
+
+** ada-show-references, ada-show-local-references now take an 'append'
+ argument, set by interactive prefix; if non-nil, preserve previous
+ output in references buffer.
+
+** Support GPS indentation engine, either as primary or backup. See
+ user guide for how to set it up; it requires compiling Ada code.
+
+** ada_mode_gps_indent patch level 001 fixes ada-gps bugs 2, 6. See
+ test/ada-gps for bug descriptions/tests.
+
+** ada-identifier-at-point properly handles adjacent operator and
+ identifier (ie +Tree).
+
+** When a 'use type' clause is inserted by the compile error
+ correction code, 'use all type' is inserted if the lanuage version
+ is 2012 (the default).
+
+** The context menu is simplified.
+
+** The 'obj_dir' project variable is supported.
+
+** ada-next-statement-keyword, ada-prev-statement-keyword are deleted;
+ use forward-sexp instead.
+
+** The license inserted by ada-skel-modified-gpl uses GPL version 3
+ language.
+
+** Several indentation bugs are fixed.
+
+** New option ada-gnat-debug-run controls echoing GNAT commands in
+ GNAT buffers.
-
* Ada mode 5.2.1
31 Oct 2016
diff --git a/packages/ada-mode/README b/packages/ada-mode/README
index 384e3ef..fee5577 100755
--- a/packages/ada-mode/README
+++ b/packages/ada-mode/README
@@ -1,40 +1,30 @@
-Emacs Ada mode version 5.2.1
+Emacs Ada mode version 5.2.2
+
+Ada mode provides auto-casing, fontification, navigation, and
+indentation for Ada source code files.
+
+Cross-reference information output by the compiler is used to provide
+powerful code navigation (jump to definition, find all uses, etc). By
+default, only the AdaCore GNAT compiler is supported; other compilers
+can be supported. Ada mode uses gpr_query to query compiler-generated
+cross reference information. gpr_query is provided as Ada source code
+that must be compiled and installed; see ada-mode.info section
+Installation for instructions.
+
+Ada mode will be automatically loaded when you open a file
+with a matching extension (default *.ads, *.adb).
+
+Ada mode uses project files to define large (multi-directory)
+projects, and to define casing exceptions.
+
+Ada mode uses a parser implemented in elisp, which can be slow on
+large files. In addition, the parser does not recover from syntax
+errors. There is support for running the AdaCore GPS indentation
+engine in a subprocess, either as a backup when the elisp parser
+fails, or as the primary indentation engine. The GPS indentation
+engine must be compiled; see ada-mode.info section ada-gps for
+instructions.
+
+See ada-mode.info for help on using and customizing Ada mode, and
+notes for Ada mode developers.
-Ada mode requires Emacs 24.2 or greater
-
-See ada-mode.texi (or a compiled version) for help on using and
-customizing Ada mode, upgrading from previous versions, and notes for
-Ada mode developers.
-
-Ada mode is provided as a Gnu ELPA package; to install the package,
-add to ~./emacs:
-
-(package-initialize)
-
-then invoke M-x list-packages, install Ada mode.
-
-Note that you must have the Emacs lisp sources installed; that's a
-separate package in some distributions.
-
-To install Ada mode, gpr mode, and associated utilities from this distribution:
-
-Unzip to a convenient place (we will use ~/ada-mode in the following).
-
-In a shell:
-$ cd ~/ada-mode/build/wisi
-$ make byte-compile
-
-Edit your ~/.emacs, add:
-
-(add-to-list 'load-path (expand-file-name "~/ada-mode"))
-
-
-Ada mode will be automatically loaded when you open a file with a
-matching extension (default *.ads, *.adb).
-
-
-By default ada-mode uses gnat find for cross-reference functions.
-There is support for an alternative: gpr_query. See ada-mode.texi
-section Installation for more.
-
-(end of file)
diff --git a/packages/ada-mode/ada-build.el b/packages/ada-mode/ada-build.el
index c166edd..f160ec9 100644
--- a/packages/ada-mode/ada-build.el
+++ b/packages/ada-mode/ada-build.el
@@ -1,7 +1,7 @@
;; ada-build.el --- Extensions to ada-mode for compiling and running -*-
lexical-binding:t -*-
;; Ada projects without 'make' or similar tool
;;
-;; Copyright (C) 1994, 1995, 1997 - 2016 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1997 - 2017 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
@@ -34,8 +34,6 @@
;; compiling and running capabilities in Ada mode 4.01, done in 2013 by
;; Stephen Leake <address@hidden>.
-(require 'ada-mode-compat-24.2)
-
(require 'ada-mode)
(require 'cl-lib)
diff --git a/packages/ada-mode/ada-fix-error.el
b/packages/ada-mode/ada-fix-error.el
index 130bb3e..59d4616 100644
--- a/packages/ada-mode/ada-fix-error.el
+++ b/packages/ada-mode/ada-fix-error.el
@@ -1,7 +1,7 @@
;;; ada-fix-error.el --- utilities for automatically fixing -*-
lexical-binding:t -*-
;; errors reported by the compiler.
-;; Copyright (C) 1999-2009, 2012-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2009, 2012-2015, 2017 Free Software Foundation, Inc.
;; Author : Stephen Leake <address@hidden>
;; Maintainer : Stephen Leake <address@hidden>
@@ -157,20 +157,18 @@ extend a with_clause to include CHILD-NAME . "
(defun ada-fix-add-use-type (type)
"Insert `use type' clause for TYPE at start of declarative part for current
construct."
(ada-goto-declarative-region-start); leaves point after 'is'
- (newline)
- (insert "use type " type ";")
(newline-and-indent)
- (forward-line -1)
- (indent-according-to-mode))
+ (cl-ecase ada-language-version
+ (ada2012
+ (insert "use all type " type ";"))
+ ((ada83 ada95 ada2005)
+ (insert "use type " type ";"))))
(defun ada-fix-add-use (package)
"Insert `use' clause for PACKAGE at start of declarative part for current
construct."
(ada-goto-declarative-region-start); leaves point after 'is'
- (newline)
- (insert "use " package ";")
(newline-and-indent)
- (forward-line -1)
- (indent-according-to-mode))
+ (insert "use " package ";"))
(defvar ada-fix-error-hook nil
;; determined by ada_compiler, set by *-select-prj-compiler
@@ -206,7 +204,7 @@ point and return nil.")
(with-current-buffer compilation-last-buffer
(when (not (ada-get-compilation-message))
(beep)
- (message "FIXME: ada-fix-compiler-error")
+ (message "ada-fix-compiler-error")
;; not clear why this can happen, but it has
(compilation-next-error 1))
(let ((comp-buf-pt (point))
diff --git a/packages/ada-mode/ada-gnat-compile.el
b/packages/ada-mode/ada-gnat-compile.el
old mode 100644
new mode 100755
index 9582f84..87833a8
--- a/packages/ada-mode/ada-gnat-compile.el
+++ b/packages/ada-mode/ada-gnat-compile.el
@@ -6,7 +6,7 @@
;;
;; GNAT is provided by AdaCore; see http://libre.adacore.com/
;;
-;;; Copyright (C) 2012 - 2016 Free Software Foundation, Inc.
+;;; Copyright (C) 2012 - 2017 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
@@ -37,6 +37,7 @@
(require 'cl-lib)
(require 'compile)
(require 'gnat-core)
+(require 'ada-fix-error)
;;;;; code
@@ -92,7 +93,7 @@ For `compilation-filter-hook'."
(list
(match-string-no-properties 2); file
(string-to-number (match-string-no-properties 3)); line
- 1)); column
+ 0)); Emacs column; zero indexed
))
(when (search-forward-regexp "\\(at line \\)\\([0-9]+\\)"
(line-end-position) t)
@@ -305,7 +306,13 @@ Prompt user if more than one."
t)
;;;; strings
- ((looking-at (concat "misspelling of " ada-gnat-quoted-name-regexp))
+ ((looking-at "package \"Ada\" is hidden")
+ (pop-to-buffer source-buffer)
+ (forward-word -1)
+ (insert "Standard.")
+ t)
+
+ ((looking-at (concat "\\(?:possible \\)?misspelling of "
ada-gnat-quoted-name-regexp))
(let ((expected-name (match-string 1)))
(pop-to-buffer source-buffer)
(looking-at ada-name-regexp)
@@ -417,10 +424,8 @@ Prompt user if more than one."
((looking-at (concat "operator for \\(private \\)?type "
ada-gnat-quoted-name-regexp))
(let ((type (match-string 2)))
(pop-to-buffer source-buffer)
- (ada-goto-declarative-region-start)
- (newline-and-indent)
- (insert "use type " type ";"))
- t)
+ (ada-fix-add-use-type type)
+ t))
((looking-at "parentheses required for unary minus")
(set-buffer source-buffer)
@@ -544,6 +549,13 @@ Prompt user if more than one."
(funcall indent-line-function)
t)
+ ((looking-at "(style) \"exit \\(.*\\)\" required")
+ (let ((name (match-string-no-properties 1)))
+ (set-buffer source-buffer)
+ (forward-word 1)
+ (insert (concat " " name))
+ t))
+
((looking-at "(style) misplaced \"then\"")
(set-buffer source-buffer)
(delete-indentation)
@@ -558,6 +570,11 @@ Prompt user if more than one."
(t
nil)))
+ ((looking-at "(style) reserved words must be all lower case")
+ (set-buffer source-buffer)
+ (downcase-word 1)
+ t)
+
((looking-at "(style) space not allowed")
(set-buffer source-buffer)
;; Error places point on space. More than one trailing space
@@ -585,6 +602,7 @@ Prompt user if more than one."
(add-to-list 'completion-ignored-extensions ".ali") ;; gnat library files
(add-hook 'ada-syntax-propertize-hook 'ada-gnat-syntax-propertize)
(add-hook 'ada-syntax-propertize-hook 'gnatprep-syntax-propertize)
+ (syntax-ppss-flush-cache (point-min));; force re-evaluate with hook.
;; There is no common convention for a file extension for gnatprep files.
;;
@@ -611,6 +629,7 @@ Prompt user if more than one."
(setq completion-ignored-extensions (delete ".ali"
completion-ignored-extensions))
(setq ada-syntax-propertize-hook (delq 'gnatprep-syntax-propertize
ada-syntax-propertize-hook))
(setq ada-syntax-propertize-hook (delq 'ada-gnat-syntax-propertize
ada-syntax-propertize-hook))
+ (syntax-ppss-flush-cache (point-min));; force re-evaluate with hook.
;; don't need to delete from compilation-search-path; completely rewritten
in ada-select-prj-file
(setq compilation-environment nil)
diff --git a/packages/ada-mode/ada-gnat-xref.el
b/packages/ada-mode/ada-gnat-xref.el
old mode 100644
new mode 100755
index 85ffcef..0507356
--- a/packages/ada-mode/ada-gnat-xref.el
+++ b/packages/ada-mode/ada-gnat-xref.el
@@ -5,7 +5,7 @@
;;
;; GNAT is provided by AdaCore; see http://libre.adacore.com/
;;
-;;; Copyright (C) 2012 - 2016 Free Software Foundation, Inc.
+;;; Copyright (C) 2012 - 2017 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
@@ -36,6 +36,7 @@
(require 'ada-fix-error)
(require 'compile)
(require 'gnat-core)
+(defvar ada-gnat-debug-run);; gnat-core requires ada-mode, which requires
ada-gnat-xref
;;;;; code
@@ -43,25 +44,65 @@
(defconst ada-gnat-file-line-col-regexp "\\(.*\\):\\([0-9]+\\):\\([0-9]+\\)")
+(defun ada-gnat-xref-adj-col (identifier col)
+ "Return COL adjusted for 1-index, quoted operators."
+ (cond
+ ((eq ?\" (aref identifier 0))
+ ;; There are two cases here:
+ ;;
+ ;; In both cases, gnat find wants the operators quoted, and the
+ ;; column on the +. Gnat column is one-indexed; emacs is 0 indexed.
+ ;;
+ ;; In the first case, the front end passes in a column on the leading ",
so we add one.
+ ;;
+ ;; In the second case, the front end passes in a column on the +
+ (cond
+ ((= ?\" (char-after (point)))
+ ;; test/ada_mode-slices.adb
+ ;; function "+" (Left : in Day; Right : in Integer) return Day;
+ (+ 2 col))
+
+ (t
+ ;; test/ada_mode-slices.adb
+ ;; D1, D2 : Day := +Sun;
+ (+ 1 col))
+ ))
+
+ (t
+ ;; Gnat column is one-indexed; emacs is 0 indexed.
+ (+ 1 col))
+ ))
+
+(defun ada-gnat-xref-common-cmd ()
+ "Returns the gnatfind command to run to find cross-references."
+ (format "%sgnatfind" (or (ada-prj-get 'target) "")))
+
+(defun ada-gnat-xref-common-args (identifier file line col)
+ "Returns a list of arguments to pass to gnatfind. The caller
+may add more args to the result before calling gnatfind. Some
+elements of the result may be nil."
+ (list "-a"
+ (when ada-xref-full-path "-f")
+ ;; src_dir contains Source_Dirs from gpr_file, Similarly for
+ ;; obj_dir. So we don't need to pass the gpr file.
+ (when (ada-prj-get 'src_dir)
+ (concat "-aI" (mapconcat 'identity (ada-prj-get 'src_dir) ":")))
+ (when (ada-prj-get 'obj_dir)
+ (concat "-aO" (mapconcat 'identity (ada-prj-get 'obj_dir) ":")))
+ (format "%s:%s:%d:%d"
+ identifier
+ (file-name-nondirectory file)
+ line
+ (ada-gnat-xref-adj-col identifier col))))
+
(defun ada-gnat-xref-other (identifier file line col)
- "For `ada-xref-other-function', using `gnat find', which is Ada-specific."
-
- (when (eq ?\" (aref identifier 0))
- ;; gnat find wants the quotes on operators, but the column is after the
first quote.
- (setq col (+ 1 col))
- )
-
- (let* ((file-non-dir (file-name-nondirectory file))
- (arg (format "%s:%s:%d:%d" identifier file-non-dir line col))
- (switches (concat
- "-a"
- (when (ada-prj-get 'gpr_ext) (concat "--ext=" (ada-prj-get
'gpr_ext)))))
- (result nil))
+ "For `ada-xref-other-function', using `gnatfind', which is Ada-specific."
+ (let* ((result nil))
(with-current-buffer (gnat-run-buffer)
- (gnat-run-gnat "find" (list switches arg))
+ (gnat-run (ada-gnat-xref-common-cmd) (ada-gnat-xref-common-args
identifier file line col))
(goto-char (point-min))
- (forward-line 2); skip ADA_PROJECT_PATH, 'gnat find'
+ (when ada-gnat-debug-run (forward-line 2)); skip ADA_PROJECT_PATH, 'gnat
find'
;; gnat find returns two items; the starting point, and the 'other' point
(unless (looking-at (concat ada-gnat-file-line-col-regexp ":"))
@@ -79,9 +120,10 @@
(found-col (string-to-number (match-string 3))))
(if (not
(and
- (equal file-non-dir found-file)
+ ;; due to symbolic links, only the non-dir filename is
comparable.
+ (equal (file-name-nondirectory file) (file-name-nondirectory
found-file))
(= line found-line)
- (= col found-col)))
+ (= (ada-gnat-xref-adj-col identifier col) found-col)))
;; found other item
(setq result (list found-file found-line (1- found-col)))
(forward-line 1))
@@ -93,20 +135,15 @@
result))
(defun ada-gnat-xref-parents (identifier file line col)
- "For `ada-xref-parents-function', using `gnat find', which is Ada-specific."
-
- (let* ((arg (format "%s:%s:%d:%d" identifier file line col))
- (switches (list
- "-a"
- "-d"
- (when (ada-prj-get 'gpr_ext) (concat "--ext=" (ada-prj-get
'gpr_ext)))
- ))
+ "For `ada-xref-parents-function', using `gnatfind', which is Ada-specific."
+
+ (let* ((arg (ada-gnat-xref-common-args identifier file line col))
(result nil))
(with-current-buffer (gnat-run-buffer)
- (gnat-run-gnat "find" (append switches (list arg)))
+ (gnat-run (ada-gnat-xref-common-cmd) (cons "-d" arg))
(goto-char (point-min))
- (forward-line 2); skip GPR_PROJECT_PATH, 'gnat find'
+ (when ada-gnat-debug-run (forward-line 2)); skip GPR_PROJECT_PATH, 'gnat
find'
;; gnat find returns two items; the starting point, and the 'other' point
(unless (looking-at (concat ada-gnat-file-line-col-regexp ":"))
@@ -139,32 +176,48 @@
)
))
-(defun ada-gnat-xref-all (identifier file line col local-only)
+(defun ada-gnat-xref-all (identifier file line col local-only append)
"For `ada-xref-all-function'."
;; we use `compilation-start' to run gnat, not `gnat-run', so it
;; is asynchronous, and automatically runs the compilation error
;; filter.
- (let* ((cmd (format "%sgnat find -a -r %s %s:%s:%d:%d %s"
- (or (ada-prj-get 'target) "")
- (if ada-xref-full-path "-f" "")
- identifier file line col (if local-only file ""))))
+ (let* ((arg (ada-gnat-xref-common-args identifier file line col)))
+ (setq arg (cons "-r" arg))
+ (when local-only (setq arg (append arg (list file))))
(with-current-buffer (gnat-run-buffer); for default-directory
- (let ((compilation-error "reference")
+ (let ((compilation-buffer-name "*gnatfind*")
+ (compilation-error "reference")
+ (command-and-args (mapconcat (lambda (a) (or a ""))
+ (cons (ada-gnat-xref-common-cmd) arg)
+ " "))
;; gnat find uses standard gnu format for output, so don't
;; need to set compilation-error-regexp-alist
- )
+ prev-content)
;; compilation-environment is buffer-local; don't set in 'let'
(setq compilation-environment (ada-prj-get 'proc_env))
- (when (ada-prj-get 'gpr_file)
- (setq cmd (concat cmd " -P" (file-name-nondirectory (ada-prj-get
'gpr_file)))))
-
- (compilation-start cmd
- 'compilation-mode
- (lambda (name) (concat "*" name "-gnatfind*")))
- ))))
+ ;; WORKAROUND: the 'compilation' API doesn't let us specify "append",
so we use this.
+ (with-current-buffer (get-buffer-create compilation-buffer-name)
+ (when append
+ (setq prev-content (buffer-substring (point-min) (point-max))))
+
+ (unless ada-gnat-debug-run
+ ;; hide the command and arguments using text properties, show only
the bare minimum
+ (setq command-and-args
+ (propertize command-and-args
+ 'display
+ (format "References to %s at %s:%d:%d" identifier
file line col))))
+ (compilation-start command-and-args
+ 'compilation-mode
+ (lambda (_name) compilation-buffer-name))
+ (when append
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (goto-char (point-min))
+ (insert prev-content)))))
+ ))))
;;;;; setup
diff --git a/packages/ada-mode/ada-gps.el b/packages/ada-mode/ada-gps.el
new file mode 100755
index 0000000..aa8b345
--- /dev/null
+++ b/packages/ada-mode/ada-gps.el
@@ -0,0 +1,466 @@
+;; Emacs ada-mode indentation engine, using GPS code in a subprocess.
+;;
+;; GNAT is provided by AdaCore; see http://libre.adacore.com/
+;;
+;;; Copyright (C) 2014, 2017 Free Software Foundation, Inc.
+;;
+;; Author: Stephen Leake <address@hidden>
+;; Maintainer: Stephen Leake <address@hidden>
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; 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/>.
+
+(require 'ada-mode)
+(require 'ada-indent-user-options)
+
+(defcustom ada-gps-size-threshold 100000
+ "Max size (in characters) for using ada-wisi indentation engine.
+Buffers larger than this will use ada-gps indentation engine,
+which is faster on large buffers."
+ :type 'integer
+ :group 'ada-indentation
+ :safe 'integerp)
+
+(defvar ada-gps-debug 0)
+
+(defconst ada-gps-indent-exec-api-version "1"
+ "API version of ada_mode_gps_indent executable this code expects.")
+
+(defvar ada-gps-indent-exec-patch-level nil
+ "Patch level of ada_mode_gps_indent executable.")
+
+;;;;; sessions
+
+;; ada_mode_gps_indent runs a loop, waiting for indentation requests.
+;;
+;; We only need one process; there is no persistent state.
+
+(cl-defstruct (ada-gps--session)
+ (process nil) ;; running gpr_query
+ (buffer nil)) ;; receives output of gpr_query
+
+(defvar ada-gps-session
+ (make-ada-gps--session)
+ "The single instance of ada-gps--session")
+
+(defconst ada-gps-buffer-name " *ada_gps*")
+
+;; ada-gps-indent-exec declared in ada-mode for auto-detection of indent engine
+
+(defun ada-gps--start-process ()
+ "Start the session process running ada_gps."
+ (unless (buffer-live-p (ada-gps--session-buffer ada-gps-session))
+ ;; user may have killed buffer
+ (setf (ada-gps--session-buffer ada-gps-session) (get-buffer-create
ada-gps-buffer-name)))
+
+ (let ((process-connection-type nil) ;; use a pipe; no need for \n or flush
on Linux or Windows
+ (exec-file (locate-file ada-gps-indent-exec exec-path '("" ".exe"))))
+ (unless exec-file
+ (error "%s not found on `exec-path'" ada-gps-indent-exec))
+
+ (with-current-buffer (ada-gps--session-buffer ada-gps-session)
+ (erase-buffer); delete any previous messages, prompt
+ (setf (ada-gps--session-process ada-gps-session)
+ (start-process ada-gps-buffer-name (current-buffer) exec-file))
+ (set-process-query-on-exit-flag (ada-gps--session-process
ada-gps-session) nil)
+ (ada-gps-session-wait)
+
+ (ada-gps-check-version)
+ )))
+
+(defun ada-gps-show-proc-id ()
+ "Display ada-gps process id, for attaching with debugger."
+ (interactive)
+ (if (process-live-p (ada-gps--session-process ada-gps-session))
+ (message "ada-gps process id: %d" (process-id (ada-gps--session-process
ada-gps-session)))
+ (message "ada-gps process not live")
+ ))
+
+(defun ada-gps-require-session ()
+ "Create ada-gps session if not active."
+ (unless (and (ada-gps--session-process ada-gps-session)
+ (process-live-p (ada-gps--session-process ada-gps-session)))
+ (ada-gps--start-process)))
+
+(defconst ada-gps-prompt "^GPS_Indent> $"
+ "Regexp matching ada_mode_gps_indent prompt; indicates previous command is
complete.")
+
+(defun ada-gps-session-wait ()
+ "Wait for the current command to complete."
+ (unless (process-live-p (ada-gps--session-process ada-gps-session))
+ (ada-gps-show-buffer)
+ (error "ada-gps process died"))
+
+ (with-current-buffer (ada-gps--session-buffer ada-gps-session)
+ (let ((process (ada-gps--session-process ada-gps-session))
+ (search-start (point-min))
+ (found nil))
+ (while (and (process-live-p process)
+ (progn
+ ;; process output is inserted before point, so move back
over it to search it
+ (goto-char search-start)
+ (not (setq found (re-search-forward ada-gps-prompt
(point-max) t)))))
+ (setq search-start (point));; don't search same text again
+ (accept-process-output process 0.1))
+ (if found
+ (when (> ada-gps-debug 0)
+ (message "'%s'" (buffer-substring-no-properties (point-min)
(point-max))))
+
+ (ada-gps-show-buffer)
+ (error "ada_gps process hung or died"))
+ )))
+
+(defun ada-gps-session-send (cmd wait prefix)
+ "Send CMD to ada_gps session.
+If WAIT is non-nil, wait for command to complete.
+If PREFIX is non-nil, prefix with count of bytes in cmd."
+ (ada-gps-require-session)
+ ;; we don't wait for previous command to complete, because the
+ ;; previous call to ada-gps-session-cmd might have been a partial
+ ;; command string (in particular, for 'compute_indent').
+ (let* ((byte-count-img (when prefix (format "%02d" (string-bytes cmd))))
+ (msg (concat byte-count-img cmd)))
+ (when (and (> ada-gps-debug 0)
+ (< (length msg) 100))
+ (message msg))
+ (with-current-buffer (ada-gps--session-buffer ada-gps-session)
+ (erase-buffer)
+ (process-send-string (ada-gps--session-process ada-gps-session) msg)
+ (when wait
+ (ada-gps-session-wait))
+ )))
+
+(defun ada-gps-kill-session ()
+ (interactive)
+ (when (process-live-p (ada-gps--session-process ada-gps-session))
+ (process-send-string (ada-gps--session-process ada-gps-session) "04exit")
+ ))
+
+(defun ada-gps-check-version ()
+ "Throw an error if gps executable version does not match expected."
+ (ada-gps-session-send "version" t t)
+ (with-current-buffer (ada-gps--session-buffer ada-gps-session)
+ (goto-char (point-min))
+ ;; We accept any patch level
+ (when (not (looking-at (concat ada-gps-indent-exec-api-version "\\....$")))
+ (error "Incorrect API version for '%s'; found '%s', expecting '%s'."
+ ada-gps-indent-exec
+ (buffer-substring (point-min) (line-end-position))
+ ada-gps-indent-exec-api-version))
+
+ (setq ada-gps-indent-exec-patch-level
+ (buffer-substring (- (line-end-position) 3) (line-end-position)))))
+
+(defun ada-gps-show-buffer ()
+ "Show ada-gps buffer."
+ (interactive)
+ (if (ada-gps--session-buffer ada-gps-session)
+ (pop-to-buffer (ada-gps--session-buffer ada-gps-session))
+ (error "ada-gps session not active")))
+
+;;;;; indenting
+
+(defun ada-gps-send-params ()
+ "Send indentation params to current gps session."
+ (ada-gps-session-send
+ (format "set_params %d %d %d %d"
+ ada-indent
+ ada-indent-broken
+ ada-indent-when
+ ada-indent-record-rel-type)
+ t t))
+
+(defconst ada-gps-output-regexp " *\\([0-9]+\\) +\\([0-9]+\\)$"
+ "Matches gps process output for one line.")
+
+(defvar-local ada-gps-indent-functions nil
+ "Functions to compute indentation special cases.
+Called with point at current indentation of a line; return
+indentation column, or nil if function does not know how to
+indent that line. Run after parser indentation, so other lines
+are indented correctly.")
+
+(defun ada-gps-indent-compute ()
+ "For `wisi-indent-fallback'; compute indent for current line."
+
+ ;; always send indent parameters - we don't track what buffer we are in
+ (ada-gps-send-params)
+
+ (save-excursion
+ ;; send complete current line
+ (end-of-line)
+ (ada-gps-session-send
+ (format "compute_indent %d %d" (line-number-at-pos) (1- (position-bytes
(point)))) nil t)
+ (ada-gps-session-send (buffer-substring-no-properties (point-min) (point))
t nil)
+ )
+ (with-current-buffer (ada-gps--session-buffer ada-gps-session)
+ (goto-char (point-min))
+ (if (looking-at ada-gps-output-regexp)
+ (string-to-number (match-string 2))
+
+ ;; gps did not compute indent for some reason
+ (when (> ada-gps-debug 0)
+ (message "ada-gps returned '%s'" (buffer-substring-no-properties
(point-min) (point-max))))
+ 0)
+ ))
+
+(defun ada-gps-indent-line ()
+ "For `indent-line-function'; indent current line using the ada-gps
indentation engine."
+ (let ((savep (copy-marker (point)))
+ (to-indent nil))
+ (back-to-indentation)
+ (when (>= (point) savep)
+ (setq to-indent t))
+
+ (ada-gps-indent-region (line-beginning-position) (line-end-position))
+
+ (goto-char savep)
+ (when to-indent (back-to-indentation))
+ ))
+
+(defun ada-gps-indent-region (begin end)
+ "For `indent-region-function'; indent lines in region BEGIN END using GPS."
+
+ (save-excursion
+ ;; always send indent parameters - we don't track what buffer we are in
+ (ada-gps-send-params)
+
+ ;; send complete lines
+ (goto-char end)
+ (setq end (line-end-position))
+
+ (let ((source-buffer (current-buffer))
+ (begin-line (line-number-at-pos begin))
+ (end-line (line-number-at-pos end))
+ (delete-bogus nil)
+ (failed nil))
+
+ (goto-char begin)
+ (when (and (= begin-line end-line)
+ (eolp))
+ ;; Indenting a single blank line. Insert some text so the GPS
+ ;; engine won't return 0.
+ ;;
+ ;; test/ada-gps/ada_gps_bug_005.adb
+ (insert "bogus")
+ (setq end (point))
+ (setq delete-bogus t))
+
+ (ada-gps-session-send
+ (format "compute_region_indent %d %d %d" begin-line end-line (1-
(position-bytes end))) nil t)
+ (ada-gps-session-send (buffer-substring-no-properties (point-min) end) t
nil)
+
+ (when delete-bogus
+ (backward-delete-char 5))
+
+ (with-current-buffer (ada-gps--session-buffer ada-gps-session)
+ ;; buffer contains two numbers per line; Emacs line number,
+ ;; indent. Or an error message.
+ (goto-char (point-min))
+ (while (and (not failed)
+ (not (looking-at ada-gps-prompt)))
+ (if (looking-at ada-gps-output-regexp)
+ (let ((line (string-to-number (match-string 1)))
+ (indent (string-to-number (match-string 2))))
+ (with-current-buffer source-buffer
+ (goto-char (point-min))
+ (forward-line (1- line)) ;; FIXME: count forward from prev
indented line
+ (indent-line-to indent)
+ )
+
+ (forward-line 1))
+
+ ;; else some error message
+ (setq failed t)
+ (cond
+ ((> ada-gps-debug 0)
+ (message "ada-gps returned '%s'" (buffer-substring-no-properties
(point-min) (point-max)))
+ (goto-char (point-max)))
+ (t
+ (message "ada-gps indent failed")
+ )))
+ ))
+
+ (unless failed
+ ;; run ada-gps-indent-functions on region
+ (goto-char begin)
+ (let ((line begin-line)
+ indent)
+ (while (<= line end-line)
+ (back-to-indentation)
+ (setq indent
+ (run-hook-with-args-until-success 'ada-gps-indent-functions))
+ (when indent
+ (indent-line-to indent))
+ (forward-line 1)
+ (setq line (1+ line))
+ )))
+ )))
+
+(defun ada-gps--comment-goto-start()
+ ;; If comment is after a terminal semicolon, indent to
+ ;; beginning of statement, not prev line.
+ ;;
+ ;; test/ada-gps/ada_gps_bug_007.adb
+ (let (cache)
+ (end-of-line)
+ (wisi-validate-cache (point))
+ (wisi-backward-token)
+ (setq cache (wisi-get-cache (point)))
+ (when (and cache
+ (eq 'statement-end (wisi-cache-class cache)))
+ (wisi-goto-start cache))))
+
+(defun ada-gps-comment ()
+ "Modify indentation of a comment:
+For `ada-gps-indent-functions'.
+- align to previous comment after code.
+- align to previous code
+- respect `ada-indent-comment-gnat'."
+ ;; We know we are at the first token on a line. We check for comment
+ ;; syntax, not comment-start, to accomodate gnatprep, skeleton
+ ;; placeholders, etc.
+ ;;
+ ;; The ada-gps indentation algorithm has already indented the
+ ;; comment; however, it gets this wrong in many cases, so we don't
+ ;; trust it. We compare the ada-gps indent to previous and following
+ ;; code indent, then choose the best fit.
+ (when (and (not (eobp))
+ (= 11 (syntax-class (syntax-after (point)))))
+
+ ;; We are looking at a comment; check for preceding comments, code
+ (let ((indent (current-column))
+ after prev-indent next-indent)
+
+ (if (save-excursion (forward-line -1) (looking-at "\\s *$"))
+ ;; after blank line - find a code line
+ (save-excursion
+ (setq after 'code)
+ (forward-line -1)
+ (while (or (bobp)
+ (looking-at "\\s *$"))
+ (forward-line -1))
+ (if (bobp)
+ (setq prev-indent 0)
+
+ (ada-gps--comment-goto-start)
+ (back-to-indentation)
+ (setq prev-indent (current-column)))
+ )
+
+ ;; after a code line
+ (save-excursion
+ (forward-comment -1)
+ (if (eolp)
+ ;; no comment on previous line
+ (progn
+ (setq after 'code)
+ (ada-gps--comment-goto-start)
+ (back-to-indentation)
+ (setq prev-indent (current-column)))
+
+ (setq prev-indent (current-column))
+ (if (not (= prev-indent (progn (back-to-indentation)
(current-column))))
+ ;; previous line has comment following code
+ (setq after 'code-comment)
+ ;; previous line has plain comment
+ (setq after 'comment)
+ )))
+ )
+
+ (cl-ecase after
+ (code
+ (if ada-indent-comment-gnat
+ (ada-wisi-comment-gnat indent 'code)
+
+ ;; Find indent of following code
+ (save-excursion
+ (forward-line 1)
+ (while (or (eobp)
+ (looking-at "\\s *$"))
+ (forward-line 1))
+ (if (eobp)
+ (setq next-indent 0)
+ (back-to-indentation)
+ (setq next-indent (current-column))))
+
+ (cond
+ ((or (= indent prev-indent)
+ (= indent next-indent))
+ indent)
+ (t
+ prev-indent))))
+
+ (comment
+ prev-indent)
+
+ (code-comment
+ (if ada-indent-comment-gnat
+ (ada-wisi-comment-gnat indent 'code-comment)
+
+ ;; After comment that follows code on the same line
+ ;; test/ada_mode-nominal.adb
+ ;;
+ ;; begin -- 2
+ ;; --EMACSCMD:(progn
(ada-goto-declarative-region-start)(looking-at "Bad_Thing"))
+ prev-indent)
+ ))
+ )))
+
+;;;;; setup
+
+(defun ada-gps-setup ()
+ "Set up a buffer for indenting with ada-gps."
+ (set (make-local-variable 'indent-line-function) 'ada-gps-indent-line)
+ (set (make-local-variable 'indent-region-function) 'ada-gps-indent-region)
+ (ada-gps-require-session)
+
+ ;; file local variables may have added opentoken, gnatprep
+ (setq ada-gps-indent-functions (append ada-gps-indent-functions (list
#'ada-gps-comment)))
+ )
+
+(require 'ada-wisi)
+
+(defun ada-gps-or-wisi-setup ()
+ "If buffer size > `ada-gps-size-threshold', use ada-gps;
+otherwise use ada-wisi indentation engine with ada-gps fallback,"
+ ;; ada-gps-size-threshold can be set in file-local variables, which
+ ;; are parsed after ada-mode-hook runs.
+ (add-hook 'hack-local-variables-hook 'ada-gps-post-local-vars nil t))
+
+(defun ada-gps-post-local-vars ()
+ "See `ada-gsp-or-wisi-setup'"
+ (setq hack-local-variables-hook (delq 'ada-gps-post-local-vars
hack-local-variables-hook))
+
+ (if (> (point-max) ada-gps-size-threshold)
+ (progn
+ ;; use ada-gps for indent, ada-wisi for face, navigation
+ (ada-wisi-setup)
+ (ada-gps-setup))
+
+ (ada-wisi-setup)
+ (set (make-local-variable 'indent-region-function) nil)
+ (setq wisi-indent-fallback 'ada-gps-indent-compute)
+ ))
+
+(provide 'ada-gps)
+
+(unless (locate-file ada-gps-indent-exec exec-path '("" ".exe"))
+ (error "%s not found on `exec-path'" ada-gps-indent-exec))
+
+(add-hook 'ada-mode-hook 'ada-gps-or-wisi-setup)
+(setq ada-mode-hook (delq 'ada-wisi-setup ada-mode-hook))
+
+;; end of file
diff --git a/packages/ada-mode/ada-grammar-wy.el
b/packages/ada-mode/ada-grammar-wy.el
old mode 100644
new mode 100755
index f98d8b9..1dc374f
--- a/packages/ada-mode/ada-grammar-wy.el
+++ b/packages/ada-mode/ada-grammar-wy.el
@@ -671,8 +671,9 @@
(expression_opt
(())
((expression )
+ (progn
(wisi-statement-action [1 expression-start])
- (wisi-containing-action 1 1)))
+ (wisi-containing-action 1 1))))
(expression_function_declaration
((overriding_indicator_opt function_specification IS paren_expression
aspect_specification_opt SEMICOLON )
(progn
@@ -1269,6 +1270,10 @@
(progn
(wisi-statement-action [1 open-paren 3 close-paren])
(wisi-containing-action 1 2)))
+ ((LEFT_PAREN association_list RIGHT_PAREN )
+ (progn
+ (wisi-statement-action [1 open-paren 3 close-paren])
+ (wisi-containing-action 1 2)))
((LEFT_PAREN conditional_quantified_expression RIGHT_PAREN )
(progn
(wisi-statement-action [1 open-paren 3 close-paren])
@@ -1376,6 +1381,7 @@
(wisi-containing-action 1 4)
(wisi-containing-action 3 5)
(wisi-containing-action 6 10)
+ (wisi-motion-action [1 6 [10 block-middle PRIVATE] 11])
(wisi-face-action [3 font-lock-type-face])))
((PROTECTED TYPE IDENTIFIER discriminant_part_opt
aspect_specification_opt IS protected_definition SEMICOLON )
(progn
@@ -1383,6 +1389,7 @@
(wisi-containing-action 1 4)
(wisi-containing-action 3 5)
(wisi-containing-action 6 7)
+ (wisi-motion-action [1 6 [7 block-middle PRIVATE] 8])
(wisi-face-action [3 font-lock-type-face]))))
(qualified_expression
((name TICK aggregate )
@@ -1446,20 +1453,30 @@
(record_type_definition
((abstract_tagged_limited_opt record_definition )))
(relation_and_list
- ((relation AND relation ))
- ((relation_and_list AND relation )))
+ ((relation AND relation )
+ (wisi-statement-action [3 expression-start]))
+ ((relation_and_list AND relation )
+ (wisi-statement-action [3 expression-start])))
(relation_and_then_list
- ((relation AND THEN relation ))
- ((relation_and_then_list AND THEN relation )))
+ ((relation AND THEN relation )
+ (wisi-statement-action [4 expression-start]))
+ ((relation_and_then_list AND THEN relation )
+ (wisi-statement-action [4 expression-start])))
(relation_or_list
- ((relation OR relation ))
- ((relation_or_list OR relation )))
+ ((relation OR relation )
+ (wisi-statement-action [3 expression-start]))
+ ((relation_or_list OR relation )
+ (wisi-statement-action [3 expression-start])))
(relation_or_else_list
- ((relation OR ELSE relation ))
- ((relation_or_else_list OR ELSE relation )))
+ ((relation OR ELSE relation )
+ (wisi-statement-action [4 expression-start]))
+ ((relation_or_else_list OR ELSE relation )
+ (wisi-statement-action [4 expression-start])))
(relation_xor_list
- ((relation XOR relation ))
- ((relation_xor_list XOR relation )))
+ ((relation XOR relation )
+ (wisi-statement-action [3 expression-start]))
+ ((relation_xor_list XOR relation )
+ (wisi-statement-action [3 expression-start])))
(relation
((simple_expression ))
((simple_expression relational_operator simple_expression ))
@@ -2142,7 +2159,7 @@
((default . error) (END . (declaration . 17)) (PRIVATE . (declaration .
17)) (IDENTIFIER . (declaration . 17)) (USE . (declaration . 17)) (TYPE .
(declaration . 17)) (TASK . (declaration . 17)) (SUBTYPE . (declaration . 17))
(PROTECTED . (declaration . 17)) (PROCEDURE . (declaration . 17)) (PRAGMA .
(declaration . 17)) (PACKAGE . (declaration . 17)) (OVERRIDING . (declaration .
17)) (NOT . (declaration . 17)) (GENERIC . (declaration . 17)) (FUNCTION .
(declaration . 17)) (FOR . (de [...]
((default . error) (BEGIN . (declarative_part_opt . 0)) (END .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 272) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
269) (IDENTIFIER . 275) (TYPE . 274) (GENERIC . 2) (PROTECTED . 271) (TASK
. 273) (PACKAGE . 270))
((default . error) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (DOT . 90) (OF . (primary . 3)) (COLON_EQUAL .
(primary . 3)) (DO . (primary . 3)) (LOOP . (primary . 3)) (BAR . (primary .
3)) (COMMA . (primary . 3)) (ELSIF . (primary . 3)) (ELSE . (primary . 3))
(EQUAL_GREATER . (primary . 3)) (RIGHT_PAREN . (primary . 3)) (DIGITS .
(primary . 3)) (RANGE . (primary . 3)) (THEN . (primary . 3)) (DOT_DOT .
(primary . 3)) (WITH . (primary . 3)) (IS . (primary . 3)) (IN . (primary . 3))
(NOT . (primary . 3)) (EQUAL . (primary . [...]
+ ((default . error) (DOT . 90) (OF . (primary . 3)) (COLON_EQUAL .
(primary . 3)) (DO . (primary . 3)) (LOOP . (primary . 3)) (BAR . (primary .
3)) (COMMA . (primary . 3)) (ELSIF . (primary . 3)) (ELSE . (primary . 3))
(RIGHT_PAREN . (primary . 3)) (EQUAL_GREATER . (primary . 3)) (DIGITS .
(primary . 3)) (RANGE . (primary . 3)) (THEN . (primary . 3)) (DOT_DOT .
(primary . 3)) (WITH . (primary . 3)) (IS . (primary . 3)) (IN . (primary . 3))
(NOT . (primary . 3)) (EQUAL . (primary . [...]
((default . error) (COLON_EQUAL . (simple_expression . 0)) (OF .
(simple_expression . 0)) (LOOP . (simple_expression . 0)) (DO .
(simple_expression . 0)) (DOT_DOT . (simple_expression . 0)) (SEMICOLON .
(simple_expression . 0)) (XOR . (simple_expression . 0)) (OR .
(simple_expression . 0)) (AND . (simple_expression . 0)) (SLASH_EQUAL .
(simple_expression . 0)) (LESS_EQUAL . (simple_expression . 0)) (LESS .
(simple_expression . 0)) (GREATER_EQUAL . (simple_expression . 0)) (GREATER
[...]
((default . error) (ABS . (binary_adding_operator . 2)) (LEFT_PAREN .
(binary_adding_operator . 2)) (NEW . (binary_adding_operator . 2)) (NOT .
(binary_adding_operator . 2)) (NULL . (binary_adding_operator . 2))
(NUMERIC_LITERAL . (binary_adding_operator . 2)) (IDENTIFIER .
(binary_adding_operator . 2)) (STRING_LITERAL . (binary_adding_operator . 2))
(CHARACTER_LITERAL . (binary_adding_operator . 2)))
((default . error) (ABS . (binary_adding_operator . 1)) (LEFT_PAREN .
(binary_adding_operator . 1)) (NEW . (binary_adding_operator . 1)) (NOT .
(binary_adding_operator . 1)) (NULL . (binary_adding_operator . 1))
(NUMERIC_LITERAL . (binary_adding_operator . 1)) (IDENTIFIER .
(binary_adding_operator . 1)) (STRING_LITERAL . (binary_adding_operator . 1))
(CHARACTER_LITERAL . (binary_adding_operator . 1)))
@@ -2195,7 +2212,7 @@
((default . error) (RIGHT_PAREN . 407))
((default . error) (COMMA . (association_opt . 5)) (RIGHT_PAREN .
(association_opt . 5)) (WITH . 406))
((default . error) (THEN . 405))
- ((default . error) (IN . 336) (NOT . 337) (DO . (relation . 0)) (LOOP
. (relation . 0)) (COMMA . (relation . 0)) (ELSIF . (relation . 0)) (ELSE .
(relation . 0)) (EQUAL_GREATER . (relation . 0)) (RIGHT_PAREN . (relation . 0))
(DIGITS . (relation . 0)) (RANGE . (relation . 0)) (THEN . (relation . 0))
(WITH . (relation . 0)) (SEMICOLON . (relation . 0)) (IS . (relation . 0)) (AND
. (relation . 0)) (OR . (relation . 0)) (XOR . (relation . 0)) (EQUAL . 339)
(SLASH_EQUAL . 344) (LES [...]
+ ((default . error) (IN . 336) (NOT . 337) (DO . (relation . 0)) (LOOP
. (relation . 0)) (COMMA . (relation . 0)) (ELSIF . (relation . 0)) (ELSE .
(relation . 0)) (RIGHT_PAREN . (relation . 0)) (EQUAL_GREATER . (relation . 0))
(DIGITS . (relation . 0)) (RANGE . (relation . 0)) (THEN . (relation . 0))
(WITH . (relation . 0)) (SEMICOLON . (relation . 0)) (IS . (relation . 0)) (AND
. (relation . 0)) (OR . (relation . 0)) (XOR . (relation . 0)) (EQUAL . 339)
(SLASH_EQUAL . 344) (LES [...]
((default . error) (IDENTIFIER . (quantifier . 0)))
((default . error) (IDENTIFIER . (quantifier . 1)))
((default . error) (IDENTIFIER . 402))
@@ -2428,7 +2445,7 @@
((default . error) (PLUS . (primary . 1)) (MINUS . (primary . 1))
(AMPERSAND . (primary . 1)) (DOT_DOT . (primary . 1)) (IN . (primary . 1)) (NOT
. (primary . 1)) (EQUAL . (primary . 1)) (GREATER . (primary . 1))
(GREATER_EQUAL . (primary . 1)) (LESS . (primary . 1)) (LESS_EQUAL . (primary .
1)) (SLASH_EQUAL . (primary . 1)) (RIGHT_PAREN . (primary . 1)) (COMMA .
(primary . 1)) (MOD . (primary . 1)) (REM . (primary . 1)) (SLASH . (primary .
1)) (STAR . (primary . 1)) (STAR_STAR . ( [...]
((default . error) (COMMA . 267) (RIGHT_PAREN . 739))
((default . error) (ELSE . 735) (RIGHT_PAREN . (if_expression . 3))
(ELSIF . 736))
- ((default . error) (DO . (relation . 1)) (LOOP . (relation . 1)) (COMMA
. (relation . 1)) (ELSIF . (relation . 1)) (ELSE . (relation . 1))
(EQUAL_GREATER . (relation . 1)) (RIGHT_PAREN . (relation . 1)) (DIGITS .
(relation . 1)) (RANGE . (relation . 1)) (THEN . (relation . 1)) (WITH .
(relation . 1)) (SEMICOLON . (relation . 1)) (IS . (relation . 1)) (AND .
(relation . 1)) (OR . (relation . 1)) (XOR . (relation . 1)))
+ ((default . error) (DO . (relation . 1)) (LOOP . (relation . 1)) (COMMA
. (relation . 1)) (ELSIF . (relation . 1)) (ELSE . (relation . 1)) (RIGHT_PAREN
. (relation . 1)) (EQUAL_GREATER . (relation . 1)) (DIGITS . (relation . 1))
(RANGE . (relation . 1)) (THEN . (relation . 1)) (WITH . (relation . 1))
(SEMICOLON . (relation . 1)) (IS . (relation . 1)) (AND . (relation . 1)) (OR .
(relation . 1)) (XOR . (relation . 1)))
((default . error) (RIGHT_PAREN . (expression_opt . 0)) (RAISE . 153)
(PLUS . 155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (REVERSE . 729) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (PLUS . 155) (MINUS . 154)
(ABS . 144) (NOT . 728) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
((default . error) (REVERSE . 726) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
@@ -2489,7 +2506,7 @@
((default . error) (SEMICOLON . 670))
((default . error) (IDENTIFIER . (generic_instantiation . 2)) (TYPE .
(generic_instantiation . 2)) (TASK . (generic_instantiation . 2)) (SUBTYPE .
(generic_instantiation . 2)) (PROTECTED . (generic_instantiation . 2)) (FOR .
(generic_instantiation . 2)) (ENTRY . (generic_instantiation . 2)) (BEGIN .
(generic_instantiation . 2)) (END . (generic_instantiation . 2)) (WITH .
(generic_instantiation . 2)) (USE . (generic_instantiation . 2)) (SEPARATE .
(generic_instantiation . 2)) (PROCE [...]
((default . error) (IDENTIFIER . (generic_instantiation . 1)) (TYPE .
(generic_instantiation . 1)) (TASK . (generic_instantiation . 1)) (SUBTYPE .
(generic_instantiation . 1)) (PROTECTED . (generic_instantiation . 1)) (FOR .
(generic_instantiation . 1)) (ENTRY . (generic_instantiation . 1)) (BEGIN .
(generic_instantiation . 1)) (END . (generic_instantiation . 1)) (WITH .
(generic_instantiation . 1)) (USE . (generic_instantiation . 1)) (SEPARATE .
(generic_instantiation . 1)) (PROCE [...]
- ((default . error) (END . (exception_handler_list_opt . 0)) (WHEN .
943))
+ ((default . error) (END . (exception_handler_list_opt . 0)) (WHEN .
944))
((default . error) (OR . (sequence_of_statements . 2)) (THEN .
(sequence_of_statements . 2)) (WHEN . (sequence_of_statements . 2))
(CHARACTER_LITERAL . ((sequence_of_statements . 2) (label_opt . 1)))
(STRING_LITERAL . ((sequence_of_statements . 2) (label_opt . 1))) (IDENTIFIER .
((sequence_of_statements . 2) (label_opt . 1))) (WHILE .
((sequence_of_statements . 2) (label_opt . 1))) (SELECT .
((sequence_of_statements . 2) (label_opt . 1))) (RETURN .
((sequence_of_statements . 2) (la [...]
((default . error) (OR . (sequence_of_statements . 1)) (THEN .
(sequence_of_statements . 1)) (WHEN . (sequence_of_statements . 1))
(CHARACTER_LITERAL . (sequence_of_statements . 1)) (STRING_LITERAL .
(sequence_of_statements . 1)) (IDENTIFIER . (sequence_of_statements . 1))
(WHILE . (sequence_of_statements . 1)) (SELECT . (sequence_of_statements . 1))
(RETURN . (sequence_of_statements . 1)) (REQUEUE . (sequence_of_statements .
1)) (RAISE . (sequence_of_statements . 1)) (PRAGMA . (se [...]
((default . error) (SEMICOLON . (expression_opt . 0)) (RAISE . 153)
(PLUS . 155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
@@ -2499,73 +2516,73 @@
((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt . 0)) (NULL . (label_opt . 0)) (PRAGMA .
(label_opt . 0)) (RAISE . (labe [...]
((default . error) (SEMICOLON . (name_opt . 0)) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
((default . error) (CHARACTER_LITERAL . (label_opt . 2)) (STRING_LITERAL
. (label_opt . 2)) (IDENTIFIER . (label_opt . 2)) (REQUEUE . (label_opt . 2))
(RAISE . (label_opt . 2)) (PRAGMA . (label_opt . 2)) (NULL . (label_opt . 2))
(GOTO . (label_opt . 2)) (EXIT . (label_opt . 2)) (DELAY . (label_opt . 2))
(ABORT . (label_opt . 2)) (WHILE . (label_opt . 2)) (SELECT . (label_opt . 2))
(RETURN . (label_opt . 2)) (LOOP . (label_opt . 2)) (IF . (label_opt . 2)) (FOR
. (label_opt . 2)) (DE [...]
- ((default . error) (GREATER_GREATER . 939))
+ ((default . error) (GREATER_GREATER . 940))
((default . error) (LOOP . (iteration_scheme . 0)))
- ((default . error) (SEMICOLON . 938))
+ ((default . error) (SEMICOLON . 939))
((default . error) (EQUAL_GREATER . (expression_opt . 0)) (RAISE . 153)
(PLUS . 155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (END . (sequence_of_statements_opt . 0)) (OR .
(sequence_of_statements_opt . 0)) (ELSE . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0))
(EXIT . (label_opt . 0)) (GOTO . ( [...]
((default . error) (ELSE . (select_alternative . 3)) (OR .
(select_alternative . 3)) (END . (select_alternative . 3)))
((default . error) (OR . (sequence_of_statements_opt . 0)) (END .
(sequence_of_statements_opt . 0)) (ELSE . (sequence_of_statements_opt . 0))
(THEN . (sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_op [...]
- ((default . error) (ELSE . 933) (OR . 934))
+ ((default . error) (ELSE . 934) (OR . 935))
((default . error) (DOT . 90) (SEMICOLON . 676) (TICK . 91) (OR .
(sequence_of_statements_opt . 0)) (ELSE . (sequence_of_statements_opt . 0))
(THEN . (sequence_of_statements_opt . 0)) (LEFT_PAREN . 107) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . [...]
((default . error) (OR . (sequence_of_statements_opt . 0)) (ELSE .
(sequence_of_statements_opt . 0)) (THEN . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0))
(EXIT . (label_opt . 0)) (GOTO . [...]
((default . error) (ELSE . (select_alternative_list . 0)) (END .
(select_alternative_list . 0)) (OR . (select_alternative_list . 0)))
- ((default . error) (ELSE . (select_alternative_list_opt . 1)) (END .
(select_alternative_list_opt . 1)) (OR . 930))
- ((default . error) (ELSE . 928) (END . 929))
- ((default . error) (THEN . 927))
+ ((default . error) (ELSE . (select_alternative_list_opt . 1)) (END .
(select_alternative_list_opt . 1)) (OR . 931))
+ ((default . error) (ELSE . 929) (END . 930))
+ ((default . error) (THEN . 928))
((default . error) (WHEN . (simple_return_statement . 0)) (THEN .
(simple_return_statement . 0)) (OR . (simple_return_statement . 0)) (ELSIF .
(simple_return_statement . 0)) (ELSE . (simple_return_statement . 0))
(CHARACTER_LITERAL . (simple_return_statement . 0)) (STRING_LITERAL .
(simple_return_statement . 0)) (IDENTIFIER . (simple_return_statement . 0))
(WHILE . (simple_return_statement . 0)) (SELECT . (simple_return_statement .
0)) (RETURN . (simple_return_statement . 0)) (REQU [...]
- ((default . error) (COLON . 926) (STAR_STAR . (name . 0)) (STAR . (name
. 0)) (SLASH . (name . 0)) (REM . (name . 0)) (MOD . (name . 0)) (SEMICOLON .
(name . 0)) (SLASH_EQUAL . (name . 0)) (LESS_EQUAL . (name . 0)) (LESS . (name
. 0)) (GREATER_EQUAL . (name . 0)) (GREATER . (name . 0)) (EQUAL . (name . 0))
(NOT . (name . 0)) (IN . (name . 0)) (AMPERSAND . (name . 0)) (MINUS . (name .
0)) (PLUS . (name . 0)) (LEFT_PAREN . (name . 0)) (AND . (name . 0)) (OR .
(name . 0)) (XOR . (nam [...]
- ((default . error) (SEMICOLON . 925))
- ((default . error) (DO . (extended_return_object_declaration_opt . 1))
(SEMICOLON . 924))
- ((default . error) (DO . 923))
- ((default . error) (WITH . 921) (DOT . 90) (TICK . 91) (SEMICOLON .
922) (LEFT_PAREN . 107))
+ ((default . error) (COLON . 927) (STAR_STAR . (name . 0)) (STAR . (name
. 0)) (SLASH . (name . 0)) (REM . (name . 0)) (MOD . (name . 0)) (SEMICOLON .
(name . 0)) (SLASH_EQUAL . (name . 0)) (LESS_EQUAL . (name . 0)) (LESS . (name
. 0)) (GREATER_EQUAL . (name . 0)) (GREATER . (name . 0)) (EQUAL . (name . 0))
(NOT . (name . 0)) (IN . (name . 0)) (AMPERSAND . (name . 0)) (MINUS . (name .
0)) (PLUS . (name . 0)) (LEFT_PAREN . (name . 0)) (AND . (name . 0)) (OR .
(name . 0)) (XOR . (nam [...]
+ ((default . error) (SEMICOLON . 926))
+ ((default . error) (DO . (extended_return_object_declaration_opt . 1))
(SEMICOLON . 925))
+ ((default . error) (DO . 924))
+ ((default . error) (WITH . 922) (DOT . 90) (TICK . 91) (SEMICOLON .
923) (LEFT_PAREN . 107))
((default . error) (WHEN . (raise_statement . 0)) (THEN .
(raise_statement . 0)) (OR . (raise_statement . 0)) (ELSIF . (raise_statement .
0)) (ELSE . (raise_statement . 0)) (CHARACTER_LITERAL . (raise_statement . 0))
(STRING_LITERAL . (raise_statement . 0)) (IDENTIFIER . (raise_statement . 0))
(WHILE . (raise_statement . 0)) (SELECT . (raise_statement . 0)) (RETURN .
(raise_statement . 0)) (REQUEUE . (raise_statement . 0)) (RAISE .
(raise_statement . 0)) (PRAGMA . (raise_statement [...]
- ((default . error) (WITH . 919) (DOT . 90) (TICK . 91) (SEMICOLON .
920) (LEFT_PAREN . 107))
+ ((default . error) (WITH . 920) (DOT . 90) (TICK . 91) (SEMICOLON .
921) (LEFT_PAREN . 107))
((default . error) (WHEN . (simple_statement . 0)) (THEN .
(simple_statement . 0)) (OR . (simple_statement . 0)) (ELSIF .
(simple_statement . 0)) (ELSE . (simple_statement . 0)) (CHARACTER_LITERAL .
(simple_statement . 0)) (STRING_LITERAL . (simple_statement . 0)) (IDENTIFIER .
(simple_statement . 0)) (WHILE . (simple_statement . 0)) (SELECT .
(simple_statement . 0)) (RETURN . (simple_statement . 0)) (REQUEUE .
(simple_statement . 0)) (RAISE . (simple_statement . 0)) (PRAGMA . (sim [...]
- ((default . error) (END . 918))
- ((default . error) (THEN . 917))
- ((default . error) (SEMICOLON . 916))
+ ((default . error) (END . 919))
+ ((default . error) (THEN . 918))
+ ((default . error) (SEMICOLON . 917))
((default . error) (LOOP . (iterator_specification_opt . 1)))
((default . error) (LOOP . (iteration_scheme . 1)))
((default . error) (WHEN . (identifier_opt . 1)) (SEMICOLON .
(identifier_opt . 1)))
- ((default . error) (WHEN . 914) (SEMICOLON . 915))
+ ((default . error) (WHEN . 915) (SEMICOLON . 916))
((default . error) (SEMICOLON . (expression_opt . 0)) (RAISE . 153)
(PLUS . 155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (SEMICOLON . 912))
- ((default . error) (BEGIN . 911))
- ((default . error) (IS . 910))
- ((default . error) (END . 909))
- ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON . 908)
(LEFT_PAREN . 107))
- ((default . error) (SEMICOLON . (actual_parameter_part_opt . 0)) (DO .
(actual_parameter_part_opt . 0)) (LEFT_PAREN . ( 905 (actual_parameter_part_opt
. 0))))
+ ((default . error) (SEMICOLON . 913))
+ ((default . error) (BEGIN . 912))
+ ((default . error) (IS . 911))
+ ((default . error) (END . 910))
+ ((default . error) (DOT . 90) (TICK . 91) (SEMICOLON . 909)
(LEFT_PAREN . 107))
+ ((default . error) (SEMICOLON . (actual_parameter_part_opt . 0)) (DO .
(actual_parameter_part_opt . 0)) (LEFT_PAREN . ( 906 (actual_parameter_part_opt
. 0))))
+ ((default . error) (IS . 905))
((default . error) (IS . 904))
- ((default . error) (IS . 903))
((default . error) (WHEN . 616))
- ((default . error) (BAR . 356) (EQUAL_GREATER . 901))
- ((default . error) (NULL . 900))
- ((default . error) (DO . (subtype_indication . 3)) (OF .
(subtype_indication . 3)) (AND . (subtype_indication . 3)) (SEMICOLON .
(subtype_indication . 3)) (WITH . (subtype_indication . 3)) (COLON_EQUAL .
(subtype_indication . 3)) (DOT . 90) (TICK . 91) (RANGE . 895) (LEFT_PAREN .
820))
- ((default . error) (OF . 899))
+ ((default . error) (BAR . 356) (EQUAL_GREATER . 902))
+ ((default . error) (NULL . 901))
+ ((default . error) (DO . (subtype_indication . 3)) (OF .
(subtype_indication . 3)) (AND . (subtype_indication . 3)) (SEMICOLON .
(subtype_indication . 3)) (WITH . (subtype_indication . 3)) (COLON_EQUAL .
(subtype_indication . 3)) (DOT . 90) (TICK . 91) (RANGE . 896) (LEFT_PAREN .
820))
+ ((default . error) (OF . 900))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (DOT . 90) (TICK . 91) (LOOP .
(iterator_specification . 5)) (EQUAL_GREATER . (iterator_specification . 5))
(LEFT_PAREN . 107))
- ((default . error) (NUMERIC_LITERAL . 156) (NULL . 897) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (NUMERIC_LITERAL . 156) (NULL . 898) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 155) (MINUS . 154) (ABS . 144) (NOT . 728)
(NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
((default . error) (LOOP . (iterator_specification . 1)) (EQUAL_GREATER
. (iterator_specification . 1)))
- ((default . error) (LOOP . (subtype_indication . 3)) (DOT . 90) (IN .
(primary . 3)) (NOT . (primary . 3)) (EQUAL . (primary . 3)) (GREATER .
(primary . 3)) (GREATER_EQUAL . (primary . 3)) (LESS . (primary . 3))
(LESS_EQUAL . (primary . 3)) (SLASH_EQUAL . (primary . 3)) (RIGHT_PAREN .
((primary . 3) (subtype_indication . 3))) (COMMA . ((primary . 3)
(subtype_indication . 3))) (BAR . (primary . 3)) (EQUAL_GREATER . ((primary .
3) (subtype_indication . 3))) (AND . (primary . 3)) (OR [...]
+ ((default . error) (LOOP . (subtype_indication . 3)) (DOT . 90) (IN .
(primary . 3)) (NOT . (primary . 3)) (EQUAL . (primary . 3)) (GREATER .
(primary . 3)) (GREATER_EQUAL . (primary . 3)) (LESS . (primary . 3))
(LESS_EQUAL . (primary . 3)) (SLASH_EQUAL . (primary . 3)) (RIGHT_PAREN .
((primary . 3) (subtype_indication . 3))) (COMMA . ((primary . 3)
(subtype_indication . 3))) (BAR . (primary . 3)) (EQUAL_GREATER . ((primary .
3) (subtype_indication . 3))) (AND . (primary . 3)) (OR [...]
((default . error) (LOOP . (discrete_subtype_definition . 1))
(EQUAL_GREATER . (discrete_subtype_definition . 1)) (COMMA .
(discrete_subtype_definition . 1)) (RIGHT_PAREN . (discrete_subtype_definition
. 1)))
((default . error) (LOOP . (discrete_subtype_definition . 0))
(EQUAL_GREATER . (discrete_subtype_definition . 0)) (COMMA .
(discrete_subtype_definition . 0)) (RIGHT_PAREN . (discrete_subtype_definition
. 0)))
((default . error) (RIGHT_PAREN . (quantified_expression . 0)))
((default . error) (RIGHT_PAREN . (expression_opt . 0)) (RAISE . 153)
(PLUS . 155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (THEN . (expression_opt . 0)) (RAISE . 153) (PLUS .
155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
((default . error) (RIGHT_PAREN . (elsif_expression_list . 0)) (ELSE .
(elsif_expression_list . 0)) (ELSIF . (elsif_expression_list . 0)))
- ((default . error) (RIGHT_PAREN . (if_expression . 1)) (ELSE . 891)
(ELSIF . 736))
+ ((default . error) (RIGHT_PAREN . (if_expression . 1)) (ELSE . 892)
(ELSIF . 736))
((default . error) (USE . (aggregate . 1)) (COLON_EQUAL . (aggregate .
1)) (CHARACTER_LITERAL . (aggregate . 1)) (STRING_LITERAL . (aggregate . 1))
(IDENTIFIER . (aggregate . 1)) (LESS_LESS . (aggregate . 1)) (WHILE .
(aggregate . 1)) (SELECT . (aggregate . 1)) (REQUEUE . (aggregate . 1)) (RAISE
. (aggregate . 1)) (PRAGMA . (aggregate . 1)) (NULL . (aggregate . 1)) (IF .
(aggregate . 1)) (GOTO . (aggregate . 1)) (FOR . (aggregate . 1)) (EXIT .
(aggregate . 1)) (DELAY . (aggregate . [...]
- ((default . error) (RIGHT_PAREN . 890))
+ ((default . error) (RIGHT_PAREN . 891))
((default . error) (XOR . (choice_relation . 0)) (OR . (choice_relation
. 0)) (BAR . (choice_relation . 0)) (EQUAL_GREATER . (choice_relation . 0))
(AND . (choice_relation . 0)))
- ((default . error) (RIGHT_PAREN . 889))
+ ((default . error) (RIGHT_PAREN . 890))
((default . error) (DO . (membership_choice_list . 1)) (LOOP .
(membership_choice_list . 1)) (ELSIF . (membership_choice_list . 1)) (ELSE .
(membership_choice_list . 1)) (EQUAL_GREATER . (membership_choice_list . 1))
(DIGITS . (membership_choice_list . 1)) (RANGE . (membership_choice_list . 1))
(THEN . (membership_choice_list . 1)) (SEMICOLON . (membership_choice_list .
1)) (IS . (membership_choice_list . 1)) (WITH . (membership_choice_list . 1))
(RIGHT_PAREN . (membership_choice_l [...]
- ((default . error) (SEMICOLON . 888))
- ((default . error) (END . 887))
+ ((default . error) (SEMICOLON . 889))
+ ((default . error) (END . 888))
((default . error) (SEMICOLON . (parameter_specification . 0))
(RIGHT_PAREN . (parameter_specification . 0)) (IDENTIFIER . 229)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (PLUS . 155) (MINUS . 154)
(ABS . 144) (NOT . 728) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
- ((default . error) (RIGHT_PAREN . (expression_opt . 0)) (FOR . 146)
(CASE . 145) (IF . 147) (RAISE . 153) (PLUS . 155) (MINUS . 154) (ABS .
144) (NOT . 324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (FOR . 146) (CASE . 145) (IF . 147) (COMMA .
((association_opt . 0) (expression_opt . 0))) (RIGHT_PAREN . ((association_opt
. 0) (expression_opt . 0))) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (OTHERS . 152) (RAISE . 153) (PLUS . 155) (MINUS
. 154) (IDENTIFIER . 48) (CHARACTER_LITERAL . 157) (STRING_LITERAL . 49)
(ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
@@ -2624,26 +2641,26 @@
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (RIGHT_PAREN . (expression_opt . 0)) (SEMICOLON .
(expression_opt . 0)) (RAISE . 153) (PLUS . 155) (MINUS . 154) (ABS . 144)
(NOT . 324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER .
48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (RIGHT_PAREN . (parameter_specification . 3))
(SEMICOLON . (parameter_specification . 3)))
- ((default . error) (COLON_EQUAL . 1077) (DOT . 90) (TICK . 91)
(RIGHT_PAREN . (parameter_specification . 2)) (SEMICOLON .
(parameter_specification . 2)) (LEFT_PAREN . 107))
+ ((default . error) (COLON_EQUAL . 1079) (DOT . 90) (TICK . 91)
(RIGHT_PAREN . (parameter_specification . 2)) (SEMICOLON .
(parameter_specification . 2)) (LEFT_PAREN . 107))
((default . error) (IDENTIFIER . (formal_object_declaration . 2)) (WITH
. (formal_object_declaration . 2)) (USE . (formal_object_declaration . 2))
(TYPE . (formal_object_declaration . 2)) (PRAGMA . (formal_object_declaration .
2)) (FUNCTION . (formal_object_declaration . 2)) (PROCEDURE .
(formal_object_declaration . 2)) (PACKAGE . (formal_object_declaration . 2)))
- ((default . error) (SEMICOLON . 1076))
- ((default . error) (SEMICOLON . 1075))
- ((default . error) (RIGHT_PAREN . 1074))
+ ((default . error) (SEMICOLON . 1078))
+ ((default . error) (SEMICOLON . 1077))
+ ((default . error) (RIGHT_PAREN . 1076))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (WITH . ( 1072 (formal_derived_type_definition . 1)))
(SEMICOLON . (formal_derived_type_definition . 1)))
- ((default . error) (AND . 1071) (WITH . (interface_type_definition .
1)) (SEMICOLON . (interface_type_definition . 1)))
+ ((default . error) (WITH . ( 1074 (formal_derived_type_definition . 1)))
(SEMICOLON . (formal_derived_type_definition . 1)))
+ ((default . error) (AND . 1073) (WITH . (interface_type_definition .
1)) (SEMICOLON . (interface_type_definition . 1)))
((default . error) (DOT . 90) (SEMICOLON . (interface_list . 0)) (WITH
. (interface_list . 0)) (AND . (interface_list . 0)) (TICK . 91) (LEFT_PAREN .
107))
- ((default . error) (AND . 1071) (WITH . (interface_type_definition .
3)) (SEMICOLON . (interface_type_definition . 3)))
- ((default . error) (AND . 1071) (WITH . (interface_type_definition .
2)) (SEMICOLON . (interface_type_definition . 2)))
- ((default . error) (AND . 1071) (WITH . (interface_type_definition .
0)) (SEMICOLON . (interface_type_definition . 0)))
+ ((default . error) (AND . 1073) (WITH . (interface_type_definition .
3)) (SEMICOLON . (interface_type_definition . 3)))
+ ((default . error) (AND . 1073) (WITH . (interface_type_definition .
2)) (SEMICOLON . (interface_type_definition . 2)))
+ ((default . error) (AND . 1073) (WITH . (interface_type_definition .
0)) (SEMICOLON . (interface_type_definition . 0)))
((default . error) (SEMICOLON . (formal_type_definition . 7)) (WITH .
(formal_type_definition . 7)))
- ((default . error) (FOR . 146) (CASE . 145) (IF . 147) (RIGHT_PAREN .
((expression_opt . 0) (association_opt . 0))) (COMMA . ((expression_opt . 0)
(association_opt . 0))) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (IDENTIFIER . 48) (CHARACTER_LITERAL . 157)
(STRING_LITERAL . 49) (PLUS . 155) (MINUS . 154) (OTHERS . 152) (ABS .
144) (NOT . 1068) (RAISE . 153) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW .
149) (LEFT_PAREN . 148))
- ((default . error) (BOX . 1067) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49) (PLUS . 155) (MINUS . 154) (ABS . 144) (NOT .
324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
+ ((default . error) (FOR . 146) (CASE . 145) (IF . 147) (RIGHT_PAREN .
((expression_opt . 0) (association_opt . 0))) (COMMA . ((expression_opt . 0)
(association_opt . 0))) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (IDENTIFIER . 48) (CHARACTER_LITERAL . 157)
(STRING_LITERAL . 49) (PLUS . 155) (MINUS . 154) (OTHERS . 152) (ABS .
144) (NOT . 1070) (RAISE . 153) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW .
149) (LEFT_PAREN . 148))
+ ((default . error) (BOX . 1069) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49) (PLUS . 155) (MINUS . 154) (ABS . 144) (NOT .
324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
((default . error) (LOOP . (subtype_indication . 2)) (DO .
(subtype_indication . 2)) (RIGHT_PAREN . (subtype_indication . 2)) (COMMA .
(subtype_indication . 2)) (EQUAL_GREATER . (subtype_indication . 2))
(COLON_EQUAL . (subtype_indication . 2)) (WITH . (subtype_indication . 2))
(SEMICOLON . (subtype_indication . 2)) (AND . (subtype_indication . 2)) (OF .
(subtype_indication . 2)))
((default . error) (LOOP . (constraint . 1)) (DO . (constraint . 1))
(RIGHT_PAREN . (constraint . 1)) (COMMA . (constraint . 1)) (EQUAL_GREATER .
(constraint . 1)) (COLON_EQUAL . (constraint . 1)) (WITH . (constraint . 1))
(SEMICOLON . (constraint . 1)) (AND . (constraint . 1)) (OF . (constraint . 1)))
- ((default . error) (OF . 1066))
+ ((default . error) (OF . 1068))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (OF . 1063))
+ ((default . error) (OF . 1065))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 155) (MINUS . 154) (ABS . 144) (NOT . 728)
(NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
((default . error) (DOT . (name . 0)) (LEFT_PAREN . (name . 0)) (TICK .
(name . 0)) (SEMICOLON . (null_exclusion_opt_name_type . 2)) (RIGHT_PAREN .
(null_exclusion_opt_name_type . 2)) (COLON_EQUAL .
(null_exclusion_opt_name_type . 2)))
((default . error) (DOT . (name . 3)) (LEFT_PAREN . (name . 3)) (TICK .
(name . 3)) (SEMICOLON . (null_exclusion_opt_name_type . 3)) (RIGHT_PAREN .
(null_exclusion_opt_name_type . 3)) (COLON_EQUAL .
(null_exclusion_opt_name_type . 3)))
@@ -2651,35 +2668,35 @@
((default . error) (SEMICOLON . (discriminant_specification_opt . 1))
(RIGHT_PAREN . (discriminant_specification_opt . 1)))
((default . error) (WHEN . (record_representation_clause . 0)) (END .
(record_representation_clause . 0)) (PRIVATE . (record_representation_clause .
0)) (CASE . (record_representation_clause . 0)) (IDENTIFIER .
(record_representation_clause . 0)) (USE . (record_representation_clause . 0))
(TYPE . (record_representation_clause . 0)) (TASK .
(record_representation_clause . 0)) (SUBTYPE . (record_representation_clause .
0)) (PROTECTED . (record_representation_clause . 0)) (PROCEDURE . [...]
((default . error) (WHEN . (enumeration_representation_clause . 0)) (END
. (enumeration_representation_clause . 0)) (PRIVATE .
(enumeration_representation_clause . 0)) (CASE .
(enumeration_representation_clause . 0)) (IDENTIFIER .
(enumeration_representation_clause . 0)) (USE .
(enumeration_representation_clause . 0)) (TYPE .
(enumeration_representation_clause . 0)) (TASK .
(enumeration_representation_clause . 0)) (SUBTYPE .
(enumeration_representation_clause . 0)) (PROTECTED . (en [...]
- ((default . error) (MOD . 1061))
- ((default . error) (IDENTIFIER . 1058))
- ((default . error) (SEMICOLON . 1057))
+ ((default . error) (MOD . 1063))
+ ((default . error) (IDENTIFIER . 1060))
+ ((default . error) (SEMICOLON . 1059))
((default . error) (WHEN . (aspect_clause . 0)) (PRIVATE .
(aspect_clause . 0)) (END . (aspect_clause . 0)) (CASE . (aspect_clause . 0))
(BEGIN . (aspect_clause . 0)) (ENTRY . (aspect_clause . 0)) (FOR .
(aspect_clause . 0)) (FUNCTION . (aspect_clause . 0)) (GENERIC . (aspect_clause
. 0)) (NOT . (aspect_clause . 0)) (OVERRIDING . (aspect_clause . 0)) (PACKAGE .
(aspect_clause . 0)) (PRAGMA . (aspect_clause . 0)) (PROCEDURE . (aspect_clause
. 0)) (PROTECTED . (aspect_clause . 0)) (S [...]
((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (END . 1053) (PRIVATE . 1054))
- ((default . error) (SEMICOLON . 1052))
- ((default . error) (IS . 1051))
+ ((default . error) (END . 1055) (PRIVATE . 1056))
+ ((default . error) (SEMICOLON . 1054))
+ ((default . error) (IS . 1053))
((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
- ((default . error) (SEMICOLON . 1049))
+ ((default . error) (SEMICOLON . 1051))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (END . 1046) (PRIVATE . 1047))
- ((default . error) (SEMICOLON . 1045))
- ((default . error) (SEMICOLON . 1044) (IS . 1043))
+ ((default . error) (END . 1048) (PRIVATE . 1049))
+ ((default . error) (SEMICOLON . 1047))
+ ((default . error) (SEMICOLON . 1046) (IS . 1045))
((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
- ((default . error) (SYNCHRONIZED . 555) (TAGGED . 556) (NEW .
((abstract_limited_opt . 3) (abstract_limited_synchronized_opt . 3))) (LIMITED
. 1041))
+ ((default . error) (SYNCHRONIZED . 555) (TAGGED . 556) (NEW .
((abstract_limited_opt . 3) (abstract_limited_synchronized_opt . 3))) (LIMITED
. 1043))
((default . error) (RANGE . (expression_opt . 0)) (WITH .
(expression_opt . 0)) (SEMICOLON . (expression_opt . 0)) (DIGITS .
(expression_opt . 0)) (RAISE . 153) (PLUS . 155) (MINUS . 154) (ABS . 144)
(NOT . 324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER .
48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (RANGE . (expression_opt . 0)) (WITH .
(expression_opt . 0)) (SEMICOLON . (expression_opt . 0)) (RAISE . 153) (PLUS .
155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
- ((default . error) (IDENTIFIER . 1035) (CHARACTER_LITERAL . 1036))
+ ((default . error) (IDENTIFIER . 1037) (CHARACTER_LITERAL . 1038))
((default . error) (INTERFACE . 549) (PRIVATE .
(abstract_tagged_limited_opt . 5)) (NULL . (abstract_tagged_limited_opt . 5))
(RECORD . (abstract_tagged_limited_opt . 5)) (NEW . ((abstract_limited_opt . 2)
(abstract_limited_synchronized_opt . 4))))
((default . error) (SEMICOLON . (expression_opt . 0)) (WITH .
(expression_opt . 0)) (RAISE . 153) (PLUS . 155) (MINUS . 154) (ABS . 144)
(NOT . 324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER .
48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (RECORD . 1033))
+ ((default . error) (RECORD . 1035))
((default . error) (PLUS . 155) (MINUS . 154) (ABS . 144) (NOT .
324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (END . (component_list_opt . 0)) (NULL . 1024) (CASE
. 1023) (IDENTIFIER . 77) (FOR . 269))
- ((default . error) (SEMICOLON . 1022) (PRIVATE .
(abstract_tagged_limited_opt . 4)) (NULL . (abstract_tagged_limited_opt . 4))
(RECORD . (abstract_tagged_limited_opt . 4)) (LIMITED . 543))
- ((default . error) (NEW . 1021))
- ((default . error) (NEW . 1020))
- ((default . error) (PRIVATE . 1018) (RECORD . 858) (NULL . 856))
+ ((default . error) (END . (component_list_opt . 0)) (NULL . 1026) (CASE
. 1025) (IDENTIFIER . 77) (FOR . 269))
+ ((default . error) (SEMICOLON . 1024) (PRIVATE .
(abstract_tagged_limited_opt . 4)) (NULL . (abstract_tagged_limited_opt . 4))
(RECORD . (abstract_tagged_limited_opt . 4)) (LIMITED . 543))
+ ((default . error) (NEW . 1023))
+ ((default . error) (NEW . 1022))
+ ((default . error) (PRIVATE . 1020) (RECORD . 858) (NULL . 856))
((default . error) (WITH . (type_definition . 8)) (SEMICOLON .
(type_definition . 8)))
((default . error) (WITH . (type_definition . 6)) (SEMICOLON .
(type_definition . 6)))
((default . error) (WITH . (type_definition . 9)) (SEMICOLON .
(type_definition . 9)))
@@ -2691,62 +2708,63 @@
((default . error) (DOT . 90) (TICK . 91) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (SEMICOLON . (package_specification . 0)))
- ((default . error) (SEMICOLON . 1013))
- ((default . error) (NULL . 1012))
+ ((default . error) (SEMICOLON . 1015))
+ ((default . error) (NULL . 1014))
+ ((default . error) (COLON_EQUAL . 1012) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109))
((default . error) (COLON_EQUAL . 1010) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109))
((default . error) (COLON_EQUAL . 1008) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109))
- ((default . error) (COLON_EQUAL . 1006) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109))
+ ((default . error) (SEMICOLON . 1007))
+ ((default . error) (SEMICOLON . 1006))
((default . error) (SEMICOLON . 1005))
((default . error) (SEMICOLON . 1004))
- ((default . error) (SEMICOLON . 1003))
- ((default . error) (SEMICOLON . 1002))
- ((default . error) (RIGHT_PAREN . 1001))
- ((default . error) (RIGHT_PAREN . 1000))
- ((default . error) (SEMICOLON . 999))
- ((default . error) (RIGHT_PAREN . 998))
+ ((default . error) (COMMA . 267) (RIGHT_PAREN . 1003))
+ ((default . error) (RIGHT_PAREN . 1002))
+ ((default . error) (COMMA . (association_opt . 5)) (RIGHT_PAREN . ( 1001
(association_opt . 5))))
+ ((default . error) (SEMICOLON . 1000))
+ ((default . error) (RIGHT_PAREN . 999))
((default . error) (SEMICOLON . (name_opt . 0)) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
((default . error) (END . (package_body . 1)) (BEGIN . (package_body .
1)) (ENTRY . (package_body . 1)) (FOR . (package_body . 1)) (PROTECTED .
(package_body . 1)) (SUBTYPE . (package_body . 1)) (TASK . (package_body . 1))
(TYPE . (package_body . 1)) (IDENTIFIER . (package_body . 1)) (WITH .
(package_body . 1)) (USE . (package_body . 1)) (SEPARATE . (package_body . 1))
(PROCEDURE . (package_body . 1)) (PRIVATE . (package_body . 1)) (PRAGMA .
(package_body . 1)) (PACKAGE . (package_ [...]
((default . error) (THEN . (range . 0)) (RANGE . (range . 0)) (DIGITS .
(range . 0)) (ELSE . (range . 0)) (ELSIF . (range . 0)) (DO . (range . 0))
(LOOP . (range . 0)) (XOR . (range . 0)) (OR . (range . 0)) (AND . (range . 0))
(WITH . (range . 0)) (IS . (range . 0)) (SEMICOLON . (range . 0)) (COLON_EQUAL
. (range . 0)) (OF . (range . 0)) (BAR . (range . 0)) (EQUAL_GREATER . (range .
0)) (RIGHT_PAREN . (range . 0)) (COMMA . (range . 0)))
((default . error) (LOOP . (aggregate . 3)) (DO . (aggregate . 3)) (OF .
(aggregate . 3)) (ACCEPT . (aggregate . 3)) (ABORT . (aggregate . 3)) (BEGIN .
(aggregate . 3)) (CASE . (aggregate . 3)) (DECLARE . (aggregate . 3)) (DELAY .
(aggregate . 3)) (EXIT . (aggregate . 3)) (FOR . (aggregate . 3)) (GOTO .
(aggregate . 3)) (IF . (aggregate . 3)) (NULL . (aggregate . 3)) (PRAGMA .
(aggregate . 3)) (RAISE . (aggregate . 3)) (REQUEUE . (aggregate . 3)) (SELECT
. (aggregate . 3)) (WHILE . [...]
((default . error) (RIGHT_PAREN . (expression_opt . 0)) (RAISE . 153)
(PLUS . 155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (ELSIF . (elsif_expression_list . 1)) (ELSE .
(elsif_expression_list . 1)) (RIGHT_PAREN . (elsif_expression_list . 1)))
- ((default . error) (THEN . 995))
+ ((default . error) (THEN . 996))
((default . error) (RIGHT_PAREN . (if_expression . 2)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 155) (MINUS . 154) (ABS . 144) (NOT . 324)
(NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
((default . error) (LOOP . (iterator_specification . 0)) (EQUAL_GREATER
. (iterator_specification . 0)))
((default . error) (PLUS . (primary . 1)) (MINUS . (primary . 1))
(AMPERSAND . (primary . 1)) (DOT_DOT . (primary . 1)) (MOD . (primary . 1))
(REM . (primary . 1)) (SLASH . (primary . 1)) (STAR . (primary . 1))
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
((default . error) (DOT . 90) (TICK . 91) (LOOP .
(iterator_specification . 4)) (EQUAL_GREATER . (iterator_specification . 4))
(LEFT_PAREN . 107))
- ((default . error) (REVERSE . 992) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (REVERSE . 993) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (COMMA . (expression_opt . 0)) (RIGHT_PAREN .
(expression_opt . 0)) (RAISE . 153) (PLUS . 155) (MINUS . 154) (ABS . 144)
(NOT . 324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER .
48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (RIGHT_PAREN . (case_expression_alternative_list .
1)) (COMMA . (case_expression_alternative_list . 1)))
- ((default . error) (END . (protected_operation_item_list_opt . 0))
(ENTRY . 979) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(FOR . 269))
+ ((default . error) (END . (protected_operation_item_list_opt . 0))
(ENTRY . 980) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(FOR . 269))
((default . error) (BEGIN . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 272) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 269) (IDENTIFIER . 275) (TYPE
. 274) (GENERIC . 2) (PROTECTED . 271) (TASK . 273) (PACKAGE . 270))
((default . error) (FOR . 146) (CASE . 145) (IF . 147) (RIGHT_PAREN .
((expression_opt . 0) (association_opt . 0))) (COMMA . ((expression_opt . 0)
(association_opt . 0))) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (OTHERS . 152) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 157) (STRING_LITERAL . 49) (RAISE . 153) (PLUS . 155)
(MINUS . 154) (ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 156) (NULL . 151)
(NEW . 149) (LEFT_PAREN . 148))
((default . error) (SEMICOLON . (actual_parameter_part_opt . 1))
(LEFT_PAREN . (actual_parameter_part_opt . 1)) (DO . (actual_parameter_part_opt
. 1)))
((default . error) (DO . (parameter_profile_opt . 0)) (SEMICOLON .
(parameter_profile_opt . 0)) (LEFT_PAREN . 801))
((default . error) (OR . (simple_statement . 8)) (THEN .
(simple_statement . 8)) (WHEN . (simple_statement . 8)) (EXCEPTION .
(simple_statement . 8)) (END . (simple_statement . 8)) (LESS_LESS .
(simple_statement . 8)) (ACCEPT . (simple_statement . 8)) (ABORT .
(simple_statement . 8)) (BEGIN . (simple_statement . 8)) (CASE .
(simple_statement . 8)) (DECLARE . (simple_statement . 8)) (DELAY .
(simple_statement . 8)) (EXIT . (simple_statement . 8)) (FOR .
(simple_statement . 8)) (GOTO [...]
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
710))
- ((default . error) (WHEN . 973))
+ ((default . error) (WHEN . 974))
((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt [...]
((default . error) (WHEN . (delay_statement . 1)) (EXCEPTION .
(delay_statement . 1)) (ELSIF . (delay_statement . 1)) (THEN . (delay_statement
. 1)) (ELSE . (delay_statement . 1)) (OR . (delay_statement . 1)) (END .
(delay_statement . 1)) (ACCEPT . (delay_statement . 1)) (ABORT .
(delay_statement . 1)) (BEGIN . (delay_statement . 1)) (CASE . (delay_statement
. 1)) (DECLARE . (delay_statement . 1)) (DELAY . (delay_statement . 1)) (EXIT .
(delay_statement . 1)) (FOR . (delay_statemen [...]
- ((default . error) (SEMICOLON . 971))
+ ((default . error) (SEMICOLON . 972))
((default . error) (SEMICOLON . (expression_opt . 0)) (RAISE . 153)
(PLUS . 155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (OR . (exit_statement . 1)) (THEN . (exit_statement .
1)) (WHEN . (exit_statement . 1)) (EXCEPTION . (exit_statement . 1)) (END .
(exit_statement . 1)) (LESS_LESS . (exit_statement . 1)) (ACCEPT .
(exit_statement . 1)) (ABORT . (exit_statement . 1)) (BEGIN . (exit_statement .
1)) (CASE . (exit_statement . 1)) (DECLARE . (exit_statement . 1)) (DELAY .
(exit_statement . 1)) (EXIT . (exit_statement . 1)) (FOR . (exit_statement .
1)) (GOTO . (exit_statement . 1)) (IF [...]
((default . error) (OR . (simple_statement . 3)) (THEN .
(simple_statement . 3)) (WHEN . (simple_statement . 3)) (EXCEPTION .
(simple_statement . 3)) (END . (simple_statement . 3)) (LESS_LESS .
(simple_statement . 3)) (ACCEPT . (simple_statement . 3)) (ABORT .
(simple_statement . 3)) (BEGIN . (simple_statement . 3)) (CASE .
(simple_statement . 3)) (DECLARE . (simple_statement . 3)) (DELAY .
(simple_statement . 3)) (EXIT . (simple_statement . 3)) (FOR .
(simple_statement . 3)) (GOTO [...]
((default . error) (ELSIF . (sequence_of_statements_opt . 0)) (ELSE .
(sequence_of_statements_opt . 0)) (END . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0))
(EXIT . (label_opt . 0)) (GOTO [...]
- ((default . error) (LOOP . 968))
+ ((default . error) (LOOP . 969))
((default . error) (SEMICOLON . (expression_opt . 0)) (RAISE . 153)
(PLUS . 155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (OR . (raise_statement . 2)) (THEN . (raise_statement
. 2)) (WHEN . (raise_statement . 2)) (EXCEPTION . (raise_statement . 2)) (END .
(raise_statement . 2)) (LESS_LESS . (raise_statement . 2)) (ACCEPT .
(raise_statement . 2)) (ABORT . (raise_statement . 2)) (BEGIN .
(raise_statement . 2)) (CASE . (raise_statement . 2)) (DECLARE .
(raise_statement . 2)) (DELAY . (raise_statement . 2)) (EXIT . (raise_statement
. 2)) (FOR . (raise_statement . 2)) (GOTO . (raise_stat [...]
- ((default . error) (ABORT . 966))
+ ((default . error) (ABORT . 967))
((default . error) (OR . (requeue_statement . 1)) (THEN .
(requeue_statement . 1)) (WHEN . (requeue_statement . 1)) (EXCEPTION .
(requeue_statement . 1)) (END . (requeue_statement . 1)) (LESS_LESS .
(requeue_statement . 1)) (ACCEPT . (requeue_statement . 1)) (ABORT .
(requeue_statement . 1)) (BEGIN . (requeue_statement . 1)) (CASE .
(requeue_statement . 1)) (DECLARE . (requeue_statement . 1)) (DELAY .
(requeue_statement . 1)) (EXIT . (requeue_statement . 1)) (FOR .
(requeue_stateme [...]
((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt [...]
((default . error) (OR . (extended_return_statement . 1)) (THEN .
(extended_return_statement . 1)) (WHEN . (extended_return_statement . 1))
(EXCEPTION . (extended_return_statement . 1)) (END . (extended_return_statement
. 1)) (LESS_LESS . (extended_return_statement . 1)) (ACCEPT .
(extended_return_statement . 1)) (ABORT . (extended_return_statement . 1))
(BEGIN . (extended_return_statement . 1)) (CASE . (extended_return_statement .
1)) (DECLARE . (extended_return_statement . 1)) (D [...]
((default . error) (OR . (simple_return_statement . 1)) (THEN .
(simple_return_statement . 1)) (WHEN . (simple_return_statement . 1))
(EXCEPTION . (simple_return_statement . 1)) (END . (simple_return_statement .
1)) (LESS_LESS . (simple_return_statement . 1)) (ACCEPT .
(simple_return_statement . 1)) (ABORT . (simple_return_statement . 1)) (BEGIN .
(simple_return_statement . 1)) (CASE . (simple_return_statement . 1)) (DECLARE
. (simple_return_statement . 1)) (DELAY . (simple_return_ [...]
((default . error) (CONSTANT . (aliased_opt . 0)) (ACCESS . (aliased_opt
. 0)) (NOT . (aliased_opt . 0)) (IDENTIFIER . (aliased_opt . 0))
(STRING_LITERAL . (aliased_opt . 0)) (CHARACTER_LITERAL . (aliased_opt . 0))
(ALIASED . 523))
- ((default . error) (ABORT . 963))
+ ((default . error) (ABORT . 964))
((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt . 0)) (NULL . (label_opt . 0)) (PRAGMA .
(label_opt . 0)) (RAISE . (labe [...]
- ((default . error) (SELECT . 961))
+ ((default . error) (SELECT . 962))
((default . error) (WHEN . 685) (TERMINATE . 684) (ACCEPT . 622)
(DELAY . 627))
((default . error) (OR . (entry_call_alternative . 0)) (ELSE .
(entry_call_alternative . 0)) (THEN . (triggering_alternative . 0)))
((default . error) (OR . (entry_call_alternative . 1)) (ELSE .
(entry_call_alternative . 1)) (THEN . (triggering_alternative . 1)))
@@ -2754,143 +2772,144 @@
((default . error) (DELAY . 627))
((default . error) (OR . (delay_alternative . 0)) (END .
(delay_alternative . 0)) (ELSE . (delay_alternative . 0)) (THEN .
(triggering_alternative . 2)))
((default . error) (END . (select_alternative . 1)) (OR .
(select_alternative . 1)) (ELSE . (select_alternative . 1)))
- ((default . error) (EQUAL_GREATER . 956))
+ ((default . error) (EQUAL_GREATER . 957))
((default . error) (END . (select_alternative . 5)) (OR .
(select_alternative . 5)) (ELSE . (select_alternative . 5)))
((default . error) (OR . (goto_label . 0)) (THEN . (goto_label . 0))
(WHEN . (goto_label . 0)) (LESS_LESS . (goto_label . 0)) (END . (goto_label .
0)) (EXCEPTION . (goto_label . 0)) (ELSE . (goto_label . 0)) (ELSIF .
(goto_label . 0)) (CHARACTER_LITERAL . (goto_label . 0)) (STRING_LITERAL .
(goto_label . 0)) (IDENTIFIER . (goto_label . 0)) (REQUEUE . (goto_label . 0))
(RAISE . (goto_label . 0)) (PRAGMA . (goto_label . 0)) (NULL . (goto_label .
0)) (GOTO . (goto_label . 0)) (EXIT . [...]
- ((default . error) (SEMICOLON . 955))
- ((default . error) (END . 954))
- ((default . error) (SEMICOLON . 953))
- ((default . error) (OTHERS . 948) (IDENTIFIER . 949)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
+ ((default . error) (SEMICOLON . 956))
+ ((default . error) (END . 955))
+ ((default . error) (SEMICOLON . 954))
+ ((default . error) (OTHERS . 949) (IDENTIFIER . 950)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
((default . error) (END . (exception_handler_list . 0)) (WHEN .
(exception_handler_list . 0)))
- ((default . error) (END . (exception_handler_list_opt . 1)) (WHEN .
943))
+ ((default . error) (END . (exception_handler_list_opt . 1)) (WHEN .
944))
((default . error) (END . (handled_sequence_of_statements . 0)))
((default . error) (WHEN . (exception_handler_list . 1)) (END .
(exception_handler_list . 1)))
((default . error) (BAR . (exception_choice . 1)) (EQUAL_GREATER .
(exception_choice . 1)))
- ((default . error) (COLON . 1175) (EQUAL_GREATER . (name . 0)) (BAR .
(name . 0)) (LEFT_PAREN . (name . 0)) (DOT . (name . 0)) (TICK . (name . 0)))
+ ((default . error) (COLON . 1177) (EQUAL_GREATER . (name . 0)) (BAR .
(name . 0)) (LEFT_PAREN . (name . 0)) (DOT . (name . 0)) (TICK . (name . 0)))
((default . error) (EQUAL_GREATER . (exception_choice_list . 0)) (BAR .
(exception_choice_list . 0)))
- ((default . error) (BAR . 1173) (EQUAL_GREATER . 1174))
+ ((default . error) (BAR . 1175) (EQUAL_GREATER . 1176))
((default . error) (DOT . 90) (BAR . (exception_choice . 0))
(EQUAL_GREATER . (exception_choice . 0)) (TICK . 91) (LEFT_PAREN . 107))
((default . error) (WHEN . (assignment_statement . 0)) (THEN .
(assignment_statement . 0)) (OR . (assignment_statement . 0)) (ELSIF .
(assignment_statement . 0)) (ELSE . (assignment_statement . 0))
(CHARACTER_LITERAL . (assignment_statement . 0)) (STRING_LITERAL .
(assignment_statement . 0)) (IDENTIFIER . (assignment_statement . 0)) (WHILE .
(assignment_statement . 0)) (SELECT . (assignment_statement . 0)) (RETURN .
(assignment_statement . 0)) (REQUEUE . (assignment_statement . 0)) [...]
- ((default . error) (LOOP . 1172))
+ ((default . error) (LOOP . 1174))
((default . error) (IDENTIFIER . (subprogram_body . 0)) (TYPE .
(subprogram_body . 0)) (TASK . (subprogram_body . 0)) (SUBTYPE .
(subprogram_body . 0)) (PROTECTED . (subprogram_body . 0)) (FOR .
(subprogram_body . 0)) (ENTRY . (subprogram_body . 0)) (BEGIN .
(subprogram_body . 0)) (END . (subprogram_body . 0)) ($EOI . (subprogram_body .
0)) (FUNCTION . (subprogram_body . 0)) (GENERIC . (subprogram_body . 0))
(LIMITED . (subprogram_body . 0)) (NOT . (subprogram_body . 0)) (OVERRIDIN [...]
- ((default . error) (TERMINATE . 1169) (ACCEPT . 622) (DELAY . 627))
- ((default . error) (END . 1168))
+ ((default . error) (TERMINATE . 1171) (ACCEPT . 622) (DELAY . 627))
+ ((default . error) (END . 1170))
((default . error) (END . (sequence_of_statements_opt . 0)) (OR .
(sequence_of_statements_opt . 0)) (ELSE . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0))
(EXIT . (label_opt . 0)) (GOTO . ( [...]
- ((default . error) (END . 1166))
+ ((default . error) (END . 1168))
((default . error) (ELSE . (select_alternative_list . 1)) (END .
(select_alternative_list . 1)) (OR . (select_alternative_list . 1)))
- ((default . error) (SEMICOLON . 1165))
- ((default . error) (END . 1164))
+ ((default . error) (SEMICOLON . 1167))
+ ((default . error) (END . 1166))
((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt . 0)) (NULL . (label_opt . 0)) (PRAGMA .
(label_opt . 0)) (RAISE . (labe [...]
((default . error) (ACCESS . (constant_opt . 0)) (NOT . (constant_opt .
0)) (IDENTIFIER . (constant_opt . 0)) (STRING_LITERAL . (constant_opt . 0))
(CHARACTER_LITERAL . (constant_opt . 0)) (CONSTANT . 753))
- ((default . error) (END . 1161))
- ((default . error) (SEMICOLON . 1160))
- ((default . error) (SEMICOLON . 1159))
+ ((default . error) (END . 1163))
+ ((default . error) (SEMICOLON . 1162))
+ ((default . error) (SEMICOLON . 1161))
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
710))
- ((default . error) (ELSE . 1153) (END . 1155) (ELSIF . 1154))
- ((default . error) (SEMICOLON . 1152))
+ ((default . error) (ELSE . 1155) (END . 1157) (ELSIF . 1156))
+ ((default . error) (SEMICOLON . 1154))
((default . error) (WHEN . (delay_statement . 0)) (ELSIF .
(delay_statement . 0)) (EXCEPTION . (delay_statement . 0)) (CHARACTER_LITERAL .
(delay_statement . 0)) (STRING_LITERAL . (delay_statement . 0)) (IDENTIFIER .
(delay_statement . 0)) (LESS_LESS . (delay_statement . 0)) (WHILE .
(delay_statement . 0)) (SELECT . (delay_statement . 0)) (RETURN .
(delay_statement . 0)) (REQUEUE . (delay_statement . 0)) (RAISE .
(delay_statement . 0)) (PRAGMA . (delay_statement . 0)) (NULL . (dela [...]
- ((default . error) (END . 1151))
+ ((default . error) (END . 1153))
((default . error) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (OTHERS . 152) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (PLUS . 155) (MINUS . 154)
(ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
((default . error) (END . (case_statement_alternative_list . 0)) (WHEN .
(case_statement_alternative_list . 0)))
- ((default . error) (END . 1148) (WHEN . 973))
- ((default . error) (SEMICOLON . 1147))
- ((default . error) (DO . 1145) (SEMICOLON . 1146))
- ((default . error) (BEGIN . 1144))
- ((default . error) (IDENTIFIER . 1143))
+ ((default . error) (END . 1150) (WHEN . 974))
+ ((default . error) (SEMICOLON . 1149))
+ ((default . error) (DO . 1147) (SEMICOLON . 1148))
+ ((default . error) (BEGIN . 1146))
+ ((default . error) (IDENTIFIER . 1145))
((default . error) (PROCEDURE . (protected_operation_item . 5))
(OVERRIDING . (protected_operation_item . 5)) (NOT . (protected_operation_item
. 5)) (FUNCTION . (protected_operation_item . 5)) (FOR .
(protected_operation_item . 5)) (ENTRY . (protected_operation_item . 5)) (END .
(protected_operation_item . 5)))
((default . error) (PROCEDURE . (protected_operation_item . 2))
(OVERRIDING . (protected_operation_item . 2)) (NOT . (protected_operation_item
. 2)) (FUNCTION . (protected_operation_item . 2)) (FOR .
(protected_operation_item . 2)) (ENTRY . (protected_operation_item . 2)) (END .
(protected_operation_item . 2)))
((default . error) (PROCEDURE . (protected_operation_item . 3))
(OVERRIDING . (protected_operation_item . 3)) (NOT . (protected_operation_item
. 3)) (FUNCTION . (protected_operation_item . 3)) (FOR .
(protected_operation_item . 3)) (ENTRY . (protected_operation_item . 3)) (END .
(protected_operation_item . 3)))
((default . error) (PROCEDURE . (protected_operation_item . 4))
(OVERRIDING . (protected_operation_item . 4)) (NOT . (protected_operation_item
. 4)) (FUNCTION . (protected_operation_item . 4)) (FOR .
(protected_operation_item . 4)) (ENTRY . (protected_operation_item . 4)) (END .
(protected_operation_item . 4)))
((default . error) (FUNCTION . 1) (PROCEDURE . 9))
((default . error) (END . (protected_operation_item_list . 0)) (ENTRY .
(protected_operation_item_list . 0)) (FOR . (protected_operation_item_list .
0)) (FUNCTION . (protected_operation_item_list . 0)) (NOT .
(protected_operation_item_list . 0)) (OVERRIDING .
(protected_operation_item_list . 0)) (PROCEDURE .
(protected_operation_item_list . 0)))
- ((default . error) (END . (protected_operation_item_list_opt . 1))
(ENTRY . 979) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(FOR . 269))
- ((default . error) (END . 1140))
+ ((default . error) (END . (protected_operation_item_list_opt . 1))
(ENTRY . 980) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(FOR . 269))
+ ((default . error) (END . 1142))
((default . error) (PROCEDURE . (protected_operation_item . 1))
(OVERRIDING . (protected_operation_item . 1)) (NOT . (protected_operation_item
. 1)) (FUNCTION . (protected_operation_item . 1)) (FOR .
(protected_operation_item . 1)) (ENTRY . (protected_operation_item . 1)) (END .
(protected_operation_item . 1)))
((default . error) (PROCEDURE . (protected_operation_item . 0))
(OVERRIDING . (protected_operation_item . 0)) (NOT . (protected_operation_item
. 0)) (FUNCTION . (protected_operation_item . 0)) (FOR .
(protected_operation_item . 0)) (ENTRY . (protected_operation_item . 0)) (END .
(protected_operation_item . 0)))
((default . error) (COMMA . (case_expression_alternative . 0))
(RIGHT_PAREN . (case_expression_alternative . 0)))
- ((default . error) (DO . (subtype_indication . 1)) (LOOP .
(subtype_indication . 1)) (COLON_EQUAL . (subtype_indication . 1)) (SEMICOLON .
(subtype_indication . 1)) (OF . (subtype_indication . 1)) (AND .
(subtype_indication . 1)) (WITH . (subtype_indication . 1)) (EQUAL_GREATER .
(subtype_indication . 1)) (COMMA . (subtype_indication . 1)) (RIGHT_PAREN .
(subtype_indication . 1)) (DOT . 90) (TICK . 91) (RANGE . 895) (LEFT_PAREN .
820))
+ ((default . error) (DO . (subtype_indication . 1)) (LOOP .
(subtype_indication . 1)) (COLON_EQUAL . (subtype_indication . 1)) (SEMICOLON .
(subtype_indication . 1)) (OF . (subtype_indication . 1)) (AND .
(subtype_indication . 1)) (WITH . (subtype_indication . 1)) (EQUAL_GREATER .
(subtype_indication . 1)) (COMMA . (subtype_indication . 1)) (RIGHT_PAREN .
(subtype_indication . 1)) (DOT . 90) (TICK . 91) (RANGE . 896) (LEFT_PAREN .
820))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (DOT . 90) (TICK . 91) (LOOP .
(iterator_specification . 3)) (EQUAL_GREATER . (iterator_specification . 3))
(LEFT_PAREN . 107))
((default . error) (DO . (constraint . 0)) (LOOP . (constraint . 0)) (OF
. (constraint . 0)) (AND . (constraint . 0)) (SEMICOLON . (constraint . 0))
(WITH . (constraint . 0)) (COLON_EQUAL . (constraint . 0)) (EQUAL_GREATER .
(constraint . 0)) (RIGHT_PAREN . (constraint . 0)) (COMMA . (constraint . 0)))
((default . error) (ELSE . (expression_opt . 0)) (ELSIF .
(expression_opt . 0)) (RIGHT_PAREN . (expression_opt . 0)) (RAISE . 153) (PLUS
. 155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156) (NULL
. 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (RIGHT_PAREN . (if_expression . 0)))
- ((default . error) (SEMICOLON . 1136))
+ ((default . error) (SEMICOLON . 1138))
((default . error) (WITH . (parameter_profile_opt . 0)) (SEMICOLON .
(parameter_profile_opt . 0)) (LEFT_PAREN . 801))
((default . error) (IDENTIFIER . (entry_declaration . 1)) (USE .
(entry_declaration . 1)) (TYPE . (entry_declaration . 1)) (TASK .
(entry_declaration . 1)) (SUBTYPE . (entry_declaration . 1)) (PROTECTED .
(entry_declaration . 1)) (PROCEDURE . (entry_declaration . 1)) (PRAGMA .
(entry_declaration . 1)) (PACKAGE . (entry_declaration . 1)) (OVERRIDING .
(entry_declaration . 1)) (NOT . (entry_declaration . 1)) (GENERIC .
(entry_declaration . 1)) (FUNCTION . (entry_declaration . 1)) (FO [...]
((default . error) (WITH . (paren_expression . 0)) (SEMICOLON .
(paren_expression . 0)))
+ ((default . error) (WITH . (paren_expression . 2)) (SEMICOLON .
(paren_expression . 2)))
((default . error) (WITH . (paren_expression . 1)) (SEMICOLON .
(paren_expression . 1)))
((default . error) (IDENTIFIER . (expression_function_declaration . 0))
(USE . (expression_function_declaration . 0)) (TYPE .
(expression_function_declaration . 0)) (TASK . (expression_function_declaration
. 0)) (SUBTYPE . (expression_function_declaration . 0)) (PROTECTED .
(expression_function_declaration . 0)) (PROCEDURE .
(expression_function_declaration . 0)) (PRAGMA .
(expression_function_declaration . 0)) (PACKAGE .
(expression_function_declaration . 0)) (OVERRIDING . (expres [...]
((default . error) (IDENTIFIER . (null_procedure_declaration . 0)) (USE
. (null_procedure_declaration . 0)) (TYPE . (null_procedure_declaration . 0))
(TASK . (null_procedure_declaration . 0)) (SUBTYPE .
(null_procedure_declaration . 0)) (PROTECTED . (null_procedure_declaration .
0)) (PROCEDURE . (null_procedure_declaration . 0)) (PRAGMA .
(null_procedure_declaration . 0)) (PACKAGE . (null_procedure_declaration . 0))
(OVERRIDING . (null_procedure_declaration . 0)) (NOT . (null_proce [...]
((default . error) (IDENTIFIER . (abstract_subprogram_declaration . 0))
(USE . (abstract_subprogram_declaration . 0)) (TYPE .
(abstract_subprogram_declaration . 0)) (TASK . (abstract_subprogram_declaration
. 0)) (SUBTYPE . (abstract_subprogram_declaration . 0)) (PROTECTED .
(abstract_subprogram_declaration . 0)) (PROCEDURE .
(abstract_subprogram_declaration . 0)) (PRAGMA .
(abstract_subprogram_declaration . 0)) (PACKAGE .
(abstract_subprogram_declaration . 0)) (OVERRIDING . (abstra [...]
((default . error) (IDENTIFIER . (subprogram_body_stub . 0)) (USE .
(subprogram_body_stub . 0)) (TYPE . (subprogram_body_stub . 0)) (TASK .
(subprogram_body_stub . 0)) (SUBTYPE . (subprogram_body_stub . 0)) (PROTECTED .
(subprogram_body_stub . 0)) (PROCEDURE . (subprogram_body_stub . 0)) (PRAGMA .
(subprogram_body_stub . 0)) (PACKAGE . (subprogram_body_stub . 0)) (OVERRIDING
. (subprogram_body_stub . 0)) (NOT . (subprogram_body_stub . 0)) (GENERIC .
(subprogram_body_stub . 0)) (FUN [...]
((default . error) (WITH . (expression_opt . 0)) (SEMICOLON .
(expression_opt . 0)) (RAISE . 153) (PLUS . 155) (MINUS . 154) (ABS . 144)
(NOT . 324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER .
48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
+ ((default . error) (SEMICOLON . 1135))
+ ((default . error) (WITH . (expression_opt . 0)) (SEMICOLON .
(expression_opt . 0)) (RAISE . 153) (PLUS . 155) (MINUS . 154) (ABS . 144)
(NOT . 324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER .
48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (SEMICOLON . 1133))
((default . error) (WITH . (expression_opt . 0)) (SEMICOLON .
(expression_opt . 0)) (RAISE . 153) (PLUS . 155) (MINUS . 154) (ABS . 144)
(NOT . 324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER .
48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (SEMICOLON . 1131))
- ((default . error) (WITH . (expression_opt . 0)) (SEMICOLON .
(expression_opt . 0)) (RAISE . 153) (PLUS . 155) (MINUS . 154) (ABS . 144)
(NOT . 324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER .
48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (SEMICOLON . 1129))
((default . error) (ACCESS . (null_exclusion_opt . 1)) (IDENTIFIER .
48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49))
((default . error) (BEGIN . (declaration . 9)) (ENTRY . (declaration .
9)) (FOR . (declaration . 9)) (FUNCTION . (declaration . 9)) (GENERIC .
(declaration . 9)) (NOT . (declaration . 9)) (OVERRIDING . (declaration . 9))
(PACKAGE . (declaration . 9)) (PRAGMA . (declaration . 9)) (PROCEDURE .
(declaration . 9)) (PROTECTED . (declaration . 9)) (SUBTYPE . (declaration .
9)) (TASK . (declaration . 9)) (TYPE . (declaration . 9)) (USE . (declaration .
9)) (IDENTIFIER . (declaration . 9)) [...]
((default . error) (DOT . 90) (TICK . 91) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109) (LEFT_PAREN . 107))
+ ((default . error) (SEMICOLON . 1129))
+ ((default . error) (SEMICOLON . 1128))
((default . error) (SEMICOLON . 1127))
- ((default . error) (SEMICOLON . 1126))
- ((default . error) (SEMICOLON . 1125))
((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
((default . error) (WITH . (record_type_definition . 0)) (SEMICOLON .
(record_type_definition . 0)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
((default . error) (NOT . 723) (IDENTIFIER . 48) (CHARACTER_LITERAL .
50) (STRING_LITERAL . 49))
((default . error) (BEGIN . (incomplete_type_declaration . 0)) (ENTRY .
(incomplete_type_declaration . 0)) (FOR . (incomplete_type_declaration . 0))
(FUNCTION . (incomplete_type_declaration . 0)) (GENERIC .
(incomplete_type_declaration . 0)) (NOT . (incomplete_type_declaration . 0))
(OVERRIDING . (incomplete_type_declaration . 0)) (PACKAGE .
(incomplete_type_declaration . 0)) (PRAGMA . (incomplete_type_declaration . 0))
(PROCEDURE . (incomplete_type_declaration . 0)) (PROTECTED . ( [...]
- ((default . error) (IS . (direct_name_opt . 0)) (IDENTIFIER . 1118)
(STRING_LITERAL . 1119))
- ((default . error) (SEMICOLON . 1117))
+ ((default . error) (IS . (direct_name_opt . 0)) (IDENTIFIER . 1120)
(STRING_LITERAL . 1121))
+ ((default . error) (SEMICOLON . 1119))
((default . error) (WHEN . (component_item . 1)) (END . (component_item
. 1)) (IDENTIFIER . (component_item . 1)) (FOR . (component_item . 1)) (CASE .
(component_item . 1)))
((default . error) (WHEN . (component_item . 0)) (END . (component_item
. 0)) (IDENTIFIER . (component_item . 0)) (FOR . (component_item . 0)) (CASE .
(component_item . 0)))
((default . error) (WHEN . (component_list . 0)) (END . (component_list
. 0)) (CASE . (component_list . 0)) (FOR . (component_list . 0)) (IDENTIFIER .
(component_list . 0)))
- ((default . error) (WHEN . (component_list_opt . 1)) (END .
(component_list_opt . 1)) (CASE . 1023) (IDENTIFIER . 77) (FOR . 269))
- ((default . error) (END . 1114))
- ((default . error) (COMMA . 96) (COLON . 1113))
+ ((default . error) (WHEN . (component_list_opt . 1)) (END .
(component_list_opt . 1)) (CASE . 1025) (IDENTIFIER . 77) (FOR . 269))
+ ((default . error) (END . 1116))
+ ((default . error) (COMMA . 96) (COLON . 1115))
((default . error) (WHEN . (component_list . 3)) (END . (component_list
. 3)) (CASE . (component_list . 3)) (FOR . (component_list . 3)) (IDENTIFIER .
(component_list . 3)))
- ((default . error) (DOT_DOT . 1112))
+ ((default . error) (DOT_DOT . 1114))
((default . error) (SEMICOLON . (record_definition . 1)) (WITH .
(record_definition . 1)))
((default . error) (SEMICOLON . (type_definition . 2)) (WITH .
(type_definition . 2)))
((default . error) (COMMA . (enumeration_literal . 0)) (RIGHT_PAREN .
(enumeration_literal . 0)))
((default . error) (COMMA . (enumeration_literal . 1)) (RIGHT_PAREN .
(enumeration_literal . 1)))
((default . error) (RIGHT_PAREN . (enumeration_literal_list . 0)) (COMMA
. (enumeration_literal_list . 0)))
- ((default . error) (COMMA . 1111) (RIGHT_PAREN . 1110))
- ((default . error) (WITH . (real_range_specification_opt . 0))
(SEMICOLON . (real_range_specification_opt . 0)) (RANGE . 1107))
- ((default . error) (DIGITS . 1106) (WITH .
(real_range_specification_opt . 0)) (SEMICOLON . (real_range_specification_opt
. 0)) (RANGE . 1107))
+ ((default . error) (COMMA . 1113) (RIGHT_PAREN . 1112))
+ ((default . error) (WITH . (real_range_specification_opt . 0))
(SEMICOLON . (real_range_specification_opt . 0)) (RANGE . 1109))
+ ((default . error) (DIGITS . 1108) (WITH .
(real_range_specification_opt . 0)) (SEMICOLON . (real_range_specification_opt
. 0)) (RANGE . 1109))
((default . error) (NEW . ((abstract_limited_synchronized_opt . 1)
(abstract_limited_opt . 1))))
- ((default . error) (SEMICOLON . 1105))
- ((default . error) (NEW . 1103) (END . (declarative_part_opt . 0))
(PRIVATE . (declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 272) (PRAGMA .
7) (NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt
. 2)) (FOR . 269) (IDENTIFIER . 275) (TYPE . 274) (GENERIC . 2) (PROTECTED
. 271) (TASK . 273) (PACKAGE . 270))
+ ((default . error) (SEMICOLON . 1107))
+ ((default . error) (NEW . 1105) (END . (declarative_part_opt . 0))
(PRIVATE . (declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 272) (PRAGMA .
7) (NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt
. 2)) (FOR . 269) (IDENTIFIER . 275) (TYPE . 274) (GENERIC . 2) (PROTECTED
. 271) (TASK . 273) (PACKAGE . 270))
((default . error) (IDENTIFIER . (task_type_declaration . 2)) (USE .
(task_type_declaration . 2)) (TYPE . (task_type_declaration . 2)) (TASK .
(task_type_declaration . 2)) (SUBTYPE . (task_type_declaration . 2)) (PROTECTED
. (task_type_declaration . 2)) (PROCEDURE . (task_type_declaration . 2))
(PRAGMA . (task_type_declaration . 2)) (PACKAGE . (task_type_declaration . 2))
(OVERRIDING . (task_type_declaration . 2)) (NOT . (task_type_declaration . 2))
(GENERIC . (task_type_declaratio [...]
((default . error) (BEGIN . (single_task_declaration . 1)) (ENTRY .
(single_task_declaration . 1)) (FOR . (single_task_declaration . 1)) (FUNCTION
. (single_task_declaration . 1)) (GENERIC . (single_task_declaration . 1)) (NOT
. (single_task_declaration . 1)) (OVERRIDING . (single_task_declaration . 1))
(PACKAGE . (single_task_declaration . 1)) (PRAGMA . (single_task_declaration .
1)) (PROCEDURE . (single_task_declaration . 1)) (PROTECTED .
(single_task_declaration . 1)) (SUBTYPE . [...]
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
710))
((default . error) (END . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 272) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 269) (IDENTIFIER . 275) (TYPE
. 274) (GENERIC . 2) (PROTECTED . 271) (TASK . 273) (PACKAGE . 270))
- ((default . error) (AND . 1071) (WITH . 1100))
+ ((default . error) (AND . 1073) (WITH . 1102))
((default . error) (IDENTIFIER . (subtype_declaration . 0)) (USE .
(subtype_declaration . 0)) (TYPE . (subtype_declaration . 0)) (TASK .
(subtype_declaration . 0)) (SUBTYPE . (subtype_declaration . 0)) (PROTECTED .
(subtype_declaration . 0)) (PROCEDURE . (subtype_declaration . 0)) (PRAGMA .
(subtype_declaration . 0)) (PACKAGE . (subtype_declaration . 0)) (OVERRIDING .
(subtype_declaration . 0)) (NOT . (subtype_declaration . 0)) (GENERIC .
(subtype_declaration . 0)) (FUNCTION . (sub [...]
- ((default . error) (SEMICOLON . 1099))
- ((default . error) (NEW . 1097) (END . (declarative_part_opt . 0))
(PRIVATE . (declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 272) (PRAGMA .
7) (NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt
. 2)) (FOR . 269) (IDENTIFIER . 275) (TYPE . 274) (GENERIC . 2) (PROTECTED
. 271) (TASK . 273) (PACKAGE . 270))
+ ((default . error) (SEMICOLON . 1101))
+ ((default . error) (NEW . 1099) (END . (declarative_part_opt . 0))
(PRIVATE . (declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 272) (PRAGMA .
7) (NOT . 4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2))
(PROCEDURE . (overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt
. 2)) (FOR . 269) (IDENTIFIER . 275) (TYPE . 274) (GENERIC . 2) (PROTECTED
. 271) (TASK . 273) (PACKAGE . 270))
((default . error) (BEGIN . (single_protected_declaration . 1)) (ENTRY .
(single_protected_declaration . 1)) (FOR . (single_protected_declaration . 1))
(FUNCTION . (single_protected_declaration . 1)) (GENERIC .
(single_protected_declaration . 1)) (NOT . (single_protected_declaration . 1))
(OVERRIDING . (single_protected_declaration . 1)) (PACKAGE .
(single_protected_declaration . 1)) (PRAGMA . (single_protected_declaration .
1)) (PROCEDURE . (single_protected_declaration . 1)) (PRO [...]
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
710))
((default . error) (END . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 272) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 269) (IDENTIFIER . 275) (TYPE
. 274) (GENERIC . 2) (PROTECTED . 271) (TASK . 273) (PACKAGE . 270))
- ((default . error) (AND . 1071) (WITH . 1094))
- ((default . error) (SEMICOLON . 1093))
+ ((default . error) (AND . 1073) (WITH . 1096))
+ ((default . error) (SEMICOLON . 1095))
((default . error) (WHEN . (at_clause . 0)) (BEGIN . (at_clause . 0))
(ENTRY . (at_clause . 0)) (FOR . (at_clause . 0)) (FUNCTION . (at_clause . 0))
(GENERIC . (at_clause . 0)) (NOT . (at_clause . 0)) (OVERRIDING . (at_clause .
0)) (PACKAGE . (at_clause . 0)) (PRAGMA . (at_clause . 0)) (PROCEDURE .
(at_clause . 0)) (PROTECTED . (at_clause . 0)) (SUBTYPE . (at_clause . 0))
(TASK . (at_clause . 0)) (TYPE . (at_clause . 0)) (USE . (at_clause . 0))
(IDENTIFIER . (at_clause . 0)) (CASE [...]
- ((default . error) (AT . 1092))
+ ((default . error) (AT . 1094))
((default . error) (END . (component_clause_list . 0)) (IDENTIFIER .
(component_clause_list . 0)))
- ((default . error) (END . 1090) (IDENTIFIER . 1058))
+ ((default . error) (END . 1092) (IDENTIFIER . 1060))
((default . error) (SEMICOLON . (expression_opt . 0)) (RAISE . 153)
(PLUS . 155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156)
(NULL . 151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (RIGHT_PAREN . (discrete_subtype_definition_list .
1)) (COMMA . (discrete_subtype_definition_list . 1)))
- ((default . error) (ALIASED . 1083) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt
. 0)) (NOT . 875))
+ ((default . error) (ALIASED . 1085) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt
. 0)) (NOT . 875))
((default . error) (RIGHT_PAREN . (index_subtype_definition_list . 1))
(COMMA . (index_subtype_definition_list . 1)))
- ((default . error) (DOT . 90) (RANGE . 1087) (TICK . 91) (LEFT_PAREN
. 107))
- ((default . error) (ALIASED . 1083) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt
. 0)) (NOT . 875))
+ ((default . error) (DOT . 90) (RANGE . 1089) (TICK . 91) (LEFT_PAREN
. 107))
+ ((default . error) (ALIASED . 1085) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt
. 0)) (NOT . 875))
((default . error) (COMMA . (index_subtype_definition . 0)) (RIGHT_PAREN
. (index_subtype_definition . 0)))
- ((default . error) (NUMERIC_LITERAL . 156) (NULL . 1082) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
- ((default . error) (COMMA . 827) (RIGHT_PAREN . 1081))
+ ((default . error) (NUMERIC_LITERAL . 156) (NULL . 1084) (NEW . 149)
(IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN
. 148))
+ ((default . error) (COMMA . 827) (RIGHT_PAREN . 1083))
((default . error) (BAR . (discrete_choice . 2)) (EQUAL_GREATER .
(discrete_choice . 2)) (RIGHT_PAREN . ((range_list . 0)
(discrete_subtype_definition . 1))) (COMMA . ((range_list . 0)
(discrete_subtype_definition . 1))))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (PRIVATE . 1079))
- ((default . error) (AND . 1071) (WITH . (and_interface_list_opt . 1))
(SEMICOLON . (and_interface_list_opt . 1)))
+ ((default . error) (PRIVATE . 1081))
+ ((default . error) (AND . 1073) (WITH . (and_interface_list_opt . 1))
(SEMICOLON . (and_interface_list_opt . 1)))
((default . error) (WITH . (formal_package_actual_part . 0)) (SEMICOLON
. (formal_package_actual_part . 0)))
((default . error) (PACKAGE . (formal_package_declaration . 0))
(PROCEDURE . (formal_package_declaration . 0)) (FUNCTION .
(formal_package_declaration . 0)) (PRAGMA . (formal_package_declaration . 0))
(TYPE . (formal_package_declaration . 0)) (USE . (formal_package_declaration .
0)) (WITH . (formal_package_declaration . 0)) (IDENTIFIER .
(formal_package_declaration . 0)))
((default . error) (PACKAGE . (formal_object_declaration . 0))
(PROCEDURE . (formal_object_declaration . 0)) (FUNCTION .
(formal_object_declaration . 0)) (PRAGMA . (formal_object_declaration . 0))
(TYPE . (formal_object_declaration . 0)) (USE . (formal_object_declaration .
0)) (WITH . (formal_object_declaration . 0)) (IDENTIFIER .
(formal_object_declaration . 0)))
@@ -2904,48 +2923,48 @@
((default . error) (WITH . (component_definition . 3)) (SEMICOLON .
(component_definition . 3)) (COLON_EQUAL . (component_definition . 3)))
((default . error) (WITH . (array_type_definition . 0)) (SEMICOLON .
(array_type_definition . 0)) (COLON_EQUAL . (array_type_definition . 0)))
((default . error) (WITH . (component_definition . 1)) (SEMICOLON .
(component_definition . 1)) (COLON_EQUAL . (component_definition . 1)))
- ((default . error) (BOX . 1067))
+ ((default . error) (BOX . 1069))
((default . error) (WITH . (array_type_definition . 1)) (SEMICOLON .
(array_type_definition . 1)) (COLON_EQUAL . (array_type_definition . 1)))
- ((default . error) (SEMICOLON . 1233))
- ((default . error) (RECORD . 1232))
+ ((default . error) (SEMICOLON . 1235))
+ ((default . error) (RECORD . 1234))
((default . error) (IDENTIFIER . (component_clause_list . 1)) (END .
(component_clause_list . 1)))
((default . error) (PLUS . 155) (MINUS . 154) (ABS . 144) (NOT .
324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (PRIVATE . (package_body_stub . 0)) (END .
(package_body_stub . 0)) (BEGIN . (package_body_stub . 0)) (ENTRY .
(package_body_stub . 0)) (FOR . (package_body_stub . 0)) (FUNCTION .
(package_body_stub . 0)) (GENERIC . (package_body_stub . 0)) (NOT .
(package_body_stub . 0)) (OVERRIDING . (package_body_stub . 0)) (PACKAGE .
(package_body_stub . 0)) (PRAGMA . (package_body_stub . 0)) (PROCEDURE .
(package_body_stub . 0)) (PROTECTED . (package_body_stub . 0)) (SUBTYPE [...]
((default . error) (END . (declarative_part_opt . 0)) (PRIVATE .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 272) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
269) (IDENTIFIER . 275) (TYPE . 274) (GENERIC . 2) (PROTECTED . 271) (TASK
. 273) (PACKAGE . 270))
- ((default . error) (END . 1229))
+ ((default . error) (END . 1231))
((default . error) (SEMICOLON . (protected_definition . 1)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (SEMICOLON . 1227))
+ ((default . error) (SEMICOLON . 1229))
((default . error) (PRIVATE . (protected_body_stub . 0)) (END .
(protected_body_stub . 0)) (BEGIN . (protected_body_stub . 0)) (ENTRY .
(protected_body_stub . 0)) (FOR . (protected_body_stub . 0)) (FUNCTION .
(protected_body_stub . 0)) (GENERIC . (protected_body_stub . 0)) (NOT .
(protected_body_stub . 0)) (OVERRIDING . (protected_body_stub . 0)) (PACKAGE .
(protected_body_stub . 0)) (PRAGMA . (protected_body_stub . 0)) (PROCEDURE .
(protected_body_stub . 0)) (PROTECTED . (protecte [...]
((default . error) (END . (declarative_part_opt . 0)) (PRIVATE .
(declarative_part_opt . 0)) (USE . 11) (SUBTYPE . 272) (PRAGMA . 7) (NOT .
4) (OVERRIDING . 5) (FUNCTION . (overriding_indicator_opt . 2)) (PROCEDURE .
(overriding_indicator_opt . 2)) (ENTRY . (overriding_indicator_opt . 2)) (FOR .
269) (IDENTIFIER . 275) (TYPE . 274) (GENERIC . 2) (PROTECTED . 271) (TASK
. 273) (PACKAGE . 270))
- ((default . error) (END . 1225))
+ ((default . error) (END . 1227))
((default . error) (SEMICOLON . (task_definition . 1)))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49))
- ((default . error) (SEMICOLON . 1223))
+ ((default . error) (SEMICOLON . 1225))
((default . error) (PRIVATE . (task_body_stub . 0)) (END .
(task_body_stub . 0)) (BEGIN . (task_body_stub . 0)) (ENTRY . (task_body_stub .
0)) (FOR . (task_body_stub . 0)) (FUNCTION . (task_body_stub . 0)) (GENERIC .
(task_body_stub . 0)) (NOT . (task_body_stub . 0)) (OVERRIDING .
(task_body_stub . 0)) (PACKAGE . (task_body_stub . 0)) (PRAGMA .
(task_body_stub . 0)) (PROCEDURE . (task_body_stub . 0)) (PROTECTED .
(task_body_stub . 0)) (SUBTYPE . (task_body_stub . 0)) (TASK . (task_ [...]
((default . error) (RANGE . (expression_opt . 0)) (WITH .
(expression_opt . 0)) (SEMICOLON . (expression_opt . 0)) (RAISE . 153) (PLUS .
155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
((default . error) (PLUS . 155) (MINUS . 154) (ABS . 144) (NOT .
324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (WITH . (type_definition . 4)) (SEMICOLON .
(type_definition . 4)))
((default . error) (WITH . (type_definition . 3)) (SEMICOLON .
(type_definition . 3)))
((default . error) (SEMICOLON . (enumeration_type_definition . 0)) (WITH
. (enumeration_type_definition . 0)))
- ((default . error) (IDENTIFIER . 1035) (CHARACTER_LITERAL . 1036))
+ ((default . error) (IDENTIFIER . 1037) (CHARACTER_LITERAL . 1038))
((default . error) (PLUS . 155) (MINUS . 154) (ABS . 144) (NOT .
324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (ALIASED . 1083) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt
. 0)) (NOT . 875))
- ((default . error) (RECORD . 1217))
+ ((default . error) (ALIASED . 1085) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt
. 0)) (NOT . 875))
+ ((default . error) (RECORD . 1219))
((default . error) (WHEN . (component_list . 1)) (IDENTIFIER .
(component_list . 1)) (FOR . (component_list . 1)) (CASE . (component_list .
1)) (END . (component_list . 1)))
((default . error) (WHEN . (component_list . 2)) (IDENTIFIER .
(component_list . 2)) (FOR . (component_list . 2)) (CASE . (component_list .
2)) (END . (component_list . 2)))
((default . error) (WHEN . (component_list . 4)) (IDENTIFIER .
(component_list . 4)) (FOR . (component_list . 4)) (CASE . (component_list .
4)) (END . (component_list . 4)))
((default . error) (IS . (direct_name . 0)))
((default . error) (IS . (direct_name . 1)))
((default . error) (IS . (direct_name_opt . 1)))
- ((default . error) (IS . 1216))
+ ((default . error) (IS . 1218))
((default . error) (WITH . (and_interface_list_opt . 0)) (AND . 812))
- ((default . error) (DOT . 90) (TICK . 91) (AND . 812) (WITH .
((constraint_opt . 0) (and_interface_list_opt . 0))) (SEMICOLON .
(constraint_opt . 0)) (RANGE . 895) (LEFT_PAREN . 820))
- ((default . error) (SEMICOLON . 1211))
+ ((default . error) (DOT . 90) (TICK . 91) (AND . 812) (WITH .
((constraint_opt . 0) (and_interface_list_opt . 0))) (SEMICOLON .
(constraint_opt . 0)) (RANGE . 896) (LEFT_PAREN . 820))
+ ((default . error) (SEMICOLON . 1213))
((default . error) (END . (full_type_declaration . 0)) (PRIVATE .
(full_type_declaration . 0)) (IDENTIFIER . (full_type_declaration . 0)) (USE .
(full_type_declaration . 0)) (TYPE . (full_type_declaration . 0)) (TASK .
(full_type_declaration . 0)) (SUBTYPE . (full_type_declaration . 0)) (PROTECTED
. (full_type_declaration . 0)) (PROCEDURE . (full_type_declaration . 0))
(PRAGMA . (full_type_declaration . 0)) (PACKAGE . (full_type_declaration . 0))
(OVERRIDING . (full_type_declaratio [...]
((default . error) (END . (object_renaming_declaration . 2)) (PRIVATE .
(object_renaming_declaration . 2)) (IDENTIFIER . (object_renaming_declaration .
2)) (USE . (object_renaming_declaration . 2)) (TYPE .
(object_renaming_declaration . 2)) (TASK . (object_renaming_declaration . 2))
(SUBTYPE . (object_renaming_declaration . 2)) (PROTECTED .
(object_renaming_declaration . 2)) (PROCEDURE . (object_renaming_declaration .
2)) (PRAGMA . (object_renaming_declaration . 2)) (PACKAGE . (obj [...]
((default . error) (END . (object_renaming_declaration . 1)) (PRIVATE .
(object_renaming_declaration . 1)) (IDENTIFIER . (object_renaming_declaration .
1)) (USE . (object_renaming_declaration . 1)) (TYPE .
(object_renaming_declaration . 1)) (TASK . (object_renaming_declaration . 1))
(SUBTYPE . (object_renaming_declaration . 1)) (PROTECTED .
(object_renaming_declaration . 1)) (PROCEDURE . (object_renaming_declaration .
1)) (PRAGMA . (object_renaming_declaration . 1)) (PACKAGE . (obj [...]
- ((default . error) (SEMICOLON . 1210))
+ ((default . error) (SEMICOLON . 1212))
((default . error) (PRIVATE . (object_declaration . 3)) (END .
(object_declaration . 3)) (BEGIN . (object_declaration . 3)) (ENTRY .
(object_declaration . 3)) (FOR . (object_declaration . 3)) (FUNCTION .
(object_declaration . 3)) (GENERIC . (object_declaration . 3)) (NOT .
(object_declaration . 3)) (OVERRIDING . (object_declaration . 3)) (PACKAGE .
(object_declaration . 3)) (PRAGMA . (object_declaration . 3)) (PROCEDURE .
(object_declaration . 3)) (PROTECTED . (object_declaration . [...]
((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
((default . error) (PRIVATE . (object_declaration . 5)) (END .
(object_declaration . 5)) (BEGIN . (object_declaration . 5)) (ENTRY .
(object_declaration . 5)) (FOR . (object_declaration . 5)) (FUNCTION .
(object_declaration . 5)) (GENERIC . (object_declaration . 5)) (NOT .
(object_declaration . 5)) (OVERRIDING . (object_declaration . 5)) (PACKAGE .
(object_declaration . 5)) (PRAGMA . (object_declaration . 5)) (PROCEDURE .
(object_declaration . 5)) (PROTECTED . (object_declaration . [...]
@@ -2960,100 +2979,100 @@
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
710))
((default . error) (PROCEDURE . (protected_operation_item_list . 1))
(OVERRIDING . (protected_operation_item_list . 1)) (NOT .
(protected_operation_item_list . 1)) (FUNCTION . (protected_operation_item_list
. 1)) (FOR . (protected_operation_item_list . 1)) (ENTRY .
(protected_operation_item_list . 1)) (END . (protected_operation_item_list .
1)))
((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (IS .
(aspect_specification_opt . 0)) (WITH . 109))
- ((default . error) (WHEN . (parameter_profile_opt . 0)) (LEFT_PAREN .
1202))
+ ((default . error) (WHEN . (parameter_profile_opt . 0)) (LEFT_PAREN .
1204))
((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt [...]
((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt [...]
((default . error) (THEN . (accept_statement . 1)) (WHEN .
(accept_statement . 1)) (EXCEPTION . (accept_statement . 1)) (ELSIF .
(accept_statement . 1)) (ELSE . (accept_statement . 1)) (OR . (accept_statement
. 1)) (END . (accept_statement . 1)) (ACCEPT . (accept_statement . 1)) (ABORT .
(accept_statement . 1)) (BEGIN . (accept_statement . 1)) (CASE .
(accept_statement . 1)) (DECLARE . (accept_statement . 1)) (DELAY .
(accept_statement . 1)) (EXIT . (accept_statement . 1)) (FOR . ( [...]
((default . error) (OR . (block_statement . 1)) (THEN . (block_statement
. 1)) (WHEN . (block_statement . 1)) (EXCEPTION . (block_statement . 1)) (END .
(block_statement . 1)) (LESS_LESS . (block_statement . 1)) (ACCEPT .
(block_statement . 1)) (ABORT . (block_statement . 1)) (BEGIN .
(block_statement . 1)) (CASE . (block_statement . 1)) (DECLARE .
(block_statement . 1)) (DELAY . (block_statement . 1)) (EXIT . (block_statement
. 1)) (FOR . (block_statement . 1)) (GOTO . (block_stat [...]
- ((default . error) (CASE . 1199))
+ ((default . error) (CASE . 1201))
((default . error) (WHEN . (case_statement_alternative_list . 1)) (END .
(case_statement_alternative_list . 1)))
- ((default . error) (BAR . 356) (EQUAL_GREATER . 1198))
+ ((default . error) (BAR . 356) (EQUAL_GREATER . 1200))
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
710))
((default . error) (OR . (exit_statement . 0)) (THEN . (exit_statement .
0)) (WHEN . (exit_statement . 0)) (EXCEPTION . (exit_statement . 0)) (END .
(exit_statement . 0)) (LESS_LESS . (exit_statement . 0)) (ACCEPT .
(exit_statement . 0)) (ABORT . (exit_statement . 0)) (BEGIN . (exit_statement .
0)) (CASE . (exit_statement . 0)) (DECLARE . (exit_statement . 0)) (DELAY .
(exit_statement . 0)) (EXIT . (exit_statement . 0)) (FOR . (exit_statement .
0)) (GOTO . (exit_statement . 0)) (IF [...]
((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt . 0)) (NULL . (label_opt . 0)) (PRAGMA .
(label_opt . 0)) (RAISE . (labe [...]
((default . error) (THEN . (expression_opt . 0)) (RAISE . 153) (PLUS .
155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
- ((default . error) (IF . 1194))
+ ((default . error) (IF . 1196))
((default . error) (END . (elsif_statement_list . 0)) (ELSE .
(elsif_statement_list . 0)) (ELSIF . (elsif_statement_list . 0)))
- ((default . error) (END . 1192) (ELSE . 1191) (ELSIF . 1154))
- ((default . error) (SEMICOLON . 1190))
+ ((default . error) (END . 1194) (ELSE . 1193) (ELSIF . 1156))
+ ((default . error) (SEMICOLON . 1192))
((default . error) (OR . (raise_statement . 1)) (THEN . (raise_statement
. 1)) (WHEN . (raise_statement . 1)) (EXCEPTION . (raise_statement . 1)) (END .
(raise_statement . 1)) (LESS_LESS . (raise_statement . 1)) (ACCEPT .
(raise_statement . 1)) (ABORT . (raise_statement . 1)) (BEGIN .
(raise_statement . 1)) (CASE . (raise_statement . 1)) (DECLARE .
(raise_statement . 1)) (DELAY . (raise_statement . 1)) (EXIT . (raise_statement
. 1)) (FOR . (raise_statement . 1)) (GOTO . (raise_stat [...]
((default . error) (OR . (requeue_statement . 0)) (THEN .
(requeue_statement . 0)) (WHEN . (requeue_statement . 0)) (EXCEPTION .
(requeue_statement . 0)) (END . (requeue_statement . 0)) (LESS_LESS .
(requeue_statement . 0)) (ACCEPT . (requeue_statement . 0)) (ABORT .
(requeue_statement . 0)) (BEGIN . (requeue_statement . 0)) (CASE .
(requeue_statement . 0)) (DECLARE . (requeue_statement . 0)) (DELAY .
(requeue_statement . 0)) (EXIT . (requeue_statement . 0)) (FOR .
(requeue_stateme [...]
- ((default . error) (RETURN . 1189))
+ ((default . error) (RETURN . 1191))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (ACCESS . (null_exclusion_opt . 0)) (NOT . 875))
- ((default . error) (END . 1185))
- ((default . error) (SELECT . 1184))
+ ((default . error) (END . 1187))
+ ((default . error) (SELECT . 1186))
((default . error) (OR . (selective_accept . 1)) (THEN .
(selective_accept . 1)) (WHEN . (selective_accept . 1)) (EXCEPTION .
(selective_accept . 1)) (END . (selective_accept . 1)) (LESS_LESS .
(selective_accept . 1)) (ACCEPT . (selective_accept . 1)) (ABORT .
(selective_accept . 1)) (BEGIN . (selective_accept . 1)) (CASE .
(selective_accept . 1)) (DECLARE . (selective_accept . 1)) (DELAY .
(selective_accept . 1)) (EXIT . (selective_accept . 1)) (FOR .
(selective_accept . 1)) (GOTO [...]
- ((default . error) (SELECT . 1183))
+ ((default . error) (SELECT . 1185))
((default . error) (END . (delay_alternative . 0)) (OR .
(delay_alternative . 0)) (ELSE . (delay_alternative . 0)))
- ((default . error) (SELECT . 1182))
- ((default . error) (SEMICOLON . 1181))
+ ((default . error) (SELECT . 1184))
+ ((default . error) (SEMICOLON . 1183))
((default . error) (ELSE . (sequence_of_statements_opt . 0)) (OR .
(sequence_of_statements_opt . 0)) (END . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0))
(EXIT . (label_opt . 0)) (GOTO . ( [...]
((default . error) (END . (select_alternative . 2)) (OR .
(select_alternative . 2)) (ELSE . (select_alternative . 2)))
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
710))
- ((default . error) (OTHERS . 948) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49))
+ ((default . error) (OTHERS . 949) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49))
((default . error) (WHEN . (sequence_of_statements_opt . 0)) (END .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt . 0)) [...]
- ((default . error) (OTHERS . 948) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49))
- ((default . error) (BAR . 1173) (EQUAL_GREATER . 1277))
+ ((default . error) (OTHERS . 949) (IDENTIFIER . 48) (CHARACTER_LITERAL
. 50) (STRING_LITERAL . 49))
+ ((default . error) (BAR . 1175) (EQUAL_GREATER . 1279))
((default . error) (WHEN . (exception_handler . 1)) (END .
(exception_handler . 1)))
((default . error) (EQUAL_GREATER . (exception_choice_list . 1)) (BAR .
(exception_choice_list . 1)))
- ((default . error) (SEMICOLON . 1276))
+ ((default . error) (SEMICOLON . 1278))
((default . error) (ELSE . (select_alternative . 0)) (OR .
(select_alternative . 0)) (END . (select_alternative . 0)))
((default . error) (ELSE . (select_alternative . 4)) (OR .
(select_alternative . 4)) (END . (select_alternative . 4)))
+ ((default . error) (SEMICOLON . 1277))
+ ((default . error) (SEMICOLON . 1276))
((default . error) (SEMICOLON . 1275))
- ((default . error) (SEMICOLON . 1274))
- ((default . error) (SEMICOLON . 1273))
- ((default . error) (SELECT . 1272))
+ ((default . error) (SELECT . 1274))
((default . error) (DO . (return_subtype_indication . 1)) (SEMICOLON .
(return_subtype_indication . 1)) (COLON_EQUAL . (return_subtype_indication .
1)))
- ((default . error) (DO . (extended_return_object_declaration . 1))
(SEMICOLON . (extended_return_object_declaration . 1)) (COLON_EQUAL . 1271))
+ ((default . error) (DO . (extended_return_object_declaration . 1))
(SEMICOLON . (extended_return_object_declaration . 1)) (COLON_EQUAL . 1273))
((default . error) (DO . (return_subtype_indication . 0)) (SEMICOLON .
(return_subtype_indication . 0)) (COLON_EQUAL . (return_subtype_indication .
0)))
- ((default . error) (SEMICOLON . 1270))
+ ((default . error) (SEMICOLON . 1272))
((default . error) (WHEN . (loop_statement . 1)) (THEN . (loop_statement
. 1)) (OR . (loop_statement . 1)) (ELSIF . (loop_statement . 1)) (ELSE .
(loop_statement . 1)) (CHARACTER_LITERAL . (loop_statement . 1))
(STRING_LITERAL . (loop_statement . 1)) (IDENTIFIER . (loop_statement . 1))
(WHILE . (loop_statement . 1)) (SELECT . (loop_statement . 1)) (RETURN .
(loop_statement . 1)) (REQUEUE . (loop_statement . 1)) (RAISE . (loop_statement
. 1)) (PRAGMA . (loop_statement . 1)) (NULL . [...]
((default . error) (END . (sequence_of_statements_opt . 0)) (ACCEPT .
(label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE .
(label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0)) (LOOP .
(label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE .
(label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT .
(label_opt . 0)) (GOTO . (label_opt . 0)) (NULL . (label_opt . 0)) (PRAGMA .
(label_opt . 0)) (RAISE . (labe [...]
- ((default . error) (IF . 1268))
+ ((default . error) (IF . 1270))
((default . error) (ELSIF . (elsif_statement_list . 1)) (ELSE .
(elsif_statement_list . 1)) (END . (elsif_statement_list . 1)))
- ((default . error) (SEMICOLON . 1267))
- ((default . error) (THEN . 1266))
- ((default . error) (END . 1265))
- ((default . error) (SEMICOLON . 1264))
+ ((default . error) (SEMICOLON . 1269))
+ ((default . error) (THEN . 1268))
+ ((default . error) (END . 1267))
+ ((default . error) (SEMICOLON . 1266))
((default . error) (END . (sequence_of_statements_opt . 0)) (WHEN .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt . 0)) [...]
- ((default . error) (SEMICOLON . 1262))
- ((default . error) (END . 1261))
- ((default . error) (END . 1260))
- ((default . error) (FOR . 1259) (SEMICOLON . (parameter_specification .
0)) (RIGHT_PAREN . (parameter_specification . 0)) (IDENTIFIER . 77))
- ((default . error) (WHEN . 1258))
+ ((default . error) (SEMICOLON . 1264))
+ ((default . error) (END . 1263))
+ ((default . error) (END . 1262))
+ ((default . error) (FOR . 1261) (SEMICOLON . (parameter_specification .
0)) (RIGHT_PAREN . (parameter_specification . 0)) (IDENTIFIER . 77))
+ ((default . error) (WHEN . 1260))
((default . error) (WHEN . (entry_body_formal_part . 1)))
+ ((default . error) (SEMICOLON . 1259))
+ ((default . error) (SEMICOLON . 1258))
((default . error) (SEMICOLON . 1257))
((default . error) (SEMICOLON . 1256))
((default . error) (SEMICOLON . 1255))
- ((default . error) (SEMICOLON . 1254))
- ((default . error) (SEMICOLON . 1253))
((default . error) (BEGIN . (object_renaming_declaration . 0)) (ENTRY .
(object_renaming_declaration . 0)) (FOR . (object_renaming_declaration . 0))
(FUNCTION . (object_renaming_declaration . 0)) (GENERIC .
(object_renaming_declaration . 0)) (NOT . (object_renaming_declaration . 0))
(OVERRIDING . (object_renaming_declaration . 0)) (PACKAGE .
(object_renaming_declaration . 0)) (PRAGMA . (object_renaming_declaration . 0))
(PROCEDURE . (object_renaming_declaration . 0)) (PROTECTED . ( [...]
((default . error) (BEGIN . (private_type_declaration . 0)) (ENTRY .
(private_type_declaration . 0)) (FOR . (private_type_declaration . 0))
(FUNCTION . (private_type_declaration . 0)) (GENERIC .
(private_type_declaration . 0)) (NOT . (private_type_declaration . 0))
(OVERRIDING . (private_type_declaration . 0)) (PACKAGE .
(private_type_declaration . 0)) (PRAGMA . (private_type_declaration . 0))
(PROCEDURE . (private_type_declaration . 0)) (PROTECTED .
(private_type_declaration . 0)) [...]
- ((default . error) (WITH . 1252))
+ ((default . error) (WITH . 1254))
((default . error) (WITH . (constraint_opt . 1)) (SEMICOLON .
(constraint_opt . 1)))
((default . error) (WITH . (derived_type_definition . 1)) (SEMICOLON .
(derived_type_definition . 1)))
- ((default . error) (WITH . 1251))
- ((default . error) (WHEN . 1248))
+ ((default . error) (WITH . 1253))
+ ((default . error) (WHEN . 1250))
((default . error) (SEMICOLON . (record_definition . 0)) (WITH .
(record_definition . 0)))
- ((default . error) (COLON_EQUAL . 1246) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109))
+ ((default . error) (COLON_EQUAL . 1248) (SEMICOLON .
(aspect_specification_opt . 0)) (WITH . 109))
((default . error) (SEMICOLON . (type_definition . 1)) (WITH .
(type_definition . 1)))
((default . error) (RIGHT_PAREN . (enumeration_literal_list . 1)) (COMMA
. (enumeration_literal_list . 1)))
- ((default . error) (DOT_DOT . 1245))
- ((default . error) (WITH . (real_range_specification_opt . 0))
(SEMICOLON . (real_range_specification_opt . 0)) (RANGE . 1107))
+ ((default . error) (DOT_DOT . 1247))
+ ((default . error) (WITH . (real_range_specification_opt . 0))
(SEMICOLON . (real_range_specification_opt . 0)) (RANGE . 1109))
((default . error) (IDENTIFIER . (task_type_declaration . 1)) (USE .
(task_type_declaration . 1)) (TYPE . (task_type_declaration . 1)) (TASK .
(task_type_declaration . 1)) (SUBTYPE . (task_type_declaration . 1)) (PROTECTED
. (task_type_declaration . 1)) (PROCEDURE . (task_type_declaration . 1))
(PRAGMA . (task_type_declaration . 1)) (PACKAGE . (task_type_declaration . 1))
(OVERRIDING . (task_type_declaration . 1)) (NOT . (task_type_declaration . 1))
(GENERIC . (task_type_declaratio [...]
- ((default . error) (AND . 1071) (WITH . 1243))
+ ((default . error) (AND . 1073) (WITH . 1245))
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
710))
- ((default . error) (SEMICOLON . 1241))
+ ((default . error) (SEMICOLON . 1243))
((default . error) (IDENTIFIER . (protected_type_declaration . 1)) (USE
. (protected_type_declaration . 1)) (TYPE . (protected_type_declaration . 1))
(TASK . (protected_type_declaration . 1)) (SUBTYPE .
(protected_type_declaration . 1)) (PROTECTED . (protected_type_declaration .
1)) (PROCEDURE . (protected_type_declaration . 1)) (PRAGMA .
(protected_type_declaration . 1)) (PACKAGE . (protected_type_declaration . 1))
(OVERRIDING . (protected_type_declaration . 1)) (NOT . (protected_ [...]
- ((default . error) (AND . 1071) (WITH . 1240))
+ ((default . error) (AND . 1073) (WITH . 1242))
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
710))
- ((default . error) (SEMICOLON . 1238))
- ((default . error) (RANGE . 1237))
+ ((default . error) (SEMICOLON . 1240))
+ ((default . error) (RANGE . 1239))
((default . error) (SEMICOLON . (record_rep . 0)))
((default . error) (IDENTIFIER . (mod_clause_opt . 1)))
((default . error) (COLON_EQUAL . (component_definition . 2)) (SEMICOLON
. (component_definition . 2)) (WITH . (component_definition . 2)))
((default . error) (COLON_EQUAL . (component_definition . 0)) (SEMICOLON
. (component_definition . 0)) (WITH . (component_definition . 0)))
- ((default . error) (RIGHT_PAREN . (subtype_indication . 1)) (COMMA .
(subtype_indication . 1)) (DOT . 90) (TICK . 91) (BAR . (discrete_choice .
1)) (EQUAL_GREATER . (discrete_choice . 1)) (RANGE . 895) (LEFT_PAREN . 820))
+ ((default . error) (RIGHT_PAREN . (subtype_indication . 1)) (COMMA .
(subtype_indication . 1)) (DOT . 90) (TICK . 91) (BAR . (discrete_choice .
1)) (EQUAL_GREATER . (discrete_choice . 1)) (RANGE . 896) (LEFT_PAREN . 820))
((default . error) (PLUS . 155) (MINUS . 154) (ABS . 144) (NOT .
324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (END . (single_protected_declaration . 0)) (PRIVATE .
(single_protected_declaration . 0)) (IDENTIFIER . (single_protected_declaration
. 0)) (USE . (single_protected_declaration . 0)) (TYPE .
(single_protected_declaration . 0)) (TASK . (single_protected_declaration . 0))
(SUBTYPE . (single_protected_declaration . 0)) (PROTECTED .
(single_protected_declaration . 0)) (PROCEDURE . (single_protected_declaration
. 0)) (PRAGMA . (single_protected_declaration . 0)) (PACK [...]
((default . error) (SEMICOLON . (protected_definition . 0)))
@@ -3064,11 +3083,11 @@
((default . error) (WITH . (type_definition . 5)) (SEMICOLON .
(type_definition . 5)))
((default . error) (PLUS . 155) (MINUS . 154) (ABS . 144) (NOT .
324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (WITH . (expression_opt . 0)) (SEMICOLON .
(expression_opt . 0)) (RAISE . 153) (PLUS . 155) (MINUS . 154) (ABS . 144)
(NOT . 324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER .
48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (SEMICOLON . 1294))
+ ((default . error) (SEMICOLON . 1296))
((default . error) (EQUAL_GREATER . (discrete_choice_list . 0)) (BAR .
(discrete_choice_list . 0)) (OTHERS . 152) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (PLUS . 155) (MINUS . 154)
(ABS . 144) (NOT . 150) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149)
(LEFT_PAREN . 148))
- ((default . error) (END . 1291) (WHEN . 1248))
+ ((default . error) (END . 1293) (WHEN . 1250))
((default . error) (END . (variant_list . 0)) (WHEN . (variant_list .
0)))
- ((default . error) (PRIVATE . 1290))
+ ((default . error) (PRIVATE . 1292))
((default . error) (RECORD . 858) (NULL . 856))
((default . error) (PRIVATE . (object_declaration . 2)) (END .
(object_declaration . 2)) (BEGIN . (object_declaration . 2)) (ENTRY .
(object_declaration . 2)) (FOR . (object_declaration . 2)) (FUNCTION .
(object_declaration . 2)) (GENERIC . (object_declaration . 2)) (NOT .
(object_declaration . 2)) (OVERRIDING . (object_declaration . 2)) (PACKAGE .
(object_declaration . 2)) (PRAGMA . (object_declaration . 2)) (PROCEDURE .
(object_declaration . 2)) (PROTECTED . (object_declaration . [...]
((default . error) (PRIVATE . (object_declaration . 4)) (END .
(object_declaration . 4)) (BEGIN . (object_declaration . 4)) (ENTRY .
(object_declaration . 4)) (FOR . (object_declaration . 4)) (FUNCTION .
(object_declaration . 4)) (GENERIC . (object_declaration . 4)) (NOT .
(object_declaration . 4)) (OVERRIDING . (object_declaration . 4)) (PACKAGE .
(object_declaration . 4)) (PRAGMA . (object_declaration . 4)) (PROCEDURE .
(object_declaration . 4)) (PROTECTED . (object_declaration . [...]
@@ -3076,20 +3095,20 @@
((default . error) (PRIVATE . (entry_declaration . 0)) (END .
(entry_declaration . 0)) (BEGIN . (entry_declaration . 0)) (ENTRY .
(entry_declaration . 0)) (FOR . (entry_declaration . 0)) (FUNCTION .
(entry_declaration . 0)) (GENERIC . (entry_declaration . 0)) (NOT .
(entry_declaration . 0)) (OVERRIDING . (entry_declaration . 0)) (PACKAGE .
(entry_declaration . 0)) (PRAGMA . (entry_declaration . 0)) (PROCEDURE .
(entry_declaration . 0)) (PROTECTED . (entry_declaration . 0)) (SUBTYPE [...]
((default . error) (PRIVATE . (protected_body . 0)) (END .
(protected_body . 0)) (BEGIN . (protected_body . 0)) (ENTRY . (protected_body .
0)) (FOR . (protected_body . 0)) (FUNCTION . (protected_body . 0)) (GENERIC .
(protected_body . 0)) (NOT . (protected_body . 0)) (OVERRIDING .
(protected_body . 0)) (PACKAGE . (protected_body . 0)) (PRAGMA .
(protected_body . 0)) (PROCEDURE . (protected_body . 0)) (PROTECTED .
(protected_body . 0)) (SUBTYPE . (protected_body . 0)) (TASK . (prote [...]
((default . error) (IS . (expression_opt . 0)) (RAISE . 153) (PLUS .
155) (MINUS . 154) (ABS . 144) (NOT . 324) (NUMERIC_LITERAL . 156) (NULL .
151) (NEW . 149) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50) (STRING_LITERAL
. 49) (LEFT_PAREN . 148))
- ((default . error) (IDENTIFIER . 1287))
+ ((default . error) (IDENTIFIER . 1289))
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
710))
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
710))
((default . error) (OR . (case_statement . 0)) (THEN . (case_statement .
0)) (WHEN . (case_statement . 0)) (EXCEPTION . (case_statement . 0)) (END .
(case_statement . 0)) (LESS_LESS . (case_statement . 0)) (ACCEPT .
(case_statement . 0)) (ABORT . (case_statement . 0)) (BEGIN . (case_statement .
0)) (CASE . (case_statement . 0)) (DECLARE . (case_statement . 0)) (DELAY .
(case_statement . 0)) (EXIT . (case_statement . 0)) (FOR . (case_statement .
0)) (GOTO . (case_statement . 0)) (IF [...]
((default . error) (END . (case_statement_alternative . 0)) (WHEN .
(case_statement_alternative . 0)))
((default . error) (OR . (block_statement . 0)) (THEN . (block_statement
. 0)) (WHEN . (block_statement . 0)) (EXCEPTION . (block_statement . 0)) (END .
(block_statement . 0)) (LESS_LESS . (block_statement . 0)) (ACCEPT .
(block_statement . 0)) (ABORT . (block_statement . 0)) (BEGIN .
(block_statement . 0)) (CASE . (block_statement . 0)) (DECLARE .
(block_statement . 0)) (DELAY . (block_statement . 0)) (EXIT . (block_statement
. 0)) (FOR . (block_statement . 0)) (GOTO . (block_stat [...]
- ((default . error) (IF . 1284))
+ ((default . error) (IF . 1286))
((default . error) (ELSE . (sequence_of_statements_opt . 0)) (ELSIF .
(sequence_of_statements_opt . 0)) (END . (sequence_of_statements_opt . 0))
(ACCEPT . (label_opt . 0)) (BEGIN . (label_opt . 0)) (CASE . (label_opt . 0))
(DECLARE . (label_opt . 0)) (FOR . (label_opt . 0)) (IF . (label_opt . 0))
(LOOP . (label_opt . 0)) (RETURN . (label_opt . 0)) (SELECT . (label_opt . 0))
(WHILE . (label_opt . 0)) (ABORT . (label_opt . 0)) (DELAY . (label_opt . 0))
(EXIT . (label_opt . 0)) (GOTO [...]
((default . error) (OR . (if_statement . 3)) (THEN . (if_statement . 3))
(WHEN . (if_statement . 3)) (EXCEPTION . (if_statement . 3)) (END .
(if_statement . 3)) (LESS_LESS . (if_statement . 3)) (ACCEPT . (if_statement .
3)) (ABORT . (if_statement . 3)) (BEGIN . (if_statement . 3)) (CASE .
(if_statement . 3)) (DECLARE . (if_statement . 3)) (DELAY . (if_statement . 3))
(EXIT . (if_statement . 3)) (FOR . (if_statement . 3)) (GOTO . (if_statement .
3)) (IF . (if_statement . 3)) (LOOP . [...]
- ((default . error) (SEMICOLON . 1282))
- ((default . error) (END . 1281))
+ ((default . error) (SEMICOLON . 1284))
+ ((default . error) (END . 1283))
((default . error) (OR . (extended_return_statement . 0)) (THEN .
(extended_return_statement . 0)) (WHEN . (extended_return_statement . 0))
(EXCEPTION . (extended_return_statement . 0)) (END . (extended_return_statement
. 0)) (LESS_LESS . (extended_return_statement . 0)) (ACCEPT .
(extended_return_statement . 0)) (ABORT . (extended_return_statement . 0))
(BEGIN . (extended_return_statement . 0)) (CASE . (extended_return_statement .
0)) (DECLARE . (extended_return_statement . 0)) (D [...]
((default . error) (DO . (expression_opt . 0)) (SEMICOLON .
(expression_opt . 0)) (RAISE . 153) (PLUS . 155) (MINUS . 154) (ABS . 144)
(NOT . 324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER .
48) (CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
- ((default . error) (SEMICOLON . 1279))
+ ((default . error) (SEMICOLON . 1281))
((default . error) (OR . (selective_accept . 0)) (THEN .
(selective_accept . 0)) (WHEN . (selective_accept . 0)) (EXCEPTION .
(selective_accept . 0)) (END . (selective_accept . 0)) (LESS_LESS .
(selective_accept . 0)) (ACCEPT . (selective_accept . 0)) (ABORT .
(selective_accept . 0)) (BEGIN . (selective_accept . 0)) (CASE .
(selective_accept . 0)) (DECLARE . (selective_accept . 0)) (DELAY .
(selective_accept . 0)) (EXIT . (selective_accept . 0)) (FOR .
(selective_accept . 0)) (GOTO [...]
((default . error) (OR . (conditional_entry_call . 0)) (THEN .
(conditional_entry_call . 0)) (WHEN . (conditional_entry_call . 0)) (EXCEPTION
. (conditional_entry_call . 0)) (END . (conditional_entry_call . 0)) (LESS_LESS
. (conditional_entry_call . 0)) (ACCEPT . (conditional_entry_call . 0)) (ABORT
. (conditional_entry_call . 0)) (BEGIN . (conditional_entry_call . 0)) (CASE .
(conditional_entry_call . 0)) (DECLARE . (conditional_entry_call . 0)) (DELAY .
(conditional_entry_call . [...]
((default . error) (OR . (timed_entry_call . 0)) (THEN .
(timed_entry_call . 0)) (WHEN . (timed_entry_call . 0)) (EXCEPTION .
(timed_entry_call . 0)) (END . (timed_entry_call . 0)) (LESS_LESS .
(timed_entry_call . 0)) (ACCEPT . (timed_entry_call . 0)) (ABORT .
(timed_entry_call . 0)) (BEGIN . (timed_entry_call . 0)) (CASE .
(timed_entry_call . 0)) (DECLARE . (timed_entry_call . 0)) (DELAY .
(timed_entry_call . 0)) (EXIT . (timed_entry_call . 0)) (FOR .
(timed_entry_call . 0)) (GOTO [...]
@@ -3098,53 +3117,53 @@
((default . error) (WHEN . (exception_handler . 0)) (END .
(exception_handler . 0)))
((default . error) (WHEN . (asynchronous_select . 0)) (THEN .
(asynchronous_select . 0)) (OR . (asynchronous_select . 0)) (ELSIF .
(asynchronous_select . 0)) (ELSE . (asynchronous_select . 0))
(CHARACTER_LITERAL . (asynchronous_select . 0)) (STRING_LITERAL .
(asynchronous_select . 0)) (IDENTIFIER . (asynchronous_select . 0)) (WHILE .
(asynchronous_select . 0)) (SELECT . (asynchronous_select . 0)) (RETURN .
(asynchronous_select . 0)) (REQUEUE . (asynchronous_select . 0)) (RAISE . (a
[...]
((default . error) (DO . (extended_return_object_declaration . 0))
(SEMICOLON . (extended_return_object_declaration . 0)))
- ((default . error) (IF . 1312))
+ ((default . error) (IF . 1314))
((default . error) (WHEN . (if_statement . 1)) (THEN . (if_statement .
1)) (OR . (if_statement . 1)) (ELSIF . (if_statement . 1)) (ELSE .
(if_statement . 1)) (CHARACTER_LITERAL . (if_statement . 1)) (STRING_LITERAL .
(if_statement . 1)) (IDENTIFIER . (if_statement . 1)) (WHILE . (if_statement .
1)) (SELECT . (if_statement . 1)) (RETURN . (if_statement . 1)) (REQUEUE .
(if_statement . 1)) (RAISE . (if_statement . 1)) (PRAGMA . (if_statement . 1))
(NULL . (if_statement . 1)) (LOOP . [...]
((default . error) (ELSE . (elsif_statement_item . 0)) (ELSIF .
(elsif_statement_item . 0)) (END . (elsif_statement_item . 0)))
+ ((default . error) (SEMICOLON . 1313))
+ ((default . error) (SEMICOLON . 1312))
((default . error) (SEMICOLON . 1311))
- ((default . error) (SEMICOLON . 1310))
- ((default . error) (SEMICOLON . 1309))
- ((default . error) (IN . 1308))
- ((default . error) (IS . 1307))
+ ((default . error) (IN . 1310))
+ ((default . error) (IS . 1309))
((default . error) (WITH . (derived_type_definition . 0)) (SEMICOLON .
(derived_type_definition . 0)))
((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
- ((default . error) (CASE . 1305))
+ ((default . error) (CASE . 1307))
((default . error) (WHEN . (variant_list . 1)) (END . (variant_list .
1)))
- ((default . error) (BAR . 356) (EQUAL_GREATER . 1304))
+ ((default . error) (BAR . 356) (EQUAL_GREATER . 1306))
((default . error) (WHEN . (component_declaration . 1)) (END .
(component_declaration . 1)) (CASE . (component_declaration . 1)) (FOR .
(component_declaration . 1)) (IDENTIFIER . (component_declaration . 1)))
((default . error) (SEMICOLON . (aspect_specification_opt . 0)) (WITH .
109))
((default . error) (SEMICOLON . (real_range_specification_opt . 1))
(WITH . (real_range_specification_opt . 1)))
- ((default . error) (SEMICOLON . 1302))
- ((default . error) (SEMICOLON . 1301))
- ((default . error) (DOT_DOT . 1300))
+ ((default . error) (SEMICOLON . 1304))
+ ((default . error) (SEMICOLON . 1303))
+ ((default . error) (DOT_DOT . 1302))
((default . error) (PLUS . 155) (MINUS . 154) (ABS . 144) (NOT .
324) (NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (IDENTIFIER . 48)
(CHARACTER_LITERAL . 50) (STRING_LITERAL . 49) (LEFT_PAREN . 148))
((default . error) (PRIVATE . (protected_type_declaration . 0)) (END .
(protected_type_declaration . 0)) (BEGIN . (protected_type_declaration . 0))
(ENTRY . (protected_type_declaration . 0)) (FOR . (protected_type_declaration .
0)) (FUNCTION . (protected_type_declaration . 0)) (GENERIC .
(protected_type_declaration . 0)) (NOT . (protected_type_declaration . 0))
(OVERRIDING . (protected_type_declaration . 0)) (PACKAGE .
(protected_type_declaration . 0)) (PRAGMA . (protected_type_dec [...]
((default . error) (PRIVATE . (task_type_declaration . 0)) (END .
(task_type_declaration . 0)) (BEGIN . (task_type_declaration . 0)) (ENTRY .
(task_type_declaration . 0)) (FOR . (task_type_declaration . 0)) (FUNCTION .
(task_type_declaration . 0)) (GENERIC . (task_type_declaration . 0)) (NOT .
(task_type_declaration . 0)) (OVERRIDING . (task_type_declaration . 0))
(PACKAGE . (task_type_declaration . 0)) (PRAGMA . (task_type_declaration . 0))
(PROCEDURE . (task_type_declaration . 0) [...]
+ ((default . error) (SEMICOLON . 1321))
+ ((default . error) (END . (component_list_opt . 0)) (WHEN .
(component_list_opt . 0)) (NULL . 1026) (CASE . 1025) (IDENTIFIER . 77) (FOR
. 269))
((default . error) (SEMICOLON . 1319))
- ((default . error) (END . (component_list_opt . 0)) (WHEN .
(component_list_opt . 0)) (NULL . 1024) (CASE . 1023) (IDENTIFIER . 77) (FOR
. 269))
- ((default . error) (SEMICOLON . 1317))
- ((default . error) (SEMICOLON . 1316))
+ ((default . error) (SEMICOLON . 1318))
((default . error) (BEGIN . (declarative_part_opt . 0)) (USE . 11)
(SUBTYPE . 272) (PRAGMA . 7) (NOT . 4) (OVERRIDING . 5) (FUNCTION .
(overriding_indicator_opt . 2)) (PROCEDURE . (overriding_indicator_opt . 2))
(ENTRY . (overriding_indicator_opt . 2)) (FOR . 269) (IDENTIFIER . 275) (TYPE
. 274) (GENERIC . 2) (PROTECTED . 271) (TASK . 273) (PACKAGE . 270))
((default . error) (IDENTIFIER . 48) (CHARACTER_LITERAL . 50)
(STRING_LITERAL . 49) (PLUS . 155) (MINUS . 154) (ABS . 144) (NOT . 728)
(NUMERIC_LITERAL . 156) (NULL . 151) (NEW . 149) (LEFT_PAREN . 148))
((default . error) (PRIVATE . (task_body . 0)) (END . (task_body . 0))
(BEGIN . (task_body . 0)) (ENTRY . (task_body . 0)) (FOR . (task_body . 0))
(FUNCTION . (task_body . 0)) (GENERIC . (task_body . 0)) (NOT . (task_body .
0)) (OVERRIDING . (task_body . 0)) (PACKAGE . (task_body . 0)) (PRAGMA .
(task_body . 0)) (PROCEDURE . (task_body . 0)) (PROTECTED . (task_body . 0))
(SUBTYPE . (task_body . 0)) (TASK . (task_body . 0)) (TYPE . (task_body . 0))
(USE . (task_body . 0)) (IDENTIFIE [...]
((default . error) (THEN . (accept_statement . 0)) (WHEN .
(accept_statement . 0)) (EXCEPTION . (accept_statement . 0)) (ELSIF .
(accept_statement . 0)) (ELSE . (accept_statement . 0)) (OR . (accept_statement
. 0)) (END . (accept_statement . 0)) (ACCEPT . (accept_statement . 0)) (ABORT .
(accept_statement . 0)) (BEGIN . (accept_statement . 0)) (CASE .
(accept_statement . 0)) (DECLARE . (accept_statement . 0)) (DELAY .
(accept_statement . 0)) (EXIT . (accept_statement . 0)) (FOR . ( [...]
((default . error) (OR . (if_statement . 2)) (THEN . (if_statement . 2))
(WHEN . (if_statement . 2)) (EXCEPTION . (if_statement . 2)) (END .
(if_statement . 2)) (LESS_LESS . (if_statement . 2)) (ACCEPT . (if_statement .
2)) (ABORT . (if_statement . 2)) (BEGIN . (if_statement . 2)) (CASE .
(if_statement . 2)) (DECLARE . (if_statement . 2)) (DELAY . (if_statement . 2))
(EXIT . (if_statement . 2)) (FOR . (if_statement . 2)) (GOTO . (if_statement .
2)) (IF . (if_statement . 2)) (LOOP . [...]
- ((default . error) (SEMICOLON . 1313))
+ ((default . error) (SEMICOLON . 1315))
((default . error) (WHEN . (if_statement . 0)) (THEN . (if_statement .
0)) (OR . (if_statement . 0)) (ELSIF . (if_statement . 0)) (ELSE .
(if_statement . 0)) (CHARACTER_LITERAL . (if_statement . 0)) (STRING_LITERAL .
(if_statement . 0)) (IDENTIFIER . (if_statement . 0)) (WHILE . (if_statement .
0)) (SELECT . (if_statement . 0)) (RETURN . (if_statement . 0)) (REQUEUE .
(if_statement . 0)) (RAISE . (if_statement . 0)) (PRAGMA . (if_statement . 0))
(NULL . (if_statement . 0)) (LOOP . [...]
- ((default . error) (RIGHT_PAREN . 1323))
- ((default . error) (BEGIN . 1322))
+ ((default . error) (RIGHT_PAREN . 1325))
+ ((default . error) (BEGIN . 1324))
((default . error) (BEGIN . (private_extension_declaration . 0)) (ENTRY
. (private_extension_declaration . 0)) (FOR . (private_extension_declaration .
0)) (FUNCTION . (private_extension_declaration . 0)) (GENERIC .
(private_extension_declaration . 0)) (NOT . (private_extension_declaration .
0)) (OVERRIDING . (private_extension_declaration . 0)) (PACKAGE .
(private_extension_declaration . 0)) (PRAGMA . (private_extension_declaration .
0)) (PROCEDURE . (private_extension_declaration [...]
((default . error) (WHEN . (variant_part . 0)) (END . (variant_part .
0)) (CASE . (variant_part . 0)) (FOR . (variant_part . 0)) (IDENTIFIER .
(variant_part . 0)))
((default . error) (END . (variant . 0)) (WHEN . (variant . 0)))
((default . error) (WHEN . (component_declaration . 0)) (END .
(component_declaration . 0)) (CASE . (component_declaration . 0)) (FOR .
(component_declaration . 0)) (IDENTIFIER . (component_declaration . 0)))
- ((default . error) (SEMICOLON . 1321))
+ ((default . error) (SEMICOLON . 1323))
((default . error) (END . (component_clause . 0)) (IDENTIFIER .
(component_clause . 0)))
((default . error) (END . (sequence_of_statements_opt . 0)) (EXCEPTION .
(sequence_of_statements_opt . 0)) (ACCEPT . (label_opt . 0)) (BEGIN .
(label_opt . 0)) (CASE . (label_opt . 0)) (DECLARE . (label_opt . 0)) (FOR .
(label_opt . 0)) (IF . (label_opt . 0)) (LOOP . (label_opt . 0)) (RETURN .
(label_opt . 0)) (SELECT . (label_opt . 0)) (WHILE . (label_opt . 0)) (ABORT .
(label_opt . 0)) (DELAY . (label_opt . 0)) (EXIT . (label_opt . 0)) (GOTO .
(label_opt . 0)) (NULL . (label_opt [...]
((default . error) (WHEN . (parameter_profile_opt . 0)) (LEFT_PAREN .
801))
((default . error) (WHEN . (entry_body_formal_part . 0)))
- ((default . error) (END . 1326))
+ ((default . error) (END . 1328))
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER .
710))
- ((default . error) (SEMICOLON . 1328))
+ ((default . error) (SEMICOLON . 1330))
((default . error) (PROCEDURE . (entry_body . 0)) (OVERRIDING .
(entry_body . 0)) (NOT . (entry_body . 0)) (FUNCTION . (entry_body . 0)) (FOR .
(entry_body . 0)) (ENTRY . (entry_body . 0)) (END . (entry_body . 0)))]
[((compilation_unit . 13)(compilation_unit_list . 14)(context_item .
15)(function_specification . 16)(generic_declaration . 17)(generic_formal_part
. 18)(generic_instantiation . 19)(generic_package_declaration .
20)(generic_renaming_declaration . 21)(generic_subprogram_declaration .
22)(library_item . 23)(library_unit_declaration .
24)(library_unit_renaming_declaration . 25)(overriding_indicator_opt .
26)(package_body . 27)(package_declaration . 28)(package_renaming_declaration .
29 [...]
((attribute_reference . 51)(name . 87)(qualified_expression .
54)(selected_component . 55))
@@ -3818,26 +3837,26 @@
nil
nil
nil
- ((exception_handler . 944)(exception_handler_list .
945)(exception_handler_list_opt . 946))
+ ((exception_handler . 945)(exception_handler_list .
946)(exception_handler_list_opt . 947))
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 942)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 943)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
- ((attribute_reference . 51)(name . 237)(name_opt .
940)(qualified_expression . 54)(selected_component . 55))
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((attribute_reference . 51)(name . 237)(name_opt .
941)(qualified_expression . 54)(selected_component . 55))
nil
nil
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 937)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 938)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
nil
- ((accept_statement . 641)(actual_parameter_part .
92)(assignment_statement . 642)(asynchronous_select . 643)(attribute_reference
. 51)(block_statement . 644)(case_statement . 645)(conditional_entry_call .
646)(delay_statement . 647)(exit_statement . 648)(extended_return_statement .
649)(goto_label . 650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statem [...]
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((accept_statement . 641)(actual_parameter_part .
92)(assignment_statement . 642)(asynchronous_select . 643)(attribute_reference
. 51)(block_statement . 644)(case_statement . 645)(conditional_entry_call .
646)(delay_statement . 647)(exit_statement . 648)(extended_return_statement .
649)(goto_label . 650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statem [...]
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
nil
nil
nil
@@ -3858,33 +3877,33 @@
nil
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 913)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 914)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
nil
nil
((actual_parameter_part . 92))
- ((actual_parameter_part . 906)(actual_parameter_part_opt . 907))
+ ((actual_parameter_part . 907)(actual_parameter_part_opt . 908))
nil
nil
- ((case_expression_alternative . 902))
+ ((case_expression_alternative . 903))
nil
nil
((actual_parameter_part . 92)(constraint . 822)(index_constraint . 823))
nil
- ((attribute_reference . 51)(name . 898)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 899)(qualified_expression .
54)(selected_component . 55))
((actual_parameter_part . 92))
((aggregate . 158)(attribute_reference . 51)(name . 325)(primary .
371)(qualified_expression . 54)(selected_component . 55))
- ((aggregate . 158)(attribute_reference . 51)(discrete_subtype_definition
. 896)(factor . 174)(name . 731)(primary . 177)(qualified_expression .
54)(range . 732)(selected_component . 55)(simple_expression .
479)(subtype_indication . 733)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(discrete_subtype_definition
. 897)(factor . 174)(name . 731)(primary . 177)(qualified_expression .
54)(range . 732)(selected_component . 55)(simple_expression .
479)(subtype_indication . 733)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
((actual_parameter_part . 92)(constraint . 822)(index_constraint . 823))
nil
nil
nil
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 895)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 894)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 893)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
- ((elsif_expression_item . 892))
+ ((elsif_expression_item . 893))
nil
nil
nil
@@ -3892,9 +3911,9 @@
nil
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(discrete_subtype_definition
. 886)(factor . 174)(identifier_list . 230)(name . 731)(parameter_specification
. 231)(parameter_specification_list . 232)(primary . 177)(qualified_expression
. 54)(range . 732)(selected_component . 55)(simple_expression .
479)(subtype_indication . 733)(term . 188)(term_list .
189)(unary_adding_operator . 190))
- ((aspect_specification_opt . 885))
- ((aggregate . 158)(attribute_reference . 51)(case_expression .
161)(conditional_quantified_expression . 883)(expression . 172)(expression_opt
. 884)(factor . 174)(if_expression . 175)(name . 325)(primary .
177)(qualified_expression . 54)(quantified_expression . 178)(raise_expression .
179)(relation_and_list . 181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 3 [...]
+ ((aggregate . 158)(attribute_reference . 51)(discrete_subtype_definition
. 887)(factor . 174)(identifier_list . 230)(name . 731)(parameter_specification
. 231)(parameter_specification_list . 232)(primary . 177)(qualified_expression
. 54)(range . 732)(selected_component . 55)(simple_expression .
479)(subtype_indication . 733)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aspect_specification_opt . 886))
+ ((aggregate . 158)(association_opt . 159)(association_list .
883)(attribute_reference . 51)(case_expression . 161)(choice_expression .
162)(choice_relation_and_list . 163)(choice_relation_or_list .
164)(choice_relation_xor_list . 165)(choice_relation_and_then_list .
166)(choice_relation_or_else_list . 167)(choice_relation .
168)(conditional_quantified_expression . 884)(discrete_choice .
170)(discrete_choice_list . 171)(expression . 172)(expression_opt . 885)(factor
. 174)(if_expres [...]
((aspect_specification_opt . 882))
((aspect_specification_opt . 881))
((aspect_specification_opt . 880))
@@ -3958,7 +3977,7 @@
nil
nil
nil
- ((attribute_reference . 51)(interface_list . 1073)(name .
815)(qualified_expression . 54)(selected_component . 55))
+ ((attribute_reference . 51)(interface_list . 1075)(name .
815)(qualified_expression . 54)(selected_component . 55))
nil
nil
((actual_parameter_part . 92))
@@ -3966,14 +3985,14 @@
nil
nil
nil
- ((aggregate . 158)(association_opt . 159)(association_list .
195)(attribute_reference . 51)(case_expression . 161)(choice_expression .
162)(choice_relation_and_list . 163)(choice_relation_or_list .
164)(choice_relation_xor_list . 165)(choice_relation_and_then_list .
166)(choice_relation_or_else_list . 167)(choice_relation .
168)(conditional_quantified_expression . 196)(discrete_choice .
170)(discrete_choice_list . 171)(discrete_subtype_definition .
781)(discrete_subtype_definition_ [...]
- ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
176)(primary . 177)(qualified_expression . 54)(range . 994)(selected_component
. 55)(simple_expression . 479)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(association_opt . 159)(association_list .
195)(attribute_reference . 51)(case_expression . 161)(choice_expression .
162)(choice_relation_and_list . 163)(choice_relation_or_list .
164)(choice_relation_xor_list . 165)(choice_relation_and_then_list .
166)(choice_relation_or_else_list . 167)(choice_relation .
168)(conditional_quantified_expression . 196)(discrete_choice .
170)(discrete_choice_list . 171)(discrete_subtype_definition .
781)(discrete_subtype_definition_ [...]
+ ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
176)(primary . 177)(qualified_expression . 54)(range . 995)(selected_component
. 55)(simple_expression . 479)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
nil
- ((attribute_reference . 51)(index_subtype_definition . 1064)(name .
1065)(qualified_expression . 54)(selected_component . 55))
+ ((attribute_reference . 51)(index_subtype_definition . 1066)(name .
1067)(qualified_expression . 54)(selected_component . 55))
nil
- ((aggregate . 158)(attribute_reference . 51)(discrete_subtype_definition
. 1062)(factor . 174)(name . 731)(primary . 177)(qualified_expression .
54)(range . 732)(selected_component . 55)(simple_expression .
479)(subtype_indication . 733)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(discrete_subtype_definition
. 1064)(factor . 174)(name . 731)(primary . 177)(qualified_expression .
54)(range . 732)(selected_component . 55)(simple_expression .
479)(subtype_indication . 733)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
nil
@@ -3981,50 +4000,50 @@
nil
nil
nil
- ((component_clause . 1059)(component_clause_list . 1060))
+ ((component_clause . 1061)(component_clause_list . 1062))
nil
nil
- ((aspect_specification_opt . 1056))
- ((attribute_reference . 51)(interface_list . 1055)(name .
815)(qualified_expression . 54)(selected_component . 55))
+ ((aspect_specification_opt . 1058))
+ ((attribute_reference . 51)(interface_list . 1057)(name .
815)(qualified_expression . 54)(selected_component . 55))
nil
nil
nil
- ((aspect_specification_opt . 1050))
+ ((aspect_specification_opt . 1052))
nil
- ((attribute_reference . 51)(interface_list . 1048)(name .
815)(qualified_expression . 54)(selected_component . 55))
+ ((attribute_reference . 51)(interface_list . 1050)(name .
815)(qualified_expression . 54)(selected_component . 55))
nil
nil
nil
- ((aspect_specification_opt . 1042))
+ ((aspect_specification_opt . 1044))
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1040)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1039)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
- ((enumeration_literal . 1037)(enumeration_literal_list . 1038))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1042)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1041)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((enumeration_literal . 1039)(enumeration_literal_list . 1040))
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1034)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1036)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
- ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1032)(term . 188)(term_list .
189)(unary_adding_operator . 190))
- ((aspect_clause . 1025)(at_clause . 278)(component_declaration .
1026)(component_item . 1027)(component_list . 1028)(component_list_opt .
1029)(enumeration_representation_clause . 285)(identifier_list .
1030)(record_representation_clause . 309)(variant_part . 1031))
+ ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1034)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aspect_clause . 1027)(at_clause . 278)(component_declaration .
1028)(component_item . 1029)(component_list . 1030)(component_list_opt .
1031)(enumeration_representation_clause . 285)(identifier_list .
1032)(record_representation_clause . 309)(variant_part . 1033))
nil
nil
nil
- ((record_definition . 1019))
+ ((record_definition . 1021))
nil
nil
nil
nil
nil
nil
- ((aspect_specification_opt . 1017))
- ((actual_parameter_part . 92)(aspect_specification_opt . 1016))
- ((actual_parameter_part . 92)(aspect_specification_opt . 1015))
- ((attribute_reference . 51)(name . 1014)(qualified_expression .
54)(selected_component . 55))
+ ((aspect_specification_opt . 1019))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 1018))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 1017))
+ ((attribute_reference . 51)(name . 1016)(qualified_expression .
54)(selected_component . 55))
nil
nil
nil
+ ((aspect_specification_opt . 1013))
((aspect_specification_opt . 1011))
((aspect_specification_opt . 1009))
- ((aspect_specification_opt . 1007))
nil
nil
nil
@@ -4033,54 +4052,55 @@
nil
nil
nil
- ((attribute_reference . 51)(name . 237)(name_opt .
997)(qualified_expression . 54)(selected_component . 55))
+ nil
+ ((attribute_reference . 51)(name . 237)(name_opt .
998)(qualified_expression . 54)(selected_component . 55))
nil
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 996)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 997)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
176)(primary . 177)(qualified_expression . 54)(range . 994)(selected_component
. 55)(simple_expression . 479)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
176)(primary . 177)(qualified_expression . 54)(range . 995)(selected_component
. 55)(simple_expression . 479)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
- ((attribute_reference . 51)(name . 991)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 992)(qualified_expression .
54)(selected_component . 55))
((actual_parameter_part . 92))
- ((attribute_reference . 51)(name . 993)(qualified_expression .
54)(selected_component . 55))
- ((attribute_reference . 51)(name . 991)(qualified_expression .
54)(selected_component . 55))
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 990)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((attribute_reference . 51)(name . 994)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 992)(qualified_expression .
54)(selected_component . 55))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 991)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
- ((aspect_clause . 980)(at_clause . 278)(entry_body .
981)(enumeration_representation_clause . 285)(expression_function_declaration .
982)(function_specification . 16)(null_procedure_declaration .
983)(overriding_indicator_opt . 984)(procedure_specification .
32)(protected_operation_item . 985)(protected_operation_item_list .
986)(protected_operation_item_list_opt . 987)(record_representation_clause .
309)(subprogram_body . 988)(subprogram_declaration . 989))
- ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 978)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
+ ((aspect_clause . 981)(at_clause . 278)(entry_body .
982)(enumeration_representation_clause . 285)(expression_function_declaration .
983)(function_specification . 16)(null_procedure_declaration .
984)(overriding_indicator_opt . 985)(procedure_specification .
32)(protected_operation_item . 986)(protected_operation_item_list .
987)(protected_operation_item_list_opt . 988)(record_representation_clause .
309)(subprogram_body . 989)(subprogram_declaration . 990))
+ ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 979)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
((aggregate . 158)(association_opt . 159)(association_list .
195)(attribute_reference . 51)(case_expression . 161)(choice_expression .
162)(choice_relation_and_list . 163)(choice_relation_or_list .
164)(choice_relation_xor_list . 165)(choice_relation_and_then_list .
166)(choice_relation_or_else_list . 167)(choice_relation .
168)(conditional_quantified_expression . 196)(discrete_choice .
170)(discrete_choice_list . 171)(expression . 172)(expression_opt . 173)(factor
. 174)(if_expres [...]
nil
- ((formal_part . 117)(parameter_profile_opt . 977))
+ ((formal_part . 117)(parameter_profile_opt . 978))
nil
- ((identifier_opt . 976))
- ((case_statement_alternative . 974)(case_statement_alternative_list .
975))
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(handled_sequence_of_statements . 972)(if_statement . 652)(iteration_scheme
. 653)(label_opt . 654)(loop_statement . 655)(name . 656)(pragma .
657)(procedure_call_statement . 658)(qualified_expression . 54)(ra [...]
+ ((identifier_opt . 977))
+ ((case_statement_alternative . 975)(case_statement_alternative_list .
976))
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(handled_sequence_of_statements . 973)(if_statement . 652)(iteration_scheme
. 653)(label_opt . 654)(loop_statement . 655)(name . 656)(pragma .
657)(procedure_call_statement . 658)(qualified_expression . 54)(ra [...]
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 970)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 971)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 967)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 968)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(handled_sequence_of_statements . 965)(if_statement . 652)(iteration_scheme
. 653)(label_opt . 654)(loop_statement . 655)(name . 656)(pragma .
657)(procedure_call_statement . 658)(qualified_expression . 54)(ra [...]
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(handled_sequence_of_statements . 966)(if_statement . 652)(iteration_scheme
. 653)(label_opt . 654)(loop_statement . 655)(name . 656)(pragma .
657)(procedure_call_statement . 658)(qualified_expression . 54)(ra [...]
nil
nil
- ((aliased_opt . 964))
+ ((aliased_opt . 965))
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
nil
- ((accept_statement . 686)(delay_alternative . 687)(delay_statement .
958)(select_alternative . 960))
+ ((accept_statement . 686)(delay_alternative . 687)(delay_statement .
959)(select_alternative . 961))
nil
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
- ((delay_alternative . 957)(delay_statement . 958))
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((delay_alternative . 958)(delay_statement . 959))
nil
nil
nil
@@ -4089,9 +4109,9 @@
nil
nil
nil
- ((attribute_reference . 51)(exception_choice .
950)(exception_choice_list . 951)(name . 952)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(exception_choice .
951)(exception_choice_list . 952)(name . 953)(qualified_expression .
54)(selected_component . 55))
nil
- ((exception_handler . 947))
+ ((exception_handler . 948))
nil
nil
nil
@@ -4102,26 +4122,26 @@
nil
nil
nil
- ((accept_statement . 1170)(delay_alternative . 1171)(delay_statement .
958))
+ ((accept_statement . 1172)(delay_alternative . 1173)(delay_statement .
959))
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
nil
nil
nil
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
- ((constant_opt . 1162))
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((constant_opt . 1164))
nil
nil
nil
- ((identifier_opt . 1158))
- ((elsif_statement_item . 1156)(elsif_statement_list . 1157))
+ ((identifier_opt . 1160))
+ ((elsif_statement_item . 1158)(elsif_statement_list . 1159))
nil
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(choice_expression .
162)(choice_relation_and_list . 163)(choice_relation_or_list .
164)(choice_relation_xor_list . 165)(choice_relation_and_then_list .
166)(choice_relation_or_else_list . 167)(choice_relation . 168)(discrete_choice
. 170)(discrete_choice_list . 1150)(factor . 174)(name . 176)(primary .
177)(qualified_expression . 54)(range . 180)(selected_component .
55)(simple_expression . 430)(term . 188)(term_list . 189)(unary_adding_ [...]
+ ((aggregate . 158)(attribute_reference . 51)(choice_expression .
162)(choice_relation_and_list . 163)(choice_relation_or_list .
164)(choice_relation_xor_list . 165)(choice_relation_and_then_list .
166)(choice_relation_or_else_list . 167)(choice_relation . 168)(discrete_choice
. 170)(discrete_choice_list . 1152)(factor . 174)(name . 176)(primary .
177)(qualified_expression . 54)(range . 180)(selected_component .
55)(simple_expression . 430)(term . 188)(term_list . 189)(unary_adding_ [...]
nil
- ((case_statement_alternative . 1149))
+ ((case_statement_alternative . 1151))
nil
nil
nil
@@ -4130,21 +4150,21 @@
nil
nil
nil
- ((function_specification . 454)(procedure_specification .
455)(subprogram_specification . 1142))
+ ((function_specification . 454)(procedure_specification .
455)(subprogram_specification . 1144))
nil
- ((aspect_clause . 980)(at_clause . 278)(entry_body .
981)(enumeration_representation_clause . 285)(expression_function_declaration .
982)(function_specification . 16)(null_procedure_declaration .
983)(overriding_indicator_opt . 984)(procedure_specification .
32)(protected_operation_item . 1141)(record_representation_clause .
309)(subprogram_body . 988)(subprogram_declaration . 989))
+ ((aspect_clause . 981)(at_clause . 278)(entry_body .
982)(enumeration_representation_clause . 285)(expression_function_declaration .
983)(function_specification . 16)(null_procedure_declaration .
984)(overriding_indicator_opt . 985)(procedure_specification .
32)(protected_operation_item . 1143)(record_representation_clause .
309)(subprogram_body . 989)(subprogram_declaration . 990))
nil
nil
nil
nil
- ((actual_parameter_part . 92)(constraint . 1139)(index_constraint . 823))
- ((attribute_reference . 51)(name . 1138)(qualified_expression .
54)(selected_component . 55))
+ ((actual_parameter_part . 92)(constraint . 1141)(index_constraint . 823))
+ ((attribute_reference . 51)(name . 1140)(qualified_expression .
54)(selected_component . 55))
((actual_parameter_part . 92))
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1137)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1139)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
- ((formal_part . 117)(parameter_profile_opt . 1135))
+ ((formal_part . 117)(parameter_profile_opt . 1137))
nil
nil
nil
@@ -4152,29 +4172,30 @@
nil
nil
nil
+ nil
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1136)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ nil
((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1134)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1132)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1130)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
- nil
- ((attribute_reference . 51)(name . 991)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 992)(qualified_expression .
54)(selected_component . 55))
nil
- ((actual_parameter_part . 92)(aspect_specification_opt . 1128))
+ ((actual_parameter_part . 92)(aspect_specification_opt . 1130))
nil
nil
nil
- ((aspect_specification_opt . 1124))
+ ((aspect_specification_opt . 1126))
nil
- ((attribute_reference . 51)(name . 1123)(qualified_expression .
54)(selected_component . 55))
- ((attribute_reference . 51)(name . 724)(qualified_expression .
54)(selected_component . 55)(subtype_indication . 1122))
+ ((attribute_reference . 51)(name . 1125)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 724)(qualified_expression .
54)(selected_component . 55)(subtype_indication . 1124))
nil
- ((direct_name . 1120)(direct_name_opt . 1121))
+ ((direct_name . 1122)(direct_name_opt . 1123))
nil
nil
nil
nil
- ((aspect_clause . 1025)(at_clause . 278)(component_declaration .
1026)(component_item . 1115)(enumeration_representation_clause .
285)(identifier_list . 1030)(record_representation_clause . 309)(variant_part .
1116))
+ ((aspect_clause . 1027)(at_clause . 278)(component_declaration .
1028)(component_item . 1117)(enumeration_representation_clause .
285)(identifier_list . 1032)(record_representation_clause . 309)(variant_part .
1118))
nil
nil
nil
@@ -4185,51 +4206,51 @@
nil
nil
nil
- ((real_range_specification_opt . 1109))
- ((real_range_specification_opt . 1108))
+ ((real_range_specification_opt . 1111))
+ ((real_range_specification_opt . 1110))
nil
nil
- ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 846)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
+ ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 846)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
nil
nil
- ((identifier_opt . 1102))
- ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 1101)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(ge [...]
+ ((identifier_opt . 1104))
+ ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 1103)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(ge [...]
nil
nil
nil
- ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 840)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
+ ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 840)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
nil
- ((identifier_opt . 1096))
- ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 1095)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(ge [...]
+ ((identifier_opt . 1098))
+ ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 1097)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(ge [...]
nil
nil
nil
nil
nil
- ((component_clause . 1091))
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1089)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((component_clause . 1093))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1091)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
- ((access_definition . 1084)(attribute_reference .
51)(component_definition . 1088)(name . 724)(null_exclusion_opt .
509)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
1086))
+ ((access_definition . 1086)(attribute_reference .
51)(component_definition . 1090)(name . 724)(null_exclusion_opt .
509)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
1088))
nil
((actual_parameter_part . 92))
- ((access_definition . 1084)(attribute_reference .
51)(component_definition . 1085)(name . 724)(null_exclusion_opt .
509)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
1086))
+ ((access_definition . 1086)(attribute_reference .
51)(component_definition . 1087)(name . 724)(null_exclusion_opt .
509)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
1088))
nil
((aggregate . 158)(attribute_reference . 51)(name . 325)(primary .
371)(qualified_expression . 54)(selected_component . 55))
nil
nil
- ((attribute_reference . 51)(name . 1080)(qualified_expression .
54)(selected_component . 55))
+ ((attribute_reference . 51)(name . 1082)(qualified_expression .
54)(selected_component . 55))
nil
nil
nil
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1078)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1080)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
((actual_parameter_part . 92))
nil
- ((attribute_reference . 51)(name . 1236)(qualified_expression .
54)(selected_component . 55))
- ((access_definition . 1234)(attribute_reference . 51)(name .
724)(null_exclusion_opt . 509)(qualified_expression . 54)(selected_component .
55)(subtype_indication . 1235))
+ ((attribute_reference . 51)(name . 1238)(qualified_expression .
54)(selected_component . 55))
+ ((access_definition . 1236)(attribute_reference . 51)(name .
724)(null_exclusion_opt . 509)(qualified_expression . 54)(selected_component .
55)(subtype_indication . 1237))
nil
nil
nil
@@ -4238,28 +4259,28 @@
nil
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1231)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1233)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
- ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 840)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
+ ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 840)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
nil
nil
- ((attribute_reference . 51)(interface_list . 1228)(name .
815)(qualified_expression . 54)(selected_component . 55))
+ ((attribute_reference . 51)(interface_list . 1230)(name .
815)(qualified_expression . 54)(selected_component . 55))
nil
nil
- ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 846)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
+ ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 846)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
nil
nil
- ((attribute_reference . 51)(interface_list . 1224)(name .
815)(qualified_expression . 54)(selected_component . 55))
+ ((attribute_reference . 51)(interface_list . 1226)(name .
815)(qualified_expression . 54)(selected_component . 55))
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1222)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
- ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1221)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1224)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1223)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
nil
- ((enumeration_literal . 1220))
- ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1219)(term . 188)(term_list .
189)(unary_adding_operator . 190))
- ((access_definition . 1084)(attribute_reference .
51)(component_definition . 1218)(name . 724)(null_exclusion_opt .
509)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
1086))
+ ((enumeration_literal . 1222))
+ ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1221)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((access_definition . 1086)(attribute_reference .
51)(component_definition . 1220)(name . 724)(null_exclusion_opt .
509)(qualified_expression . 54)(selected_component . 55)(subtype_indication .
1088))
nil
nil
nil
@@ -4268,47 +4289,47 @@
nil
nil
nil
- ((and_interface_list_opt . 1215))
- ((actual_parameter_part . 92)(and_interface_list_opt . 1212)(constraint
. 1213)(constraint_opt . 1214)(index_constraint . 823))
+ ((and_interface_list_opt . 1217))
+ ((actual_parameter_part . 92)(and_interface_list_opt . 1214)(constraint
. 1215)(constraint_opt . 1216)(index_constraint . 823))
nil
nil
nil
nil
nil
nil
- ((aspect_specification_opt . 1209))
+ ((aspect_specification_opt . 1211))
nil
- ((aspect_specification_opt . 1208))
+ ((aspect_specification_opt . 1210))
nil
- ((aspect_specification_opt . 1207))
- ((aspect_specification_opt . 1206))
+ ((aspect_specification_opt . 1209))
+ ((aspect_specification_opt . 1208))
nil
nil
((actual_parameter_part . 92))
nil
- ((identifier_opt . 1205))
+ ((identifier_opt . 1207))
nil
((aspect_specification_opt . 129))
- ((entry_body_formal_part . 1203)(formal_part .
117)(parameter_profile_opt . 1204))
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(handled_sequence_of_statements . 1201)(if_statement .
652)(iteration_scheme . 653)(label_opt . 654)(loop_statement . 655)(name .
656)(pragma . 657)(procedure_call_statement . 658)(qualified_expression . 54)(r
[...]
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(handled_sequence_of_statements . 1200)(if_statement .
652)(iteration_scheme . 653)(label_opt . 654)(loop_statement . 655)(name .
656)(pragma . 657)(procedure_call_statement . 658)(qualified_expression . 54)(r
[...]
+ ((entry_body_formal_part . 1205)(formal_part .
117)(parameter_profile_opt . 1206))
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(handled_sequence_of_statements . 1203)(if_statement .
652)(iteration_scheme . 653)(label_opt . 654)(loop_statement . 655)(name .
656)(pragma . 657)(procedure_call_statement . 658)(qualified_expression . 54)(r
[...]
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(handled_sequence_of_statements . 1202)(if_statement .
652)(iteration_scheme . 653)(label_opt . 654)(loop_statement . 655)(name .
656)(pragma . 657)(procedure_call_statement . 658)(qualified_expression . 54)(r
[...]
nil
nil
nil
nil
nil
- ((identifier_opt . 1197))
+ ((identifier_opt . 1199))
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1195)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1197)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
- ((elsif_statement_item . 1193))
+ ((elsif_statement_item . 1195))
nil
nil
nil
nil
- ((access_definition . 1186)(attribute_reference . 51)(name .
724)(null_exclusion_opt . 509)(qualified_expression .
54)(return_subtype_indication . 1187)(selected_component .
55)(subtype_indication . 1188))
+ ((access_definition . 1188)(attribute_reference . 51)(name .
724)(null_exclusion_opt . 509)(qualified_expression .
54)(return_subtype_indication . 1189)(selected_component .
55)(subtype_indication . 1190))
nil
nil
nil
@@ -4316,12 +4337,12 @@
nil
nil
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
nil
- ((identifier_opt . 1179))
- ((attribute_reference . 51)(exception_choice . 1178)(name .
952)(qualified_expression . 54)(selected_component . 55))
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
- ((attribute_reference . 51)(exception_choice .
950)(exception_choice_list . 1176)(name . 952)(qualified_expression .
54)(selected_component . 55))
+ ((identifier_opt . 1181))
+ ((attribute_reference . 51)(exception_choice . 1180)(name .
953)(qualified_expression . 54)(selected_component . 55))
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((attribute_reference . 51)(exception_choice .
951)(exception_choice_list . 1178)(name . 953)(qualified_expression .
54)(selected_component . 55))
nil
nil
nil
@@ -4337,14 +4358,14 @@
nil
nil
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
nil
nil
nil
nil
nil
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
nil
nil
nil
@@ -4362,68 +4383,68 @@
nil
nil
nil
- ((variant_list . 1249)(variant . 1250))
+ ((variant_list . 1251)(variant . 1252))
nil
- ((aspect_specification_opt . 1247))
+ ((aspect_specification_opt . 1249))
nil
nil
nil
- ((real_range_specification_opt . 1244))
+ ((real_range_specification_opt . 1246))
nil
nil
- ((identifier_opt . 1242))
+ ((identifier_opt . 1244))
nil
nil
nil
- ((identifier_opt . 1239))
+ ((identifier_opt . 1241))
nil
nil
nil
nil
nil
nil
- ((actual_parameter_part . 92)(constraint . 1139)(index_constraint . 823))
- ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1299)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((actual_parameter_part . 92)(constraint . 1141)(index_constraint . 823))
+ ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1301)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
- ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 840)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
+ ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 840)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
nil
nil
- ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 846)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
+ ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 846)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(gen [...]
nil
- ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1296)(term . 188)(term_list .
189)(unary_adding_operator . 190))
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1295)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1298)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1297)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
- ((aggregate . 158)(attribute_reference . 51)(choice_expression .
162)(choice_relation_and_list . 163)(choice_relation_or_list .
164)(choice_relation_xor_list . 165)(choice_relation_and_then_list .
166)(choice_relation_or_else_list . 167)(choice_relation . 168)(discrete_choice
. 170)(discrete_choice_list . 1293)(factor . 174)(name . 176)(primary .
177)(qualified_expression . 54)(range . 180)(selected_component .
55)(simple_expression . 430)(term . 188)(term_list . 189)(unary_adding_ [...]
- ((variant . 1292))
+ ((aggregate . 158)(attribute_reference . 51)(choice_expression .
162)(choice_relation_and_list . 163)(choice_relation_or_list .
164)(choice_relation_xor_list . 165)(choice_relation_and_then_list .
166)(choice_relation_or_else_list . 167)(choice_relation . 168)(discrete_choice
. 170)(discrete_choice_list . 1295)(factor . 174)(name . 176)(primary .
177)(qualified_expression . 54)(range . 180)(selected_component .
55)(simple_expression . 430)(term . 188)(term_list . 189)(unary_adding_ [...]
+ ((variant . 1294))
nil
nil
- ((record_definition . 1289))
+ ((record_definition . 1291))
nil
nil
nil
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1288)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1290)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
- ((identifier_opt . 1286))
- ((identifier_opt . 1285))
+ ((identifier_opt . 1288))
+ ((identifier_opt . 1287))
nil
nil
nil
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
nil
nil
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1280)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(expression .
172)(expression_opt . 1282)(factor . 174)(name . 325)(primary .
177)(qualified_expression . 54)(raise_expression . 179)(relation_and_list .
181)(relation_and_then_list . 182)(relation_or_list .
183)(relation_or_else_list . 184)(relation_xor_list . 185)(relation .
186)(selected_component . 55)(simple_expression . 378)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
nil
nil
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(if_statement . 652)(iteration_scheme . 653)(label_opt .
654)(loop_statement . 655)(name . 656)(pragma . 657)(procedure_call_statement .
658)(qualified_expression . 54)(raise_statement . 659)(requeue_statement [...]
nil
nil
nil
@@ -4436,25 +4457,25 @@
nil
nil
nil
- ((aspect_specification_opt . 1306))
+ ((aspect_specification_opt . 1308))
nil
nil
nil
nil
- ((aspect_specification_opt . 1303))
+ ((aspect_specification_opt . 1305))
nil
nil
nil
nil
- ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1320)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((aggregate . 158)(attribute_reference . 51)(factor . 174)(name .
325)(primary . 177)(qualified_expression . 54)(selected_component .
55)(simple_expression . 1322)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
nil
- ((aspect_clause . 1025)(at_clause . 278)(component_declaration .
1026)(component_item . 1027)(component_list . 1028)(component_list_opt .
1318)(enumeration_representation_clause . 285)(identifier_list .
1030)(record_representation_clause . 309)(variant_part . 1031))
+ ((aspect_clause . 1027)(at_clause . 278)(component_declaration .
1028)(component_item . 1029)(component_list . 1030)(component_list_opt .
1320)(enumeration_representation_clause . 285)(identifier_list .
1032)(record_representation_clause . 309)(variant_part . 1033))
nil
nil
- ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 1315)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(ge [...]
- ((aggregate . 158)(attribute_reference . 51)(discrete_subtype_definition
. 1314)(factor . 174)(name . 731)(primary . 177)(qualified_expression .
54)(range . 732)(selected_component . 55)(simple_expression .
479)(subtype_indication . 733)(term . 188)(term_list .
189)(unary_adding_operator . 190))
+ ((abstract_subprogram_declaration . 276)(aspect_clause . 277)(at_clause
. 278)(body . 279)(body_stub . 280)(declaration . 281)(declarations .
282)(declarative_part_opt . 1317)(entry_declaration .
284)(enumeration_representation_clause . 285)(exception_declaration .
286)(expression_function_declaration . 287)(full_type_declaration .
288)(function_specification . 16)(generic_declaration .
289)(generic_formal_part . 18)(generic_instantiation .
290)(generic_package_declaration . 20)(ge [...]
+ ((aggregate . 158)(attribute_reference . 51)(discrete_subtype_definition
. 1316)(factor . 174)(name . 731)(primary . 177)(qualified_expression .
54)(range . 732)(selected_component . 55)(simple_expression .
479)(subtype_indication . 733)(term . 188)(term_list .
189)(unary_adding_operator . 190))
nil
nil
nil
@@ -4468,11 +4489,11 @@
nil
nil
nil
- ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(handled_sequence_of_statements . 1325)(if_statement .
652)(iteration_scheme . 653)(label_opt . 654)(loop_statement . 655)(name .
656)(pragma . 657)(procedure_call_statement . 658)(qualified_expression . 54)(r
[...]
- ((formal_part . 117)(parameter_profile_opt . 1324))
+ ((accept_statement . 641)(assignment_statement .
642)(asynchronous_select . 643)(attribute_reference . 51)(block_statement .
644)(case_statement . 645)(conditional_entry_call . 646)(delay_statement .
647)(exit_statement . 648)(extended_return_statement . 649)(goto_label .
650)(handled_sequence_of_statements . 1327)(if_statement .
652)(iteration_scheme . 653)(label_opt . 654)(loop_statement . 655)(name .
656)(pragma . 657)(procedure_call_statement . 658)(qualified_expression . 54)(r
[...]
+ ((formal_part . 117)(parameter_profile_opt . 1326))
nil
nil
- ((identifier_opt . 1327))
+ ((identifier_opt . 1329))
nil
nil]))
"Parser table.")
diff --git a/packages/ada-mode/ada-indent-user-options.el
b/packages/ada-mode/ada-indent-user-options.el
old mode 100644
new mode 100755
index 267ac41..0d2123a
--- a/packages/ada-mode/ada-indent-user-options.el
+++ b/packages/ada-mode/ada-indent-user-options.el
@@ -1,6 +1,6 @@
;; user options shared by Ada mode indentation engines -*- lexical-binding:t
-*-
;;
-;; Copyright (C) 2012, 2013, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2012, 2013, 2015, 2017 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;; Contributors: Simon Wright <address@hidden>
@@ -131,9 +131,9 @@ zero or less the indentation is abs `ada-indent-renames'
relative
to the open parenthesis; if `ada-indent-renames' is one or more
the indentation is relative to the line containing the keyword.
-If the subprogram has no parameters then `ada-indent-broken' the
-indentation is relative to the indentation of the line containing
-the keyword.
+If the subprogram has no parameters then the indentation is
+`ada-indent-broken' relative to the indentation of the line
+containing the keyword.
Examples:
ada-indent-renames = 2
@@ -229,6 +229,13 @@ An example is:
:safe #'integerp)
(make-variable-buffer-local 'ada-indent-with)
+(defcustom ada-indent-hanging-rel-exp nil
+ "If non-nil, indent hanging lines relative to start of expression.
+Otherwise, indent relative to previous line."
+ :type 'boolean
+ :safe #'booleanp)
+(make-variable-buffer-local 'ada-indent-hanging-rel-exp)
+
(provide 'ada-indent-user-options)
;; end file
diff --git a/packages/ada-mode/ada-mode-compat-24.2.el
b/packages/ada-mode/ada-mode-compat.el
similarity index 55%
rename from packages/ada-mode/ada-mode-compat-24.2.el
rename to packages/ada-mode/ada-mode-compat.el
index 51ac700..f244d86 100644
--- a/packages/ada-mode/ada-mode-compat-24.2.el
+++ b/packages/ada-mode/ada-mode-compat.el
@@ -1,7 +1,6 @@
-;; ada-mode-compat-24.2.el --- Implement current Emacs features not present in
Emacs 24.2 -*- lexical-binding:t -*-
-;; FIXME: rename to ada-mode-compat.el, rely on functionp etc. doc emacs
version for each item
+;; ada-mode-compat.el --- Implement current Emacs features not present earlier
versions -*- lexical-binding:t -*-
-;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -18,20 +17,11 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;; using cl-lib 0.4 from Gnu ELPA
-
-(when (not (functionp 'file-name-base))
- (defun file-name-base (&optional filename)
- "Return the base name of the FILENAME: no directory, no extension.
-FILENAME defaults to `buffer-file-name'."
- (file-name-sans-extension
- (file-name-nondirectory (or filename (buffer-file-name))))))
-
(when (not (functionp 'font-lock-ensure))
+ ;; not in 24.3, 24.4, 24.5; in 25.1
(defun font-lock-ensure (&optional beg end)
(font-lock-fontify-region (or beg (point-min)) (or end (point-max)))))
-;; FIXME: need cl-flet, but there is no macrop
-(provide 'ada-mode-compat-24.2)
+(provide 'ada-mode-compat)
;; end of file
diff --git a/packages/ada-mode/ada-mode.el b/packages/ada-mode/ada-mode.el
old mode 100644
new mode 100755
index bf93b28..6ded112
--- a/packages/ada-mode/ada-mode.el
+++ b/packages/ada-mode/ada-mode.el
@@ -6,8 +6,8 @@
;; Maintainer: Stephen Leake <address@hidden>
;; Keywords: languages
;; ada
-;; Version: 5.2.1
-;; package-requires: ((wisi "1.1.4") (cl-lib "0.4") (emacs "24.2"))
+;; Version: 5.2.2
+;; package-requires: ((wisi "1.1.5") (cl-lib "0.4") (emacs "24.3"))
;; url: http://www.nongnu.org/ada-mode/
;;
;; (Gnu ELPA requires single digits between dots in versions)
@@ -168,7 +168,7 @@
(defun ada-mode-version ()
"Return Ada mode version."
(interactive)
- (let ((version-string "5.2.1"))
+ (let ((version-string "5.2.2"))
;; must match:
;; ada-mode.texi
;; README-ada-mode
@@ -306,6 +306,12 @@ nil, only the file name."
:type 'boolean
:safe #'booleanp)
+(defcustom ada-gps-indent-exec "ada_mode_gps_indent"
+ ;; declared here, not in ada-gps.el, for auto-detection of indent engine
below
+ "Name of executable to use for ada_mode_gps_indent,"
+ :type 'string
+ :group 'ada-indentation)
+
;;;;; end of user variables
(defconst ada-symbol-end
@@ -360,11 +366,11 @@ Values defined by cross reference packages.")
(define-key map "\C-c\C-i" 'ada-indent-statement)
(define-key map "\C-c\C-l" 'ada-show-local-references)
(define-key map "\C-c\C-m" 'ada-build-set-make)
- (define-key map "\C-c\C-n" 'ada-next-statement-keyword)
+ (define-key map "\C-c\C-n" 'forward-sexp)
(define-key map "\C-c\M-n" 'ada-next-placeholder)
(define-key map "\C-c\C-o" 'ada-find-other-file)
(define-key map "\C-c\M-o" 'ada-find-other-file-noset)
- (define-key map "\C-c\C-p" 'ada-prev-statement-keyword)
+ (define-key map "\C-c\C-p" 'backward-sexp)
(define-key map "\C-c\M-p" 'ada-prev-placeholder)
(define-key map "\C-c\C-q" 'ada-xref-refresh)
(define-key map "\C-c\C-r" 'ada-show-references)
@@ -415,7 +421,9 @@ Values defined by cross reference packages.")
["Other file don't find decl" ada-find-other-file-noset t]
["Find file in project" ada-find-file t]
["Goto declaration/body" ada-goto-declaration t]
- ["Goto next statement keyword" ada-next-statement-keyword t]
+ ["Goto next statement keyword" forward-sexp t]
+ ["Goto prev statement keyword" backward-sexp t]
+ ["Goto declarative region start" ada-goto-declarative-region-start t]
["Goto declaration start" ada-goto-declaration-start t]
["Goto declaration end" ada-goto-declaration-end t]
["Show parent declarations" ada-show-declaration-parents t]
@@ -454,31 +462,36 @@ Values defined by cross reference packages.")
["Reset parser" ada-reset-parser t]
)))
-;; This doesn't need to be buffer-local because there can be only one
-;; popup menu at a time.
-(defvar ada-context-menu-on-identifier nil)
-
(easy-menu-define ada-context-menu nil
"Context menu keymap for Ada mode"
'("Ada"
- ["Make body for subprogram" ada-make-subprogram-body t]
- ["Goto declaration/body" ada-goto-declaration :included
ada-context-menu-on-identifier]
- ["Show parent declarations" ada-show-declaration-parents :included
ada-context-menu-on-identifier]
- ["Show references" ada-show-references :included
ada-context-menu-on-identifier]
- ["Show overriding" ada-show-overriding :included
ada-context-menu-on-identifier]
- ["Show overridden" ada-show-overridden :included
ada-context-menu-on-identifier]
- ["Expand skeleton" ada-expand t]
- ["Create full case exception" ada-case-create-exception t]
- ["Create partial case exception" ada-case-create-partial-exception t]
+ ["Goto declaration/body" ada-goto-declaration t]
+ ["Show parent declarations" ada-show-declaration-parents t]
+ ["Goto declarative region start" ada-goto-declarative-region-start t]
+ ["Goto declaration start" ada-goto-declaration-start t]
+ ["Goto declaration end" ada-goto-declaration-end t]
+ ["Show parent declarations" ada-show-declaration-parents t]
+ ["Show references" ada-show-references t]
+ ["Show overriding" ada-show-overriding t]
+ ["Show overridden" ada-show-overridden t]
+ ["Goto next statement keyword" forward-sexp t]
+ ["Goto prev statement keyword" backward-sexp t]
["-" nil nil]
+
["Align" ada-align t]
+ ["Comment/uncomment selection" comment-dwim t]
+ ["Fill comment paragraph" ada-fill-comment-paragraph
(ada-in-comment-p)]
+ ["Fill comment paragraph justify" (ada-fill-comment-paragraph 'full)
(ada-in-comment-p)]
+ ["Fill comment paragraph postfix" (ada-fill-comment-paragraph 'full t)
(ada-in-comment-p)]
["Adjust case at point" ada-case-adjust-at-point (not
(use-region-p))]
["Adjust case region" ada-case-adjust-region (use-region-p)]
+ ["Create full case exception" ada-case-create-exception t]
+ ["Create partial case exception" ada-case-create-partial-exception t]
["Indent current statement" ada-indent-statement t]
- ["Goto next statement keyword" ada-next-statement-keyword t]
- ["Goto prev statement keyword" ada-next-statement-keyword t]
- ["Other File" ada-find-other-file t]))
+ ["Expand skeleton" ada-expand t]
+ ["Make body for subprogram" ada-make-subprogram-body t]
+ ))
(defun ada-popup-menu ()
"Pops up `ada-context-menu'.
@@ -1353,6 +1366,7 @@ Optional PLIST defaults to `ada-prj-current-project'."
(path_sep path-separator)
(proc_env (cl-copy-list process-environment))
(src_dir (list (directory-file-name default-directory)))
+ (obj_dir (list (directory-file-name default-directory)))
(xref_tool ada-xref-tool)
))))
@@ -1468,9 +1482,21 @@ list. Parser must modify or add to the property list and
return it.")
(defun ada-prj-reparse-select-current ()
"Reparse the current project file, re-select it.
Useful when the project file has been edited."
+ (interactive)
(ada-parse-prj-file ada-prj-current-file)
(ada-select-prj-file ada-prj-current-file))
+(defun ada-reset-comp-prj ()
+ "Reset compilation and project vars affected by a change in compiler version.
+Useful when experimenting with an upgraded compiler."
+ (interactive)
+ (when (buffer-live-p "*compilation*")
+ (with-current-buffer "*compilation*"
+ (setq compilation-environment nil)))
+ (setq ada-prj-alist nil)
+ (setq ada-prj-current-project nil)
+ )
+
(defvar ada-prj-parse-one-compiler nil
;; project file parse
"Compiler-specific function to process one Ada project property.
@@ -1507,7 +1533,7 @@ should add to or modify the list and return it.")
"Parse the Ada mode project file PRJ-FILE, set project properties in PROJECT.
Return new value of PROJECT."
(let (;; fields that are lists or that otherwise require special processing
- casing src_dir
+ casing src_dir obj_dir
tmp-prj
(parse-one-compiler (cdr (assoc ada-compiler
ada-prj-parse-one-compiler)))
(parse-final-compiler (cdr (assoc ada-compiler
ada-prj-parse-final-compiler)))
@@ -1560,6 +1586,11 @@ Return new value of PROJECT."
(expand-file-name (match-string 2)))
src_dir :test #'equal))
+ ((string= (match-string 1) "obj_dir")
+ (cl-pushnew (file-name-as-directory
+ (expand-file-name (match-string 2)))
+ obj_dir :test #'equal))
+
((string= (match-string 1) "xref_tool")
(let ((xref (intern (match-string 2))))
(setq project (plist-put project 'xref_tool xref))
@@ -1599,6 +1630,7 @@ Return new value of PROJECT."
;; process accumulated lists
(if casing (setq project (plist-put project 'casing (reverse casing))))
(if src_dir (setq project (plist-put project 'src_dir (reverse src_dir))))
+ (if obj_dir (setq project (plist-put project 'obj_dir (reverse obj_dir))))
(when parse-final-compiler
;; parse-final-compiler may reference the "current project", so
@@ -1787,8 +1819,10 @@ Called by `syntax-propertize', which is called by
font-lock in
race conditions with the grammar parser.")
(defun ada-syntax-propertize (start end)
- "Assign `syntax-table' properties in accessible part of buffer.
-In particular, character constants are set to have string syntax."
+ "For `syntax-propertize-function'.
+Assign `syntax-table' properties in region START .. END.
+In particular, character constants are set to have string syntax.
+Runs `ada-syntax-propertize-hook'."
;; (info "(elisp)Syntax Properties")
;;
;; called from `syntax-propertize', inside save-excursion
with-silent-modifications
@@ -1846,6 +1880,15 @@ If PARSE-RESULT is non-nil, use it instead of calling
`syntax-ppss'."
If PARSE-RESULT is non-nil, use it instead of calling `syntax-ppss'."
(> (nth 0 (or parse-result (syntax-ppss))) 0))
+(defun ada-pos-in-paren-p (pos)
+ "Return t if POS is inside a pair of parentheses."
+ (save-excursion
+ (> (nth 0 (syntax-ppss pos)) 0)))
+
+(defun ada-same-paren-depth-p (pos1 pos2)
+ "Return t if POS1 is at same parentheses depth as POS2."
+ (= (nth 0 (syntax-ppss pos1)) (nth 0 (syntax-ppss pos2))))
+
(defun ada-goto-open-paren (&optional offset parse-result)
"Move point to innermost opening paren surrounding current point, plus
OFFSET.
Throw error if not in paren. If PARSE-RESULT is non-nil, use it
@@ -1945,10 +1988,10 @@ unit name; it should return the Ada name that should be
found in FILE-NAME.")
;; been set by ff-treat-special; don't reset it.
"Function called with no parameters; it should return the name
of the package, protected type, subprogram, or task type whose
-definition/declaration point is in or just after, or nil. In
-addition, if ff-function-name is non-nil, store in
-ff-function-name a regexp that will find the function in the
-other file.")
+definition/declaration point is in, or for declarations that
+don't have declarative regions, just after; or nil. In addition,
+if `ff-function-name' is non-nil, store in `ff-function-name' a
+regexp that will find the function in the other file.")
(defun ada-which-function ()
"See `ada-which-function' variable."
@@ -2119,7 +2162,7 @@ buffer in another window."
)
(defvar ada-operator-re
-
"\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>"
+
"\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|\\_<\\(abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\)\\_>\\|<=\\|<\\|>=\\|>"
"Regexp matching Ada operator_symbol.")
(defun ada-identifier-at-point ()
@@ -2129,7 +2172,16 @@ identifier. May be an Ada identifier or operator."
(when (ada-in-comment-p)
(error "Inside comment"))
- (skip-chars-backward "a-zA-Z0-9_<>=+\\-\\*/&")
+ ;; Handle adjacent operator/identifer like:
+ ;; test/ada_mode-slices.adb
+ ;; D1, D2 : Day := +Sun;
+
+ ;; Move to the beginning of the identifier or operator
+ (if (looking-at "[a-zA-Z0-9_]")
+ ;; In an identifier
+ (skip-chars-backward "a-zA-Z0-9_")
+ ;; In an operator
+ (skip-chars-backward "+\\-\\*/&<>="))
;; Just in front of, or inside, a string => we could have an
;; operator function declaration.
@@ -2151,7 +2203,11 @@ identifier. May be an Ada identifier or operator."
(looking-at (concat "\"\\(" ada-operator-re "\\)\"")))
(concat "\"" (match-string-no-properties 1) "\""))
- ((looking-at "[a-zA-Z0-9_]+\\|[+\\-*/&=<>]")
+ ((looking-at ada-operator-re)
+ ;; Return quoted operator, as this is what the back end expects.
+ (concat "\"" (match-string-no-properties 0) "\""))
+
+ ((looking-at "[a-zA-Z0-9_]+")
(match-string-no-properties 0))
(t
@@ -2247,7 +2303,8 @@ Function is called with four arguments:
- an Ada identifier or operator_symbol
- filename containing the identifier (full path)
- line number containing the identifier
-- column of the start of the identifier
+- Emacs column of the start of the identifier
+Point is on the start of the identifier.
Returns a list (FILE LINE COLUMN) giving the corresponding location.
FILE may be absolute, or on `compilation-search-path'. If point is
at the specification, the corresponding location is the body, and vice
@@ -2270,7 +2327,7 @@ buffer in another window."
(ada-identifier-at-point)
(buffer-file-name)
(line-number-at-pos)
- (1+ (current-column))
+ (current-column)
)))
(ada-goto-source (nth 0 target)
@@ -2286,7 +2343,7 @@ Function is called with four arguments:
- an Ada identifier or operator_symbol
- filename containing the identifier
- line number containing the identifier
-- column of the start of the identifier
+- Emacs column of the start of the identifier
Displays a buffer in compilation-mode giving locations of the parent type
declarations.")
(defun ada-show-declaration-parents ()
@@ -2301,7 +2358,7 @@ Displays a buffer in compilation-mode giving locations of
the parent type declar
(ada-identifier-at-point)
(file-name-nondirectory (buffer-file-name))
(line-number-at-pos)
- (1+ (current-column)))
+ (current-column))
)
(defvar ada-xref-all-function nil
@@ -2311,14 +2368,16 @@ Called with four arguments:
- an Ada identifier or operator_symbol
- filename containing the identifier
- line number containing the identifier
-- column of the start of the identifier
+- Emacs column of the start of the identifier
- local-only; if t, show references in current file only
+- append; if t, keep previous output in result buffer
Displays a buffer in compilation-mode giving locations where the
identifier is declared or referenced.")
-(defun ada-show-references ()
- "Show all references of identifier at point."
- (interactive)
+(defun ada-show-references (&optional append)
+ "Show all references of identifier at point.
+With prefix, keep previous references in output buffer."
+ (interactive "P")
(ada-check-current-project (buffer-file-name))
(when (null ada-xref-all-function)
@@ -2328,13 +2387,15 @@ identifier is declared or referenced.")
(ada-identifier-at-point)
(file-name-nondirectory (buffer-file-name))
(line-number-at-pos)
- (1+ (current-column))
- nil)
+ (current-column)
+ nil ;; local-only
+ append)
)
-(defun ada-show-local-references ()
- "Show all references of identifier at point."
- (interactive)
+(defun ada-show-local-references (&optional append)
+ "Show all references of identifier at point.
+With prefix, keep previous references in output buffer."
+ (interactive "P")
(ada-check-current-project (buffer-file-name))
(when (null ada-xref-all-function)
@@ -2344,8 +2405,9 @@ identifier is declared or referenced.")
(ada-identifier-at-point)
(file-name-nondirectory (buffer-file-name))
(line-number-at-pos)
- (1+ (current-column))
- t)
+ (current-column)
+ t ;; local-only
+ append)
)
(defvar ada-xref-overriding-function nil
@@ -2355,7 +2417,7 @@ Called with four arguments:
- an Ada identifier or operator_symbol
- filename containing the identifier
- line number containing the identifier
-- column of the start of the identifier
+- Emacs column of the start of the identifier
Displays a buffer in compilation-mode giving locations of the overriding
declarations.")
(defun ada-show-overriding ()
@@ -2370,7 +2432,7 @@ Displays a buffer in compilation-mode giving locations of
the overriding declara
(ada-identifier-at-point)
(file-name-nondirectory (buffer-file-name))
(line-number-at-pos)
- (1+ (current-column)))
+ (current-column))
)
(defvar ada-xref-overridden-function nil
@@ -2380,7 +2442,7 @@ Called with four arguments:
- an Ada identifier or operator_symbol
- filename containing the identifier
- line number containing the identifier
-- column of the start of the identifier
+- Emacs column of the start of the identifier
Returns a list (FILE LINE COLUMN) giving the corresponding location.
FILE may be absolute, or on `compilation-search-path'.")
@@ -2397,7 +2459,7 @@ FILE may be absolute, or on `compilation-search-path'.")
(ada-identifier-at-point)
(file-name-nondirectory (buffer-file-name))
(line-number-at-pos)
- (1+ (current-column)))))
+ (current-column))))
(ada-goto-source (nth 0 target)
(nth 1 target)
@@ -2452,21 +2514,26 @@ buffer in another window."
(let ((start-buffer (current-buffer))
(start-window (selected-window))
pos item file)
- (set-buffer compilation-last-buffer)
- (setq pos (next-single-property-change (point) 'ada-secondary-error))
- (when pos
- (setq item (get-text-property pos 'ada-secondary-error))
- ;; file-relative-name handles absolute Windows paths from
- ;; g++. Do this in compilation buffer to get correct
- ;; default-directory.
- (setq file (file-relative-name (nth 0 item)))
-
- ;; Set point in compilation buffer past this secondary error, so
- ;; user can easily go to the next one. For some reason, this
- ;; doesn't change the visible point!?
- (forward-line 1))
+ ;; We use `pop-to-buffer', not `set-buffer', so `forward-line'
+ ;; works. But that might eat an `other-frame-window-mode' prefix;
+ ;; disable that temporarily.
+ (let ((display-buffer-overriding-action nil))
+ (pop-to-buffer compilation-last-buffer nil t)
+ (setq pos (next-single-property-change (point) 'ada-secondary-error))
+ (when pos
+ (setq item (get-text-property pos 'ada-secondary-error))
+ ;; file-relative-name handles absolute Windows paths from
+ ;; g++. Do this in compilation buffer to get correct
+ ;; default-directory.
+ (setq file (file-relative-name (nth 0 item)))
+
+ ;; Set point in compilation buffer past this secondary error, so
+ ;; user can easily go to the next one.
+ (goto-char pos)
+ (forward-line 1))
- (set-buffer start-buffer);; for windowing history
+ (pop-to-buffer start-buffer nil t);; for windowing history
+ )
(when item
(ada-goto-source
file
@@ -2512,18 +2579,10 @@ is currently in. Called with no parameters.")
(defun ada-goto-declarative-region-start ()
"Call `ada-goto-declarative-region-start'."
+ (interactive)
(when ada-goto-declarative-region-start
(funcall ada-goto-declarative-region-start)))
-(defvar ada-next-statement-keyword nil
- ;; Supplied by indentation engine
- "Function called with no parameters; it should move forward to
-the next keyword in the statement following the one point is
-in (ie from `if' to `then'). If not in a keyword, move forward to
-the next keyword in the current statement. If at the last
-keyword, move forward to the first keyword in the next statement
-or next keyword in the containing statement.")
-
(defvar ada-goto-end nil
;; Supplied by indentation engine
"Function to move point to end of the declaration or statement point is in
or before.
@@ -2534,42 +2593,6 @@ Called with no parameters.")
(when ada-goto-end
(funcall ada-goto-end)))
-(defun ada-next-statement-keyword ()
- ;; Supplied by indentation engine
- "See `ada-next-statement-keyword' variable. In addition,
-if on open parenthesis move to matching closing parenthesis."
- (interactive)
- (if (= (syntax-class (syntax-after (point))) 4)
- ;; on open paren
- (forward-sexp)
-
- ;; else move by keyword
- (when ada-next-statement-keyword
- (unless (region-active-p)
- (push-mark))
- (funcall ada-next-statement-keyword))))
-
-(defvar ada-prev-statement-keyword nil
- ;; Supplied by indentation engine
- "Function called with no parameters; it should move to the previous
-keyword in the statement following the one point is in (ie from
-`then' to `if'). If at the first keyword, move to the previous
-keyword in the previous statement or containing statement.")
-
-(defun ada-prev-statement-keyword ()
- "See `ada-prev-statement-keyword' variable. In addition,
-if on close parenthesis move to matching open parenthesis."
- (interactive)
- (if (= (syntax-class (syntax-after (1- (point)))) 5)
- ;; on close paren
- (backward-sexp)
-
- ;; else move by keyword
- (when ada-prev-statement-keyword
- (unless (region-active-p)
- (push-mark))
- (funcall ada-prev-statement-keyword))))
-
;;;; code creation
(defvar ada-make-subprogram-body nil
@@ -2776,8 +2799,11 @@ The paragraph is indented on the first line."
(setq local-abbrev-table ada-mode-abbrev-table)
(set (make-local-variable 'syntax-propertize-function)
'ada-syntax-propertize)
+ (syntax-ppss-flush-cache (point-min));; reparse with new function
+
(when (boundp 'syntax-begin-function)
- ;; obsolete in emacs-25.1
+ ;; default ‘beginning-of-defun’ in emacs-24.2; we need it nil
+ ;; obsolete in 25.1
(set (make-local-variable 'syntax-begin-function) nil))
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'parse-sexp-lookup-properties) t)
@@ -2813,7 +2839,9 @@ The paragraph is indented on the first line."
(setq ff-search-directories 'compilation-search-path)
(when (null (car compilation-search-path))
;; find-file doesn't handle nil in search path
- (setq compilation-search-path (list (file-name-directory
(buffer-file-name)))))
+ (setq compilation-search-path (list (if buffer-file-name
+ (file-name-directory
(buffer-file-name))
+ "."))))
(ada-set-ff-special-constructs)
(set (make-local-variable 'add-log-current-defun-function)
@@ -2846,11 +2874,7 @@ The paragraph is indented on the first line."
(run-mode-hooks 'ada-mode-hook)
- ;; If global-font-lock is not enabled, ada-syntax-propertize is
- ;; not run when the text is first loaded into the buffer. Recover
- ;; from that.
- (syntax-ppss-flush-cache (point-min))
- (syntax-propertize (point-max))
+ (when (< emacs-major-version 25) (syntax-propertize (point-max)))
(add-hook 'hack-local-variables-hook 'ada-mode-post-local-vars nil t)
)
@@ -2865,6 +2889,8 @@ The paragraph is indented on the first line."
;; This means to fully set ada-mode interactively, user must
;; do M-x ada-mode M-; (hack-local-variables)
+ (setq hack-local-variables-hook (delq 'ada-mode-post-local-vars
hack-local-variables-hook))
+
;; fill-region-as-paragraph in ada-fill-comment-paragraph does not
;; call syntax-propertize, so set comment syntax on
;; ada-fill-comment-prefix. In post-local because user may want to
@@ -2912,7 +2938,8 @@ The paragraph is indented on the first line."
(require 'ada-build)
-(unless (featurep 'ada-indent-engine)
+(if (locate-file ada-gps-indent-exec exec-path '("" ".exe"))
+ (require 'ada-gps)
(require 'ada-wisi))
(cl-case ada-xref-tool
@@ -2926,7 +2953,6 @@ The paragraph is indented on the first line."
(require 'ada-gnat-xref)
(setq ada-xref-tool 'gnat)))
)
-;; FIXME: warn if gnat version >= gpl 2016, fsf 6 and no gpr_query installed
(unless (featurep 'ada-compiler)
(require 'ada-gnat-compile))
@@ -2937,4 +2963,4 @@ The paragraph is indented on the first line."
(when (featurep 'imenu)
(require 'ada-imenu))
-;;; ada-mode.el ends here
+;;; end of file
diff --git a/packages/ada-mode/ada-mode.info b/packages/ada-mode/ada-mode.info
index 0c703b5..161070d 100644
--- a/packages/ada-mode/ada-mode.info
+++ b/packages/ada-mode/ada-mode.info
@@ -1,7 +1,7 @@
-This is ada-mode.info, produced by makeinfo version 6.1 from
+This is ada-mode.info, produced by makeinfo version 6.3 from
ada-mode.texi.
-Copyright (C) 1999 - 2016 Free Software Foundation, Inc.
+Copyright (C) 1999 - 2017 Free Software Foundation, Inc.
Permission is granted to copy, distribute and/or modify this
document under the terms of the GNU Free Documentation License,
@@ -22,9 +22,9 @@ END-INFO-DIR-ENTRY
File: ada-mode.info, Node: Top, Next: Overview, Prev: (dir), Up: (dir)
-Ada Mode Version 5.2.1
+Ada Mode Version 5.2.2
- Copyright (C) 1999 - 2016 Free Software Foundation, Inc.
+ Copyright (C) 1999 - 2017 Free Software Foundation, Inc.
Permission is granted to copy, distribute and/or modify this
document under the terms of the GNU Free Documentation License,
@@ -57,6 +57,67 @@ Ada Mode Version 5.2.1
* GNU Free Documentation License::
* Index::
+ -- The Detailed Node Listing --
+
+Installation
+
+* Ada Reference Manual::
+* gpr_query::
+* ada_mode_gps_indent::
+
+gpr_query
+
+* Building GNATCOLL::
+
+ada_mode_gps_indent
+
+* ada_mode_gps_indent install::
+* ada_mode_gps_indent configure::
+
+Customizing Ada mode
+
+* Non-standard file names::
+* Other compiler::
+* Other cross-reference::
+* Other customization::
+
+Compiling Executing
+
+* Compile commands::
+* Compiling Examples::
+* Compiler errors::
+
+Compiling Examples
+
+* No project files:: Just menus
+* Set compiler options:: A basic Ada mode project file
+* Set source search path:: Source in multiple directories
+* Use GNAT project file::
+* Use multiple GNAT project files::
+* Use a Makefile::
+
+Project files
+
+* Project file overview::
+* Project file variables::
+
+Developer overview
+
+* Directory structure::
+* Package organization::
+* OpenToken::
+* ELPA::
+* Savannah::
+* ada-france::
+
+Package organization
+
+* Ada mode::
+* gpr mode::
+* GNAT core::
+* Wisi::
+
+
File: ada-mode.info, Node: Overview, Next: Installation, Prev: Top, Up: Top
@@ -73,7 +134,7 @@ powerful code navigation (jump to definition, find all uses,
etc).
will automatically load and activate Ada mode.
Ada mode works without any customization, if you are using the GNAT
-compiler (<https://libre2.adacore.com/>) and the GNAT default naming
+compiler (<https://libre.adacore.com/>) and the GNAT default naming
convention.
You must customize a few things if you are using a different file
@@ -96,7 +157,7 @@ File: ada-mode.info, Node: Installation, Next:
Customization, Prev: Overview,
2 Installation
**************
-Ada mode requires Emacs 24.2 or greater.
+Ada mode requires Emacs 24.3 or greater.
Ada mode is distributed in the Gnu ELPA package archive; it can be
installed via 'M-x list-packages' (*note (emacs)Packages::). You must
@@ -121,6 +182,7 @@ ada-mode-version'.
* Ada Reference Manual::
* gpr_query::
+* ada_mode_gps_indent::
File: ada-mode.info, Node: Ada Reference Manual, Next: gpr_query, Prev:
Installation, Up: Installation
@@ -161,8 +223,15 @@ format can change with each compiler version. 'gpr_query'
creates a
database of cross reference information; that database must be deleted
if the compiler version changes, to force a complete rebuild.
-2.2.1 Building GNATCOLL if required
------------------------------------
+* Menu:
+
+* Building GNATCOLL::
+
+
+File: ada-mode.info, Node: Building GNATCOLL, Up: gpr_query
+
+2.2.1 Building GNATCOLL
+-----------------------
'GNATCOLL' may already be installed on your system: if it is,
'$prefix/lib/gnat' will contain 'gnatcoll' GPR files. If not, configure
@@ -191,10 +260,10 @@ executable that is compatible with the database it
creates:
2.2.2 Building 'gpr_query'
--------------------------
-To build and install 'gpr_query', assuming the 'ada-mode-5.2.0' GNU ELPA
-package is installed:
+To build and install 'gpr_query', assuming the 'ada-mode-5.2.xx' GNU
+ELPA package is installed:
- cd ~/.emacs.d/elpa/ada-mode-5.2.0
+ cd ~/.emacs.d/elpa/ada-mode-5.2.xx
gprbuild -p -P gpr_query.gpr
gprinstall -P gpr_query.gpr
@@ -202,6 +271,72 @@ package is installed:
'gpr_query' is found in 'PATH'.
+File: ada-mode.info, Node: ada_mode_gps_indent, Prev: gpr_query, Up:
Installation
+
+2.3 ada_mode_gps_indent
+=======================
+
+'ada_mode_gps_indent' is an alternate indentation engine, using the
+indentation engine from AdaCore's GPS. It is fast for indenting in very
+large files; the default ada-wisi is slow in that case. It also
+tolerates most syntax errors, producing reasonable indentation.
+
+ It can be used either as the primary indentation engine, or as a
+fallback when ada-wisi fails due to syntax errors or in large files.
+
+ In either case, the ada-wisi parser is still used for syntax
+highlighting (font-lock) and navigation.
+
+ The ada-mode Gnu ELPA package includes a copy of the source code for
+the GPS indentation engine from GPS GPS 2016, patched to be more
+consistent with the ada-wisi indentation engine.
+
+* Menu:
+
+* ada_mode_gps_indent install::
+* ada_mode_gps_indent configure::
+
+
+File: ada-mode.info, Node: ada_mode_gps_indent install, Next:
ada_mode_gps_indent configure, Up: ada_mode_gps_indent
+
+2.3.1 Install
+-------------
+
+To install 'ada_mode_gps_indent', assuming the 'ada-mode-5.2.xx' GNU
+ELPA package is installed:
+ * Install 'gnatcoll' (*note Building GNATCOLL::).
+
+ * Compile and install 'ada_mode_gps_indent.adb':
+ cd ~/.emacs.d/elpa/ada-mode-5.xx/build/Makefile
+ export GPS_ROOT=<path to GPS>
+ gprbuild -p -P ada_mode_gps_indent.gpr
+ gprinstall -p -P ada_mode_gps_indent.gpr
+
+
+File: ada-mode.info, Node: ada_mode_gps_indent configure, Prev:
ada_mode_gps_indent install, Up: ada_mode_gps_indent
+
+2.3.2 Configure
+---------------
+
+By default, 'ada-mode' will use 'ada_mode_gps_indent' as a fallback
+indentation engine if 'ada_mode_gps_indent' is found on 'PATH'.
+
+ Large files (determined by 'ada-gps-size-threshold') will use
+'ada_mode_gps_indent' as the primary indentation engine.
+
+ To force the use of 'ada_mode_gps_indent', set
+'ada-gps-size-threshold' to 0, either globally, or in a file-local
+variable:
+
+ -- Local Variables:
+ -- ada-gps-size-threshold : 0
+ -- End:
+
+ In addition, files larger than 'wisi-size-threshold' will not run the
+wisi parser for font-lock; some syntax highlighting will be lost. This
+provides better response in files where the parser is slow.
+
+
File: ada-mode.info, Node: Customization, Next: Compiling Executing, Prev:
Installation, Up: Top
3 Customizing Ada mode
@@ -322,6 +457,11 @@ the syntax to set a variable is the following:
(setq variable-name value)
Some general Emacs settings that are useful for Ada files:
+'context menu'
+ By default, the context menu is bound to <C-down-mouse-3>, i.e.
+ control-right-click. <down-mouse-3> is already bound in the global
+ map; you can override that global binding in the 'ada-mode-hook'
+ (see below for code).
'delete-trailing-whitespace'
Deletes space, tab at end of line and blank lines at end of buffer.
'untabify'
@@ -369,6 +509,7 @@ unless imenu is loaded first.
(require 'ada-mode)
(add-to-list 'hippie-expand-try-functions-list 'ada-skel-hippie-try)
(define-key ada-mode-map "\C-e" 'hippie-expand)
+ (define-key ada-mode-map [down-mouse-3] 'ada-popup-menu)
(add-hook 'ada-mode-hook
(lambda ()
(add-hook 'before-save-hook 'delete-trailing-whitespace nil t)
@@ -1124,11 +1265,16 @@ the project file.
indentation variables, and any arbitrary elisp code used to
customize the project.
+'obj_dir' [default: '"."']
+ A list of directories to search for object and cross-reference
+ files. Only needed if you are not using GPR files.
+
'path_sep' [default: 'path-separator']
Separator character used in compiler search paths.
'src_dir' [default: '"."']
- A list of directories to search for source files.
+ A list of directories to search for source files. Added to the
+ source directories from a GPR file.
'xref_tool' [default: 'ada-xref-tool']
Cross reference tool for this project.
@@ -2529,48 +2675,52 @@ Index
Tag Table:
Node: Top945
-Node: Overview2603
-Node: Installation3814
-Node: Ada Reference Manual4692
-Node: gpr_query4968
-Node: Customization7646
-Node: Non-standard file names8128
-Node: Other compiler9969
-Node: Other cross-reference10548
-Node: Other customization11290
-Node: Compiling Executing14319
-Node: Compile commands15054
-Node: Compiling Examples17705
-Node: No project files18537
-Node: Set compiler options23903
-Node: Set source search path25865
-Node: Use GNAT project file28318
-Node: Use multiple GNAT project files31092
-Node: Use a Makefile33812
-Node: Compiler errors35127
-Node: Project files35944
-Node: Project file overview36971
-Node: Project file variables38515
-Node: Moving Through Ada Code43182
-Node: Identifier completion45881
-Node: Indentation46843
-Node: Statement skeletons51191
-Node: Aligning code52976
-Node: Automatic casing53921
-Node: Comment Handling56625
-Node: Key summary57144
-Node: Developer overview59771
-Node: Directory structure60139
-Node: Package organization64110
-Node: Ada mode64345
-Node: gpr mode66541
-Node: GNAT core66824
-Node: Wisi67658
-Node: OpenToken68558
-Node: ELPA69160
-Node: Savannah69770
-Node: ada-france70108
-Node: GNU Free Documentation License70348
-Node: Index95509
+Node: Overview3576
+Node: Installation4786
+Node: Ada Reference Manual5688
+Node: gpr_query5964
+Node: Building GNATCOLL7451
+Node: ada_mode_gps_indent8717
+Node: ada_mode_gps_indent install9631
+Node: ada_mode_gps_indent configure10184
+Node: Customization11007
+Node: Non-standard file names11489
+Node: Other compiler13330
+Node: Other cross-reference13909
+Node: Other customization14651
+Node: Compiling Executing17996
+Node: Compile commands18731
+Node: Compiling Examples21382
+Node: No project files22214
+Node: Set compiler options27580
+Node: Set source search path29542
+Node: Use GNAT project file31995
+Node: Use multiple GNAT project files34769
+Node: Use a Makefile37489
+Node: Compiler errors38804
+Node: Project files39621
+Node: Project file overview40648
+Node: Project file variables42192
+Node: Moving Through Ada Code47067
+Node: Identifier completion49766
+Node: Indentation50728
+Node: Statement skeletons55076
+Node: Aligning code56861
+Node: Automatic casing57806
+Node: Comment Handling60510
+Node: Key summary61029
+Node: Developer overview63656
+Node: Directory structure64024
+Node: Package organization67995
+Node: Ada mode68230
+Node: gpr mode70426
+Node: GNAT core70709
+Node: Wisi71543
+Node: OpenToken72443
+Node: ELPA73045
+Node: Savannah73655
+Node: ada-france73993
+Node: GNU Free Documentation License74233
+Node: Index99394
End Tag Table
diff --git a/packages/ada-mode/ada-mode.texi b/packages/ada-mode/ada-mode.texi
index 755347a..ed05879 100755
--- a/packages/ada-mode/ada-mode.texi
+++ b/packages/ada-mode/ada-mode.texi
@@ -3,7 +3,7 @@
@settitle Ada Mode
@copying
-Copyright @copyright{} 1999 - 2016 Free Software Foundation, Inc.
+Copyright @copyright{} 1999 - 2017 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -26,7 +26,7 @@ developing GNU and promoting software freedom.''
@titlepage
@sp 10
address@hidden Ada Mode Version 5.2.1
address@hidden Ada Mode Version 5.2.2
@page
@vskip 0pt plus 1filll
@insertcopying
@@ -36,7 +36,7 @@ developing GNU and promoting software freedom.''
@node Top, Overview, (dir), (dir)
-Ada Mode Version 5.2.1
+Ada Mode Version 5.2.2
@ifnottex
@insertcopying
@@ -60,6 +60,68 @@ Ada Mode Version 5.2.1
* GNU Free Documentation License::
* Index::
address@hidden
+ --- The Detailed Node Listing ---
+
+Installation
+
+* Ada Reference Manual::
+* gpr_query::
+* ada_mode_gps_indent::
+
+gpr_query
+
+* Building GNATCOLL::
+
+ada_mode_gps_indent
+
+* ada_mode_gps_indent install::
+* ada_mode_gps_indent configure::
+
+Customizing Ada mode
+
+* Non-standard file names::
+* Other compiler::
+* Other cross-reference::
+* Other customization::
+
+Compiling Executing
+
+* Compile commands::
+* Compiling Examples::
+* Compiler errors::
+
+Compiling Examples
+
+* No project files:: Just menus
+* Set compiler options:: A basic Ada mode project file
+* Set source search path:: Source in multiple directories
+* Use GNAT project file::
+* Use multiple GNAT project files::
+* Use a Makefile::
+
+Project files
+
+* Project file overview::
+* Project file variables::
+
+Developer overview
+
+* Directory structure::
+* Package organization::
+* OpenToken::
+* ELPA::
+* Savannah::
+* ada-france::
+
+Package organization
+
+* Ada mode::
+* gpr mode::
+* GNAT core::
+* Wisi::
+
address@hidden detailmenu
@end menu
@node Overview, Installation, Top, Top
@@ -76,7 +138,7 @@ When you open a file with a file extension of @file{.ads} or
mode.
Ada mode works without any customization, if you are using the GNAT
-compiler (@url{https://libre2.adacore.com/}) and the GNAT default
+compiler (@url{https://libre.adacore.com/}) and the GNAT default
naming convention.
You must customize a few things if you are using a different file
@@ -97,7 +159,7 @@ information on debugging.
@node Installation, Customization, Overview, Top
@chapter Installation
-Ada mode requires Emacs 24.2 or greater.
+Ada mode requires Emacs 24.3 or greater.
Ada mode is distributed in the Gnu ELPA package archive; it can be
installed via @code{M-x list-packages} (@pxref{Packages,,,emacs,Emacs
@@ -124,6 +186,7 @@ You may also want to install additional utilities:
@menu
* Ada Reference Manual::
* gpr_query::
+* ada_mode_gps_indent::
@end menu
@node Ada Reference Manual, gpr_query, Installation, Installation
@@ -161,7 +224,12 @@ version. @code{gpr_query} creates a database of cross
reference
information; that database must be deleted if the compiler version
changes, to force a complete rebuild.
address@hidden Building GNATCOLL if required
address@hidden
+* Building GNATCOLL::
address@hidden menu
+
address@hidden Building GNATCOLL
address@hidden Building GNATCOLL
@code{GNATCOLL} may already be installed on your system: if it is,
@file{$prefix/lib/gnat} will contain @file{gnatcoll} GPR files. If
@@ -198,10 +266,10 @@ gcc -O2 -o sqlite3 shell.c sqlite3.c -ldl -lpthread
@subsection Building @code{gpr_query}
To build and install @code{gpr_query}, assuming the
address@hidden GNU ELPA package is installed:
address@hidden GNU ELPA package is installed:
@example
-cd ~/.emacs.d/elpa/ada-mode-5.2.0
+cd ~/.emacs.d/elpa/ada-mode-5.2.xx
gprbuild -p -P gpr_query.gpr
gprinstall -P gpr_query.gpr
@end example
@@ -209,6 +277,70 @@ gprinstall -P gpr_query.gpr
@code{ada-mode} will use @code{gpr_query} for cross reference
functions if @code{gpr_query} is found in @code{PATH}.
address@hidden ada_mode_gps_indent, , gpr_query, Installation
address@hidden ada_mode_gps_indent
address@hidden is an alternate indentation engine, using the
+indentation engine from AdaCore's GPS. It is fast for indenting in
+very large files; the default ada-wisi is slow in that case. It also
+tolerates most syntax errors, producing reasonable indentation.
+
+It can be used either as the primary indentation engine, or as a
+fallback when ada-wisi fails due to syntax errors or in large files.
+
+In either case, the ada-wisi parser is still used for syntax
+highlighting (font-lock) and navigation.
+
+The ada-mode Gnu ELPA package includes a copy of the source code for
+the GPS indentation engine from GPS GPS 2016, patched to be more
+consistent with the ada-wisi indentation engine.
+
address@hidden
+* ada_mode_gps_indent install::
+* ada_mode_gps_indent configure::
address@hidden menu
+
address@hidden ada_mode_gps_indent install
address@hidden Install
+To install @code{ada_mode_gps_indent}, assuming the
address@hidden GNU ELPA package is installed:
address@hidden
address@hidden
+Install @file{gnatcoll} (@ref{Building GNATCOLL}).
+
address@hidden
+Compile and install @file{ada_mode_gps_indent.adb}:
address@hidden
+cd ~/.emacs.d/elpa/ada-mode-5.xx/build/Makefile
+export GPS_ROOT=<path to GPS>
+gprbuild -p -P ada_mode_gps_indent.gpr
+gprinstall -p -P ada_mode_gps_indent.gpr
address@hidden example
+
address@hidden itemize
+
address@hidden ada_mode_gps_indent configure
address@hidden Configure
+By default, @code{ada-mode} will use @code{ada_mode_gps_indent} as a
+fallback indentation engine if @code{ada_mode_gps_indent} is found on
address@hidden
+
+Large files (determined by @code{ada-gps-size-threshold}) will use
address@hidden as the primary indentation engine.
+
+To force the use of @code{ada_mode_gps_indent}, set
address@hidden to 0, either globally, or in a
+file-local variable:
+
address@hidden
+-- Local Variables:
+-- ada-gps-size-threshold : 0
+-- End:
address@hidden example
+
+In addition, files larger than @code{wisi-size-threshold} will not run
+the wisi parser for font-lock; some syntax highlighting will be
+lost. This provides better response in files where the parser is slow.
+
@node Customization, Compiling Executing, Installation, Top
@chapter Customizing Ada mode
@@ -322,6 +454,11 @@ and the syntax to set a variable is the following:
Some general Emacs settings that are useful for Ada files:
@table @code
address@hidden context menu
+By default, the context menu is bound to @key{C-down-mouse-3},
+i.e. control-right-click. @key{down-mouse-3} is already bound in the
+global map; you can override that global binding in the
address@hidden (see below for code).
@item delete-trailing-whitespace
Deletes space, tab at end of line and blank lines at end of buffer.
@item untabify
@@ -374,6 +511,7 @@ first.
(require 'ada-mode)
(add-to-list 'hippie-expand-try-functions-list 'ada-skel-hippie-try)
(define-key ada-mode-map "\C-e" 'hippie-expand)
+(define-key ada-mode-map [down-mouse-3] 'ada-popup-menu)
(add-hook 'ada-mode-hook
(lambda ()
(add-hook 'before-save-hook 'delete-trailing-whitespace nil t)
@@ -1174,11 +1312,16 @@ The value is a file name, which is loaded as an elisp
file when the
project file is parsed or selected. This allows setting Ada mode indentation
variables, and any arbitrary elisp code used to customize the project.
address@hidden @code{obj_dir} [default: @code{"."}]
+A list of directories to search for object and cross-reference
+files. Only needed if you are not using GPR files.
+
@item @code{path_sep} [default: @code{path-separator}]
Separator character used in compiler search paths.
@item @code{src_dir} [default: @code{"."}]
-A list of directories to search for source files.
+A list of directories to search for source files. Added to the source
+directories from a GPR file.
@item @code{xref_tool} [default: @code{ada-xref-tool}]
Cross reference tool for this project.
diff --git a/packages/ada-mode/ada-skel.el b/packages/ada-mode/ada-skel.el
old mode 100644
new mode 100755
index 4cf2cc5..4684c23
--- a/packages/ada-mode/ada-skel.el
+++ b/packages/ada-mode/ada-skel.el
@@ -1,6 +1,6 @@
;;; ada-skel.el --- Extension to Ada mode for inserting statement skeletons
-*- lexical-binding:t -*-
-;; Copyright (C) 1987, 1993, 1994, 1996-2016 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1993, 1994, 1996-2017 Free Software Foundation, Inc.
;; Authors: Stephen Leake <address@hidden>
@@ -114,26 +114,18 @@ This could end in a token recognized by
`ada-skel-expand'."
()
"-- Copyright (C) " (format-time-string "%Y ") user-full-name " All Rights
Reserved.\n"
"--\n"
- "-- This program is free software; you can redistribute it and/or\n"
- "-- modify it under terms of the GNU General Public License as\n"
- "-- published by the Free Software Foundation; either version 3, or (at\n"
- "-- your option) any later version. This program is distributed in the\n"
- "-- hope that it will be useful, but WITHOUT ANY WARRANTY; without even\n"
- "-- the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR\n"
- "-- PURPOSE. See the GNU General Public License for more details. You\n"
- "-- should have received a copy of the GNU General Public License\n"
- "-- distributed with this program; see file COPYING. If not, write to\n"
- "-- the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,\n"
- "-- MA 02110-1335, USA.\n"
- "--\n"
- "-- As a special exception, if other files instantiate generics from\n"
- "-- this unit, or you link this unit with other files to produce an\n"
- "-- executable, this unit does not by itself cause the resulting\n"
- "-- executable to be covered by the GNU General Public License. This\n"
- "-- exception does not however invalidate any other reasons why the\n"
- "-- executable file might be covered by the GNU Public License.\n"
+ "-- This library is free software; you can redistribute it and/or modify
it\n"
+ "-- under terms of the GNU General Public License as published by the
Free\n"
+ "-- Software Foundation; either version 3, or (at your option) any
later\n"
+ "-- version. This library is distributed in the hope that it will be
useful,\n"
+ "-- but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHAN-\n"
+ "-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n"
"\n"
- "pragma License (GPL);\n"
+ "-- As a special exception under Section 7 of GPL version 3, you are
granted\n"
+ "-- additional permissions described in the GCC Runtime Library
Exception,\n"
+ "-- version 3.1, as published by the Free Software Foundation.\n"
+ "\n"
+ "pragma License (Modified_GPL);\n"
)
diff --git a/packages/ada-mode/ada-wisi-opentoken.el
b/packages/ada-mode/ada-wisi-opentoken.el
old mode 100644
new mode 100755
index 374c599..1972977
--- a/packages/ada-mode/ada-wisi-opentoken.el
+++ b/packages/ada-mode/ada-wisi-opentoken.el
@@ -1,7 +1,7 @@
;; ada-wisi-opentoken.el --- An indentation function for ada-wisi that indents
-*- lexical-binding:t -*-
;; OpenTokengrammar statements nicely.
-;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -43,7 +43,8 @@
;; included in package specs that exist solely to define OpenToken
;; grammar fragments.
(save-excursion
- (let ((token-text (wisi-token-text (wisi-backward-token))))
+ (let ((token-text (wisi-token-text (wisi-backward-token)))
+ cache)
(cond
((equal token-text "<=")
(+ (current-indentation) ada-indent-broken))
@@ -53,23 +54,24 @@
(+ (current-indentation) ada-indent-broken))
((equal token-text "and")
- (wisi-goto-containing (wisi-backward-cache))
;; test/ada_mode-opentoken.ads
;; Tokens.Statement <= Add_Statement and
;; Add_Statement <=
;; ... and
;; Add_Statement <=
;;
- ;; point is on :=
+ (setq cache (wisi-goto-containing (wisi-backward-cache))) ;;
Tokens.Statement
+ (wisi-goto-containing cache);; :=
+
(+ (current-indentation) ada-indent-broken))
))))
(defconst ada-wisi-opentoken-align
- "Align rule for OpenToken grammar definitions."
'(ada-opentoken
(regexp . "[^=]\\(\\s-*\\)<=")
(valid . (lambda() (not (ada-in-comment-p))))
- (modes . '(ada-mode))))
+ (modes . '(ada-mode)))
+ "Align rule for OpenToken grammar definitions.")
;;;###autoload
(define-minor-mode ada-indent-opentoken-mode
diff --git a/packages/ada-mode/ada-wisi.el b/packages/ada-mode/ada-wisi.el
old mode 100644
new mode 100755
index d4ae61f..8dbdc41
--- a/packages/ada-mode/ada-wisi.el
+++ b/packages/ada-mode/ada-wisi.el
@@ -2,7 +2,7 @@
;;
;; [1] ISO/IEC 8652:2012(E); Ada 2012 reference manual
;;
-;; Copyright (C) 2012 - 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2012 - 2017 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;;
@@ -55,17 +55,22 @@
;;;; indentation
-(defun ada-wisi-current-indentation ()
- "Return indentation of current line, taking into account leading parens and
labels."
- (let ((in-paren (ada-in-paren-p))
- cache)
+(defun ada-wisi-current-indentation (indenting)
+ "Return indentation of current line, taking into account leading parens and
labels.
+INDENTING is point at indenting token."
+ (let* ((parse-result (save-excursion (syntax-ppss indenting)))
+ (in-paren (ada-in-paren-p parse-result))
+ (cur-line (line-number-at-pos (point)))
+ (paren-pos (nth 1 parse-result))
+ (paren-line (line-number-at-pos paren-pos))
+ cache)
(save-excursion
(back-to-indentation)
(cond
- ((and (eq ?\( (char-after (point)))
- in-paren)
- (forward-same-syntax) ;; skip all leading parens
- (current-column))
+ ((and in-paren
+ (= cur-line paren-line))
+ (goto-char paren-pos)
+ (1+ (current-column)))
((and (setq cache (wisi-get-cache (point)))
(eq 'label (wisi-cache-class cache)))
@@ -76,7 +81,7 @@
))))
-(defun ada-wisi-indent-containing (offset cache &optional before indenting)
+(defun ada-wisi-indent-containing (offset cache before indenting)
"Return indentation of OFFSET plus indentation of token containing CACHE.
point should be at CACHE.
BEFORE should be t when called from ada-wisi-before-cache, nil otherwise.
@@ -86,6 +91,7 @@ If may be in parens, INDENTING must be point at indenting
token."
(and (progn
(when (and (eq (wisi-cache-token cache) 'WHEN)
(memq (wisi-cache-nonterm cache)
+ ;; not entry_body, exit_statement
'(case_statement_alternative
;; test/ada_mode-nominal.adb
;; case Local_4 is
@@ -128,6 +134,11 @@ If may be in parens, INDENTING must be point at indenting
token."
;; ...
;; is
;; use Ada.Strings;
+ WHEN
+ ;; test/ada_mode-conditional_expressions.adb
+ ;; L3 : Integer := (case J is
+ ;; when 42 =>
+ ;; -1,
))
(memq
(wisi-cache-nonterm cache)
@@ -166,79 +177,70 @@ If may be in parens, INDENTING must be point at indenting
token."
)
)))
- (let ((cur-line (line-number-at-pos (point)))
- (paren-line (line-number-at-pos (nth 1 (syntax-ppss)))))
+ (cond
+ (cache
(cond
- (cache
- (cond
- ((and (ada-in-paren-p)
- (eq cur-line paren-line)
- (memq (wisi-cache-class cache)
- '(block-middle
- ;; ada_mode-conditional_expressions.adb
- ;; K := (if K < 0 then 42
- ;; elsif K = 0 then
-
- expression-start
- ;; test/ada_mode-parens.adb
- ;; := Local_11_Type'(A => Integer
- ;; (1.0),
-
- statement-start
- ;; ada_mode-conditional_expressions.adb
- ;; K1 : Integer := (if J > 42 then -1
- ;; else +1);
- )))
-
- (wisi-indent-paren (1+ offset)))
-
- ((eq 'LEFT_PAREN (wisi-cache-token cache))
- ;; test/ada_mode-parens.adb
- ;; or else ((B.all
- ;; and then C)
- ;; or else
- ;;
- ;; test/ada_mode-nominal.adb
- ;; => (others
- ;; => 2.0),
- (goto-char indenting)
- (wisi-indent-paren (1+ offset)))
-
- ((memq (wisi-cache-class cache)
- '(expression-start))
- ;; test/indent.ads
- ;; in higher-level parens, but that's not significant
- ;; IO_CPU_Control_State_S_Pkg.CPU2_Fault_Status_Type'
- ;; (Unused2 => 10, -- Used to be aligned on "1 =>"
- ;;
- ;; test/ada_mode-conditional_expressions.adb
- ;; when B =>
- ;; Fun (J) = 0
- ;; or else M,
- (+ (ada-wisi-current-indentation) offset))
-
- (t
- ;; not in paren
- ;; test/ada_mode-nominal.adb
- ;; function Local_Function return Integer
- ;; is -- target 3
- (+ (ada-wisi-current-indentation) offset))
- ))
+ ((memq (wisi-cache-class cache)
+ '(expression-start))
+ ;; test/indent.ads
+ ;; IO_CPU_Control_State_S_Pkg.CPU2_Fault_Status_Type'
+ ;; (Unused2 => 10, -- Used to be aligned on "1 =>"
+ ;;
+ ;; test/ada_mode-conditional_expressions.adb
+ ;; when B =>
+ ;; Fun (J) = 0
+ ;; or else M,
+ ;;
+ ;; test/hanging.adb
+ ;; X_Long_Name
+ ;; := F_Long_Name
+ ;; (A => True,
+ ;; B => True);
+ (if ada-indent-hanging-rel-exp
+ (+ (current-column) offset)
+ (+ (ada-wisi-current-indentation indenting) offset)))
(t
- ;; at outermost containing statement. If called from
- ;; ada-wisi-before-cache, we want to ignore OFFSET (indenting
- ;; 'package' in a package spec). If called from
- ;; ada-wisi-after-cache, we want to include offset (indenting
- ;; first declaration in the package).
- (if before
- ;; test/ada_mode-nominal.adb
- ;; package body Ada_Mode.Nominal
- 0
+ ;; test/ada_mode-parens.adb
+ ;; := Local_11_Type'(A => Integer
+ ;; (1.0),
+ ;;
+ ;; test/ada_mode-parens.adb
+ ;; or else ((B.all
+ ;; and then C)
+ ;; or else
+ ;;
+ ;; test/ada_mode-nominal.adb
+ ;; => (others
+ ;; => 2.0),
+ ;;
+ ;; test/ada_mode-conditional_expressions.adb
+ ;; K1 : Integer := (if J > 42 then -1
+ ;; else +1);
+ ;;
+ ;; test/ada_mode-conditional_expressions.adb
+ ;; K := (if K < 0 then 42
+ ;; elsif K = 0 then
+ ;; test/ada_mode-nominal.adb
+ ;; function Local_Function return Integer
+ ;; is -- target 3
+ (+ (ada-wisi-current-indentation indenting) offset))
+ ))
+
+ (t
+ ;; at outermost containing statement. If called from
+ ;; ada-wisi-before-cache, we want to ignore OFFSET (indenting
+ ;; 'package' in a package spec). If called from
+ ;; ada-wisi-after-cache, we want to include offset (indenting
+ ;; first declaration in the package).
+ (if before
;; test/ada_mode-nominal.adb
- ;; use Ada.Strings;
- offset)
- ))))
+ ;; package body Ada_Mode.Nominal
+ 0
+ ;; test/ada_mode-nominal.adb
+ ;; use Ada.Strings;
+ offset)
+ )))
(defun ada-wisi-indent-list-break (cache prev-token)
"Return indentation for a token contained or preceeded by CACHE, which must
be a list-break.
@@ -312,7 +314,7 @@ Point must be on CACHE. PREV-TOKEN is the token before the
one being indented."
(block-start
(cl-case (wisi-cache-token cache)
(IS ;; subprogram body
- (ada-wisi-indent-containing 0 cache t))
+ (ada-wisi-indent-containing 0 cache t start))
(RECORD
;; test/ada_mode-nominal.ads; ada-indent-record-rel-type = 3
@@ -334,10 +336,10 @@ Point must be on CACHE. PREV-TOKEN is the token before
the one being indented."
;; test/ada_mode-nominal.adb
;; or
;; when Started => -- Ada mode 4.01 ada-when-indent, GPS
ada-indent
- (ada-wisi-indent-containing 0 cache t))
+ (ada-wisi-indent-containing 0 cache t start))
(t ;; other
- (ada-wisi-indent-containing ada-indent cache t))))
+ (ada-wisi-indent-containing ada-indent cache t start))))
(block-end
(cl-case (wisi-cache-nonterm cache)
@@ -347,7 +349,7 @@ Point must be on CACHE. PREV-TOKEN is the token before the
one being indented."
(current-indentation)))
(t
- (ada-wisi-indent-containing 0 cache t))
+ (ada-wisi-indent-containing 0 cache t start))
))
(block-middle
@@ -367,7 +369,7 @@ Point must be on CACHE. PREV-TOKEN is the token before the
one being indented."
;; Block_1:
;; declare -- label, no statements between begin, label
;; indenting Block_1
- (ada-wisi-indent-containing (+ ada-indent-label ada-indent) cache t))
+ (ada-wisi-indent-containing (+ ada-indent-label ada-indent) cache t
start))
(list-break
;; test/ada_mode-parens.adb
@@ -392,7 +394,7 @@ Point must be on CACHE. PREV-TOKEN is the token before the
one being indented."
;;
;; not overriding function
;; Function_2e (Param : in Parent_Type_1) return Float;
- (ada-wisi-indent-containing ada-indent-broken cache t))
+ (ada-wisi-indent-containing ada-indent-broken cache t start))
(t
;; defer to ada-wisi-after-cache, for consistency
@@ -404,36 +406,19 @@ Point must be on CACHE. PREV-TOKEN is the token before
the one being indented."
nil)
(open-paren
- ;; In some cases, we indent the leading paren one less than
- ;; normal, so the following lines look normal. However, when
- ;; ada-indent-broken = 1- ada-indent, the distinction is
- ;; moot.
- (let ((content (save-excursion (wisi-forward-cache))))
- (cond
- ((or
- (memq (wisi-cache-nonterm cache)
- '(formal_part)
- ;; test/ada_mode-nominal.adb
- ;; entry E2
- ;; (X : Integer)
- )
- (memq (wisi-cache-nonterm content)
- '(case_expression
- ;; test/ada_mode-conditional_expressions.adb
- ;; K :=
- ;; (case Bounded (K) is
-
- if_expression
- ;; test/ada_mode-conditional_expressions.adb
- ;; when 1 =>
- ;; (if J > 42
- )))
-
- (ada-wisi-indent-containing (1- ada-indent) cache t start))
-
- (t
- (ada-wisi-indent-containing ada-indent-broken cache t start))
- )))
+ ;; test/ada_mode-nominal.adb
+ ;; entry E2
+ ;; (X : Integer)
+ ;;
+ ;; test/ada_mode-conditional_expressions.adb
+ ;; K :=
+ ;; (case Bounded (K) is
+ ;;
+ ;; test/ada_mode-conditional_expressions.adb
+ ;; when 1 =>
+ ;; (if J > 42
+ ;;
+ (ada-wisi-indent-containing ada-indent-broken cache t start))
(return-with-params
;; test/ada_mode-options-intent_return_1.ads, _2, _3
@@ -451,13 +436,14 @@ Point must be on CACHE. PREV-TOKEN is the token before
the one being indented."
)))
(return-without-params;; no parameter list
- ;; test/ada_mode-options-intent_return_1.ads, _2, _3
- ;; indenting 'return' with no ()
+ ;; test/ada_mode-generic_package.ads
+ ;; with function Concrete_Function_3
+ ;; return Float is <>;
(wisi-goto-containing cache nil) ;; matching 'function'
- (+ (current-column) ada-indent-broken))
+ (+ (current-indentation) ada-indent-broken))
(statement-end
- (ada-wisi-indent-containing ada-indent-broken cache t))
+ (ada-wisi-indent-containing ada-indent-broken cache t start))
(statement-other
(cond
@@ -591,9 +577,14 @@ new indentation for point."
0)
(t
- (while (memq (wisi-cache-class cache) '(name name-paren))
+ (while (memq (wisi-cache-class cache) '(close-paren name name-paren))
;; not useful for indenting
- (setq cache (wisi-backward-cache)))
+ (cond
+ ((eq (wisi-cache-class cache) 'close-paren)
+ (setq cache (wisi-goto-containing cache)))
+
+ (t
+ (setq cache (wisi-backward-cache)))))
(cl-ecase (wisi-cache-class cache)
(block-end
@@ -612,14 +603,14 @@ new indentation for point."
;; test/ada_mode-nominal.adb
;; case Param_1 is
;; -- comment after "is", before "when"
- (ada-wisi-indent-containing 0 cache))
+ (ada-wisi-indent-containing 0 cache nil start))
(t
;; test/ada_mode-nominal.adb
;; function F2 (Param_1 : Discrete_Type_1; B : Float) return
Float
;; is
;; Local : Object_Access_Type_0a := new Float'(9.0);
- (+ (ada-wisi-indent-containing ada-indent cache)))
+ (+ (ada-wisi-indent-containing ada-indent cache nil start)))
))
((THEN ELSE)
@@ -698,12 +689,18 @@ new indentation for point."
;;
;; begin
;; --EMACSCMD:(progn
(ada-goto-declarative-region-start)(looking-at " -- target 5"))
- (ada-wisi-indent-containing ada-indent cache nil))
+ (ada-wisi-indent-containing ada-indent cache nil start))
))
(block-start
(cl-case (wisi-cache-nonterm cache)
- ((exception_handler
+ ((entry_body
+ ;; test/ada_mode-nominal.adb
+ ;; entry E2
+ ;; (X : Integer)
+ ;; -- an expression with 'not' to see if we need that in the
+
+ exception_handler
;; test/ada_mode-nominal.adb
;; when -- 2
;; Bad_Thing -- ada-mode 4.01 indentation
@@ -719,18 +716,13 @@ new indentation for point."
;; test/ada_mode-nominal.adb
;; task body Task_Type_1 is
;; -- a more typical task
- (+ (ada-wisi-current-indentation) ada-indent))
+ (+ (ada-wisi-current-indentation start) ada-indent))
))
- (close-paren
- ;; test/ada_mode-parens.adb
- ;; and then E))
- ;; or else G
- (ada-wisi-indent-containing ada-indent-broken cache nil start))
-
(expression-start
(cond
- ((eq 'LEFT_PAREN (wisi-cache-token cache))
+ ((and (eq 'LEFT_PAREN (wisi-cache-token cache))
+ (not (ada-same-paren-depth-p start (point))))
(if (= (point) (cadr prev-token))
;; test/ada_mode-parens.adb
;; Local_9 : String := (
@@ -755,16 +747,61 @@ new indentation for point."
(containing3 (wisi-get-containing-cache containing2)))
(cond
- ((and (eq 'EQUAL_GREATER (wisi-cache-token containing1))
- (or
- (eq 'aspect_specification_opt (wisi-cache-nonterm
containing2))
- (and (eq 'association_list (wisi-cache-nonterm
containing2))
- (eq 'aspect_specification_opt (wisi-cache-nonterm
containing3)))))
+ ((and (not (ada-pos-in-paren-p start))
+ (or (eq 'aspect_specification_opt (wisi-cache-nonterm
containing2))
+ (eq 'aspect_specification_opt (wisi-cache-nonterm
containing3))))
;; special case for aspects
;; test/aspects.ads
;; with Pre => X > 10 and
+ ;; X < 50 and
+ ;; F (X),
+ ;; Post =>
+ ;; Y >= X and
+ ;; Some_Very_Verbose_Predicate (X, Y);
+
+ ;;
+ ;; Indenting ’X < 50’
+ ;; cache nonterm is expression_opt at ’X < 10’
+ ;; containing1 nonterm is association_opt at ’=>’
+ ;; containing2 nonterm is aspect_specification_opt at ’with’
+ ;;
+ ;; Indenting ’F (X)’:
+ ;; cache nonterm is relation_and_list at ’X < 50’
+ ;; containing1 nonterm is expression_opt at ’X < 10’
+ ;; containing2 nonterm is association_opt at ’=>’
+ ;; containing3 nonterm is aspect_specification_opt at ’with’
+ ;;
+ ;; Indenting ’Y’
+ ;; cache nonterm is association_opt at ’=>’
+ ;; containing1 nonterm is association_list at ’,’
+ ;; containing2 nonterm is aspect_specification_opt at ’with’
+ ;;
+ ;; Indenting ’Some_...’:
+ ;; cache nonterm is expression_opt at ’Y’ (loop on ’name’
above)
+ ;; containing1 nonterm is association_opt at ’=>’
+ ;; containing2 nonterm is association_list at ’,’
+ ;; containing3 nonterm is aspect_specification_opt at ’with’
+ ;;
+ ;; does _not_ include this case:
+ ;; test/aspects.ads
+ ;; function Wuff return Boolean with Pre =>
+ ;; (for all X in U =>
+ ;; (if X in D then
+ ;; indenting ’(if’; handled by containing paren
+
+ ;; move point to ’=>’
+ (cond
+ ((eq 'aspect_specification_opt (wisi-cache-nonterm
containing2))
+ (wisi-goto-containing cache))
+ ((eq 'aspect_specification_opt (wisi-cache-nonterm
containing3))
+ (cond
+ ((eq 'association_opt (wisi-cache-nonterm containing2))
+ (wisi-goto-containing containing1))
+ ((eq 'association_list (wisi-cache-nonterm containing2))
+ (wisi-goto-containing cache))
+ ))
+ )
- (wisi-goto-containing cache);; EQUAL_GREATER
(let ((cache-col (current-column))
(cache-pos (point))
(line-end-pos (line-end-position)))
@@ -781,35 +818,52 @@ new indentation for point."
))
(t
- (let ((cur-line (line-number-at-pos (point)))
- (paren-line (line-number-at-pos (nth 1 (syntax-ppss)))))
- (cond
- ((and (ada-in-paren-p)
- (eq cur-line paren-line))
- ;; test/ada_mode-parens.adb
- ;; Local_2 : Integer := (1 + 2 +
- ;; 3);
- ;;
- ;; test/ada_mode-parens.adb
- ;; if A.all
- ;; or else (B.all
- ;; --EMACSCMD:(test-face "then"
'font-lock-keyword-face)
- ;; and then C
- (+ (current-column) ada-indent-broken))
-
- (t
- ;; test/ada_mode-conditional_expressions.adb
- ;; L5 : Boolean :=
- ;; (case C is
- ;; when A =>
- ;; J = 4
- ;; or else M, -- test case from Piotr Trojanek
- ;;
- ;; test/ada_mode-nominal.adb
- ;; return 1.0 +
- ;; Function_2a (Parent_Type_1'(1, 2.0, False)) +
- (+ (ada-wisi-current-indentation) ada-indent-broken))
- )))
+ ;; test/ada_mode-parens.adb
+ ;; if A.all
+ ;; or else (B.all
+ ;; --EMACSCMD:(test-face "then"
'font-lock-keyword-face)
+ ;; and then C
+ ;; and then D
+ ;; indenting last two lines
+ ;;
+ ;; test/hanging.adb
+ ;; if A
+ ;; and then C
+ ;; and then B
+ ;; /= A
+ ;;
+ ;; FIXME: we currently can't distinguish between 'and
+ ;; then C' and ' /= A'; the latter is indented wrong.
+ (while (memq (wisi-cache-nonterm cache)
+ '(relation_and_list
+ relation_and_then_list
+ relation_or_list
+ relation_or_else_list
+ relation_xor_list))
+ (setq cache (wisi-goto-containing cache)))
+
+ ;; test/ada_mode-parens.adb
+ ;; or else ((B.all
+ ;; and then C)
+ ;; or else
+ ;;
+ ;; test/ada_mode-parens.adb
+ ;; Local_2 : Integer := (1 + 2 +
+ ;; 3);
+ ;;
+ ;; test/ada_mode-conditional_expressions.adb
+ ;; L5 : Boolean :=
+ ;; (case C is
+ ;; when A =>
+ ;; J = 4
+ ;; or else M, -- test case from Piotr Trojanek
+ ;;
+ ;; test/ada_mode-nominal.adb
+ ;; return 1.0 +
+ ;; Function_2a (Parent_Type_1'(1, 2.0, False)) +
+ (if ada-indent-hanging-rel-exp
+ (+ (current-column) ada-indent-broken)
+ (+ (ada-wisi-current-indentation start) ada-indent-broken)))
)))
));; expression-start
@@ -873,7 +927,7 @@ new indentation for point."
;; test/ada_mode-nominal.ads
;; pragma Elaborate_Body (Ada_Mode.Nominal);
;; -- Comment after one line of code; broken versions of the
- (ada-wisi-indent-containing 0 cache nil))
+ (ada-wisi-indent-containing 0 cache nil start))
(statement-other
(cl-case (wisi-cache-token cache)
@@ -885,7 +939,7 @@ new indentation for point."
;; abort
;; -- 'abort' indented with ada-indent-broken, since this is
part
;; Titi;
- (ada-wisi-indent-containing ada-indent cache))
+ (ada-wisi-indent-containing ada-indent cache nil start))
(COMMA
(cl-ecase (wisi-cache-nonterm cache)
@@ -895,7 +949,7 @@ new indentation for point."
;; test/with_use1.adb
;; use Ada.Text_IO,
;; Ada.Numerics, -- used to be indented with
ada-broken-indent
- (ada-wisi-indent-containing ada-indent-use cache))
+ (ada-wisi-indent-containing ada-indent-use cache nil start))
(with_clause
;; test/ada_mode-nominal.ads
@@ -904,7 +958,7 @@ new indentation for point."
;; Ada.Containers;
;;
;; test/with_use1.adb
- (ada-wisi-indent-containing ada-indent-with cache))
+ (ada-wisi-indent-containing ada-indent-with cache nil
start))
))
))
@@ -928,7 +982,7 @@ new indentation for point."
;; Post =>
;; Y >= X and
)
- (ada-wisi-indent-containing (* 2 ada-indent-broken) cache))
+ (ada-wisi-indent-containing (* 2 ada-indent-broken) cache nil
start))
((memq
(wisi-cache-nonterm cache)
@@ -936,9 +990,20 @@ new indentation for point."
;; test/ada_mode-nominal.adb
;; when C =>
;; --EMACSCMD:...
+
+ case_expression_alternative
+ ;; test/ada_mode-conditional_expressions.adb
+ ;; L3 : Integer := (case J is
+ ;; when 42 =>
+ ;; -1,
+ ;; when Integer'First .. 41 =>
+ ;; 0,
+ ;; indenting -1, 0
+
exception_handler
;; test/ada_mode-nominal.adb
;; when E : Constraint_Error =>
+
select_alternative
;; test/test_select.adb
;; or
@@ -954,14 +1019,6 @@ new indentation for point."
;; 2 =>
;; 1 + 2 * 3,
;; indenting '1,' or '1 +'
- ;;
- ;; test/ada_mode-conditional_expressions.adb
- ;; L3 : Integer := (case J is
- ;; when 42 =>
- ;; -1,
- ;; when Integer'First .. 41 =>
- ;; 0,
- ;; indenting -1, 0
(ada-wisi-indent-containing ada-indent-broken cache nil start))
))
@@ -974,9 +1031,9 @@ new indentation for point."
(goto-char start)
(if (wisi-forward-find-token 'RECORD (line-end-position) t)
;; 'record' on line being indented
- (ada-wisi-indent-containing ada-indent-record-rel-type
cache)
+ (ada-wisi-indent-containing ada-indent-record-rel-type
cache nil start)
;; 'record' on later line
- (ada-wisi-indent-containing ada-indent-broken cache)))
+ (ada-wisi-indent-containing ada-indent-broken cache nil
start)))
(t
;; test/ada_mode-generic_package.ads
@@ -993,7 +1050,7 @@ new indentation for point."
;; ada_mode-nominal.ads
;; procedure Procedure_3b is
;; null;
- (ada-wisi-indent-containing ada-indent-broken cache))
+ (ada-wisi-indent-containing ada-indent-broken cache nil start))
))
@@ -1040,7 +1097,7 @@ new indentation for point."
;; test/ada_mode-long_paren.adb
;; Packet := new Packet_Type'
;; (RT => RT,
- (+ (ada-wisi-current-indentation) ada-indent-broken))
+ (+ (ada-wisi-current-indentation start) ada-indent-broken))
))
(statement-start
@@ -1062,81 +1119,137 @@ new indentation for point."
;; test/ada_mode-generic_instantiation.ads
;; procedure Procedure_8
;; is new Instance.Generic_Procedure (Integer, Function_1);
- (+ (ada-wisi-current-indentation) ada-indent-broken)))
+ (+ (ada-wisi-current-indentation start) ada-indent-broken)))
))
)))
)))
+(defun ada-wisi-comment-gnat (indent after)
+ "Modify INDENT to match gnat rules. Return new indent.
+INDENT must be indent computed by `ada-wisi-after-cache'.
+AFTER indicates what is on the previous line; one of:
+
+code: blank line, or code with no trailing comment
+code-comment: code with trailing comment
+comment: comment"
+ (let (prev-indent next-indent)
+ ;; the gnat comment indent style check; comments must
+ ;; be aligned to one of:
+ ;;
+ ;; - multiple of ada-indent
+ ;; - next non-blank line
+ ;; - previous non-blank line
+ ;;
+ ;; Note that we must indent the prev and next lines, in case
+ ;; they are not currently correct.
+ (cond
+ ((and (not (eq after 'comment))
+ (= 0 (% indent ada-indent)))
+ ;; this will handle comments at bob and eob, so we don't
+ ;; need to worry about those positions in the next checks.
+ indent)
+
+ ((and (setq prev-indent
+ (if (eq after 'comment)
+ (progn (forward-comment -1) (current-column))
+ (save-excursion (forward-line
-1)(indent-according-to-mode)(current-indentation))))
+ (= indent prev-indent))
+ indent)
+
+ ((and (setq next-indent
+ ;; we use forward-comment here, instead of
+ ;; forward-line, because consecutive comment
+ ;; lines are indented to the current one, which
+ ;; we don't know yet.
+ (save-excursion (forward-comment
(point-max))(indent-according-to-mode)(current-indentation)))
+ (= indent next-indent))
+ indent)
+
+ (t
+ (cl-ecase after
+ (code-comment
+ ;; After comment that follows code on the same line
+ ;; test/ada_mode-conditional_expressions.adb
+ ;;
+ ;; then 44 -- comment matching GNAT
+ ;; -- second line
+ ;;
+ ;; else 45)); -- comment _not_ matching GNAT style check
+ ;; -- comment matching GNAT
+ ;;
+ (+ indent (- ada-indent (% indent ada-indent))))
+
+ ((code comment)
+ ;; After code with no trailing comment, or after comment
+ ;; test/ada_mode-conditional_expressions.adb
+ ;; (if J > 42
+ ;; -- comment indent matching GNAT style check
+ ;; -- second line of comment
+ prev-indent)
+
+ ))
+ )))
+
(defun ada-wisi-comment ()
"Compute indentation of a comment. For `wisi-indent-calculate-functions'."
;; We know we are at the first token on a line. We check for comment
;; syntax, not comment-start, to accomodate gnatprep, skeleton
;; placeholders, etc.
- (when (and (not (= (point) (point-max))) ;; no char after EOB!
- (= 11 (syntax-class (syntax-after (point)))))
+ (cond
+ ((not (and (not (= (point) (point-max))) ;; no char after EOB!
+ (= 11 (syntax-class (syntax-after (point))))))
+ ;; not looking at comment
+ nil)
+
+ ;; We are at a comment; indent to previous code or comment.
+ ((and ada-indent-comment-col-0
+ (= 0 (current-column)))
+ 0)
+
+ (t
+ (let (after indent)
+ (if (save-excursion (forward-line -1) (looking-at "\\s *$"))
+ ;; after blank line
+ (setq after 'code)
- ;; We are at a comment; indent to previous code or comment.
- (cond
- ((and ada-indent-comment-col-0
- (= 0 (current-column)))
- 0)
-
- ((or
- (save-excursion (forward-line -1) (looking-at "\\s *$"))
- (save-excursion (forward-comment -1)(not (looking-at comment-start))))
- ;; comment is after a blank line or code; indent as if code
- ;;
- ;; ada-wisi-before-cache will find the keyword _after_ the
- ;; comment, which could be a block-middle or block-end, and that
- ;; would align the comment with the block-middle, which is wrong. So
- ;; we only call ada-wisi-after-cache.
-
- (let ((indent (ada-wisi-after-cache))
- prev-indent next-indent)
- (if ada-indent-comment-gnat
- ;; match the gnat comment indent style check; comments must
- ;; be aligned to one of:
- ;;
- ;; - multiple of ada-indent
- ;; - next non-blank line
- ;; - previous non-blank line
- ;;
- ;; Note that we must indent the prev and next lines, in case
- ;; they are not currently correct.
- (cond
- ((= 0 (% indent ada-indent))
- ;; this will handle comments at bob and eob, so we don't
- ;; need to worry about those positions in the next checks.
- indent)
-
- ((and (setq prev-indent
- (save-excursion (forward-line
-1)(indent-according-to-mode)(current-indentation)))
- (= indent prev-indent))
- indent)
-
- ((and (setq next-indent
- ;; we use forward-comment here, instead of
- ;; forward-line, because consecutive comment
- ;; lines are indented to the current one, which
- ;; we don't know yet.
- (save-excursion (forward-comment
(point-max))(indent-according-to-mode)(current-indentation)))
- (= indent next-indent))
- indent)
+ (save-excursion
+ (forward-comment -1)
+ (if (looking-at "\\s *$")
+ ;; no comment on previous line
+ (setq after 'code)
+
+ (setq indent (current-column))
+ (if (not (= indent (progn (back-to-indentation) (current-column))))
+ ;; previous line has comment following code
+ (setq after 'code-comment)
+ ;; previous line has plain comment
+ (setq indent (current-column))
+ (setq after 'comment)
+ )))
+ )
- (t
- ;; prev-indent and next-indent are both set here;
- ;; could add more checks to decide which one to use.
- prev-indent)
- )
-
- ;; not forcing gnat style
- indent)))
-
- (t
- ;; comment is after a comment
- (forward-comment -1)
- (current-column))
- )))
+ (cl-ecase after
+ (code
+ ;; ada-wisi-before-cache will find the keyword _after_ the
+ ;; comment, which could be a block-middle or block-end, and that
+ ;; would align the comment with the block-middle, which is wrong. So
+ ;; we only call ada-wisi-after-cache.
+ (let ((indent (ada-wisi-after-cache)))
+ (if ada-indent-comment-gnat
+ (ada-wisi-comment-gnat indent 'code)
+ ;; not forcing gnat style
+ indent)))
+
+ (comment
+ ;; assume previous line indented correctly
+ indent)
+
+ (code-comment
+ (if ada-indent-comment-gnat
+ (ada-wisi-comment-gnat indent 'code-comment)
+ indent))
+ )))
+ ))
(defun ada-wisi-post-parse-fail ()
"For `wisi-post-parse-fail-hook'."
@@ -1175,11 +1288,11 @@ new indentation for point."
(use_clause (wisi-goto-end-1 cache))
(with_clause
(when (not begin)
- (setq begin (point-at-bol)))
+ (setq begin (line-beginning-position)))
(wisi-goto-end-1 cache))
(t
;; start of compilation unit
- (setq end (point-at-bol))
+ (setq end (line-beginning-position))
(unless begin
(setq begin end)))
))
@@ -1265,10 +1378,11 @@ Also return cache at start."
((abstract_subprogram_declaration
subprogram_body
subprogram_declaration
+ subprogram_renaming_declaration
null_procedure_declaration)
(memq (wisi-cache-token cache) '(NOT OVERRIDING FUNCTION
PROCEDURE)))
- (task_type_declaration
+ ((single_task_declaration task_body task_type_declaration)
(eq (wisi-cache-token cache) 'TASK))
))
@@ -1539,9 +1653,12 @@ Also return cache at start."
(wisi-cache-text (wisi-forward-find-token '(FUNCTION
PROCEDURE) (point-max)))
nil)))
- (task_type_declaration
+ ((single_task_declaration task_type_declaration)
(setq result (ada-wisi-which-function-1 "task" t)))
+
+ (task_body
+ (setq result (ada-wisi-which-function-1 "task" nil)))
))
result))
))
@@ -1550,7 +1667,6 @@ Also return cache at start."
(defun ada-wisi-debug-keys ()
"Add debug key definitions to `ada-mode-map'."
(interactive)
- (define-key ada-mode-map "\M-e" 'wisi-show-parse-error)
(define-key ada-mode-map "\M-h" 'wisi-show-containing-or-previous-cache)
(define-key ada-mode-map "\M-i" 'wisi-goto-statement-end)
(define-key ada-mode-map "\M-j" 'wisi-show-cache)
@@ -1667,13 +1783,11 @@ TOKEN-TEXT; move point to just past token."
(setq ada-goto-declarative-region-start
'ada-wisi-goto-declarative-region-start)
(setq ada-goto-end 'wisi-goto-statement-end)
(setq ada-goto-subunit-name 'ada-wisi-goto-subunit-name)
+(setq ada-in-case-expression 'ada-wisi-in-case-expression)
(setq ada-in-paramlist-p 'ada-wisi-in-paramlist-p)
(setq ada-indent-statement 'wisi-indent-statement)
(setq ada-make-subprogram-body 'ada-wisi-make-subprogram-body)
-(setq ada-next-statement-keyword 'wisi-forward-statement-keyword)
(setq ada-on-context-clause 'ada-wisi-on-context-clause)
-(setq ada-in-case-expression 'ada-wisi-in-case-expression)
-(setq ada-prev-statement-keyword 'wisi-backward-statement-keyword)
(setq ada-reset-parser 'wisi-invalidate-cache)
(setq ada-scan-paramlist 'ada-wisi-scan-paramlist)
(setq ada-show-parse-error 'wisi-show-parse-error)
diff --git a/packages/ada-mode/ada_mode_gps_indent.adb
b/packages/ada-mode/ada_mode_gps_indent.adb
new file mode 100755
index 0000000..f6abc0f
--- /dev/null
+++ b/packages/ada-mode/ada_mode_gps_indent.adb
@@ -0,0 +1,303 @@
+-- Abstract :
+--
+-- Back end for Emacs Ada mode indentation engine, using GPS
+-- indentation code.
+--
+-- Copyright (C) 2014, 2017 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
+-- published by the Free Software Foundation; either version 3, or (at
+-- your option) any later version. This program is distributed in the
+-- hope that it will be useful, but WITHOUT ANY WARRANTY; without even
+-- the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+-- PURPOSE. See the GNU General Public License for more details. You
+-- should have received a copy of the GNU General Public License
+-- distributed with this program; see file COPYING. If not, write to
+-- the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,
+-- MA 02110-1335, USA.
+
+pragma License (GPL);
+
+with Ada.Command_Line;
+with Ada.Exceptions;
+with Ada.Strings.Fixed;
+with Ada.Strings.Unbounded;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada_Analyzer;
+with Case_Handling;
+with GNAT.OS_Lib;
+with GNAT.Traceback.Symbolic;
+with GNATCOLL.Symbols;
+with Language;
+with System.Storage_Elements;
+procedure Ada_Mode_GPS_Indent is
+
+ Programmer_Error : exception;
+
+ Version : constant String := "1.001";
+ -- Format: API_version . patch_level
+ --
+ -- API_version match ada-gps.el ada-gps-indent-exec-api-version.
+ --
+ -- Bump API_version for change in commands/response; bump patch
+ -- level for patches to GPS indentation code.
+
+ Prompt : constant String := "GPS_Indent> ";
+
+ -- Indentation parameters to Analyze_Ada_Source
+ -- Defaults for debugging.
+ Indent_Level : Natural := 0; --
ada-indent
+ Indent_Continue : Natural := 0; --
ada-broken-indent
+ Indent_Case_Extra : Language.Indent_Style := Language.Non_RM_Style; --
derived from ada-indent-when
+ Indent_Record : Natural := 0; --
ada-indent-record-rel-type
+
+ procedure Usage
+ is begin
+ Put_Line ("Prompt is '" & Prompt & "'");
+ Put_Line ("commands are case sensitive");
+ Put_Line ("each command starts with a two-character decimal count of
bytes in command");
+ New_Line;
+ Put_Line ("Commands: ");
+ New_Line;
+ Put_Line ("07version");
+ Put_Line (" outputs: <version>");
+ New_Line;
+ Put_Line ("NNset_params <ada-indent> <ada-indent-broken>
<ada-indent-when>");
+ New_Line;
+ Put_Line ("NNcompute_indent <line> <text_byte_count><text>");
+ Put_Line (" first line is 1 (emacs convention)");
+ Put_Line (" text must be UTF8 encoded");
+ Put_Line (" outputs: <line number> <indent><newline>");
+ Put_Line (" no indent is 0 (emacs convention)");
+ New_Line;
+ Put_Line ("NNcompute_region_indent <start line> <end line>
<text_byte_count><text>");
+ Put_Line (" outputs for each line: <line number> <indent><newline>");
+ New_Line;
+ Put_Line ("04exit");
+ end Usage;
+
+ procedure Read_Input
+ (A : System.Address;
+ N : Integer)
+ is
+ use System.Storage_Elements;
+
+ B : System.Address := A;
+ Remaining : Integer := N;
+ Read : Integer;
+ begin
+ -- WORKAROUND: with GNAT GPL 2016, GNAT.OS_Lib.Read does _not_
+ -- wait for all N bytes or EOF; it returns as soon as it gets
+ -- some bytes.
+ --
+ -- Note that with this loop we cannot detect EOF; that's ok for
+ -- this application.
+ loop
+ Read := GNAT.OS_Lib.Read (GNAT.OS_Lib.Standin, B, Remaining);
+ Remaining := Remaining - Read;
+ exit when Remaining <= 0;
+ B := B + Storage_Offset (Read);
+ end loop;
+ end Read_Input;
+
+ function Get_Command_Length return Integer
+ is
+ Temp : aliased String (1 .. 2) := " ";
+ begin
+ Read_Input (Temp'Address, 2);
+ return Integer'Value (Temp);
+
+ exception
+ when Constraint_Error =>
+ -- From Integer'Value
+ raise Programmer_Error with "command byte count not provided; got '" &
Temp & "'";
+ end Get_Command_Length;
+
+ function Get_Integer
+ (Source : in String;
+ Last : in out Integer)
+ return Integer
+ is
+ use Ada.Exceptions;
+ use Ada.Strings.Fixed;
+ First : constant Integer := Last + 2; -- final char of previous
word/integer, space
+ begin
+ Last := Index
+ (Source => Source,
+ Pattern => " ",
+ From => First);
+
+ if Last = 0 then
+ Last := Source'Last;
+ else
+ Last := Last - 1;
+ end if;
+
+ return Integer'Value (Source (First .. Last));
+ exception
+ when E : others =>
+ Put_Line ("bad integer '" & Source (First .. Source'Last) & "'");
+ Put_Line ("Exception : " & Exception_Name (E));
+ Put_Line (Exception_Message (E));
+ raise;
+ end Get_Integer;
+
+ procedure Replace_Cb
+ (Line : in Natural;
+ First : in Natural;
+ Last : in Natural;
+ Replace : in String)
+ is
+ pragma Unreferenced (Last);
+ begin
+ -- analyze calls replace_cb for ":", ":=" etc. We only
+ -- want the leading spaces, for indentation.
+ if Replace'Length > 0 and First = 1 then
+ Put_Line (Natural'Image (Line) & Natural'Image (Replace'Length));
+ end if;
+ end Replace_Cb;
+
+ procedure Compute_Indent
+ (Start_Line : in Natural;
+ End_Line : in Natural;
+ Byte_Count : in Integer)
+ is
+ use Ada.Strings.Unbounded;
+ Buffer : aliased String_Access := new String (1 .. Byte_Count);
+ begin
+ Read_Input (Buffer.all'Address, Byte_Count);
+
+ Ada_Analyzer.Analyze_Ada_Source
+ (Buffer.all, GNATCOLL.Symbols.Allocate,
+ Indent_Params =>
+ (Indent_Level => Indent_Level,
+ Indent_Continue => Indent_Continue,
+ Indent_Decl => 2, -- no ada-mode equivalent
+ Indent_Conditional => 1, -- no ada-mode equivalent
+ Indent_Record => Indent_Record,
+ Indent_Case_Extra => Indent_Case_Extra,
+ Casing_Policy => Case_Handling.Disabled,
+ Reserved_Casing => Case_Handling.Unchanged,
+ Ident_Casing => Case_Handling.Unchanged,
+ Format_Operators => False,
+ Use_Tabs => False,
+ Align_On_Colons => False,
+ Align_On_Arrows => False,
+ Align_Decl_On_Colon => False,
+ Indent_Comments => True,
+ Stick_Comments => False), -- no ada-mode equivalent.
+ -- Stick_Comments = True causes comments to be not indented.
+
+ From => Start_Line,
+ To => End_Line,
+ Replace => Replace_Cb'Unrestricted_Access);
+
+ Free (Buffer);
+ exception
+ when E : others =>
+ declare
+ use Ada.Exceptions;
+ use GNAT.Traceback.Symbolic;
+ begin
+ Put_Line ("analyze failed on '" & Buffer.all & "'");
+ Put_Line ("Exception : " & Exception_Name (E));
+ Put_Line (Exception_Message (E));
+ Put_Line (Symbolic_Traceback (E));
+ end;
+ end Compute_Indent;
+begin
+
+ Commands :
+ loop
+ Put (Prompt); Flush;
+
+ declare
+ use Ada.Strings.Fixed;
+ Command_Length : constant Integer := Get_Command_Length;
+ Command_Line : aliased String (1 .. Command_Length);
+ Last : Integer;
+ begin
+ Read_Input (Command_Line'Address, Command_Length);
+ Last := Index (Source => Command_Line, Pattern => " ");
+
+ if Last = 0 then
+ Last := Command_Line'Last;
+ else
+ Last := Last - 1;
+ end if;
+
+ if Command_Line (1 .. Last) = "exit" then
+ exit Commands;
+
+ elsif Command_Line (1 .. Last) = "version" then
+ Put_Line (Version);
+
+ elsif Command_Line (1 .. Last) = "set_params" then
+ declare
+ Ada_Indent : constant Integer := Get_Integer
(Command_Line, Last);
+ Ada_Broken_Indent : constant Integer := Get_Integer
(Command_Line, Last);
+ Ada_Indent_When : constant Integer := Get_Integer
(Command_Line, Last);
+ Ada_Indent_Record_Rel_Type : constant Integer := Get_Integer
(Command_Line, Last);
+ begin
+ Indent_Level := Ada_Indent;
+ Indent_Continue := Ada_Broken_Indent;
+ Indent_Record := Ada_Indent_Record_Rel_Type;
+
+ if Ada_Indent_When = 0 then
+ Indent_Case_Extra := Language.Non_RM_Style;
+ else
+ Indent_Case_Extra := Language.RM_Style;
+ -- IMPROVEME: maybe Automatic if ada-indent-when < 0?
+ end if;
+ end;
+
+ elsif Command_Line (1 .. Last) = "compute_indent" then
+ declare
+ Line : constant Integer := Get_Integer (Command_Line,
Last);
+ Byte_Count : constant Integer := Get_Integer (Command_Line,
Last);
+ begin
+ Compute_Indent (Line, Line, Byte_Count);
+ end;
+
+ elsif Command_Line (1 .. Last) = "compute_region_indent" then
+ declare
+ Start_Line : constant Integer := Get_Integer (Command_Line,
Last);
+ End_Line : constant Integer := Get_Integer (Command_Line,
Last);
+ Byte_Count : constant Integer := Get_Integer (Command_Line,
Last);
+ begin
+ Compute_Indent (Start_Line, End_Line, Byte_Count);
+ end;
+
+ else
+ Put_Line ("unrecognized command '" & Command_Line & "'");
+ Usage;
+ end if;
+ exception
+ when E : Programmer_Error =>
+ declare
+ use Ada.Exceptions;
+ begin
+ Put_Line (Exception_Message (E));
+ Usage;
+ Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
+ exit Commands;
+ end;
+
+ when E : others =>
+ declare
+ use Ada.Exceptions;
+ use GNAT.Traceback.Symbolic;
+ begin
+ Put_Line ("Bad command '" & Command_Line & "'");
+ Put_Line ("Exception : " & Exception_Name (E));
+ Put_Line (Exception_Message (E));
+ Put_Line (Symbolic_Traceback (E));
+ Usage;
+ Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
+ exit Commands;
+ end;
+ end;
+ end loop Commands;
+
+end Ada_Mode_GPS_Indent;
diff --git a/packages/ada-mode/gpr_query.gpr
b/packages/ada-mode/ada_mode_gps_indent.gpr
similarity index 63%
copy from packages/ada-mode/gpr_query.gpr
copy to packages/ada-mode/ada_mode_gps_indent.gpr
index 6e57ee1..3667edf 100755
--- a/packages/ada-mode/gpr_query.gpr
+++ b/packages/ada-mode/ada_mode_gps_indent.gpr
@@ -1,6 +1,6 @@
-- Abstract :
--
--- build gpr_query
+-- build ada_mode_gps_indent
--
-- Copyright (C) 2014 Stephen Leake All Rights Reserved.
--
@@ -16,20 +16,33 @@
-- the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,
-- MA 02110-1335, USA.
-with "gnatcoll";
-with "gnatcoll_sqlite";
with "gnat_util";
-project Gpr_query is
- for Main use ("gpr_query.adb");
+with "gnatcoll_sqlite";
+with "gnatcoll_iconv";
+project Ada_Mode_GPS_Indent is
+ for Main use ("ada_mode_gps_indent.adb");
- for Source_Dirs use (".");
+ type GPS_Source_Type is ("ada-mode", "GPS");
+ GPS_Source : GPS_Source_Type := External ("Ada_Mode_GPS_Source",
"ada-mode");
+
+ case GPS_Source is
+ when "ada-mode" =>
+ for Source_Dirs use (".", "gps_source");
+ when "GPS" =>
+ for Source_Dirs use
+ (".",
+ External ("GPS_ROOT") & "/common/core/src",
+ External ("GPS_ROOT") & "/syntax/src",
+ External ("GPS_ROOT") & "/language/src/"
+ );
+ end case;
for Object_Dir use "obj";
for Exec_Dir use ".";
type Build_Type is ("Debug", "Normal");
- Build : Build_Type := External ("Gpr_Query_Build", "Normal");
+ Build : Build_Type := External ("Ada_Mode_GPS_Indent_Build", "Normal");
for Languages use ("Ada");
@@ -40,7 +53,7 @@ project Gpr_query is
"-gnata", -- assertions
"-gnatfoqQ",
"-gnatVa", -- validity checks
- "-gnaty3abcefhiklM120nOprtx",
+ "-gnaty3abcefhiklM120nprtx", -- no 'O'; gnatcoll-traces missing
"overriding"
"-gnateE", -- extra info in exceptions
"-gnatwaBCeJL",
"-fstack-check",
@@ -48,10 +61,9 @@ project Gpr_query is
case Build is
when "Debug" =>
- for Default_Switches ("Ada") use Common_Switches & ("-O0");
+ for Switches ("Ada") use Common_Switches & ("-O0");
when "Normal" =>
- -- WORKAROUND (GNAT 7.2.1): adding -gnatn here gives errors about
missing sources in installed gnatcoll.
- for Default_Switches ("Ada") use Common_Switches & ("-O2");
+ for Switches ("Ada") use Common_Switches & ("-O2", "-gnatn");
end case;
end Compiler;
@@ -63,8 +75,4 @@ project Gpr_query is
for default_switches ("Ada") use ("-E"); -- symbolic traceback
end Binder;
- package Install is
- for Mode use "usage";
- end Install;
-
-end Gpr_query;
+end Ada_Mode_GPS_Indent;
diff --git a/packages/ada-mode/debug_gps_indent.adb
b/packages/ada-mode/debug_gps_indent.adb
new file mode 100755
index 0000000..d7cb941
--- /dev/null
+++ b/packages/ada-mode/debug_gps_indent.adb
@@ -0,0 +1,84 @@
+-- Abstract :
+--
+-- call the GPS indentation engine with debug text
+--
+-- Copyright (C) 2017 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
+-- published by the Free Software Foundation; either version 3, or (at
+-- your option) any later version. This program is distributed in the
+-- hope that it will be useful, but WITHOUT ANY WARRANTY; without even
+-- the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+-- PURPOSE. See the GNU General Public License for more details. You
+-- should have received a copy of the GNU General Public License
+-- distributed with this program; see file COPYING. If not, write to
+-- the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,
+-- MA 02110-1335, USA.
+
+pragma License (GPL);
+
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada_Analyzer;
+with Case_Handling;
+with GNATCOLL.Symbols;
+with Language;
+procedure Debug_GPS_Indent is
+
+ NL : constant Character := ASCII.LF;
+
+ Buffer : constant String :=
+ "procedure Bug_002 is begin" & NL &
+ "Error_Report.Report_Error (Severity =>" & NL &
+ "Error_Report.Severe," & NL &
+ "Description => ""In theory the counterp_process..., "" &" & NL &
+ """as they should not differ but they do... """ & NL &
+ "& ""the indexes, so that we do not crash....""," & NL &
+ "Title => ""Curtain indexes should not differ but they do.""," &
NL &
+ "Caller_Scope => ""Curtain_Indexes_May_Differ"");" & NL &
+ "end Bug_002;";
+
+ procedure Replace_Cb
+ (Line : in Natural;
+ First : in Natural;
+ Last : in Natural;
+ Replace : in String)
+ is
+ pragma Unreferenced (Last);
+ begin
+ -- Provide a place to put a debugger break when an indentation is
computed.
+
+
+ -- analyze calls replace_cb for ":", ":=" etc. We only
+ -- want the leading spaces, for indentation.
+ if Replace'Length > 0 and First = 1 then
+ Put_Line (Natural'Image (Line) & Natural'Image (Replace'Length));
+ end if;
+ end Replace_Cb;
+
+begin
+
+ Ada_Analyzer.Analyze_Ada_Source
+ (Buffer, GNATCOLL.Symbols.Allocate,
+ Indent_Params =>
+ (Indent_Level => 3,
+ Indent_Continue => 2,
+ Indent_Decl => 2, -- no ada-mode equivalent
+ Indent_Conditional => 1, -- no ada-mode equivalent
+ Indent_Record => 3,
+ Indent_Case_Extra => Language.Non_RM_Style,
+ Casing_Policy => Case_Handling.Disabled,
+ Reserved_Casing => Case_Handling.Unchanged,
+ Ident_Casing => Case_Handling.Unchanged,
+ Format_Operators => False,
+ Use_Tabs => False,
+ Align_On_Colons => False,
+ Align_On_Arrows => False,
+ Align_Decl_On_Colon => False,
+ Indent_Comments => True,
+ Stick_Comments => False), -- no ada-mode equivalent.
+ From => 1,
+ To => 7,
+ Replace => Replace_Cb'Unrestricted_Access);
+
+end Debug_GPS_Indent;
diff --git a/packages/ada-mode/gnat-core.el b/packages/ada-mode/gnat-core.el
old mode 100644
new mode 100755
index 66104c5..69548a1
--- a/packages/ada-mode/gnat-core.el
+++ b/packages/ada-mode/gnat-core.el
@@ -3,7 +3,7 @@
;;
;; GNAT is provided by AdaCore; see http://libre.adacore.com/
;;
-;;; Copyright (C) 2012 - 2016 Free Software Foundation, Inc.
+;;; Copyright (C) 2012 - 2017 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
@@ -28,6 +28,14 @@
;;;;; code
+(defcustom ada-gnat-debug-run nil
+ "If t, compilation buffers containing a GNAT command will show
+the command. Otherwise, they will show only the output of the
+command. This applies e.g. to *gnatfind* buffers."
+ :type 'boolean
+ :safe #'booleanp
+ :group 'ada)
+
;;;; project file handling
(defun gnat-prj-add-prj-dir (dir project)
@@ -113,9 +121,9 @@ See also `gnat-parse-emacs-final'."
project)
-(defun gnat-get-paths-1 (src-dirs prj-dirs)
- "Append list of source and project dirs in current gpr project to SRC-DIRS,
PRJ-DIRS.
-Uses `gnat list'. Returns new (SRC-DIRS PRJ-DIRS)."
+(defun gnat-get-paths-1 (src-dirs obj-dirs prj-dirs)
+ "Append list of source, project and object dirs in current gpr project to
SRC-DIRS,
+OBJ-DIRS and PRJ-DIRS. Uses `gnat list'. Returns new (SRC-DIRS OBJ-DIRS
PRJ-DIRS)."
(with-current-buffer (gnat-run-buffer)
;; gnat list -v -P can return status 0 or 4; always lists compiler dirs
;;
@@ -144,6 +152,21 @@ Uses `gnat list'. Returns new (SRC-DIRS PRJ-DIRS)."
:test #'equal)
(forward-line 1))
+ ;; Object path
+ (search-forward "Object Search Path:")
+ (forward-line 1)
+ (while (not (looking-at "^$")) ; terminate on blank line
+ (back-to-indentation) ; skip whitespace forward
+ (cl-pushnew
+ (if (looking-at "<Current_Directory>")
+ (directory-file-name default-directory)
+ (expand-file-name ; Canonicalize path part.
+ (directory-file-name
+ (buffer-substring-no-properties (point) (point-at-eol)))))
+ obj-dirs
+ :test #'equal)
+ (forward-line 1))
+
;; Project path
;;
;; These are also added to src_dir, so compilation errors
@@ -166,7 +189,7 @@ Uses `gnat list'. Returns new (SRC-DIRS PRJ-DIRS)."
;; search-forward failed
(error "parse gpr failed")
))
- (list src-dirs prj-dirs)))
+ (list (cl-remove-duplicates src-dirs) (cl-remove-duplicates obj-dirs)
(cl-remove-duplicates prj-dirs))))
;; FIXME: use a dispatching function instead, with autoload, to
;; avoid "require" here, and this declare
@@ -174,24 +197,28 @@ Uses `gnat list'. Returns new (SRC-DIRS PRJ-DIRS)."
(declare-function gpr-query-get-src-dirs "gpr-query.el" (src-dirs))
(declare-function gpr-query-get-prj-dirs "gpr-query.el" (prj-dirs))
(defun gnat-get-paths (project)
- "Add project and/or compiler source, project paths to PROJECT src_dir and/or
prj_dir."
+ "Add project and/or compiler source, object, project paths to PROJECT
src_dir, obj_dir and/or prj_dir."
(let ((src-dirs (ada-prj-get 'src_dir project))
+ (obj-dirs (ada-prj-get 'obj_dir project))
(prj-dirs (ada-prj-get 'prj_dir project)))
(cl-ecase (ada-prj-get 'xref_tool project)
(gnat
- (let ((res (gnat-get-paths-1 src-dirs prj-dirs)))
- (setq src-dirs (car res))
- (setq prj-dirs (cadr res))))
+ (let ((res (gnat-get-paths-1 src-dirs obj-dirs prj-dirs)))
+ (setq src-dirs (pop res))
+ (setq obj-dirs (pop res))
+ (setq prj-dirs (pop res))))
(gpr_query
(when (ada-prj-get 'gpr_file)
(require 'gpr-query)
(setq src-dirs (gpr-query-get-src-dirs src-dirs))
+ (setq obj-dirs nil) ;; gpr-query does not provide obj-dirs
(setq prj-dirs (gpr-query-get-prj-dirs prj-dirs))))
)
(setq project (plist-put project 'src_dir (reverse src-dirs)))
+ (setq project (plist-put project 'obj_dir (reverse obj-dirs)))
(mapc (lambda (dir) (gnat-prj-add-prj-dir dir project))
(reverse prj-dirs))
)
@@ -267,9 +294,10 @@ Assumes current buffer is (gnat-run-buffer)"
(let ((process-environment (cl-copy-list (ada-prj-get 'proc_env))) ;; for
GPR_PROJECT_PATH
status)
- (insert (format "GPR_PROJECT_PATH=%s\n%s " (getenv "GPR_PROJECT_PATH")
exec)); for debugging
- (mapc (lambda (str) (insert (concat str " "))) command); for debugging
- (newline)
+ (when ada-gnat-debug-run
+ (insert (format "GPR_PROJECT_PATH=%s\n%s " (getenv "GPR_PROJECT_PATH")
exec))
+ (mapc (lambda (str) (insert (concat str " "))) command)
+ (newline))
(setq status (apply 'call-process exec nil t nil command))
(cond
@@ -312,9 +340,10 @@ which is displayed on error."
(set 'buffer-read-only nil)
(erase-buffer)
- (setq command (cl-delete-if 'null command))
- (mapc (lambda (str) (insert (concat str " "))) command)
- (newline)
+ (when ada-gnat-debug-run
+ (setq command (cl-delete-if 'null command))
+ (mapc (lambda (str) (insert (concat str " "))) command)
+ (newline))
(let ((default-directory (or dir default-directory))
status)
@@ -383,7 +412,7 @@ list."
"0"))
(goto-char (point-min))
- (forward-line 1); skip cmd
+ (when ada-gnat-debug-run (forward-line 1)); skip cmd
(setq result (buffer-substring-no-properties (line-beginning-position)
(line-end-position)))
)
result))
diff --git a/packages/ada-mode/gpr-grammar-wy.el
b/packages/ada-mode/gpr-grammar-wy.el
old mode 100644
new mode 100755
index 342d832..e2f9f26
--- a/packages/ada-mode/gpr-grammar-wy.el
+++ b/packages/ada-mode/gpr-grammar-wy.el
@@ -86,7 +86,7 @@
(progn
(wisi-statement-action [1 statement-start 3 statement-other 5
statement-end])
(wisi-containing-action 3 4)))
- ((FOR IDENTIFIER LEFT_PAREN STRING_LITERAL RIGHT_PAREN USE expression
SEMICOLON )
+ ((FOR IDENTIFIER LEFT_PAREN discrete_choice RIGHT_PAREN USE expression
SEMICOLON )
(progn
(wisi-statement-action [1 statement-start 3 open-paren 5 close-paren 6
statement-other 8 statement-end])
(wisi-containing-action 6 7)))
@@ -207,8 +207,6 @@
(progn
(wisi-statement-action [1 statement-start 3 block-start 5 block-end 7
statement-end])
(wisi-containing-action 3 4))))
- (string_expression
- ((string_primary )))
(string_primary
((STRING_LITERAL ))
((name ))
@@ -221,7 +219,7 @@
(wisi-statement-action [2 list-break])
(wisi-containing-action 2 3))))
(term
- ((string_expression ))
+ ((string_primary ))
((LEFT_PAREN RIGHT_PAREN ))
((aggregate )))
(typed_string_declaration
@@ -233,12 +231,12 @@
((WITH string_list SEMICOLON ))))
[((default . error) (ABSTRACT . (context_clause_opt . 0)) (AGGREGATE .
(context_clause_opt . 0)) (CONFIGURATION . (context_clause_opt . 0)) (LIBRARY .
(context_clause_opt . 0)) (STANDARD . (context_clause_opt . 0)) (PROJECT .
(context_clause_opt . 0)) ($EOI . (context_clause_opt . 0)) (WITH . 7))
((default . error) ($EOI . (project_qualifier_opt . 1)) (PROJECT .
(project_qualifier_opt . 1)))
- ((default . error) (LIBRARY . 35) ($EOI . (project_qualifier_opt . 3))
(PROJECT . (project_qualifier_opt . 3)))
+ ((default . error) (LIBRARY . 34) ($EOI . (project_qualifier_opt . 3))
(PROJECT . (project_qualifier_opt . 3)))
((default . error) ($EOI . (project_qualifier_opt . 6)) (PROJECT .
(project_qualifier_opt . 6)))
((default . error) ($EOI . (project_qualifier_opt . 5)) (PROJECT .
(project_qualifier_opt . 5)))
((default . error) (EXTENDS . (identifier_opt . 0)) (IS .
(identifier_opt . 0)) (IDENTIFIER . 21))
((default . error) ($EOI . (project_qualifier_opt . 2)) (PROJECT .
(project_qualifier_opt . 2)))
- ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (COMMA .
(identifier_opt . 0)) (QUOTE . (identifier_opt . 0)) (IDENTIFIER . 21)
(PROJECT . 20))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (COMMA .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (QUOTE . (identifier_opt . 0)) (IDENTIFIER . 21)
(PROJECT . 20))
((default . error) ($EOI . 16))
((default . error) (ABSTRACT . (context_clause_opt . 1)) (AGGREGATE .
(context_clause_opt . 1)) (CONFIGURATION . (context_clause_opt . 1)) (LIBRARY .
(context_clause_opt . 1)) (STANDARD . (context_clause_opt . 1)) (PROJECT .
(context_clause_opt . 1)) ($EOI . (context_clause_opt . 1)) (WITH . 7))
((default . error) (PROJECT . (project_qualifier_opt . 0)) ($EOI .
(project_qualifier_opt . 0)) (ABSTRACT . 1) (STANDARD . 6) (AGGREGATE . 2)
(LIBRARY . 4) (CONFIGURATION . 3))
@@ -248,133 +246,132 @@
((default . error) ($EOI . (project_declaration_opt . 0)) (PROJECT . 5))
((default . error) (WITH . (context_clause . 1)) (ABSTRACT .
(context_clause . 1)) (AGGREGATE . (context_clause . 1)) (CONFIGURATION .
(context_clause . 1)) (LIBRARY . (context_clause . 1)) (STANDARD .
(context_clause . 1)) (PROJECT . (context_clause . 1)) ($EOI . (context_clause
. 1)))
((default . error) ($EOI . accept) (STRING_LITERAL . accept) (IDENTIFIER
. accept) (VERTICAL_BAR . accept) (SEMICOLON . accept) (QUOTE . accept)
(EQUAL_GREATER . accept) (DOT . accept) (COMMA . accept) (COLON_EQUALS .
accept) (COLON . accept) (AMPERSAND . accept) (WITH . accept) (WHEN . accept)
(USE . accept) (TYPE . accept) (STANDARD . accept) (RIGHT_PAREN . accept)
(RENAMES . accept) (PROJECT . accept) (PACKAGE . accept) (OTHERS . accept)
(NULL . accept) (LIBRARY . accept) (LEFT_ [...]
- ((default . error) (LEFT_PAREN . 45))
- ((default . error) (LEFT_PAREN . 45))
- ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (RIGHT_PAREN . ( 43 (identifier_opt . 0))) (COMMA .
(identifier_opt . 0)) (QUOTE . (identifier_opt . 0)) (IDENTIFIER . 21)
(PROJECT . 20))
+ ((default . error) (LEFT_PAREN . 44))
+ ((default . error) (LEFT_PAREN . 44))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (COMMA .
(identifier_opt . 0)) (RIGHT_PAREN . ( 42 (identifier_opt . 0))) (AMPERSAND .
(identifier_opt . 0)) (QUOTE . (identifier_opt . 0)) (IDENTIFIER . 21)
(PROJECT . 20))
((default . error) (QUOTE . (attribute_prefix . 0)))
- ((default . error) (RIGHT_PAREN . (identifier_opt . 1)) (COMMA .
(identifier_opt . 1)) (EXTENDS . (identifier_opt . 1)) (RENAMES .
(identifier_opt . 1)) (IS . (identifier_opt . 1)) (DOT . (identifier_opt . 1))
(AMPERSAND . (identifier_opt . 1)) (QUOTE . (identifier_opt . 1)) (SEMICOLON .
(identifier_opt . 1)))
- ((default . error) (RIGHT_PAREN . (string_primary . 0)) (COMMA .
(string_primary . 0)) (AMPERSAND . (string_primary . 0)) (SEMICOLON .
(string_primary . 0)))
+ ((default . error) (COMMA . (identifier_opt . 1)) (RIGHT_PAREN .
(identifier_opt . 1)) (EXTENDS . (identifier_opt . 1)) (RENAMES .
(identifier_opt . 1)) (IS . (identifier_opt . 1)) (DOT . (identifier_opt . 1))
(AMPERSAND . (identifier_opt . 1)) (QUOTE . (identifier_opt . 1)) (SEMICOLON .
(identifier_opt . 1)))
+ ((default . error) (COMMA . (string_primary . 0)) (RIGHT_PAREN .
(string_primary . 0)) (SEMICOLON . (string_primary . 0)) (AMPERSAND .
(string_primary . 0)))
((default . error) (RIGHT_PAREN . (term . 2)) (COMMA . (term . 2))
(AMPERSAND . (term . 2)) (SEMICOLON . (term . 2)))
- ((default . error) (QUOTE . 42))
- ((default . error) (RIGHT_PAREN . (string_primary . 3)) (COMMA .
(string_primary . 3)) (AMPERSAND . (string_primary . 3)) (SEMICOLON .
(string_primary . 3)))
- ((default . error) (SEMICOLON . (string_list . 0)) (RIGHT_PAREN .
(string_list . 0)) (COMMA . (string_list . 0)) (AMPERSAND . 41))
- ((default . error) (RIGHT_PAREN . (string_primary . 2)) (COMMA .
(string_primary . 2)) (AMPERSAND . (string_primary . 2)) (SEMICOLON .
(string_primary . 2)))
- ((default . error) (COMMA . (name . 0)) (RIGHT_PAREN . (name . 0)) (IS .
(name . 0)) (SEMICOLON . (name . 0)) (AMPERSAND . (name . 0)) (DOT . (name .
0)) (QUOTE . (name . 0)))
- ((default . error) (RIGHT_PAREN . (string_primary . 1)) (COMMA .
(string_primary . 1)) (AMPERSAND . (string_primary . 1)) (SEMICOLON .
(string_primary . 1)) (DOT . 40) (QUOTE . (attribute_prefix . 1)))
+ ((default . error) (QUOTE . 41))
+ ((default . error) (COMMA . (string_primary . 3)) (RIGHT_PAREN .
(string_primary . 3)) (SEMICOLON . (string_primary . 3)) (AMPERSAND .
(string_primary . 3)))
+ ((default . error) (SEMICOLON . (string_list . 0)) (RIGHT_PAREN .
(string_list . 0)) (COMMA . (string_list . 0)) (AMPERSAND . 40))
+ ((default . error) (COMMA . (string_primary . 2)) (RIGHT_PAREN .
(string_primary . 2)) (SEMICOLON . (string_primary . 2)) (AMPERSAND .
(string_primary . 2)))
+ ((default . error) (RIGHT_PAREN . (name . 0)) (COMMA . (name . 0)) (IS .
(name . 0)) (AMPERSAND . (name . 0)) (SEMICOLON . (name . 0)) (DOT . (name .
0)) (QUOTE . (name . 0)))
+ ((default . error) (COMMA . (string_primary . 1)) (RIGHT_PAREN .
(string_primary . 1)) (SEMICOLON . (string_primary . 1)) (AMPERSAND .
(string_primary . 1)) (DOT . 39) (QUOTE . (attribute_prefix . 1)))
((default . error) (RIGHT_PAREN . (term . 0)) (COMMA . (term . 0))
(AMPERSAND . (term . 0)) (SEMICOLON . (term . 0)))
- ((default . error) (COMMA . (string_expression . 0)) (RIGHT_PAREN .
(string_expression . 0)) (SEMICOLON . (string_expression . 0)) (AMPERSAND .
(string_expression . 0)))
- ((default . error) (COMMA . 38) (SEMICOLON . 39))
+ ((default . error) (COMMA . 37) (SEMICOLON . 38))
((default . error) (COMMA . (expression . 0)) (RIGHT_PAREN . (expression
. 0)) (SEMICOLON . (expression . 0)) (AMPERSAND . (expression . 0)))
- ((default . error) (EXTENDS . 36) (IS . 37))
+ ((default . error) (EXTENDS . 35) (IS . 36))
((default . error) ($EOI . (project_qualifier_opt . 4)) (PROJECT .
(project_qualifier_opt . 4)))
- ((default . error) (STRING_LITERAL . 71))
- ((default . error) (END . (declarative_items_opt . 0)) (TYPE . 58)
(IDENTIFIER . 59) (NULL . 56) (CASE . 54) (FOR . 55) (PACKAGE . 57))
- ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (RIGHT_PAREN . (identifier_opt . 0)) (COMMA .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
- ((default . error) (WITH . (with_clause . 0)) (ABSTRACT . (with_clause .
0)) (AGGREGATE . (with_clause . 0)) (CONFIGURATION . (with_clause . 0))
(LIBRARY . (with_clause . 0)) (STANDARD . (with_clause . 0)) (PROJECT .
(with_clause . 0)) ($EOI . (with_clause . 0)))
- ((default . error) (IDENTIFIER . 52))
+ ((default . error) (STRING_LITERAL . 70))
+ ((default . error) (END . (declarative_items_opt . 0)) (TYPE . 57)
(IDENTIFIER . 58) (NULL . 55) (CASE . 53) (FOR . 54) (PACKAGE . 56))
((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (SEMICOLON .
(identifier_opt . 0)) (COMMA . (identifier_opt . 0)) (RIGHT_PAREN .
(identifier_opt . 0)) (AMPERSAND . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
- ((default . error) (IDENTIFIER . 50))
+ ((default . error) (WITH . (with_clause . 0)) (ABSTRACT . (with_clause .
0)) (AGGREGATE . (with_clause . 0)) (CONFIGURATION . (with_clause . 0))
(LIBRARY . (with_clause . 0)) (STANDARD . (with_clause . 0)) (PROJECT .
(with_clause . 0)) ($EOI . (with_clause . 0)))
+ ((default . error) (IDENTIFIER . 51))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (RIGHT_PAREN . (identifier_opt . 0)) (COMMA .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
+ ((default . error) (IDENTIFIER . 49))
((default . error) (SEMICOLON . (term . 1)) (AMPERSAND . (term . 1))
(COMMA . (term . 1)) (RIGHT_PAREN . (term . 1)))
- ((default . error) (COMMA . 38) (RIGHT_PAREN . 49))
- ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (RIGHT_PAREN . (identifier_opt . 0)) (COMMA .
(identifier_opt . 0)) (QUOTE . (identifier_opt . 0)) (IDENTIFIER . 21)
(PROJECT . 20))
- ((default . error) (AMPERSAND . (external_value . 1)) (SEMICOLON .
(external_value . 1)) (RIGHT_PAREN . (external_value . 1)) (COMMA .
(external_value . 1)))
- ((default . error) (AMPERSAND . (external_value . 0)) (SEMICOLON .
(external_value . 0)) (RIGHT_PAREN . (external_value . 0)) (COMMA .
(external_value . 0)))
+ ((default . error) (COMMA . 37) (RIGHT_PAREN . 48))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (COMMA .
(identifier_opt . 0)) (RIGHT_PAREN . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (QUOTE . (identifier_opt . 0)) (IDENTIFIER . 21)
(PROJECT . 20))
+ ((default . error) (SEMICOLON . (external_value . 1)) (AMPERSAND .
(external_value . 1)) (COMMA . (external_value . 1)) (RIGHT_PAREN .
(external_value . 1)))
+ ((default . error) (SEMICOLON . (external_value . 0)) (AMPERSAND .
(external_value . 0)) (COMMA . (external_value . 0)) (RIGHT_PAREN .
(external_value . 0)))
((default . error) ($EOI . (compilation_unit . 0)))
((default . error) (COMMA . (aggregate . 0)) (RIGHT_PAREN . (aggregate .
0)) (SEMICOLON . (aggregate . 0)) (AMPERSAND . (aggregate . 0)))
- ((default . error) (LEFT_PAREN . 83) (COMMA . (attribute_reference .
0)) (RIGHT_PAREN . (attribute_reference . 0)) (SEMICOLON . (attribute_reference
. 0)) (AMPERSAND . (attribute_reference . 0)))
+ ((default . error) (LEFT_PAREN . 82) (RIGHT_PAREN .
(attribute_reference . 0)) (COMMA . (attribute_reference . 0)) (AMPERSAND .
(attribute_reference . 0)) (SEMICOLON . (attribute_reference . 0)))
((default . error) (SEMICOLON . (expression . 1)) (COMMA . (expression .
1)) (RIGHT_PAREN . (expression . 1)) (AMPERSAND . (expression . 1)))
- ((default . error) (IS . (name . 1)) (COMMA . (name . 1)) (RIGHT_PAREN .
(name . 1)) (SEMICOLON . (name . 1)) (AMPERSAND . (name . 1)) (DOT . (name .
1)) (QUOTE . (name . 1)))
- ((default . error) (AMPERSAND . 41) (RIGHT_PAREN . (string_list . 1))
(SEMICOLON . (string_list . 1)) (COMMA . (string_list . 1)))
+ ((default . error) (IS . (name . 1)) (RIGHT_PAREN . (name . 1)) (COMMA .
(name . 1)) (AMPERSAND . (name . 1)) (SEMICOLON . (name . 1)) (DOT . (name .
1)) (QUOTE . (name . 1)))
+ ((default . error) (AMPERSAND . 40) (RIGHT_PAREN . (string_list . 1))
(SEMICOLON . (string_list . 1)) (COMMA . (string_list . 1)))
((default . error) (DOT . (identifier_opt . 0)) (IS . (identifier_opt .
0)) (IDENTIFIER . 21))
- ((default . error) (EXTERNAL . 80) (IDENTIFIER . 81))
- ((default . error) (SEMICOLON . 79))
+ ((default . error) (EXTERNAL . 79) (IDENTIFIER . 80))
+ ((default . error) (SEMICOLON . 78))
((default . error) (IS . (identifier_opt . 0)) (EXTENDS .
(identifier_opt . 0)) (RENAMES . (identifier_opt . 0)) (IDENTIFIER . 21))
- ((default . error) (IDENTIFIER . 77))
- ((default . error) (COLON . 75) (COLON_EQUALS . 76))
+ ((default . error) (IDENTIFIER . 76))
+ ((default . error) (COLON . 74) (COLON_EQUALS . 75))
((default . error) (WHEN . (simple_declarative_item . 2)) (END .
(simple_declarative_item . 2)) (CASE . (simple_declarative_item . 2)) (FOR .
(simple_declarative_item . 2)) (NULL . (simple_declarative_item . 2)) (PACKAGE
. (simple_declarative_item . 2)) (TYPE . (simple_declarative_item . 2))
(IDENTIFIER . (simple_declarative_item . 2)))
((default . error) (WHEN . (simple_declarative_item . 3)) (END .
(simple_declarative_item . 3)) (CASE . (simple_declarative_item . 3)) (FOR .
(simple_declarative_item . 3)) (NULL . (simple_declarative_item . 3)) (PACKAGE
. (simple_declarative_item . 3)) (TYPE . (simple_declarative_item . 3))
(IDENTIFIER . (simple_declarative_item . 3)))
((default . error) (WHEN . (declarative_items . 0)) (END .
(declarative_items . 0)) (CASE . (declarative_items . 0)) (FOR .
(declarative_items . 0)) (NULL . (declarative_items . 0)) (PACKAGE .
(declarative_items . 0)) (TYPE . (declarative_items . 0)) (IDENTIFIER .
(declarative_items . 0)))
- ((default . error) (WHEN . (declarative_items_opt . 1)) (END .
(declarative_items_opt . 1)) (TYPE . 58) (IDENTIFIER . 59) (NULL . 56) (CASE
. 54) (FOR . 55) (PACKAGE . 57))
- ((default . error) (END . 73))
+ ((default . error) (WHEN . (declarative_items_opt . 1)) (END .
(declarative_items_opt . 1)) (TYPE . 57) (IDENTIFIER . 58) (NULL . 55) (CASE
. 53) (FOR . 54) (PACKAGE . 56))
+ ((default . error) (END . 72))
((default . error) (WHEN . (declarative_item . 2)) (END .
(declarative_item . 2)) (IDENTIFIER . (declarative_item . 2)) (TYPE .
(declarative_item . 2)) (PACKAGE . (declarative_item . 2)) (NULL .
(declarative_item . 2)) (FOR . (declarative_item . 2)) (CASE .
(declarative_item . 2)))
((default . error) (WHEN . (package_declaration . 0)) (END .
(package_declaration . 0)) (CASE . (package_declaration . 0)) (FOR .
(package_declaration . 0)) (NULL . (package_declaration . 0)) (PACKAGE .
(package_declaration . 0)) (TYPE . (package_declaration . 0)) (IDENTIFIER .
(package_declaration . 0)))
((default . error) (WHEN . (package_declaration . 1)) (END .
(package_declaration . 1)) (CASE . (package_declaration . 1)) (FOR .
(package_declaration . 1)) (NULL . (package_declaration . 1)) (PACKAGE .
(package_declaration . 1)) (TYPE . (package_declaration . 1)) (IDENTIFIER .
(package_declaration . 1)))
((default . error) (WHEN . (package_declaration . 2)) (END .
(package_declaration . 2)) (CASE . (package_declaration . 2)) (FOR .
(package_declaration . 2)) (NULL . (package_declaration . 2)) (PACKAGE .
(package_declaration . 2)) (TYPE . (package_declaration . 2)) (IDENTIFIER .
(package_declaration . 2)))
((default . error) (WHEN . (declarative_item . 0)) (END .
(declarative_item . 0)) (IDENTIFIER . (declarative_item . 0)) (TYPE .
(declarative_item . 0)) (PACKAGE . (declarative_item . 0)) (NULL .
(declarative_item . 0)) (FOR . (declarative_item . 0)) (CASE .
(declarative_item . 0)))
((default . error) (WHEN . (declarative_item . 1)) (END .
(declarative_item . 1)) (IDENTIFIER . (declarative_item . 1)) (TYPE .
(declarative_item . 1)) (PACKAGE . (declarative_item . 1)) (NULL .
(declarative_item . 1)) (FOR . (declarative_item . 1)) (CASE .
(declarative_item . 1)))
- ((default . error) (IS . 72))
- ((default . error) (END . (declarative_items_opt . 0)) (TYPE . 58)
(IDENTIFIER . 59) (NULL . 56) (CASE . 54) (FOR . 55) (PACKAGE . 57))
+ ((default . error) (IS . 71))
+ ((default . error) (END . (declarative_items_opt . 0)) (TYPE . 57)
(IDENTIFIER . 58) (NULL . 55) (CASE . 53) (FOR . 54) (PACKAGE . 56))
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER . 21))
((default . error) (WHEN . (declarative_items . 1)) (IDENTIFIER .
(declarative_items . 1)) (TYPE . (declarative_items . 1)) (PACKAGE .
(declarative_items . 1)) (NULL . (declarative_items . 1)) (FOR .
(declarative_items . 1)) (CASE . (declarative_items . 1)) (END .
(declarative_items . 1)))
- ((default . error) (IDENTIFIER . 94))
- ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
- ((default . error) (IS . 92))
- ((default . error) (IS . 90) (EXTENDS . 89) (RENAMES . 91))
+ ((default . error) (IDENTIFIER . 93))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (SEMICOLON .
(identifier_opt . 0)) (AMPERSAND . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
+ ((default . error) (IS . 91))
+ ((default . error) (IS . 89) (EXTENDS . 88) (RENAMES . 90))
((default . error) (WHEN . (simple_declarative_item . 4)) (IDENTIFIER .
(simple_declarative_item . 4)) (TYPE . (simple_declarative_item . 4)) (PACKAGE
. (simple_declarative_item . 4)) (NULL . (simple_declarative_item . 4)) (FOR .
(simple_declarative_item . 4)) (CASE . (simple_declarative_item . 4)) (END .
(simple_declarative_item . 4)))
- ((default . error) (LEFT_PAREN . 88))
- ((default . error) (USE . 87) (LEFT_PAREN . 86))
- ((default . error) (DOT . 40) (IS . 85))
- ((default . error) (STRING_LITERAL . 84))
- ((default . error) (RIGHT_PAREN . 111))
- ((default . error) (END . (case_items . 0)) (WHEN . ( 108 (case_items .
0))))
- ((default . error) (STRING_LITERAL . 107))
- ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
- ((default . error) (STRING_LITERAL . 105))
+ ((default . error) (LEFT_PAREN . 87))
+ ((default . error) (USE . 86) (LEFT_PAREN . 85))
+ ((default . error) (DOT . 39) (IS . 84))
+ ((default . error) (STRING_LITERAL . 83))
+ ((default . error) (RIGHT_PAREN . 112))
+ ((default . error) (END . (case_items . 0)) (WHEN . ( 109 (case_items .
0))))
+ ((default . error) (RIGHT_PAREN . (discrete_choice . 0)) (STRING_LITERAL
. 107) (OTHERS . 106))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (SEMICOLON .
(identifier_opt . 0)) (AMPERSAND . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
+ ((default . error) (STRING_LITERAL . 104))
((default . error) (DOT . (identifier_opt . 0)) (IS . (identifier_opt .
0)) (IDENTIFIER . 21))
- ((default . error) (END . (declarative_items_opt . 0)) (TYPE . 58)
(IDENTIFIER . 59) (NULL . 56) (CASE . 54) (FOR . 55) (PACKAGE . 57))
+ ((default . error) (END . (declarative_items_opt . 0)) (TYPE . 57)
(IDENTIFIER . 58) (NULL . 55) (CASE . 53) (FOR . 54) (PACKAGE . 56))
((default . error) (DOT . (identifier_opt . 0)) (SEMICOLON .
(identifier_opt . 0)) (IDENTIFIER . 21))
- ((default . error) (LEFT_PAREN . 45))
- ((default . error) (AMPERSAND . 41) (SEMICOLON . 100))
- ((default . error) (COLON_EQUALS . 99))
- ((default . error) (SEMICOLON . 98))
- ((default . error) (END . 97))
+ ((default . error) (LEFT_PAREN . 44))
+ ((default . error) (AMPERSAND . 40) (SEMICOLON . 99))
+ ((default . error) (COLON_EQUALS . 98))
+ ((default . error) (SEMICOLON . 97))
+ ((default . error) (END . 96))
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER . 21))
((default . error) ($EOI . (simple_project_declaration . 0)))
- ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (SEMICOLON .
(identifier_opt . 0)) (AMPERSAND . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
((default . error) (WHEN . (simple_declarative_item . 0)) (IDENTIFIER .
(simple_declarative_item . 0)) (TYPE . (simple_declarative_item . 0)) (PACKAGE
. (simple_declarative_item . 0)) (NULL . (simple_declarative_item . 0)) (FOR .
(simple_declarative_item . 0)) (CASE . (simple_declarative_item . 0)) (END .
(simple_declarative_item . 0)))
- ((default . error) (SEMICOLON . 124))
- ((default . error) (DOT . 40) (SEMICOLON . 123))
- ((default . error) (END . 122))
- ((default . error) (DOT . 40) (IS . 121))
- ((default . error) (RIGHT_PAREN . 120))
- ((default . error) (AMPERSAND . 41) (SEMICOLON . 119))
- ((default . error) (RIGHT_PAREN . 118))
- ((default . error) (VERTICAL_BAR . (discrete_choice . 0)) (EQUAL_GREATER
. (discrete_choice . 0)) (STRING_LITERAL . 115) (OTHERS . 114))
+ ((default . error) (SEMICOLON . 123))
+ ((default . error) (DOT . 39) (SEMICOLON . 122))
+ ((default . error) (END . 121))
+ ((default . error) (DOT . 39) (IS . 120))
+ ((default . error) (RIGHT_PAREN . 119))
+ ((default . error) (AMPERSAND . 40) (SEMICOLON . 118))
+ ((default . error) (RIGHT_PAREN . (discrete_choice . 2)) (VERTICAL_BAR .
(discrete_choice . 2)) (EQUAL_GREATER . (discrete_choice . 2)))
+ ((default . error) (RIGHT_PAREN . (discrete_choice . 1)) (VERTICAL_BAR .
(discrete_choice . 1)) (EQUAL_GREATER . (discrete_choice . 1)))
+ ((default . error) (RIGHT_PAREN . 117))
+ ((default . error) (VERTICAL_BAR . (discrete_choice . 0)) (EQUAL_GREATER
. (discrete_choice . 0)) (STRING_LITERAL . 107) (OTHERS . 106))
((default . error) (END . (case_items . 1)) (WHEN . (case_items . 1)))
- ((default . error) (END . 112) (WHEN . 108))
- ((default . error) (AMPERSAND . (attribute_reference . 1)) (SEMICOLON .
(attribute_reference . 1)) (RIGHT_PAREN . (attribute_reference . 1)) (COMMA .
(attribute_reference . 1)))
- ((default . error) (CASE . 135))
+ ((default . error) (END . 113) (WHEN . 109))
+ ((default . error) (SEMICOLON . (attribute_reference . 1)) (AMPERSAND .
(attribute_reference . 1)) (COMMA . (attribute_reference . 1)) (RIGHT_PAREN .
(attribute_reference . 1)))
+ ((default . error) (CASE . 134))
((default . error) (WHEN . (case_items . 2)) (END . (case_items . 2)))
- ((default . error) (VERTICAL_BAR . (discrete_choice . 2)) (EQUAL_GREATER
. (discrete_choice . 2)))
- ((default . error) (VERTICAL_BAR . (discrete_choice . 1)) (EQUAL_GREATER
. (discrete_choice . 1)))
((default . error) (EQUAL_GREATER . (discrete_choice_list . 0))
(VERTICAL_BAR . (discrete_choice_list . 0)))
- ((default . error) (VERTICAL_BAR . 134) (EQUAL_GREATER . 133))
- ((default . error) (USE . 132))
- ((default . error) (WHEN . (attribute_declaration . 0)) (END .
(attribute_declaration . 0)) (IDENTIFIER . (attribute_declaration . 0)) (TYPE .
(attribute_declaration . 0)) (PACKAGE . (attribute_declaration . 0)) (NULL .
(attribute_declaration . 0)) (FOR . (attribute_declaration . 0)) (CASE .
(attribute_declaration . 0)))
+ ((default . error) (VERTICAL_BAR . 133) (EQUAL_GREATER . 132))
((default . error) (USE . 131))
- ((default . error) (END . (declarative_items_opt . 0)) (TYPE . 58)
(IDENTIFIER . 59) (NULL . 56) (CASE . 54) (FOR . 55) (PACKAGE . 57))
+ ((default . error) (WHEN . (attribute_declaration . 0)) (END .
(attribute_declaration . 0)) (IDENTIFIER . (attribute_declaration . 0)) (TYPE .
(attribute_declaration . 0)) (PACKAGE . (attribute_declaration . 0)) (NULL .
(attribute_declaration . 0)) (FOR . (attribute_declaration . 0)) (CASE .
(attribute_declaration . 0)))
+ ((default . error) (USE . 130))
+ ((default . error) (END . (declarative_items_opt . 0)) (TYPE . 57)
(IDENTIFIER . 58) (NULL . 55) (CASE . 53) (FOR . 54) (PACKAGE . 56))
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER . 21))
((default . error) (WHEN . (package_renaming . 0)) (END .
(package_renaming . 0)) (IDENTIFIER . (package_renaming . 0)) (TYPE .
(package_renaming . 0)) (PACKAGE . (package_renaming . 0)) (NULL .
(package_renaming . 0)) (FOR . (package_renaming . 0)) (CASE .
(package_renaming . 0)))
((default . error) (WHEN . (typed_string_declaration . 0)) (END .
(typed_string_declaration . 0)) (CASE . (typed_string_declaration . 0)) (FOR .
(typed_string_declaration . 0)) (NULL . (typed_string_declaration . 0))
(PACKAGE . (typed_string_declaration . 0)) (TYPE . (typed_string_declaration .
0)) (IDENTIFIER . (typed_string_declaration . 0)))
- ((default . error) (AMPERSAND . 41) (SEMICOLON . 128))
- ((default . error) (SEMICOLON . 127))
+ ((default . error) (AMPERSAND . 40) (SEMICOLON . 127))
+ ((default . error) (SEMICOLON . 126))
((default . error) ($EOI . (project_extension . 0)))
((default . error) (WHEN . (simple_declarative_item . 1)) (IDENTIFIER .
(simple_declarative_item . 1)) (TYPE . (simple_declarative_item . 1)) (PACKAGE
. (simple_declarative_item . 1)) (NULL . (simple_declarative_item . 1)) (FOR .
(simple_declarative_item . 1)) (CASE . (simple_declarative_item . 1)) (END .
(simple_declarative_item . 1)))
- ((default . error) (SEMICOLON . 142))
- ((default . error) (END . 141))
- ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
- ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (AMPERSAND .
(identifier_opt . 0)) (SEMICOLON . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
- ((default . error) (END . (declarative_items_opt . 0)) (WHEN .
(declarative_items_opt . 0)) (TYPE . 58) (IDENTIFIER . 59) (NULL . 56) (CASE
. 54) (FOR . 55) (PACKAGE . 57))
- ((default . error) (EQUAL_GREATER . (discrete_choice . 0)) (VERTICAL_BAR
. (discrete_choice . 0)) (STRING_LITERAL . 115) (OTHERS . 114))
- ((default . error) (SEMICOLON . 136))
+ ((default . error) (SEMICOLON . 141))
+ ((default . error) (END . 140))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (SEMICOLON .
(identifier_opt . 0)) (AMPERSAND . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
+ ((default . error) (LEFT_PAREN . 19) (STRING_LITERAL . 22) (EXTERNAL .
17) (EXTERNAL_AS_LIST . 18) (DOT . (identifier_opt . 0)) (SEMICOLON .
(identifier_opt . 0)) (AMPERSAND . (identifier_opt . 0)) (QUOTE .
(identifier_opt . 0)) (IDENTIFIER . 21) (PROJECT . 20))
+ ((default . error) (END . (declarative_items_opt . 0)) (WHEN .
(declarative_items_opt . 0)) (TYPE . 57) (IDENTIFIER . 58) (NULL . 55) (CASE
. 53) (FOR . 54) (PACKAGE . 56))
+ ((default . error) (EQUAL_GREATER . (discrete_choice . 0)) (VERTICAL_BAR
. (discrete_choice . 0)) (STRING_LITERAL . 107) (OTHERS . 106))
+ ((default . error) (SEMICOLON . 135))
((default . error) (WHEN . (case_statement . 0)) (END . (case_statement
. 0)) (IDENTIFIER . (case_statement . 0)) (TYPE . (case_statement . 0))
(PACKAGE . (case_statement . 0)) (NULL . (case_statement . 0)) (FOR .
(case_statement . 0)) (CASE . (case_statement . 0)))
((default . error) (EQUAL_GREATER . (discrete_choice_list . 1))
(VERTICAL_BAR . (discrete_choice_list . 1)))
((default . error) (END . (case_item . 0)) (WHEN . (case_item . 0)))
- ((default . error) (AMPERSAND . 41) (SEMICOLON . 145))
- ((default . error) (AMPERSAND . 41) (SEMICOLON . 144))
+ ((default . error) (AMPERSAND . 40) (SEMICOLON . 144))
+ ((default . error) (AMPERSAND . 40) (SEMICOLON . 143))
((default . error) (SEMICOLON . (identifier_opt . 0)) (IDENTIFIER . 21))
((default . error) (WHEN . (package_spec . 0)) (END . (package_spec .
0)) (IDENTIFIER . (package_spec . 0)) (TYPE . (package_spec . 0)) (PACKAGE .
(package_spec . 0)) (NULL . (package_spec . 0)) (FOR . (package_spec . 0))
(CASE . (package_spec . 0)))
- ((default . error) (SEMICOLON . 146))
+ ((default . error) (SEMICOLON . 145))
((default . error) (WHEN . (attribute_declaration . 2)) (CASE .
(attribute_declaration . 2)) (FOR . (attribute_declaration . 2)) (NULL .
(attribute_declaration . 2)) (PACKAGE . (attribute_declaration . 2)) (TYPE .
(attribute_declaration . 2)) (IDENTIFIER . (attribute_declaration . 2)) (END .
(attribute_declaration . 2)))
((default . error) (WHEN . (attribute_declaration . 1)) (CASE .
(attribute_declaration . 1)) (FOR . (attribute_declaration . 1)) (NULL .
(attribute_declaration . 1)) (PACKAGE . (attribute_declaration . 1)) (TYPE .
(attribute_declaration . 1)) (IDENTIFIER . (attribute_declaration . 1)) (END .
(attribute_declaration . 1)))
((default . error) (WHEN . (package_extension . 0)) (END .
(package_extension . 0)) (IDENTIFIER . (package_extension . 0)) (TYPE .
(package_extension . 0)) (PACKAGE . (package_extension . 0)) (NULL .
(package_extension . 0)) (FOR . (package_extension . 0)) (CASE .
(package_extension . 0)))]
@@ -383,23 +380,21 @@
nil
nil
nil
- ((identifier_opt . 34))
+ ((identifier_opt . 33))
nil
- ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 26)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(string_list . 32)(term . 33))
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 26)(external_value . 27)(identifier_opt . 28)(name .
29)(string_primary . 30)(string_list . 31)(term . 32))
nil
((with_clause . 15))
((project_qualifier_opt . 14))
nil
nil
nil
- ((project_declaration_opt . 48)(project_extension .
11)(simple_project_declaration . 12))
+ ((project_declaration_opt . 47)(project_extension .
11)(simple_project_declaration . 12))
nil
nil
- ((aggregate . 47))
((aggregate . 46))
- ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 26)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(string_list . 44)(term . 33))
- nil
- nil
+ ((aggregate . 45))
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 26)(external_value . 27)(identifier_opt . 28)(name .
29)(string_primary . 30)(string_list . 43)(term . 32))
nil
nil
nil
@@ -415,16 +410,16 @@
nil
nil
nil
- ((attribute_declaration . 60)(case_statement . 61)(declarative_item .
62)(declarative_items . 63)(declarative_items_opt . 64)(package_declaration .
65)(package_spec . 66)(package_extension . 67)(package_renaming .
68)(simple_declarative_item . 69)(typed_string_declaration . 70))
- ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 53)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(term . 33))
nil
+ ((attribute_declaration . 59)(case_statement . 60)(declarative_item .
61)(declarative_items . 62)(declarative_items_opt . 63)(package_declaration .
64)(package_spec . 65)(package_extension . 66)(package_renaming .
67)(simple_declarative_item . 68)(typed_string_declaration . 69))
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 52)(external_value . 27)(identifier_opt . 28)(name .
29)(string_primary . 30)(term . 32))
nil
- ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(external_value . 27)(identifier_opt . 28)(name . 29)(string_expression .
30)(string_primary . 31)(term . 51))
nil
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(external_value . 27)(identifier_opt . 28)(name . 29)(string_primary .
30)(term . 50))
nil
nil
- ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 26)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(string_list . 44)(term . 33))
nil
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 26)(external_value . 27)(identifier_opt . 28)(name .
29)(string_primary . 30)(string_list . 43)(term . 32))
nil
nil
nil
@@ -432,17 +427,17 @@
nil
nil
nil
- ((identifier_opt . 28)(name . 82))
nil
+ ((identifier_opt . 28)(name . 81))
nil
- ((identifier_opt . 78))
nil
+ ((identifier_opt . 77))
nil
nil
nil
nil
- ((attribute_declaration . 60)(case_statement . 61)(declarative_item .
74)(package_declaration . 65)(package_spec . 66)(package_extension .
67)(package_renaming . 68)(simple_declarative_item .
69)(typed_string_declaration . 70))
nil
+ ((attribute_declaration . 59)(case_statement . 60)(declarative_item .
73)(package_declaration . 64)(package_spec . 65)(package_extension .
66)(package_renaming . 67)(simple_declarative_item .
68)(typed_string_declaration . 69))
nil
nil
nil
@@ -450,12 +445,12 @@
nil
nil
nil
- ((attribute_declaration . 60)(case_statement . 61)(declarative_item .
62)(declarative_items . 63)(declarative_items_opt . 96)(package_declaration .
65)(package_spec . 66)(package_extension . 67)(package_renaming .
68)(simple_declarative_item . 69)(typed_string_declaration . 70))
- ((identifier_opt . 95))
nil
+ ((attribute_declaration . 59)(case_statement . 60)(declarative_item .
61)(declarative_items . 62)(declarative_items_opt . 95)(package_declaration .
64)(package_spec . 65)(package_extension . 66)(package_renaming .
67)(simple_declarative_item . 68)(typed_string_declaration . 69))
+ ((identifier_opt . 94))
nil
- ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 93)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(term . 33))
nil
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 92)(external_value . 27)(identifier_opt . 28)(name .
29)(string_primary . 30)(term . 32))
nil
nil
nil
@@ -463,21 +458,22 @@
nil
nil
nil
- ((case_item . 109)(case_items . 110))
nil
- ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 106)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(term . 33))
+ ((case_item . 110)(case_items . 111))
+ ((discrete_choice . 108))
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 105)(external_value . 27)(identifier_opt . 28)(name .
29)(string_primary . 30)(term . 32))
nil
- ((identifier_opt . 28)(name . 104))
- ((attribute_declaration . 60)(case_statement . 61)(declarative_item .
62)(declarative_items . 63)(declarative_items_opt . 103)(package_declaration .
65)(package_spec . 66)(package_extension . 67)(package_renaming .
68)(simple_declarative_item . 69)(typed_string_declaration . 70))
- ((identifier_opt . 28)(name . 102))
- ((aggregate . 101))
+ ((identifier_opt . 28)(name . 103))
+ ((attribute_declaration . 59)(case_statement . 60)(declarative_item .
61)(declarative_items . 62)(declarative_items_opt . 102)(package_declaration .
64)(package_spec . 65)(package_extension . 66)(package_renaming .
67)(simple_declarative_item . 68)(typed_string_declaration . 69))
+ ((identifier_opt . 28)(name . 101))
+ ((aggregate . 100))
nil
nil
nil
nil
- ((identifier_opt . 126))
+ ((identifier_opt . 125))
nil
- ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 125)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(term . 33))
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 124)(external_value . 27)(identifier_opt . 28)(name .
29)(string_primary . 30)(term . 32))
nil
nil
nil
@@ -486,11 +482,11 @@
nil
nil
nil
- ((discrete_choice . 116)(discrete_choice_list . 117))
nil
- ((case_item . 113))
nil
+ ((discrete_choice . 115)(discrete_choice_list . 116))
nil
+ ((case_item . 114))
nil
nil
nil
@@ -499,8 +495,8 @@
nil
nil
nil
- ((attribute_declaration . 60)(case_statement . 61)(declarative_item .
62)(declarative_items . 63)(declarative_items_opt . 130)(package_declaration .
65)(package_spec . 66)(package_extension . 67)(package_renaming .
68)(simple_declarative_item . 69)(typed_string_declaration . 70))
- ((identifier_opt . 129))
+ ((attribute_declaration . 59)(case_statement . 60)(declarative_item .
61)(declarative_items . 62)(declarative_items_opt . 129)(package_declaration .
64)(package_spec . 65)(package_extension . 66)(package_renaming .
67)(simple_declarative_item . 68)(typed_string_declaration . 69))
+ ((identifier_opt . 128))
nil
nil
nil
@@ -509,17 +505,17 @@
nil
nil
nil
- ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 140)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(term . 33))
- ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 139)(external_value . 27)(identifier_opt . 28)(name .
29)(string_expression . 30)(string_primary . 31)(term . 33))
- ((attribute_declaration . 60)(case_statement . 61)(declarative_item .
62)(declarative_items . 63)(declarative_items_opt . 138)(package_declaration .
65)(package_spec . 66)(package_extension . 67)(package_renaming .
68)(simple_declarative_item . 69)(typed_string_declaration . 70))
- ((discrete_choice . 137))
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 139)(external_value . 27)(identifier_opt . 28)(name .
29)(string_primary . 30)(term . 32))
+ ((aggregate . 23)(attribute_prefix . 24)(attribute_reference .
25)(expression . 138)(external_value . 27)(identifier_opt . 28)(name .
29)(string_primary . 30)(term . 32))
+ ((attribute_declaration . 59)(case_statement . 60)(declarative_item .
61)(declarative_items . 62)(declarative_items_opt . 137)(package_declaration .
64)(package_spec . 65)(package_extension . 66)(package_renaming .
67)(simple_declarative_item . 68)(typed_string_declaration . 69))
+ ((discrete_choice . 136))
nil
nil
nil
nil
nil
nil
- ((identifier_opt . 143))
+ ((identifier_opt . 142))
nil
nil
nil
diff --git a/packages/ada-mode/gpr-mode.el b/packages/ada-mode/gpr-mode.el
old mode 100644
new mode 100755
diff --git a/packages/ada-mode/gpr-mode.info b/packages/ada-mode/gpr-mode.info
index 5a5fc23..03c0a6c 100644
--- a/packages/ada-mode/gpr-mode.info
+++ b/packages/ada-mode/gpr-mode.info
@@ -1,4 +1,4 @@
-This is gpr-mode.info, produced by makeinfo version 6.1 from
+This is gpr-mode.info, produced by makeinfo version 6.3 from
gpr-mode.texi.
Copyright (C) 2013 Free Software Foundation, Inc.
diff --git a/packages/ada-mode/gpr-query.el b/packages/ada-mode/gpr-query.el
old mode 100644
new mode 100755
index 0e8e651..aedaae7
--- a/packages/ada-mode/gpr-query.el
+++ b/packages/ada-mode/gpr-query.el
@@ -3,7 +3,7 @@
;; gpr-query supports Ada and any gcc language that supports the
;; AdaCore -fdump-xref switch (which includes C, C++).
;;
-;; Copyright (C) 2013 - 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2013 - 2017 Free Software Foundation, Inc.
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
@@ -28,7 +28,7 @@
;;
;; M-x gpr-query
-(require 'ada-mode-compat-24.2)
+(require 'ada-mode-compat) ;; font-lock-ensure
(require 'ada-mode) ;; for ada-prj-*, some other things
(require 'gnat-core)
@@ -49,18 +49,57 @@
(process nil) ;; running gpr_query
(buffer nil)) ;; receives output of gpr_query
-(defconst gpr-query-buffer-name-prefix " *gpr_query-")
+;; Starting the buffer name with a space hides it from some lists, and
+;; also disables font-lock. We sometimes use it to display xref
+;; locations in compilation-mode, so we want font-lock enabled.
+;;
+;; IMPROVEME: copy the xref info to a true user buffer, optionally an
+;; *xref* buffer.
+(defconst gpr-query-buffer-name-prefix "*gpr_query-")
+
+(defgroup gpr-query nil
+ "Options for gpr-query."
+ :group 'tools)
+
+(defcustom gpr-query-mingw64-bin nil
+ "Path to mingw64 bin directory.
+On Windows systems, this directory is deleted from exec-path when launching
gpr-query.
+See comment in ‘gpr-queyr--start-process’."
+ :group 'gpr-query)
+
+(defcustom gpr-query-mingw32-bin nil
+ "Path to mingw32 bin directory.
+On Windows systems, this directory is added to exec-path when launching
gpr-query.
+See comment in ‘gpr-queyr--start-process’."
+ :group 'gpr-query)
(defun gpr-query--start-process (session)
"Start the session process running gpr_query."
(unless (buffer-live-p (gpr-query--session-buffer session))
;; user may have killed buffer
- (setf (gpr-query--session-buffer session) (gnat-run-buffer
gpr-query-buffer-name-prefix)))
+ (setf (gpr-query--session-buffer session) (gnat-run-buffer
gpr-query-buffer-name-prefix))
+ (with-current-buffer (gpr-query--session-buffer session)
+ (compilation-mode)
+ (setq buffer-read-only nil)))
(with-current-buffer (gpr-query--session-buffer session)
- (let ((process-environment (cl-copy-list (ada-prj-get 'proc_env))) ;; for
GPR_PROJECT_PATH
+ (let ((process-environment (cl-copy-list (ada-prj-get 'proc_env)))
+ ;; for GPR_PROJECT_PATH, other env vars set in ada-mode
+ ;; project files and used by gpr files.
(project-file (file-name-nondirectory (ada-prj-get 'gpr_file))))
+ (when (and (eq system-type 'windows-nt)
+ gpr-query-mingw64-bin
+ gpr-query-mingw32-bin)
+ ;; gpr_query is a 32 bit application (because Windows GNAT GPL
+ ;; only supports 32 bit), and for gnat gpl 2017 requires the
+ ;; libiconv mingw32 dll. On the other hand, Emacs is probably
+ ;; a 64 bit application, and requires the png mingw64 dll. So
+ ;; delete mingw64 from exec-path, and add mingw32.
+ (setq exec-path (delete gpr-query-mingw64-bin exec-path))
+ (push gpr-query-mingw32-bin exec-path)
+ )
+
(erase-buffer); delete any previous messages, prompt
(setf (gpr-query--session-process session)
(start-process (concat "gpr_query " (buffer-name))
@@ -87,7 +126,8 @@
"Create and return a session for the current project file."
(let ((session
(make-gpr-query--session
- :buffer (gnat-run-buffer gpr-query-buffer-name-prefix))))
+ :buffer nil
+ :process nil)))
(gpr-query--start-process session)
session))
@@ -229,7 +269,7 @@ Uses `gpr_query'. Returns new list."
;;
C:\Projects\GDS\work_dscovr_release\common\1553\gds-mil_std_1553-utf.ads:252:25
;;
/Projects/GDS/work_dscovr_release/common/1553/gds-mil_std_1553-utf.ads:252:25
"\\(\\(?:.:\\\\\\|/\\)[^:]*\\):\\([0123456789]+\\):\\([0123456789]+\\)"
- ;; 1 2 3
+ ;; 1 2 3
"Regexp matching <file>:<line>:<column>")
(defconst gpr-query-ident-file-regexp-alist
@@ -242,15 +282,18 @@ Uses `gpr_query'. Returns new list."
(defun gpr-query-compilation (identifier file line col cmd comp-err)
"Run gpr_query IDENTIFIER:FILE:LINE:COL CMD,
-set compilation-mode with compilation-error-regexp-alist set to COMP-ERR."
+with compilation-error-regexp-alist set to COMP-ERR."
;; Useful when gpr_query will return a list of references; the user
;; can navigate to each result in turn via `next-error'.
;; FIXME: implement ada-xref-full-path.
- (let ((cmd-1 (format "%s %s:%s:%d:%d" cmd identifier file line col))
+ ;;
+ ;; FIXME: implement append
+
+ ;; Emacs column is 0-indexed, gpr_query is 1-indexed.
+ (let ((cmd-1 (format "%s %s:%s:%d:%d" cmd identifier file line (1+ col)))
(result-count 0)
target-file target-line target-col)
(with-current-buffer (gpr-query--session-buffer (gpr-query-cached-session))
- (compilation-mode)
(setq buffer-read-only nil)
(set (make-local-variable 'compilation-error-regexp-alist) (list
comp-err))
(gpr-query-session-send cmd-1 t)
@@ -258,17 +301,8 @@ set compilation-mode with compilation-error-regexp-alist
set to COMP-ERR."
;; point is at EOB. gpr_query returns one line per result plus prompt,
warnings
(setq result-count (- (line-number-at-pos) 1))
- (font-lock-ensure)
- ;; pre Emacs 25, font-lock-ensure applies compilation-message
- ;; text properties
- ;;
- ;; post Emacs 25, compilation-next-error applies
- ;; compilation-message text properties on the fly via
- ;; compilation--ensure-parse. But that doesn't apply face text
- ;; properties.
- ;;
- ;; IMPROVEME: next-error works, but the font colors are not
- ;; right (bad regexp?)
+ (compilation--flush-parse (point-min) (point-max))
+ (compilation--ensure-parse (point-max))
(goto-char (point-min))
(cond
@@ -287,7 +321,6 @@ set compilation-mode with compilation-error-regexp-alist
set to COMP-ERR."
;; fetch the compilation-message while in the
;; session-buffer. and call ada-goot-source outside the
;; with-current-buffer above.
- (compilation--ensure-parse (point-max))
(let* ((msg (compilation-next-error 0))
;; IMPROVEME: '--' indicates internal-only. But we can't
;; use compile-goto-error, because that displays the
@@ -335,7 +368,7 @@ set compilation-mode with compilation-error-regexp-alist
set to COMP-ERR."
(thing-at-point 'symbol)
(file-name-nondirectory (buffer-file-name))
(line-number-at-pos)
- (1+ (current-column)))
+ (current-column))
)
(defun gpr-query-overridden (other-window)
@@ -351,7 +384,7 @@ buffer in another window."
(line-number-at-pos)
(save-excursion
(goto-char (car (bounds-of-thing-at-point 'symbol)))
- (1+ (current-column)))
+ (current-column))
)))
(ada-goto-source (nth 0 target)
@@ -376,7 +409,7 @@ buffer in another window."
(line-number-at-pos)
(save-excursion
(goto-char (car (bounds-of-thing-at-point 'symbol)))
- (1+ (current-column)))
+ (current-column))
)))
(ada-goto-source (nth 0 target)
@@ -438,23 +471,25 @@ Enable mode if ARG is positive."
(gpr-query--start-process session)))
(defun gpr-query-other (identifier file line col)
- "For `ada-xref-other-function', using gpr_query."
+ "For `ada-xref-other-function', using gpr_query.
+FILE must be non-nil; line, col can be nil."
(when (eq ?\" (aref identifier 0))
;; gpr_query wants the quotes stripped
(setq col (+ 1 col))
(setq identifier (substring identifier 1 (1- (length identifier))))
)
- (when (eq system-type 'windows-nt)
- ;; Since Windows file system is case insensitive, GNAT and Emacs
- ;; can disagree on the case, so convert all to lowercase.
- (setq file (downcase file)))
+ (setq file (gpr-query--normalize-filename file))
- (let ((cmd (format "refs %s:%s:%d:%d" identifier (file-name-nondirectory
file) line col))
+ (let ((cmd (format "refs %s:%s:%s:%s"
+ identifier
+ (file-name-nondirectory file)
+ (or line "")
+ (if col (1+ col) "")))
(decl-loc nil)
(body-loc nil)
(search-type nil)
- (min-distance (1- (expt 2 29)))
+ (min-distance most-positive-fixnum)
(result nil))
(with-current-buffer (gpr-query-session-send cmd t)
@@ -492,29 +527,30 @@ Enable mode if ARG is positive."
(found-line (string-to-number (match-string 2)))
(found-col (string-to-number (match-string 3)))
(found-type (match-string 4))
- (dist (gpr-query-dist found-line line found-col col))
+ (dist (if (and line col)
+ (gpr-query-dist found-line line found-col col)
+ most-positive-fixnum))
)
- (when (eq system-type 'windows-nt)
- ;; 'expand-file-name' converts Windows directory
- ;; separators to normal Emacs. Since Windows file
- ;; system is case insensitive, GNAT and Emacs can
- ;; disagree on the case, so convert all to lowercase.
- (setq found-file (downcase (expand-file-name found-file))))
+ (setq found-file (gpr-query--normalize-filename found-file))
- (when (string-equal found-type "declaration")
+ (cond
+ ((string-equal found-type "declaration")
(setq decl-loc (list found-file found-line (1- found-col))))
- (when (or
- (string-equal found-type "body")
- (string-equal found-type "full declaration"))
+ ((or
+ (string-equal found-type "body")
+ (string-equal found-type "full declaration"))
(setq body-loc (list found-file found-line (1- found-col))))
-
- (when
- ;; The source may have changed since the xref database
- ;; was computed, so allow for fuzzy matches.
- (and (equal found-file file)
- (< dist min-distance))
+ )
+
+ (when (and (equal found-file file)
+ (or
+ (string-equal found-type "body")
+ (string-equal found-type "declaration"))
+ (<= dist min-distance))
+ ;; The source may have changed since the xref database
+ ;; was computed, so allow for fuzzy matches.
(setq min-distance dist)
(setq search-type found-type))
))
@@ -537,12 +573,26 @@ Enable mode if ARG is positive."
)
(cond
- ((null search-type)
- nil)
-
((and
+ line
(string-equal search-type "declaration")
body-loc)
+ ;; We started the search on the declaration; find the body
+ (setq result body-loc))
+
+ ((and
+ (not line)
+ (string-equal search-type "declaration"))
+ ;; We started in the spec file; find the declaration
+ ;;
+ ;; If the file has both declaration and body, this will go to
+ ;; declaration. Then a search with line, col can go to body.
+ (setq result decl-loc))
+
+ ((and
+ (not line)
+ (string-equal search-type "body"))
+ ;; We started in the body file; find the body
(setq result body-loc))
(decl-loc
@@ -555,9 +605,9 @@ Enable mode if ARG is positive."
(message "parsing result ... done")
result)))
-(defun gpr-query-all (identifier file line col _local-only)
+(defun gpr-query-all (identifier file line col &optional _local-only _append)
"For `ada-xref-all-function', using gpr_query."
- ;; FIXME: implement local-only
+ ;; FIXME: implement local-only, append
(gpr-query-compilation identifier file line col "refs"
'gpr-query-ident-file))
(defun gpr-query-parents (identifier file line col)
@@ -576,7 +626,7 @@ Enable mode if ARG is positive."
(setq identifier (substring identifier 1 (1- (length identifier))))
)
- (let ((cmd (format "overridden %s:%s:%d:%d" identifier
(file-name-nondirectory file) line col))
+ (let ((cmd (format "overridden %s:%s:%d:%d" identifier
(file-name-nondirectory file) line (1+ col)))
result)
(with-current-buffer (gpr-query-session-send cmd t)
@@ -594,6 +644,20 @@ Enable mode if ARG is positive."
(message "parsing result ... done")
result)))
+(defun gpr-query--normalize-filename (file)
+ "Takes account of filesystem differences."
+ (when (eq system-type 'windows-nt)
+ ;; 'expand-file-name' converts Windows directory
+ ;; separators to normal Emacs. Since Windows file
+ ;; system is case insensitive, GNAT and Emacs can
+ ;; disagree on the case, so convert all to lowercase.
+ (setq file (downcase (expand-file-name file))))
+ (when (eq system-type 'darwin)
+ ;; case-insensitive case-preserving; so just downcase
+ (setq file (downcase file)))
+ file
+ )
+
(defun ada-gpr-query-select-prj ()
(setq ada-file-name-from-ada-name 'ada-gnat-file-name-from-ada-name)
(setq ada-ada-name-from-file-name 'ada-gnat-ada-name-from-file-name)
diff --git a/packages/ada-mode/gpr_query-process_refresh.adb.gp
b/packages/ada-mode/gpr_query-process_refresh.adb.gp
new file mode 100755
index 0000000..72ccbfc
--- /dev/null
+++ b/packages/ada-mode/gpr_query-process_refresh.adb.gp
@@ -0,0 +1,33 @@
+-- Abstract :
+--
+-- body compatible with either GNAT GPL 2016 or GNAT GPL 2017
+--
+-- Copyright (C) 2017 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
+-- Software Foundation; either version 3, or (at your option) any later
+-- version. This library is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN-
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+pragma License (GPL);
+separate (Gpr_Query)
+procedure Process_Refresh (Args : GNATCOLL.Arg_Lists.Arg_List)
+is
+ use type GNATCOLL.Projects.Project_Environment_Access;
+ pragma Unreferenced (Args);
+begin
+ Parse_All_LI_Files
+ (Self => Xref,
+#if GNAT_VERSION="GPL_2016"
+ Tree => Tree,
+#end if;
+ Project => Tree.Root_Project,
+ Parse_Runtime_Files => False, -- True encounters bug in
gnatcoll.projects; null pointer
+ Show_Progress => Progress_Reporter,
+ ALI_Encoding => ALI_Encoding.all,
+ From_DB_Name => Nightly_DB_Name.all,
+ To_DB_Name => DB_Name.all,
+ Force_Refresh => Force_Refresh);
+end Process_Refresh;
diff --git a/packages/ada-mode/gpr_query.adb b/packages/ada-mode/gpr_query.adb
index 3307aaf..9fcd2fc 100755
--- a/packages/ada-mode/gpr_query.adb
+++ b/packages/ada-mode/gpr_query.adb
@@ -5,7 +5,7 @@
--
-- requires gnatcoll 1.7w 20140330, gnat 7.2.1
--
--- Copyright (C) 2014-2016 Free Software Foundation All Rights Reserved.
+-- Copyright (C) 2014-2017 Free Software Foundation 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
@@ -43,7 +43,6 @@ with GNATCOLL.Utils;
with GNATCOLL.VFS;
with GNATCOLL.VFS_Utils;
with GNATCOLL.Xref;
-with Prj;
procedure Gpr_Query is
use GNATCOLL;
@@ -320,7 +319,6 @@ procedure Gpr_Query is
elsif GNATCOLL.Xref.Is_Fuzzy_Match (Ref.Entity) then
Ada.Text_IO.Put_Line ("warning: fuzzy match for the entity");
- -- FIXME: gnat-query.el look for this, prompt for reparse?
end if;
return Ref.Entity;
@@ -439,21 +437,8 @@ procedure Gpr_Query is
Put (Dirs);
end Process_Project_Path;
- procedure Process_Refresh (Args : GNATCOLL.Arg_Lists.Arg_List)
- is
- use type GNATCOLL.Projects.Project_Environment_Access;
- pragma Unreferenced (Args);
- begin
- Xref.Parse_All_LI_Files
- (Tree => Tree,
- Project => Tree.Root_Project,
- Parse_Runtime_Files => False, -- True encounters bug in
gnatcoll.projects; null pointer
- Show_Progress => Progress_Reporter,
- ALI_Encoding => ALI_Encoding.all,
- From_DB_Name => Nightly_DB_Name.all,
- To_DB_Name => DB_Name.all,
- Force_Refresh => Force_Refresh);
- end Process_Refresh;
+ procedure Process_Refresh (Args : GNATCOLL.Arg_Lists.Arg_List) is separate;
+ -- Requires different code for GNAT GPL 2016 vs 2017
procedure Process_Refs (Args : GNATCOLL.Arg_Lists.Arg_List)
is
@@ -551,7 +536,7 @@ begin
(Cmdline,
Output => Traces_Config_File'Access,
Long_Switch => "--tracefile=",
- Help => "Specify a traces configuration file");
+ Help => "Specify a traces configuration file, set projects lib
verbose");
Getopt (Cmdline, Callback => null);
end;
@@ -568,9 +553,6 @@ begin
(Filename => Traces_Config_File.all,
Force_Activation => False);
Trace (Me, "trace enabled");
-
- -- Prj.* not controlled by Traces
- Prj.Current_Verbosity := Prj.High;
end if;
GNATCOLL.Projects.Initialize (Env); -- for register_default_language
diff --git a/packages/ada-mode/gpr_query.gpr
b/packages/ada-mode/gpr_query.gpr.gp
similarity index 97%
rename from packages/ada-mode/gpr_query.gpr
rename to packages/ada-mode/gpr_query.gpr.gp
index 6e57ee1..ef39dce 100755
--- a/packages/ada-mode/gpr_query.gpr
+++ b/packages/ada-mode/gpr_query.gpr.gp
@@ -18,6 +18,9 @@
with "gnatcoll";
with "gnatcoll_sqlite";
+#if GNAT_VERSION="GPL_2017"
+with "gnatcoll_xref";
+#end if;
with "gnat_util";
project Gpr_query is
for Main use ("gpr_query.adb");
diff --git a/packages/ada-mode/gps_source/ada_analyzer.adb
b/packages/ada-mode/gps_source/ada_analyzer.adb
new file mode 100755
index 0000000..b08cb4e
--- /dev/null
+++ b/packages/ada-mode/gps_source/ada_analyzer.adb
@@ -0,0 +1,4834 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2001-2017, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+with Ada.Characters.Handling; use Ada.Characters.Handling;
+
+with GNAT.Regpat; use GNAT.Regpat;
+
+with Generic_Stack;
+with Indent_Stack;
+with String_Utils; use String_Utils;
+
+with GNATCOLL.Traces; use GNATCOLL.Traces;
+with GNATCOLL.Utils; use GNATCOLL.Utils;
+with UTF8_Utils; use UTF8_Utils;
+
+package body Ada_Analyzer is
+
+ Me : constant Trace_Handle := Create ("LANGUAGE.ADA_ANALYZER", On);
+
+ use Indent_Stack.Stack;
+
+ -----------------
+ -- Local types --
+ -----------------
+
+ type Token_Type is
+ (
+ -- Token name Token type Class(es)
+
+ Tok_Integer_Literal, -- numeric lit Literal, Lit_Or_Name
+
+ Tok_String_Literal, -- string lit Literal. Lit_Or_Name
+
+ Tok_Char_Literal, -- char lit Name, Literal. Lit_Or_Name
+
+ Tok_Operator_Symbol, -- op symbol Name, Literal, Lit_Or_Name, Desig
+
+ Tok_Identifier, -- identifer Name, Lit_Or_Name, Desig
+
+ Tok_Double_Asterisk, -- **
+
+ Tok_Minus, -- - Binary_Addop, Unary_Addop
+ Tok_Plus, -- + Binary_Addop, Unary_Addop
+
+ Tok_Asterisk, -- * Mulop
+ Tok_Slash, -- / Mulop
+
+ Tok_Dot, -- . Namext
+ Tok_Apostrophe, -- ' Namext
+
+ Tok_Right_Paren, -- ) Sterm
+ Tok_Comma, -- , Sterm
+
+ Tok_Less, -- < Relop, Sterm
+ Tok_Equal, -- = Relop, Sterm
+ Tok_Greater, -- > Relop, Sterm
+ Tok_Not_Equal, -- /= Relop, Sterm
+ Tok_Greater_Equal, -- >= Relop, Sterm
+ Tok_Less_Equal, -- <= Relop, Sterm
+
+ Tok_Box, -- <> Relop, Eterm, Sterm
+ Tok_Colon_Equal, -- := Eterm, Sterm
+
+ Tok_Abstract, -- ABSTRACT Eterm, Sterm
+ Tok_Access, -- ACCESS Eterm, Sterm
+ Tok_Aliased, -- ALIASED Eterm, Sterm
+ Tok_All, -- ALL Eterm, Sterm
+ Tok_Array, -- ARRAY Eterm, Sterm
+ Tok_At, -- AT Eterm, Sterm
+
+ Tok_Mod, -- MOD Mulop
+ Tok_Rem, -- REM Mulop
+
+ Tok_And, -- AND Logop, Sterm
+
+ Tok_Delta, -- DELTA Atkwd, Sterm, Consk
+ Tok_Digits, -- DIGITS Atkwd, Sterm, Consk
+ Tok_Range, -- RANGE Atkwd, Sterm, Consk
+
+ Tok_Abs, -- ABS
+ Tok_New, -- NEW
+ Tok_Null, -- NULL
+ Tok_Others, -- OTHERS
+
+ Tok_In, -- IN Relop, Sterm
+ Tok_Not, -- NOT Relop, Sterm
+
+ Tok_Or, -- OR Logop, Sterm
+ Tok_Xor, -- XOR Logop, Sterm
+
+ Tok_Body, -- BODY Eterm, Sterm
+ Tok_Constant, -- CONSTANT Eterm, Sterm
+ Tok_Limited, -- LIMITED Eterm, Sterm
+ Tok_Of, -- OF Eterm, Sterm
+ Tok_Out, -- OUT Eterm, Sterm
+ Tok_Renames, -- RENAMES Eterm, Sterm
+ Tok_Reverse, -- REVERSE Eterm, Sterm
+ Tok_Some, -- SOME Eterm, Sterm
+ Tok_Tagged, -- TAGGED Eterm, Sterm
+
+ Tok_Case, -- CASE Eterm, Sterm, After_SM
+ Tok_Delay, -- DELAY Eterm, Sterm, After_SM
+
+ Tok_Accept, -- ACCEPT Eterm, Sterm, After_SM
+ Tok_Elsif, -- ELSIF Eterm, Sterm, After_SM
+ Tok_End, -- END Eterm, Sterm, After_SM
+ Tok_Exit, -- EXIT Eterm, Sterm, After_SM
+ Tok_Goto, -- GOTO Eterm, Sterm, After_SM
+ Tok_If, -- IF Eterm, Sterm, After_SM
+ Tok_Pragma, -- PRAGMA Eterm, Sterm, After_SM
+ Tok_Raise, -- RAISE Eterm, Sterm, After_SM
+ Tok_Requeue, -- REQUEUE Eterm, Sterm, After_SM
+ Tok_Return, -- RETURN Eterm, Sterm, After_SM
+ Tok_Terminate, -- TERMINATE Eterm, Sterm, After_SM
+ Tok_Until, -- UNTIL Eterm, Sterm, After_SM
+ Tok_When, -- WHEN Eterm, Sterm, After_SM
+
+ Tok_For, -- FOR Eterm, Sterm, After_SM, Labeled_Stmt
+ Tok_While, -- WHILE Eterm, Sterm, After_SM, Labeled_Stmt
+
+ Tok_Separate, -- SEPARATE Eterm, Sterm, Cunit, After_SM
+
+ Tok_Entry, -- ENTRY Eterm, Sterm, Declk, Deckn, After_SM
+ Tok_Protected, -- PROTECTED Eterm, Sterm, Declk, Deckn, After_SM
+ Tok_Task, -- TASK Eterm, Sterm, Declk, Deckn, After_SM
+ Tok_Type, -- TYPE Eterm, Sterm, Declk, Deckn, After_SM
+ Tok_Subtype, -- SUBTYPE Eterm, Sterm, Declk, Deckn, After_SM
+ Tok_Overriding, -- OVERRIDING Eterm, Sterm, Declk, Declk, After_SM
+ Tok_Synchronized, -- SYNCHRONIZED Eterm, Sterm, Declk, Deckn, After_SM
+ Tok_Use, -- USE Eterm, Sterm, Declk, Deckn, After_SM
+
+ Tok_Generic, -- GENERIC Eterm, Sterm, Cunit, Declk, After_SM
+
+ Tok_Function, -- FUNCTION Eterm, Sterm, Cunit, Declk, After_SM
+ Tok_Package, -- PACKAGE Eterm, Sterm, Cunit, Declk, After_SM
+ Tok_Procedure, -- PROCEDURE Eterm, Sterm, Cunit, Declk, After_SM
+
+ Tok_Do, -- DO Eterm, Sterm
+ Tok_Is, -- IS Eterm, Sterm
+ Tok_Interface, -- INTERFACE Eterm, Sterm
+ Tok_Record, -- RECORD Eterm, Sterm
+ Tok_Then, -- THEN Eterm, Sterm
+
+ Tok_Abort, -- ABORT Eterm, Sterm, After_SM
+ Tok_Else, -- ELSE Eterm, Sterm, After_SM
+ Tok_Exception, -- EXCEPTION Eterm, Sterm, After_SM
+
+ Tok_Select, -- SELECT Eterm, Sterm, After_SM
+
+ Tok_Begin, -- BEGIN Eterm, Sterm, After_SM, Labeled_Stmt
+ Tok_Declare, -- DECLARE Eterm, Sterm, After_SM, Labeled_Stmt
+ Tok_Loop, -- LOOP Eterm, Sterm, After_SM, Labeled_Stmt
+
+ Tok_Private, -- PRIVATE Eterm, Sterm, Cunit, After_SM
+ Tok_With, -- WITH Eterm, Sterm, Cunit, After_SM
+
+ Tok_Semicolon, -- ; Eterm, Sterm, Cterm
+
+ Tok_Left_Paren, -- ( Namext, Consk
+
+ Tok_Ampersand, -- & Binary_Addop
+
+ Tok_Vertical_Bar, -- | Cterm, Sterm, Chtok
+
+ Tok_Less_Less, -- << Eterm, Sterm, After_SM
+ Tok_Greater_Greater, -- >> Eterm, Sterm
+
+ Tok_Pound, -- # sign, used by the preprocessor
+
+ Tok_Left_Square_Bracket, -- '[' used in wide character encoding
+ Tok_Right_Square_Bracket, -- ']' used in wide character encoding
+
+ Tok_Colon, -- : Eterm, Sterm
+
+ Tok_Arrow, -- => Sterm, Cterm, Chtok
+
+ Tok_Dot_Dot, -- .. Sterm, Chtok
+
+ No_Token);
+ -- No_Token is used for initializing Token values to indicate that
+ -- no value has been set yet.
+
+ type Token_Set is array (Token_Type) of Boolean;
+ pragma Pack (Token_Set);
+
+ subtype Reserved_Token_Type is Token_Type range Tok_Abstract .. Tok_With;
+
+ subtype Token_Class_Literal is
+ Token_Type range Tok_Integer_Literal .. Tok_Operator_Symbol;
+ -- Literal
+
+ subtype Token_Class_Declk is
+ Token_Type range Tok_Entry .. Tok_Procedure;
+ -- Keywords which start a declaration
+
+ subtype Token_Class_No_Cont is Token_Type range Tok_Generic .. Tok_Colon;
+ -- Do not allow a following continuation line
+
+ Is_Operator : constant Token_Set :=
+ (Tok_Double_Asterisk |
+ Tok_Minus |
+ Tok_Plus |
+ Tok_Asterisk |
+ Tok_Slash |
+ Tok_Less |
+ Tok_Equal |
+ Tok_Greater |
+ Tok_Not_Equal |
+ Tok_Greater_Equal |
+ Tok_Less_Equal |
+ Tok_Ampersand => True,
+ others => False);
+
+ Is_Extended_Operator : constant Token_Set :=
+ (Tok_Double_Asterisk .. Tok_Slash |
+ Tok_Comma .. Tok_Colon_Equal |
+ Tok_Semicolon |
+ Tok_Ampersand .. Tok_Greater_Greater |
+ Tok_Colon .. Tok_Dot_Dot => True,
+ others => False);
+
+ Max_Identifier : constant := 256;
+ -- Maximum length of an identifier
+
+ type Variable_Kind_Type is
+ (Unknown_Kind, Parameter_Kind, Discriminant_Kind);
+
+ type Extended_Token is record
+ Token : Token_Type := No_Token;
+ -- Enclosing token
+
+ In_Declaration : Boolean := False;
+ -- Are we inside a declarative part ?
+
+ In_Entity_Profile : Boolean := True;
+ -- Are we in a definition?
+ -- (e.g. [procedure bla] is
+ -- [type T is record] null; end record;
+ -- etc...
+
+ Extra_Indent : Boolean := False;
+ -- Used for various kinds of constructs, when detecting different
+ -- ways of indenting code (only used internally).
+ -- For a Tok_Record, set to True if the keyword "record" was found on
+ -- its own line.
+ -- For a Tok_Case, set to True if 'when' constructs should be indented
+ -- an extra level, as for the RM style.
+
+ Type_Declaration : Boolean := False;
+ -- Is it a type declaration ?
+
+ Package_Declaration : Boolean := False;
+ -- Is it a package declaration ?
+
+ Protected_Declaration : Boolean := False;
+ -- Is this a protected declaration ?
+
+ -- ??? It would be nice to merge the fields Declaration,
+ -- Type_Declaration and Package_Declaration at some point.
+
+ Identifier : String (1 .. Max_Identifier);
+ -- Name of the enclosing token
+ -- The actual name is Identifier (1 .. Ident_Len)
+
+ Ident_Len : Natural := 0;
+ -- Actual length of Indentifier
+
+ Profile_Start : Natural := 0;
+ -- Position in the buffer where the profile of the current subprogram
+ -- starts.
+
+ Profile_End : Natural := 0;
+ -- Position in the buffer where the profile of the current subprogram
+ -- ends.
+
+ Align_Colon : Natural := 0;
+ -- The column on which to align declarations
+
+ Colon_Col : Natural := 0;
+ -- The column where the last ':' was found.
+ -- Only relevant for Tok_Colon tokens
+
+ Sloc : Source_Location;
+ -- Source location for this entity
+
+ Sloc_Name : Source_Location;
+ -- Source location for the name of this entity, if relevant
+
+ Visibility : Construct_Visibility := Visibility_Public;
+ -- Is the token public or private ?
+
+ Visibility_Section : Construct_Visibility := Visibility_Public;
+ -- Are we on the public or on the private section of the token ?
+
+ Variable_Kind : Variable_Kind_Type := Unknown_Kind;
+ -- If the token is a variable, hold wether this is actually a variable,
+ -- a discriminant or a parameter
+
+ Type_Definition_Section : Boolean := False;
+ -- Are we currently processing the type definition of the token ?
+
+ Is_In_Type_Definition : Boolean := False;
+ -- Is this token found in the type definition section of its parent ?
+
+ Attributes : Construct_Attribute_Map := No_Attribute;
+ -- Defines the attributes that have been found for the given token
+
+ Is_Generic_Param : Boolean := False;
+ -- Is this token a generic parameter?
+ end record;
+ -- Extended information for a token
+
+ package Token_Stack is new Generic_Stack (Extended_Token);
+ use Token_Stack;
+
+ type Construct_Type is
+ (Conditional,
+ Type_Declaration,
+ Function_Call,
+ Aggregate);
+ -- Type used to differentiate different constructs to refine indentation
+
+ package Construct_Stack is new Generic_Stack (Construct_Type);
+ use Construct_Stack;
+
+ ----------------------
+ -- Local procedures --
+ ----------------------
+
+ function Get_Token
+ (Str : String; Prev_Token : Token_Type) return Token_Type;
+ -- Return a token_Type given a string.
+ -- For efficiency, S is assumed to start at index 1.
+ -- Prev_Token is the previous token scanned, if any. This is needed
+ -- to e.g. differenciate pragma Interface vs interface keyword.
+
+ function Is_Library_Level (Stack : Token_Stack.Simple_Stack) return Boolean;
+ -- Return True if the current scope in Stack is a library level package
+
+ ---------------
+ -- Get_Token --
+ ---------------
+
+ function Get_Token
+ (Str : String; Prev_Token : Token_Type) return Token_Type
+ is
+ S : String (Str'Range);
+ begin
+ pragma Assert (S'First = 1);
+
+ -- First convert Str to lower case for the token parser below
+
+ for K in Str'Range loop
+ S (K) := To_Lower (Str (K));
+ end loop;
+
+ if S'Length = 0 then
+ return No_Token;
+
+ elsif S'Length = 1 then
+ if Is_Control (S (S'First)) then
+ return No_Token;
+ else
+ return Tok_Identifier;
+ end if;
+ end if;
+
+ -- Use a case statement instead of a loop for efficiency
+
+ case S (1) is
+ when 'a' =>
+ case S (2) is
+ when 'b' =>
+ if S (3 .. S'Last) = "ort" then
+ return Tok_Abort;
+ elsif S (3 .. S'Last) = "s" then
+ return Tok_Abs;
+ elsif S (3 .. S'Last) = "stract" then
+ return Tok_Abstract;
+ end if;
+
+ when 'c' =>
+ if S (3 .. S'Last) = "cept" then
+ return Tok_Accept;
+ elsif S (3 .. S'Last) = "cess" then
+ return Tok_Access;
+ end if;
+
+ when 'l' =>
+ if S (3 .. S'Last) = "l" then
+ return Tok_All;
+ elsif S (3 .. S'Last) = "iased" then
+ return Tok_Aliased;
+ end if;
+
+ when 'n' =>
+ if S (3 .. S'Last) = "d" then
+ return Tok_And;
+ end if;
+
+ when 'r' =>
+ if S (3 .. S'Last) = "ray" then
+ return Tok_Array;
+ end if;
+
+ when 't' =>
+ if S'Length = 2 then
+ return Tok_At;
+ end if;
+
+ when others =>
+ return Tok_Identifier;
+ end case;
+
+ when 'b' =>
+ if S (2 .. S'Last) = "egin" then
+ return Tok_Begin;
+ elsif S (2 .. S'Last) = "ody" then
+ return Tok_Body;
+ end if;
+
+ when 'c' =>
+ if S (2 .. S'Last) = "ase" then
+ return Tok_Case;
+ elsif S (2 .. S'Last) = "onstant" then
+ return Tok_Constant;
+ end if;
+
+ when 'd' =>
+ if S (2) = 'e' then
+ if S (3 .. S'Last) = "clare" then
+ return Tok_Declare;
+ elsif S (3 .. S'Last) = "lay" then
+ return Tok_Delay;
+ elsif S (3 .. S'Last) = "lta" then
+ return Tok_Delta;
+ end if;
+
+ elsif S (2 .. S'Last) = "igits" then
+ return Tok_Digits;
+ elsif S (2 .. S'Last) = "o" then
+ return Tok_Do;
+ end if;
+
+ when 'e' =>
+ if S (2 .. S'Last) = "lse" then
+ return Tok_Else;
+ elsif S (2 .. S'Last) = "lsif" then
+ return Tok_Elsif;
+ elsif S (2 .. S'Last) = "nd" then
+ return Tok_End;
+ elsif S (2 .. S'Last) = "ntry" then
+ return Tok_Entry;
+ elsif S (2 .. S'Last) = "xception" then
+ return Tok_Exception;
+ elsif S (2 .. S'Last) = "xit" then
+ return Tok_Exit;
+ end if;
+
+ when 'f' =>
+ if S (2 .. S'Last) = "or" then
+ return Tok_For;
+ elsif S (2 .. S'Last) = "unction" then
+ return Tok_Function;
+ end if;
+
+ when 'g' =>
+ if S (2 .. S'Last) = "eneric" then
+ return Tok_Generic;
+ elsif S (2 .. S'Last) = "oto" then
+ return Tok_Goto;
+ end if;
+
+ when 'i' =>
+ if S (2 .. S'Last) = "f" then
+ return Tok_If;
+ elsif S (2 .. S'Last) = "n" then
+ return Tok_In;
+ elsif S (2 .. S'Last) = "nterface" then
+ if Prev_Token = Tok_Pragma then
+ return Tok_Identifier;
+ else
+ return Tok_Interface;
+ end if;
+
+ elsif S (2 .. S'Last) = "s" then
+ return Tok_Is;
+ end if;
+
+ when 'l' =>
+ if S (2 .. S'Last) = "imited" then
+ return Tok_Limited;
+ elsif S (2 .. S'Last) = "oop" then
+ return Tok_Loop;
+ end if;
+
+ when 'm' =>
+ if S (2 .. S'Last) = "od" then
+ return Tok_Mod;
+ end if;
+
+ when 'n' =>
+ if S (2 .. S'Last) = "ew" then
+ return Tok_New;
+ elsif S (2 .. S'Last) = "ot" then
+ return Tok_Not;
+ elsif S (2 .. S'Last) = "ull" then
+ return Tok_Null;
+ end if;
+
+ when 'o' =>
+ if S (2 .. S'Last) = "thers" then
+ return Tok_Others;
+ elsif S (2 .. S'Last) = "ut" then
+ return Tok_Out;
+ elsif S (2 .. S'Last) = "f" then
+ return Tok_Of;
+ elsif S (2 .. S'Last) = "r" then
+ return Tok_Or;
+ elsif S (2 .. S'Last) = "verriding" then
+ return Tok_Overriding;
+ end if;
+
+ when 'p' =>
+ if S (2) = 'r' then
+ if S (3 .. S'Last) = "agma" then
+ return Tok_Pragma;
+ elsif S (3 .. S'Last) = "ivate" then
+ return Tok_Private;
+ elsif S (3 .. S'Last) = "ocedure" then
+ return Tok_Procedure;
+ elsif S (3 .. S'Last) = "otected" then
+ return Tok_Protected;
+ end if;
+
+ elsif S (2 .. S'Last) = "ackage" then
+ return Tok_Package;
+ end if;
+
+ when 'r' =>
+ if S (2) = 'a' then
+ if S (3 .. S'Last) = "ise" then
+ return Tok_Raise;
+ elsif S (3 .. S'Last) = "nge" then
+ return Tok_Range;
+ end if;
+
+ elsif S (2) = 'e' then
+ if S (3 .. S'Last) = "cord" then
+ return Tok_Record;
+ elsif S (3 .. S'Last) = "m" then
+ return Tok_Rem;
+ elsif S (3 .. S'Last) = "names" then
+ return Tok_Renames;
+ elsif S (3 .. S'Last) = "queue" then
+ return Tok_Requeue;
+ elsif S (3 .. S'Last) = "turn" then
+ return Tok_Return;
+ elsif S (3 .. S'Last) = "verse" then
+ return Tok_Reverse;
+ end if;
+ end if;
+
+ when 's' =>
+ if S (2 .. S'Last) = "elect" then
+ return Tok_Select;
+ elsif S (2 .. S'Last) = "eparate" then
+ return Tok_Separate;
+ elsif S (2 .. S'Last) = "ome" then
+ if Prev_Token = Tok_For then
+ return Tok_Some;
+ else
+ return Tok_Identifier;
+ end if;
+ elsif S (2 .. S'Last) = "ubtype" then
+ return Tok_Subtype;
+ elsif S (2 .. S'Last) = "ynchronized" then
+ return Tok_Synchronized;
+ end if;
+
+ when 't' =>
+ if S (2 .. S'Last) = "agged" then
+ return Tok_Tagged;
+ elsif S (2 .. S'Last) = "ask" then
+ return Tok_Task;
+ elsif S (2 .. S'Last) = "erminate" then
+ return Tok_Terminate;
+ elsif S (2 .. S'Last) = "hen" then
+ return Tok_Then;
+ elsif S (2 .. S'Last) = "ype" then
+ return Tok_Type;
+ end if;
+
+ when 'u' =>
+ if S (2 .. S'Last) = "ntil" then
+ return Tok_Until;
+ elsif S (2 .. S'Last) = "se" then
+ return Tok_Use;
+ end if;
+
+ when 'w' =>
+ if S (2 .. S'Last) = "hen" then
+ return Tok_When;
+ elsif S (2 .. S'Last) = "hile" then
+ return Tok_While;
+ elsif S (2 .. S'Last) = "ith" then
+ return Tok_With;
+ end if;
+
+ when 'x' =>
+ if S (2 .. S'Last) = "or" then
+ return Tok_Xor;
+ end if;
+
+ when others =>
+ return Tok_Identifier;
+ end case;
+
+ return Tok_Identifier;
+ end Get_Token;
+
+ ----------------------
+ -- Is_Library_Level --
+ ----------------------
+
+ function Is_Library_Level
+ (Stack : Token_Stack.Simple_Stack) return Boolean
+ is
+ Result : Boolean := True;
+
+ function Check_Token (Token : Extended_Token) return Boolean;
+
+ function Check_Token (Token : Extended_Token) return Boolean is
+ begin
+ if Token.Token /= No_Token
+ and then Token.Token /= Tok_Package
+ and then Token.Token /= Tok_Generic
+ then
+ Result := False;
+ return False;
+ end if;
+
+ return True;
+ end Check_Token;
+
+ begin
+ Traverse_Stack (Stack, Check_Token'Access);
+ return Result;
+ end Is_Library_Level;
+
+ ------------------------
+ -- Analyze_Ada_Source --
+ ------------------------
+
+ SPARK_Keywords : constant Pattern_Matcher := Compile
+ ("^(a(bs|ll|nd|ss(ert|ume))|check|derives|e(lse|nd)|" &
+ "f(or|rom|unction)|global|" &
+ "h(ide|old)|i(n|s)|in(herit|itializes|variant)|" &
+ "main_program|n(ot|ull)|o(r|wn|thers)|post|pre|some|" &
+ "a(ccept|re_interchangeable|s|ssume)|const|div|" &
+ "element|fi(nish|rst)|for_(all|some)|goal|" &
+ "last|may_be_(deduced|deduced_from|" &
+ "replaced_by)|no(n(first|last)|t_in)|o(dd|ut)|" &
+ "p(ending|red|roof)|r(ange|e(al|quires|turn|m))|s(ave|" &
+ "e(quence|t)|ome|qr|t(art|rict_subset_of)|" &
+ "u(bset_of|cc))|t(hen|ype)|update|var|where|xor|" &
+ "fld_.*|upf_.*)$");
+ -- Regular expression for SPARK keywords
+
+ procedure Analyze_Ada_Source
+ (Buffer : UTF8_String;
+ Symbols : GNATCOLL.Symbols.Symbol_Table_Access;
+ Indent_Params : Indent_Parameters;
+ Format : Boolean := True;
+ From, To : Natural := 0;
+ Replace : Replace_Text_Callback := null;
+ Constructs : Construct_List_Access := null;
+ Callback : Entity_Callback := null;
+ Indent_Offset : Natural := 0;
+ Case_Exceptions : Casing_Exceptions := No_Casing_Exception;
+ Is_Optional_Keyword : access function (S : String)
+ return Boolean := null)
+ is
+ ---------------
+ -- Constants --
+ ---------------
+
+ None : constant := -1;
+
+ Default_Extended : Extended_Token;
+ pragma Warnings (Off, Default_Extended);
+ -- Use default values to initialize this pseudo constant
+
+ Indent_Level : Natural renames Indent_Params.Indent_Level;
+ Indent_Continue : Natural renames Indent_Params.Indent_Continue;
+ Indent_Decl : Natural renames Indent_Params.Indent_Decl;
+ Indent_With : constant := 5;
+ Indent_Use : constant := 4;
+ Indent_When : constant := 5;
+ Indent_Comments : Boolean renames Indent_Params.Indent_Comments;
+ Stick_Comments : Boolean renames Indent_Params.Stick_Comments;
+ Stop_On_Blank_Line : constant Boolean := True;
+ Indent_Record : Natural renames Indent_Params.Indent_Record;
+ Indent_Case_Extra : Indent_Style renames
+ Indent_Params.Indent_Case_Extra;
+ Indent_Conditional : Natural renames Indent_Params.Indent_Conditional;
+ Reserved_Casing : Casing_Type renames Indent_Params.Reserved_Casing;
+ Ident_Casing : Casing_Type renames Indent_Params.Ident_Casing;
+ Use_Tabs : Boolean renames Indent_Params.Use_Tabs;
+ Format_Operators : constant Boolean :=
+ Format and then Indent_Params.Format_Operators;
+ Align_On_Colons : constant Boolean :=
+ Format and then Indent_Params.Align_On_Colons;
+ Align_On_Arrows : constant Boolean :=
+ Format and then Indent_Params.Align_On_Arrows;
+ Align_Decl_On_Colon : constant Boolean :=
+ Format
+ and then Indent_Params.Align_Decl_On_Colon;
+ Buffer_Last : constant Natural := Buffer'Last;
+
+ ---------------
+ -- Variables --
+ ---------------
+
+ Line_Count : Integer := 1;
+ Str : String (1 .. 1024);
+ Str_Len : Natural := 0;
+ Current : Natural;
+ Prec : Natural := Buffer'First;
+ Start_Of_Line : Natural;
+ Prev_Line : Natural;
+ Num_Spaces : Integer := 0;
+ Continuation_Val : Integer := 0;
+ Indent_Done : Boolean := False;
+ Num_Parens : Integer := 0;
+ Index_Ident : Natural;
+ In_Generic : Boolean := False;
+
+ Aspect_Clause : Boolean := False;
+ -- True when the current construct is an Ada 2012 aspect clause
+ -- Consider merging with Subprogram_Aspect ???
+
+ Aspect_Clause_Sloc : Source_Location;
+ -- source location of start of the current aspect clause, when
+ -- Aspect_Clause is True.
+
+ type In_Declaration_Kind is
+ (No_Decl, Subprogram_Decl, Subprogram_Aspect, Type_Decl);
+
+ In_Declaration : In_Declaration_Kind := No_Decl;
+ -- Identifies when we are in a declaration
+
+ Syntax_Error : Boolean := False;
+ -- Not used for now, but may be useful in the future
+ pragma Unreferenced (Syntax_Error);
+
+ Comments_Skipped : Boolean := False;
+ Token : Token_Type;
+ Prev_Token : Token_Type := No_Token;
+ Prev_Prev_Token : Token_Type := No_Token;
+ Tokens : Token_Stack.Simple_Stack;
+ Paren_Stack : Construct_Stack.Simple_Stack;
+ Indents : Indent_Stack.Stack.Simple_Stack;
+ Top_Token : Token_Stack.Generic_Type_Access;
+ Casing : Casing_Type := Unchanged;
+ Terminated : Boolean := False;
+ End_Reached : Boolean := False;
+ Last_Replace_Line : Natural := 0;
+ Padding : Integer := 0;
+ Paren_In_Middle : Boolean := False;
+
+ Is_Parameter : Boolean := False;
+ -- This variable is true if the identifiers picked are parameters, false
+ -- otherwise.
+
+ Is_Discriminant : Boolean := False;
+ -- This variable is true if the identifiers picked are parameters, false
+ -- otherwise.
+
+ Right_Assignment : Boolean := False;
+ -- When this is true, we are in a left assignment section
+
+ procedure Handle_Word_Token
+ (Reserved : Token_Type;
+ Temp : out Extended_Token;
+ Do_Pop : out Integer;
+ Do_Push : out Boolean;
+ Finish : out Boolean);
+ -- Handle a reserved word and computes a token out of it. Results
+ -- reads as follows:
+ -- Temp - the token created
+ -- Do_Pop - number of tokens to be popped out of the token list after
+ -- intendation
+ -- Do_Push - does temp needs to be pushed to the token list after
+ -- indentation?
+ -- Finish - should the analysis be terminated?
+
+ procedure Handle_Word_Indent
+ (Reserved : Token_Type; Temp : in out Extended_Token);
+ -- Performs indentation after a call to Handle_Word_Token, and before
+ -- tokens are pushed or popped.
+
+ procedure Finish_Aspect_Clause
+ (P, Line : Natural; Done : out Boolean);
+ -- We are at the end of an aspect clause, so pop the stack,
+ -- call corresponding callbacks.
+ -- Done is set to True if processing should stop after this call.
+ -- P points to the first character in Buffer after the aspect clause.
+ -- Line is the current line.
+
+ procedure Next_Word
+ (P : in out Natural;
+ L : in out Natural;
+ Terminated : out Boolean;
+ End_Reached : out Boolean);
+ -- Starting at Buffer (P), find the location of the next word
+ -- and set P accordingly.
+ -- Formatting of operators is performed by this procedure.
+ -- The following variables are accessed read-only:
+ -- Buffer, Tokens, Num_Spaces, Indent_Continue
+ -- The following variables are read and modified:
+ -- New_Buffer, Num_Parens, Line_Count, Indents, Indent_Done,
+ -- Prev_Token.
+ -- If the end of the buffer has been reached, set End_Reached to True.
+ -- If parsing should be terminated, set Terminated to True.
+
+ function End_Of_Word (P : Natural) return Natural;
+ -- Return the end of the word pointed by P
+
+ function End_Of_Identifier (P : Natural) return Natural;
+ -- Starting from P, scan for the end of the identifier.
+ -- P should be at the first non word character, which means that
+ -- if the identifier does not contain any dot, P - 1 will be returned.
+
+ procedure Look_For_End_Of_Data_Declaration
+ (Sloc : in out Source_Location);
+ -- Search the first ; character, or the first closing parenthesis,
+ -- skipping nested ones. Intended to go at the end of a variable or
+ -- parameter declaration.
+
+ procedure Look_For (Sloc : in out Source_Location; Char : Character);
+ -- Search Char in Buffer starting from Sloc.
+ -- Sloc is updated to the first occurrence of Char in Buffer, or
+ -- Buffer_Last if not found.
+
+ function Look_For (Index : Natural; S : String) return Boolean;
+ -- Return True if Buffer (Index) contains the word S
+
+ procedure New_Line (Count : in out Natural);
+ pragma Inline (New_Line);
+ -- Increment Count and poll if needed (e.g for graphic events)
+
+ procedure Do_Indent
+ (Prec : Natural;
+ Line_Count : Natural;
+ Num_Spaces : Integer;
+ Continuation : Boolean := False);
+ -- Perform indentation by inserting spaces in the buffer.
+ -- If Continuation is True, Indent_Continue extra spaces are added.
+
+ procedure Indent_Function_Return (Prec : Natural);
+ -- Perform special indentation for function return/rename statements
+
+ function Is_Continuation_Line
+ (Token : Token_Type;
+ Prev_Token : Token_Type;
+ Prev_Prev_Token : Token_Type) return Boolean;
+ -- Return True if we are indenting a continuation line
+
+ procedure Compute_Indentation
+ (Token : Token_Type;
+ Prev_Token : Token_Type;
+ Prev_Prev_Token : Token_Type;
+ Prec : Natural;
+ Line_Count : Natural;
+ Num_Spaces : Integer);
+ -- Compute proper indentation, taking into account various cases
+ -- of simple/continuation/declaration/... lines.
+
+ function Next_Char (P : Natural) return Natural;
+ -- Return the next char in buffer. P is the current character
+ pragma Inline (Next_Char);
+
+ function Prev_Char (P : Natural) return Natural;
+ -- Return the previous char in buffer. P is the current character
+ pragma Inline (Prev_Char);
+
+ function Compute_Alignment
+ (P : Natural;
+ Stop_On_Blank_Line : Boolean := False;
+ Skip_First_Line : Boolean := True;
+ Align_On : Token_Type := Tok_Colon) return Natural;
+ -- Compute the column number for an alignment on Align_On, starting at P
+ -- Align_On can take one of the following values:
+ -- - Tok_Colon
+ -- - Tok_Arrow
+ -- - Tok_Colon_Equal (not supported yet)
+
+ procedure Replace_Text
+ (First : Natural;
+ Last : Natural;
+ Line : Natural;
+ Str : String);
+ -- Wrapper for Replace.all, taking (From, To) into account
+
+ function Call_Callback
+ (Entity : Language_Entity;
+ Sloc_Start : Source_Location;
+ Sloc_End : Source_Location;
+ Partial_Entity : Boolean) return Boolean;
+ -- Call Callback and take into account Aspect_Clause/Aspect_Clause_Sloc
+ -- if needed.
+
+ --------------------
+ -- Stack Routines --
+ --------------------
+
+ procedure Pop
+ (Stack : in out Token_Stack.Simple_Stack; Value : out Extended_Token);
+ -- Pop Value on top of Stack
+
+ procedure Pop (Stack : in out Token_Stack.Simple_Stack);
+ -- Pop Value on top of Stack. Ignore returned value
+
+ ---------------
+ -- Next_Char --
+ ---------------
+
+ function Next_Char (P : Natural) return Natural is
+ begin
+ return UTF8_Next_Char (Buffer, P);
+ end Next_Char;
+
+ ---------------
+ -- Prev_Char --
+ ---------------
+
+ function Prev_Char (P : Natural) return Natural is
+ begin
+ return UTF8_Prev_Char (Buffer, P);
+ end Prev_Char;
+
+ ---------------
+ -- Do_Indent --
+ ---------------
+
+ procedure Do_Indent
+ (Prec : Natural;
+ Line_Count : Natural;
+ Num_Spaces : Integer;
+ Continuation : Boolean := False)
+ is
+ Start : Natural;
+ Indentation : Integer;
+ Index : Natural;
+
+ begin
+ if Indent_Done or not Format then
+ return;
+ end if;
+
+ Paren_In_Middle := False;
+
+ if Prec > Buffer_Last then
+ -- In this case, we've parsed the entire buffer, so just compute
+ -- from the last offset
+
+ Start := Line_Start (Buffer, Buffer'Last);
+ else
+ Start := Line_Start (Buffer, Prec);
+ end if;
+
+ Index := Start;
+
+ loop
+ -- Manual unrolling for efficiency
+
+ exit when Buffer (Index) /= ' '
+ and then Buffer (Index) /= ASCII.HT;
+
+ Index := Index + 1;
+
+ exit when Buffer (Index) /= ' '
+ and then Buffer (Index) /= ASCII.HT;
+
+ Index := Index + 1;
+
+ exit when Buffer (Index) /= ' '
+ and then Buffer (Index) /= ASCII.HT;
+
+ Index := Index + 1;
+ end loop;
+
+ if Top (Indents).Level = None then
+ Indentation := Num_Spaces + Indent_Offset;
+ else
+ Indentation := Top (Indents).Level;
+ end if;
+
+ if Continuation then
+ Continuation_Val := Continuation_Val + Indent_Continue;
+ Indentation := Indentation + Continuation_Val;
+ else
+ Continuation_Val := 0;
+ end if;
+
+ Replace_Text
+ (Start, Index, Line_Count,
+ Blank_Slice (Indentation, Use_Tabs, Tab_Width));
+ Indent_Done := True;
+ end Do_Indent;
+
+ ----------------------------
+ -- Indent_Function_Return --
+ ----------------------------
+
+ procedure Indent_Function_Return (Prec : Natural) is
+ Top_Token : constant Token_Stack.Generic_Type_Access := Top (Tokens);
+ begin
+ -- function A
+ -- return B; -- from Indent_Continue
+ -- function A (....)
+ -- return B;
+ -- function A
+ -- (...)
+ -- return B;
+
+ if Top_Token.Profile_Start = 0 then
+ Do_Indent (Prec, Line_Count, Num_Spaces + Indent_Continue);
+ else
+ Do_Indent
+ (Prec,
+ Line_Count,
+ Top_Token.Profile_Start -
+ Line_Start (Buffer, Top_Token.Profile_Start) + 1);
+ end if;
+ end Indent_Function_Return;
+
+ -----------------------
+ -- Compute_Alignment --
+ -----------------------
+
+ function Compute_Alignment
+ (P : Natural;
+ Stop_On_Blank_Line : Boolean := False;
+ Skip_First_Line : Boolean := True;
+ Align_On : Token_Type := Tok_Colon) return Natural
+ is
+ Alignment : Natural := 0;
+ New_Align : Natural;
+ Found_Align : Boolean := False;
+ J : Natural;
+ Non_Blank : Natural := 0;
+ Length_Ident : Natural := 0;
+ Local_Num_Parens : Natural := 0;
+
+ begin
+ if Align_On /= Tok_Colon
+ and then Align_On /= Tok_Arrow
+ -- and then Align_On /= Tok_Colon_Equal ??? not supported yet
+ then
+ return 0;
+ end if;
+
+ if Skip_First_Line then
+ J := Next_Line (Buffer, P);
+ else
+ J := P;
+ end if;
+
+ Main_Loop :
+ loop
+ exit Main_Loop when J >= Buffer'Last;
+
+ if Non_Blank = 0 then
+ if not Is_Blank (Buffer (J)) then
+ Non_Blank := J;
+ Length_Ident := 1;
+ end if;
+
+ else
+ Length_Ident := Length_Ident + 1;
+ end if;
+
+ exit Main_Loop when Look_For (J, "begin")
+ or else Look_For (J, "case")
+ or else Look_For (J, "end")
+ or else Look_For (J, "package")
+ or else Look_For (J, "protected")
+ or else Look_For (J, "task")
+ or else Look_For (J, "type");
+
+ case Buffer (J) is
+ when '"' =>
+ if Buffer (J - 1) /= ''' then
+ J := J + 1;
+ Skip_To_Char (Buffer, J, '"');
+ end if;
+
+ when '-' =>
+ if Buffer (J + 1) = '-' then
+ -- Skip comment
+
+ J := Next_Line (Buffer, J) - 1;
+ Found_Align := False;
+ Non_Blank := 0;
+ end if;
+
+ when '(' =>
+ if Buffer (J - 1) /= '''
+ or else Buffer (J + 1) /= '''
+ then
+ Local_Num_Parens := Local_Num_Parens + 1;
+ end if;
+
+ when ')' =>
+ if Buffer (J - 1) /= ''' then
+ exit Main_Loop when Local_Num_Parens = 0;
+
+ Local_Num_Parens := Local_Num_Parens - 1;
+ end if;
+
+ when ':' =>
+ if Align_On = Tok_Colon
+ and then Local_Num_Parens = 0
+ and then Buffer (J - 1) /= '''
+ and then not Found_Align
+ then
+ Found_Align := True;
+ New_Align := Length_Ident;
+
+ if Format_Operators
+ and then not Is_Blank (Buffer (J - 1))
+ then
+ New_Align := New_Align + 1;
+ end if;
+
+ Alignment := Natural'Max (Alignment, New_Align);
+ end if;
+
+ when '=' =>
+ if Align_On = Tok_Arrow
+ and then Buffer (J + 1) = '>'
+ and then Local_Num_Parens = 0
+ and then not Found_Align
+ then
+ Found_Align := True;
+ New_Align := Length_Ident + 1;
+
+ if Format_Operators
+ and then not Is_Blank (Buffer (J - 1))
+ then
+ -- ??? Format_Operators may add more than a single
+ -- blank inside the expression.
+
+ New_Align := New_Align + 1;
+ end if;
+
+ Alignment := Natural'Max (Alignment, New_Align);
+ end if;
+
+ when ASCII.LF =>
+ exit Main_Loop when Stop_On_Blank_Line
+ and then Non_Blank = 0;
+
+ Found_Align := False;
+ Non_Blank := 0;
+
+ when others =>
+ null;
+ end case;
+
+ J := Next_Char (J);
+ end loop Main_Loop;
+
+ return Alignment;
+ end Compute_Alignment;
+
+ --------------------------
+ -- Is_Continuation_Line --
+ --------------------------
+
+ function Is_Continuation_Line
+ (Token : Token_Type;
+ Prev_Token : Token_Type;
+ Prev_Prev_Token : Token_Type) return Boolean
+ is
+ Top_Tok : constant Token_Type := Top (Tokens).Token;
+ begin
+ if Aspect_Clause then
+ return True;
+ end if;
+
+ if Prev_Token = Tok_Is and then In_Generic then
+ return True;
+ end if;
+
+ if Top_Tok = No_Token then
+ return False;
+ end if;
+
+ -- Special case for variable (Tok_Colon) or type (only case when
+ -- Tok_Is is passed to this subprogram) declarations.
+ -- In these cases, and if the Indent_Decl preference is set to 0
+ -- then this is not a continuation line, e.g:
+ -- Var
+ -- : Integer;
+ -- type T
+ -- is new Integer;
+ -- Note that we reuse Indent_Decl for now to avoid introducing
+ -- a new preference.
+
+ if (Top_Tok = Tok_Colon and then Token = Tok_Colon)
+ or else Token = Tok_Is
+ then
+ return Indent_Decl /= 0;
+ end if;
+
+ return
+ (Token not in Reserved_Token_Type
+ and then Prev_Token not in Token_Class_No_Cont
+ and then
+ (Prev_Token /= Tok_Arrow
+ or else (not Top (Tokens).In_Declaration
+ and then Top_Tok not in
+ Tok_Case | Tok_When | Tok_Select
+ | Tok_Exception)))
+ or else (Prev_Token = Tok_Is
+ and then (Token in Tok_New | Tok_Access
+ | Tok_Separate | Tok_Abstract
+ or else
+ (Top_Tok = Tok_Subtype
+ and then Token /= Tok_Subtype)))
+ or else Token in Tok_Array | Tok_Of
+ or else (Token = Tok_Not
+ and then (Prev_Token in Tok_And | Tok_Or
+ | Tok_Then | Tok_Else))
+ or else (Prev_Token = Tok_With
+ and then (Token = Tok_String_Literal
+ or else Token = Tok_Private
+ or else Top_Tok = Tok_Procedure
+ or else Top_Tok = Tok_Function))
+ or else Prev_Token in Tok_Colon_Equal | Tok_Access | Tok_Of
+ or else (Prev_Token = Tok_Protected
+ and then Prev_Prev_Token = Tok_Access)
+ or else (Prev_Token = Tok_When and then Token = Tok_Others)
+ or else (Prev_Token = Tok_Exit and then Token = Tok_When)
+ or else (Prev_Token = Tok_Null and then Token = Tok_Record)
+ or else (Prev_Prev_Token = Tok_And
+ and then Prev_Token = Tok_Then
+ and then Num_Parens = 0)
+ or else (Prev_Prev_Token = Tok_Or
+ and then Prev_Token = Tok_Else
+ and then Num_Parens = 0)
+ or else (Token = Tok_With
+ and then (Prev_Prev_Token = Tok_Raise
+ or else Top_Tok = Tok_Colon))
+ or else
+ (Top_Tok = Tok_Type
+ and then (Token = Tok_Null or else Token = Tok_Tagged))
+ or else (Token = Tok_When and then Top_Tok = Tok_Entry);
+ end Is_Continuation_Line;
+
+ -------------------------
+ -- Compute_Indentation --
+ -------------------------
+
+ procedure Compute_Indentation
+ (Token : Token_Type;
+ Prev_Token : Token_Type;
+ Prev_Prev_Token : Token_Type;
+ Prec : Natural;
+ Line_Count : Natural;
+ Num_Spaces : Integer)
+ is
+ Top_Tok : constant Token_Type := Top (Tokens).Token;
+ begin
+ if Indent_Done or not Format then
+ return;
+ end if;
+
+ if (Prev_Token = Tok_Vertical_Bar or else Prev_Token = Tok_Or)
+ and then Top_Tok = Tok_When
+ then
+ -- Indent multiple-line when statements specially:
+ -- case Foo is
+ -- when A |
+ -- B => -- from Indent_When
+
+ Do_Indent
+ (Prec, Line_Count, Num_Spaces - Indent_Level + Indent_When);
+
+ elsif Prev_Token = Tok_Comma
+ and then (Num_Parens = 0 or else Token /= Tok_When)
+ then
+ if Top_Tok = Tok_Declare
+ or else Top_Tok = Tok_Identifier
+ or else Top_Tok = Tok_Record
+ or else Top_Tok = Tok_Case
+ or else Top_Tok = Tok_When
+ then
+ -- Inside a declare block, indent broken lines specially
+ -- declare
+ -- A,
+ -- B : Integer; -- from Indent_Decl
+
+ Do_Indent (Prec, Line_Count, Num_Spaces + Indent_Decl);
+
+ elsif Top_Tok = Tok_With then
+ -- Indent continuation lines in with clauses:
+ -- with Package1,
+ -- Package2; -- from Indent_With
+
+ Do_Indent (Prec, Line_Count, Num_Spaces + Indent_With);
+
+ elsif Top_Tok = Tok_Use then
+ -- Ditto for use clauses:
+ -- use Package1,
+ -- Package2; -- from Indent_Use
+
+ Do_Indent (Prec, Line_Count, Num_Spaces + Indent_Use);
+
+ elsif Num_Parens = 0 then
+ if Continuation_Val > 0 then
+ declare
+ Tmp_Index : Natural := Prec + 1;
+ begin
+ Skip_Blanks (Buffer, Tmp_Index);
+
+ if Look_For (Tmp_Index, "=>") then
+ -- May happen with aspects:
+ -- procedure G with
+ -- Pre => F,
+ -- Post => F;
+
+ Continuation_Val := Continuation_Val - Indent_Continue;
+ end if;
+ end;
+ end if;
+
+ Do_Indent (Prec, Line_Count, Num_Spaces, Continuation => True);
+ else
+ -- Default case, simply use Num_Spaces
+
+ Do_Indent (Prec, Line_Count, Num_Spaces);
+ end if;
+
+ elsif Top (Tokens).Colon_Col /= 0
+ and then Continuation_Val = 0
+ and then Num_Parens = 0
+ and then (Prev_Token = Tok_Colon_Equal
+ or else Prev_Token = Tok_Renames
+ or else Is_Operator (Prev_Token)
+ or else Is_Operator (Token))
+ then
+ Continuation_Val := Top (Tokens).Colon_Col + 4 - Indent_Continue;
+ Do_Indent (Prec, Line_Count, Num_Spaces, Continuation => True);
+
+ elsif Prev_Token = Tok_Ampersand or else Token = Tok_Ampersand then
+ if Continuation_Val > 0 then
+ Continuation_Val := Continuation_Val - Indent_Continue;
+ end if;
+
+ Do_Indent (Prec, Line_Count, Num_Spaces, Continuation => True);
+ Continuation_Val := 0;
+
+ elsif Is_Continuation_Line
+ (Token, Prev_Token, Prev_Prev_Token)
+ then
+ Do_Indent (Prec, Line_Count, Num_Spaces, Continuation => True);
+
+ if Is_Operator (Token) then
+ Continuation_Val := 0;
+ end if;
+
+ elsif Num_Parens > 0
+ and then
+ (Token in Tok_When | Tok_Vertical_Bar
+ or else Prev_Token = Tok_Arrow
+ or else (Prev_Token = Tok_Then
+ and then Prev_Prev_Token /= Tok_And)
+ or else (Prev_Token = Tok_Else
+ and then Prev_Prev_Token /= Tok_Or))
+ then
+ -- Handle a bit better Ada 2012 conditional expressions
+
+ if Token in Tok_When | Tok_Vertical_Bar then
+ Continuation_Val := Indent_Level - Indent_Continue;
+ else
+ Continuation_Val :=
+ Continuation_Val + Indent_Level - Indent_Continue;
+ end if;
+
+ Do_Indent (Prec, Line_Count, Num_Spaces, Continuation => True);
+ else
+ Do_Indent (Prec, Line_Count, Num_Spaces);
+ end if;
+ end Compute_Indentation;
+
+ -----------------
+ -- End_Of_Word --
+ -----------------
+
+ function End_Of_Word (P : Natural) return Natural is
+ Cur : Natural;
+ begin
+ if P >= Buffer_Last then
+ return Buffer_Last;
+ end if;
+
+ Cur := Next_Char (P);
+
+ while Cur <= Buffer_Last
+ and then Is_Entity_Letter
+ (UTF8_Get_Char (Buffer (Cur .. Buffer_Last)))
+ loop
+ Cur := Next_Char (Cur);
+ end loop;
+
+ if Cur > Buffer_Last then
+ return Buffer_Last;
+ else
+ return Cur - 1;
+ end if;
+ end End_Of_Word;
+
+ -----------------------
+ -- End_Of_Identifier --
+ -----------------------
+
+ function End_Of_Identifier (P : Natural) return Natural is
+ Tmp : Natural := P;
+ Prev : Natural := P - 1;
+ Start : Natural;
+ New_Lines : Natural;
+ Last_Dot : Natural;
+
+ begin
+ -- Do not try to go past '.' and line breaks when reformatting,
+ -- this is causing too much trouble for no gain.
+ -- Getting full identifiers is only useful when parsing, not
+ -- when reformatting.
+
+ if Format then
+ return P - 1;
+ end if;
+
+ loop
+ New_Lines := 0;
+
+ while Tmp < Buffer_Last and then Is_Blank (Buffer (Tmp)) loop
+ if Buffer (Tmp) = ASCII.LF then
+ New_Lines := New_Lines + 1;
+ end if;
+
+ Tmp := Tmp + 1;
+ end loop;
+
+ if Tmp >= Buffer_Last
+ or else Buffer (Tmp) /= '.'
+ or else Buffer (Tmp + 1) = '.'
+ then
+ return Prev;
+ end if;
+
+ Last_Dot := Tmp;
+
+ while Tmp < Buffer_Last loop
+ Tmp := Tmp + 1;
+
+ if Buffer (Tmp) = ASCII.LF then
+ Compute_Indentation
+ (Token, Prev_Token, Prev_Prev_Token,
+ Tmp - 1, Line_Count, Num_Spaces);
+ New_Lines := New_Lines + 1;
+ end if;
+
+ exit when not Is_Blank (Buffer (Tmp));
+ end loop;
+
+ if Buffer (Tmp) = '"' then
+ -- Case of an operator, e.g System."=", will be handled
+ -- separately for proper highlighting.
+
+ return Prev;
+
+ elsif not Is_Entity_Letter
+ (UTF8_Get_Char (Buffer (Tmp .. Buffer_Last)))
+ then
+ return Last_Dot;
+ else
+ Start := Tmp;
+ Tmp := End_Of_Word (Tmp);
+
+ if Buffer (Start .. Tmp) = "all"
+ -- constructions like sth.procedure often reflect incomplete
+ -- statements, e.g.:
+ --
+ -- use Ada.
+ -- procedure P is
+ --
+ -- retreiving these here improve the general tree balance in
+ -- case of incomplete constructs.
+ or else Buffer (Start .. Tmp) = "procedure"
+ or else Buffer (Start .. Tmp) = "function"
+ or else Buffer (Start .. Tmp) = "package"
+ then
+ return Prev;
+ end if;
+ end if;
+
+ Line_Count := Line_Count + New_Lines;
+ Prev := Tmp;
+ Tmp := Tmp + 1;
+ end loop;
+ end End_Of_Identifier;
+
+ --------------------------------------
+ -- Look_For_End_Of_Data_Declaration --
+ --------------------------------------
+
+ procedure Look_For_End_Of_Data_Declaration
+ (Sloc : in out Source_Location)
+ is
+ C : Character;
+ In_Comments : Boolean := False;
+ Paren_Depth : Integer := 0;
+ begin
+ for J in Sloc.Index .. Buffer_Last loop
+ C := Buffer (J);
+
+ if not In_Comments
+ and then Paren_Depth = 0
+ and then (C = ';' or else C = ')')
+ then
+ Sloc.Index := J;
+ return;
+
+ elsif C = '-' and then Buffer (J - 1) = '-' then
+ In_Comments := True;
+
+ elsif C = ASCII.LF then
+ In_Comments := False;
+ Sloc.Line := Sloc.Line + 1;
+ Sloc.Column := 1;
+
+ elsif C = '(' then
+ Paren_Depth := Paren_Depth + 1;
+ Sloc.Column := Sloc.Column + 1;
+
+ elsif C = ')' then
+ Paren_Depth := Paren_Depth - 1;
+ Sloc.Column := Sloc.Column + 1;
+
+ elsif C /= ASCII.CR then
+ Sloc.Column := Sloc.Column + 1;
+
+ end if;
+ end loop;
+ end Look_For_End_Of_Data_Declaration;
+
+ --------------
+ -- Look_For --
+ --------------
+
+ procedure Look_For (Sloc : in out Source_Location; Char : Character) is
+ C : Character;
+ In_Comments : Boolean := False;
+ begin
+ for J in Sloc.Index .. Buffer_Last loop
+ C := Buffer (J);
+
+ if not In_Comments and then C = Char then
+ Sloc.Index := J;
+ return;
+
+ elsif C = '-' and then Buffer (J - 1) = '-' then
+ In_Comments := True;
+
+ elsif C = ASCII.LF then
+ In_Comments := False;
+ Sloc.Line := Sloc.Line + 1;
+ Sloc.Column := 1;
+
+ elsif C /= ASCII.CR then
+ Sloc.Column := Sloc.Column + 1;
+ end if;
+ end loop;
+ end Look_For;
+
+ function Look_For (Index : Natural; S : String) return Boolean is
+ begin
+ return Is_Blank (Buffer (Index - 1))
+ and then Index + S'Length < Buffer'Last
+ and then To_Lower (Buffer (Index .. Index + S'Length - 1)) = S
+ and then (Buffer (Index + S'Length) = ';'
+ or else Buffer (Index + S'Length) = '-'
+ or else Is_Blank (Buffer (Index + S'Length)));
+ end Look_For;
+
+ --------------
+ -- New_Line --
+ --------------
+
+ procedure New_Line (Count : in out Natural) is
+ begin
+ Count := Count + 1;
+ end New_Line;
+
+ ---------
+ -- Pop --
+ ---------
+
+ procedure Pop
+ (Stack : in out Token_Stack.Simple_Stack;
+ Value : out Extended_Token)
+ is
+ Column : Natural;
+ Info : Construct_Access;
+
+ begin
+ -- Never pop the initial value
+
+ if Top (Stack).Token = No_Token then
+ Value := Top (Stack).all;
+ return;
+ end if;
+
+ Token_Stack.Pop (Stack, Value);
+
+ Top_Token := Token_Stack.Top (Stack);
+
+ -- Tok_Record will be taken into account by Tok_Type if needed.
+ -- Build next entry of Constructs
+
+ if Value.Token = Tok_Colon and then Constructs /= null then
+ -- If we are on a Tok_Colon, then we want to assign attibutes to
+ -- all the data that are related to this declaration.
+
+ declare
+ Current : Construct_Access := Constructs.Current;
+ begin
+ while Current /= null
+ and then Current.Category in Data_Category
+ and then Current.Sloc_Start.Index <= Prec
+ and then Current.Sloc_End.Index >= Prec
+ loop
+ Current.Attributes := Value.Attributes;
+ Current := Current.Prev;
+ end loop;
+ end;
+
+ elsif Value.Token /= Tok_Record
+ and then Value.Token /= Tok_When
+ and then Value.Token /= Tok_Generic
+ and then Constructs /= null
+ then
+ Column := Prec - Line_Start (Buffer, Prec) + 1;
+ Info := Constructs.Current;
+ Constructs.Current := new Construct_Information;
+
+ if Constructs.First = null then
+ Constructs.First := Constructs.Current;
+ else
+ Constructs.Current.Prev := Info;
+ Constructs.Current.Next := Info.Next;
+ Info.Next := Constructs.Current;
+ end if;
+
+ Constructs.Last := Constructs.Current;
+ Constructs.Size := Constructs.Size + 1;
+
+ Constructs.Current.Visibility := Value.Visibility;
+ Constructs.Current.Attributes := Value.Attributes;
+
+ Constructs.Current.Is_Generic_Spec := Value.Is_Generic_Param;
+
+ if Value.Attributes (Ada_Tagged_Attribute) then
+ Constructs.Current.Category := Cat_Class;
+
+ elsif Value.Attributes (Ada_Record_Attribute) then
+ if Value.Token = Tok_Case then
+ -- A case statement inside a record
+ Constructs.Current.Category := Cat_Case_Inside_Record;
+ else
+ Constructs.Current.Category := Cat_Structure;
+ end if;
+
+ else
+ case Value.Token is
+ when Tok_Package =>
+ Constructs.Current.Category := Cat_Package;
+ when Tok_Procedure =>
+ Constructs.Current.Category := Cat_Procedure;
+ when Tok_Function =>
+ Constructs.Current.Category := Cat_Function;
+ when Tok_Task =>
+ Constructs.Current.Category := Cat_Task;
+ when Tok_Protected =>
+ Constructs.Current.Category := Cat_Protected;
+ when Tok_Entry =>
+ Constructs.Current.Category := Cat_Entry;
+
+ when Tok_Type =>
+ Constructs.Current.Category := Cat_Type;
+ when Tok_Subtype =>
+ Constructs.Current.Category := Cat_Subtype;
+ when Tok_For =>
+ Constructs.Current.Category := Cat_Representation_Clause;
+ when Tok_Identifier =>
+ if Is_Library_Level (Stack) then
+ Constructs.Current.Category := Cat_Variable;
+ elsif Value.Variable_Kind = Parameter_Kind then
+ Constructs.Current.Category := Cat_Parameter;
+ elsif Value.Variable_Kind = Discriminant_Kind then
+ Constructs.Current.Category := Cat_Discriminant;
+ elsif Value.Is_In_Type_Definition then
+ if Top (Stack).Type_Declaration
+ or else Top (Stack).Protected_Declaration
+ or else Top (Stack).Attributes (Ada_Record_Attribute)
+ then
+ Constructs.Current.Category := Cat_Field;
+ else
+ Constructs.Current.Category := Cat_Literal;
+ end if;
+ else
+ Constructs.Current.Category := Cat_Local_Variable;
+ end if;
+ when Tok_With =>
+ Constructs.Current.Category := Cat_With;
+ when Tok_Use =>
+ Constructs.Current.Category := Cat_Use;
+
+ when Tok_Loop =>
+ Constructs.Current.Category := Cat_Loop_Statement;
+ when Tok_Then =>
+ Constructs.Current.Category := Cat_If_Statement;
+ when Tok_Case =>
+ Constructs.Current.Category := Cat_Case_Statement;
+ when Tok_Select =>
+ Constructs.Current.Category := Cat_Select_Statement;
+ when Tok_Accept | Tok_Do =>
+ Constructs.Current.Category := Cat_Accept_Statement;
+ when Tok_Declare =>
+ Constructs.Current.Category := Cat_Declare_Block;
+ when Tok_Begin =>
+ Constructs.Current.Category := Cat_Simple_Block;
+ when Tok_Return =>
+ Constructs.Current.Category := Cat_Return_Block;
+
+ when Tok_Exception =>
+ Constructs.Current.Category := Cat_Exception_Handler;
+ when Tok_Pragma =>
+ Constructs.Current.Category := Cat_Pragma;
+ when Tok_Arrow =>
+ Constructs.Current.Category := Cat_Aspect;
+ when others =>
+ Constructs.Current.Category := Cat_Unknown;
+ end case;
+ end if;
+
+ if Value.Ident_Len > 0 then
+ Constructs.Current.Name :=
+ Symbols.Find (Value.Identifier (1 .. Value.Ident_Len));
+ Constructs.Current.Sloc_Entity := Value.Sloc_Name;
+ end if;
+
+ if Value.Profile_Start /= 0 then
+ Constructs.Current.Profile :=
+ new String'
+ (Buffer (Value.Profile_Start .. Value.Profile_End));
+ end if;
+
+ Constructs.Current.Sloc_Start := Value.Sloc;
+
+ if Comments_Skipped then
+ Constructs.Current.Sloc_End := (Prev_Line, Column, Prec);
+ else
+ Constructs.Current.Sloc_End := (Line_Count, Column, Prec);
+ end if;
+
+ case Constructs.Current.Category is
+ when Cat_Parameter | Cat_Discriminant =>
+ -- Adjust the Sloc_End to the next semicolon for enclosing
+ -- entities and variable declarations, or next closing
+ -- parenthesis
+
+ Look_For_End_Of_Data_Declaration
+ (Constructs.Current.Sloc_End);
+
+ when Cat_Variable | Cat_Local_Variable | Cat_Field |
+ Cat_Declare_Block | Cat_Simple_Block |
+ Cat_Type | Cat_Subtype | Namespace_Category |
+ Subprogram_Category | Cat_Pragma
+ =>
+ -- Adjust the Sloc_End to the next semicolon for enclosing
+ -- entities and variable declarations. In case if loops,
+ -- adjust the end of the source location to the end of the
+ -- identifier.
+
+ if Prev_Token /= Tok_For then
+ Look_For (Constructs.Current.Sloc_End, ';');
+ else
+ Constructs.Current.Sloc_End.Column :=
+ Constructs.Current.Sloc_End.Column +
+ Value.Ident_Len - 1;
+ Constructs.Current.Sloc_End.Index :=
+ Constructs.Current.Sloc_End.Index +
+ Value.Ident_Len - 1;
+ end if;
+
+ when others =>
+ null;
+ end case;
+
+ Constructs.Current.Is_Declaration :=
+ In_Declaration in Subprogram_Decl .. Subprogram_Aspect
+ or else Value.Type_Declaration
+ or else Value.Package_Declaration
+ or else Value.Protected_Declaration;
+ end if;
+ end Pop;
+
+ procedure Pop (Stack : in out Token_Stack.Simple_Stack) is
+ Value : Extended_Token;
+ begin
+ Pop (Stack, Value);
+ end Pop;
+
+ --------------------------
+ -- Finish_Aspect_Clause --
+ --------------------------
+
+ procedure Finish_Aspect_Clause
+ (P, Line : Natural; Done : out Boolean)
+ is
+ Prec_Saved : constant Natural := Prec;
+ begin
+ Aspect_Clause := False;
+ Done := False;
+
+ -- Pop aspect clause
+ -- Set Prec so that Pop will use the proper index/column
+ Prec := Prev_Char (P);
+ Pop (Tokens);
+
+ if Callback /= null then
+ Start_Of_Line := Line_Start (Buffer, Prec);
+
+ Done := Callback
+ (Aspect_Text,
+ Aspect_Clause_Sloc,
+ (Line, Prec - Start_Of_Line + 1, Prec),
+ False);
+ end if;
+
+ Prec := Prec_Saved;
+ end Finish_Aspect_Clause;
+
+ -----------------------
+ -- Handle_Word_Token --
+ -----------------------
+
+ procedure Handle_Word_Token
+ (Reserved : Token_Type;
+ Temp : out Extended_Token;
+ Do_Pop : out Integer;
+ Do_Push : out Boolean;
+ Finish : out Boolean)
+ is
+ Top_Token : Token_Stack.Generic_Type_Access;
+ Start_Of_Line : Natural;
+ Index_Next : Natural;
+ Tmp_Index : Natural;
+
+ procedure Adjust_Block_Column;
+ -- Adjust status column of declare block to take into
+ -- account a label at start of the line by using the first
+ -- non blank character on the line.
+
+ -------------------------
+ -- Adjust_Block_Column --
+ -------------------------
+
+ procedure Adjust_Block_Column is
+ begin
+ if Prev_Token = Tok_Colon then
+ Tmp_Index := Start_Of_Line;
+ Skip_Blanks (Buffer, Tmp_Index);
+ Temp.Sloc.Column := Tmp_Index - Start_Of_Line + 1;
+ Temp.Sloc.Index := Tmp_Index;
+ end if;
+ end Adjust_Block_Column;
+
+ begin
+ Do_Push := False;
+ Do_Pop := 0;
+ Finish := False;
+
+ if Reserved = Tok_Is and then Aspect_Clause then
+ Finish_Aspect_Clause (Prec, Line_Count, Done => Finish);
+
+ if Finish then
+ return;
+ end if;
+ end if;
+
+ Top_Token := Top (Tokens);
+ Temp := (others => <>);
+ Temp.Token := Reserved;
+ Start_Of_Line := Line_Start (Buffer, Prec);
+ Temp.Sloc.Line := Line_Count;
+ Temp.Sloc.Column := Prec - Start_Of_Line + 1;
+ Temp.Sloc.Index := Prec;
+ Temp.Visibility := Top_Token.Visibility_Section;
+
+ if Callback /= null then
+ Finish := Call_Callback
+ (Keyword_Text,
+ Temp.Sloc,
+ (Line_Count, Current - Start_Of_Line + 1, Current),
+ False);
+
+ if Finish then
+ return;
+ end if;
+ end if;
+
+ -- Computes Tok_Token.Type_Att
+
+ if not Right_Assignment then
+ case Reserved is
+ when Tok_Abstract =>
+ Top_Token.Attributes (Ada_Abstract_Attribute) := True;
+ when Tok_Access =>
+ Top_Token.Attributes (Ada_Access_Attribute) := True;
+ when Tok_Aliased =>
+ Top_Token.Attributes (Ada_Aliased_Attribute) := True;
+ when Tok_Array =>
+ Top_Token.Attributes (Ada_Array_Attribute) := True;
+ when Tok_Colon_Equal =>
+ Top_Token.Attributes (Ada_Assign_Attribute) := True;
+ when Tok_Constant =>
+ Top_Token.Attributes (Ada_Constant_Attribute) := True;
+ when Tok_Delta =>
+ Top_Token.Attributes (Ada_Delta_Attribute) := True;
+ when Tok_Digits =>
+ Top_Token.Attributes (Ada_Digits_Attribute) := True;
+ when Tok_Range =>
+ Top_Token.Attributes (Ada_Range_Attribute) := True;
+ when Tok_Mod =>
+ Top_Token.Attributes (Ada_Mod_Attribute) := True;
+ when Tok_New =>
+ Top_Token.Attributes (Ada_New_Attribute) := True;
+ when Tok_Not =>
+ Top_Token.Attributes (Ada_Not_Attribute) := True;
+ when Tok_Null =>
+ Top_Token.Attributes (Ada_Null_Attribute) := True;
+ when Tok_Out =>
+ Top_Token.Attributes (Ada_Out_Attribute) := True;
+ when Tok_Tagged =>
+ Top_Token.Attributes (Ada_Tagged_Attribute) := True;
+ when Tok_In =>
+ Top_Token.Attributes (Ada_In_Attribute) := True;
+ when Tok_Interface =>
+ Top_Token.Attributes (Ada_Interface_Attribute) := True;
+ when Tok_Record =>
+ if Prev_Token /= Tok_Null
+ or else Prev_Prev_Token = Tok_Is
+ then
+ -- Do not take aggregates like (null record) as a record
+ -- definition but we still want "is null record" to be
+ -- properly reported as record type.
+ Top_Token.Attributes (Ada_Record_Attribute) := True;
+ end if;
+ when Tok_Renames =>
+ Top_Token.Attributes (Ada_Renames_Attribute) := True;
+ when others =>
+ null;
+ end case;
+ end if;
+
+ -- Computes the end of the profile
+
+ case Top_Token.Token is
+ when Tok_Procedure
+ | Tok_Function
+ | Tok_Entry =>
+
+ if Reserved = Tok_Is then
+ Top_Token.In_Entity_Profile := False;
+ end if;
+
+ when Tok_Type =>
+ if Reserved = Tok_Record then
+ Top_Token.In_Entity_Profile := False;
+
+ -- type N is new O with record ...
+ -- type N is new O with null record ...
+ if Prev_Token = Tok_With or
+ (Prev_Prev_Token = Tok_With and Prev_Token = Tok_Null)
+ then
+ Top_Token.Attributes (Ada_Tagged_Attribute) := True;
+ end if;
+
+ -- type N is new O with private;
+ elsif Prev_Token = Tok_With and Reserved = Tok_Private then
+ Top_Token.Attributes (Ada_Tagged_Attribute) := True;
+ end if;
+
+ when others =>
+ null;
+
+ end case;
+
+ -- Note: the order of the following conditions is important
+
+ if Reserved = Tok_Body then
+ if Top_Token.Token = Tok_Package then
+ Top_Token.Package_Declaration := False;
+ elsif Top_Token.Token = Tok_Protected then
+ Top_Token.Protected_Declaration := False;
+ end if;
+
+ elsif Prev_Token /= Tok_End
+ and then Reserved = Tok_Case
+ and then Num_Parens = 0
+ then
+ Temp.Visibility_Section := Top_Token.Visibility_Section;
+
+ -- If the case is in a type declaration (e.g. protected), then
+ -- mark itself as a type declaration so we will extract the
+ -- corresponding fields.
+ if Top_Token.Type_Declaration then
+ Temp.Type_Declaration := True;
+ end if;
+
+ -- If the case is in a record, then mark itself as a record so we
+ -- will extract the corresponding fields.
+ if Top_Token.Attributes (Ada_Record_Attribute) then
+ Temp.Attributes (Ada_Record_Attribute) := True;
+ end if;
+
+ Do_Push := True;
+
+ elsif Prev_Token /= Tok_End and then
+ ((Reserved = Tok_If and then Num_Parens = 0)
+ or else Reserved = Tok_For
+ or else Reserved = Tok_While
+ or else Reserved = Tok_Accept)
+ then
+ Do_Push := True;
+
+ elsif Reserved = Tok_Renames then
+ if not Top_Token.In_Declaration
+ and then (Top_Token.Token = Tok_Function
+ or else Top_Token.Token = Tok_Procedure
+ or else Top_Token.Token = Tok_Package)
+ then
+ -- Terminate current subprogram declaration, e.g:
+ -- procedure ... renames ...;
+
+ Do_Pop := Do_Pop + 1;
+ end if;
+
+ elsif Prev_Token = Tok_Is
+ and then Top_Token.Token /= Tok_Type
+ and then (Top_Token.Token not in Tok_Task | Tok_Protected
+ or else Reserved = Tok_Separate)
+ and then Top_Token.Token /= Tok_Subtype
+ and then (Reserved = Tok_New
+ or else Reserved = Tok_In
+ or else Reserved = Tok_Abstract
+ or else Reserved = Tok_Separate
+ or else (Reserved = Tok_Null
+ and then not In_Generic
+ and then Top_Token.Token = Tok_Procedure))
+ then
+ In_Declaration := Subprogram_Decl;
+
+ elsif Reserved = Tok_Pragma then
+ Num_Parens := 0;
+ Do_Push := True;
+
+ elsif Reserved = Tok_Function
+ or else Reserved = Tok_Procedure
+ or else Reserved = Tok_Package
+ or else Reserved = Tok_Task
+ or else Reserved = Tok_Protected
+ or else Reserved = Tok_Entry
+ then
+ if not In_Generic
+ and then
+ (Top_Token.Token = Tok_With
+ or else Top_Token.Token = Tok_Use)
+ then
+ -- In this case, we're probably parsing code in the process
+ -- of being written, and the use or with clause is not finished
+ -- yet. Close the construct anyway, so that the tree stays
+ -- correctly balanced.
+ Do_Pop := Do_Pop + 1;
+ end if;
+
+ if Reserved = Tok_Package then
+ Temp.Package_Declaration := True;
+
+ elsif Reserved = Tok_Protected then
+ Temp.Protected_Declaration := True;
+
+ elsif (Top_Token.Token = Tok_Type
+ and then (Prev_Token /= Tok_Access
+ or else Prev_Prev_Token = Tok_Is))
+ or else (Prev_Token /= Tok_Access
+ and then Prev_Token /= Tok_Protected
+ and then Prev_Token /= Tok_Constant)
+ then
+ -- take into account the following:
+ -- type P is access procedure;
+ --
+ -- and ignore the following cases:
+ -- type P is array () of access procedure;
+ -- procedure P (X : access procedure);
+
+ In_Declaration := Subprogram_Decl;
+ Num_Parens := 0;
+ end if;
+
+ if Prev_Token = Tok_Overriding
+ or else (Token = Tok_Package and then Prev_Token = Tok_Private)
+ or else (Token in Tok_Procedure | Tok_Function
+ and then Prev_Token = Tok_With)
+ then
+ -- Adjust column of subprogram to take into account possible
+ -- [not] overriding at start of the line by using the
+ -- first non blank character on the line.
+ -- Ditto for "private package xxx is" and "with procedure xx"
+
+ Tmp_Index := Start_Of_Line;
+ Skip_Blanks (Buffer, Tmp_Index);
+ Temp.Sloc.Column := Tmp_Index - Start_Of_Line + 1;
+ Temp.Sloc.Index := Tmp_Index;
+ end if;
+
+ if Prev_Token = Tok_Access or else Prev_Token = Tok_Protected then
+ -- Ada 2005 anonymous access subprogram parameter:
+ -- procedure P (F : access [protected] procedure);
+
+ null;
+
+ elsif Top_Token.Token = Tok_Type then
+ null;
+
+ else
+ if not Top_Token.In_Declaration
+ and then (Top_Token.Token = Tok_Function
+ or else Top_Token.Token = Tok_Procedure)
+ then
+ -- There was a function declaration, e.g:
+ --
+ -- procedure xxx ();
+ -- procedure ...
+ Do_Pop := Do_Pop + 1;
+ end if;
+
+ if Top_Token.Token = Tok_Generic
+ and then Prev_Token /= Tok_With
+ then
+ -- Pops the temporary generic token and replace it by
+ -- the actual subprogram or package
+
+ Temp.Sloc := Top_Token.Sloc;
+ Temp.Attributes (Ada_Generic_Attribute) := True;
+ Do_Pop := Do_Pop + 1;
+ end if;
+
+ Do_Push := True;
+ end if;
+
+ elsif Reserved = Tok_End
+ or else (Reserved = Tok_Elsif and then Num_Parens = 0)
+ or else (Reserved = Tok_Null
+ and then Prev_Token = Tok_Is
+ and then not In_Generic
+ and then Top_Token.Token = Tok_Procedure)
+ then
+ -- unindent after end of elsif, e.g:
+ --
+ -- if xxx then
+ -- xxx
+ -- elsif xxx then
+ -- xxx
+ -- end if;
+
+ if Reserved = Tok_End then
+ case Top_Token.Token is
+ when Tok_When | Tok_Exception =>
+ -- End of subprogram
+ Do_Pop := Do_Pop + 1;
+
+ when others =>
+ null;
+ end case;
+
+ Do_Pop := Do_Pop + 1;
+
+ elsif Top_Token.Token = Tok_Then
+ and then Reserved = Tok_Elsif
+ then
+ Top_Token.Token := Tok_If;
+ end if;
+
+ elsif Reserved = Tok_With then
+ if not In_Generic then
+ if Top_Token.Token = Tok_With
+ or else Top_Token.Token = Tok_Use
+ then
+ -- Incomplete clause, pops to preserve tree balance
+
+ Do_Pop := Do_Pop + 1;
+ end if;
+
+ if Top_Token.Token = No_Token then
+ Do_Push := True;
+ end if;
+ end if;
+
+ if Prev_Prev_Token not in Tok_Raise | Tok_Left_Paren
+ -- Exclude Tok_Raise: raise CE with "string";
+ -- Ditto for Tok_Left_Paren: X := (Parent with Field => null);
+ and then
+ ((Top_Token.Token in Tok_Type | Tok_Subtype
+ | Tok_Function | Tok_Procedure | Tok_Colon
+ and then Num_Parens = 0)
+ or else (Top_Token.Token in Tok_Task | Tok_Protected
+ and then (Prev_Prev_Token
+ in Tok_Protected | Tok_Task | Tok_Type
+ or else Prev_Token = Tok_Right_Paren))
+ or else (Top_Token.Token = No_Token
+ and then Prev_Token
+ not in Tok_Semicolon | Tok_Limited |
+ Tok_Private | No_Token))
+ then
+ -- Recognize aspect clauses, even in the case of a partial
+ -- buffer. But do not confuse with a 'with' clause.
+
+ Tmp_Index := Current + 1;
+ Skip_Blanks (Buffer, Tmp_Index);
+
+ if not Look_For (Tmp_Index, "record")
+ and then not Look_For (Tmp_Index, "null")
+ and then not Look_For (Tmp_Index, "private")
+ then
+ Aspect_Clause := True;
+ Aspect_Clause_Sloc :=
+ (Line_Count,
+ Current + 1 - Start_Of_Line + 1,
+ Current + 1);
+ Do_Push := True;
+ Temp.Token := Tok_Arrow; -- Arrow is used for aspects
+ Temp.Sloc := Aspect_Clause_Sloc;
+ end if;
+ end if;
+
+ elsif Reserved = Tok_Use and then
+ (Top_Token.Token = No_Token or else
+ (Top_Token.Token /= Tok_For
+ and then Top_Token.Token /= Tok_Record))
+ then
+ if Top_Token.Token = Tok_With
+ or else Top_Token.Token = Tok_Use
+ then
+ -- Incomplete clause, pops to preserve tree balance
+
+ Do_Pop := Do_Pop + 1;
+ end if;
+
+ Do_Push := True;
+
+ elsif Reserved = Tok_Is
+ or else Reserved = Tok_Declare
+ or else Reserved = Tok_Begin
+ or else Reserved = Tok_Do
+ or else (Prev_Token /= Tok_Or
+ and then Reserved = Tok_Else
+ and then Num_Parens = 0)
+ or else (Prev_Token /= Tok_And
+ and then Reserved = Tok_Then
+ and then Num_Parens = 0)
+ or else (Prev_Token /= Tok_End and then Reserved = Tok_Select)
+ or else (Reserved = Tok_Or
+ and then (Top_Token.Token = Tok_Select
+ or else Top_Token.Token = Tok_When))
+ or else (Prev_Token /= Tok_End and then Reserved = Tok_Loop)
+ or else (Prev_Token /= Tok_End and then Prev_Token /= Tok_Null
+ and then Reserved = Tok_Record)
+ or else ((Top_Token.Token = Tok_Exception
+ or else Top_Token.Token = Tok_Case
+ or else Top_Token.Token = Tok_Select)
+ and then Reserved = Tok_When
+ and then Prev_Token /= Tok_Exit
+ and then Prev_Prev_Token /= Tok_Exit)
+ or else (Top_Token.In_Declaration
+ and then Reserved = Tok_Private
+ and then
+ (Prev_Token /= Tok_Is
+ or else Top_Token.Token = Tok_Package)
+ and then Prev_Token /= Tok_Limited
+ and then Prev_Token /= Tok_With)
+ then
+ if Reserved = Tok_Do then
+ if Top_Token.Token = Tok_Accept then
+ Top_Token.Token := Tok_Do;
+ else
+ -- Extended return statement:
+ -- return X : xxx do
+ -- ...
+ -- end;
+
+ Temp.Token := Tok_Return;
+ Do_Push := True;
+ end if;
+ end if;
+
+ if Reserved = Tok_Select then
+ Do_Push := True;
+
+ elsif Top_Token.Token = Tok_If
+ and then Reserved = Tok_Then
+ then
+ -- Notify that we're past the 'if' condition
+
+ Top_Token.Token := Tok_Then;
+
+ elsif Reserved = Tok_Loop then
+ if Top_Token.Token = Tok_While
+ or else Top_Token.Token = Tok_For
+ then
+ -- Replace token since this is a loop construct
+ -- but keep the original source location.
+
+ Top_Token.Token := Tok_Loop;
+
+ else
+ Do_Push := True;
+ end if;
+
+ elsif Reserved = Tok_Declare then
+ if Align_On_Colons then
+ Temp.Align_Colon :=
+ Compute_Alignment
+ (Prec, Stop_On_Blank_Line => Stop_On_Blank_Line);
+ end if;
+
+ Temp.In_Declaration := True;
+ Adjust_Block_Column;
+ Do_Push := True;
+
+ elsif Reserved = Tok_Is then
+ case Top_Token.Token is
+ when Tok_Case | Tok_When | Tok_Type | Tok_Subtype =>
+ Top_Token.Type_Definition_Section := True;
+
+ when Tok_Task | Tok_Protected =>
+ if Top_Token.Token = Tok_Protected then
+ Top_Token.Type_Definition_Section := True;
+ end if;
+
+ if Align_On_Colons then
+ Top_Token.Align_Colon := Compute_Alignment
+ (Prec, Stop_On_Blank_Line => Stop_On_Blank_Line);
+ end if;
+
+ Top_Token.In_Declaration := True;
+
+ when others =>
+ if Top_Token.Token = Tok_Function then
+ Index_Next := Current + 1;
+
+ -- Skip blanks on current line
+
+ while Index_Next < Buffer'Last
+ and then Buffer (Index_Next) /= ASCII.LF
+ and then (Buffer (Index_Next) = ' '
+ or else Buffer (Index_Next) = ASCII.HT)
+ loop
+ Index_Next := Index_Next + 1;
+ end loop;
+ end if;
+
+ if Align_On_Colons then
+ Top_Token.Align_Colon := Compute_Alignment
+ (Prec, Stop_On_Blank_Line => Stop_On_Blank_Line);
+ end if;
+
+ Top_Token.In_Declaration := True;
+ end case;
+
+ elsif Reserved = Tok_Begin then
+ if Top_Token.In_Declaration then
+ Num_Spaces := Num_Spaces - Indent_Level;
+ Top_Token.Align_Colon := 0;
+ Top_Token.In_Declaration := False;
+
+ else
+ Adjust_Block_Column;
+ Do_Push := True;
+ end if;
+
+ elsif Reserved = Tok_Record then
+ -- Is "record" the first keyword on the line ?
+ -- If True, we are in a case like:
+ -- type A is
+ -- record -- from Indent_Record
+ -- null;
+ -- end record;
+
+ if Top_Token.Token = Tok_Type then
+ Top_Token.Attributes (Ada_Record_Attribute) := True;
+ Temp.Attributes (Ada_Record_Attribute) := True;
+ Temp.Type_Definition_Section :=
+ Top_Token.Type_Definition_Section;
+ end if;
+
+ Do_Push := True;
+
+ elsif Reserved = Tok_Else
+ or else (Top_Token.Token = Tok_Select
+ and then Reserved = Tok_Then)
+ or else (Reserved = Tok_When and then Num_Parens = 0)
+ or else Reserved = Tok_Or
+ or else Reserved = Tok_Private
+ then
+ if (Reserved = Tok_Or or else Reserved = Tok_Else)
+ and then Top_Token.Token = Tok_When
+ then
+ Do_Pop := Do_Pop + 1;
+ Top_Token := Top (Tokens);
+ end if;
+
+ if Reserved = Tok_Private then
+ Top_Token.Visibility_Section := Visibility_Private;
+ end if;
+
+ if Reserved = Tok_When then
+ Do_Push := True;
+ end if;
+ end if;
+
+ elsif (Reserved = Tok_Type
+ and then Prev_Token /= Tok_With -- with type
+ and then Prev_Token /= Tok_Use -- use type
+ and then (Prev_Prev_Token /= Tok_Use or
+ Prev_Token /= Tok_All)) -- use all type
+ or else Reserved = Tok_Subtype
+ then
+ -- Entering a type declaration/definition
+
+ if Prev_Token = Tok_Task -- task type
+ or else Prev_Token = Tok_Protected -- protected type
+ then
+ Top_Token.Type_Declaration := True;
+ else
+ Do_Push := True;
+ end if;
+
+ In_Declaration := Type_Decl;
+
+ elsif Reserved = Tok_Exception then
+ if Top_Token.Token /= Tok_Colon then
+ Do_Push := True;
+ end if;
+
+ elsif Reserved = Tok_Generic then
+ Temp.In_Declaration := True;
+ Do_Push := True;
+ end if;
+
+ exception
+ when Token_Stack.Stack_Empty =>
+ Syntax_Error := True;
+ end Handle_Word_Token;
+
+ ------------------------
+ -- Handle_Word_Indent --
+ ------------------------
+
+ procedure Handle_Word_Indent
+ (Reserved : Token_Type; Temp : in out Extended_Token)
+ is
+ Top_Token : Token_Stack.Generic_Type_Access := Top (Tokens);
+ Start_Of_Line : Natural;
+ Index_Next : Natural;
+ Tmp_Index : Natural;
+
+ begin
+ Top_Token := Top (Tokens);
+ Start_Of_Line := Line_Start (Buffer, Prec);
+
+ -- Note: the order of the following conditions is important
+
+ if Prev_Token /= Tok_End and then Reserved = Tok_Case then
+ if Align_On_Colons
+ and then Top_Token.Token = Tok_Record
+ then
+ Temp.Align_Colon := Compute_Alignment
+ (Prec,
+ Stop_On_Blank_Line => Stop_On_Blank_Line);
+ end if;
+
+ Do_Indent (Prec, Line_Count, Num_Spaces);
+
+ if Prev_Token /= Tok_Left_Paren
+ and then Indent_Case_Extra = RM_Style
+ then
+ Temp.Extra_Indent := True;
+ Num_Spaces := Num_Spaces + Indent_Level;
+ end if;
+
+ elsif Reserved = Tok_Abort then
+ if Top_Token.Token = Tok_Select and then Prev_Token = Tok_Then then
+ -- Temporarily unindent if we have a 'then abort' construct,
+ -- with 'abort' on its own line, e.g:
+ -- select
+ -- Foo;
+ -- then
+ -- abort
+ -- Bar;
+
+ Do_Indent
+ (Prec,
+ Line_Count,
+ Num_Spaces - Indent_Level,
+ Continuation => True);
+ end if;
+
+ elsif Reserved = Tok_Renames then
+ if In_Declaration = Subprogram_Decl then
+ -- function A (....)
+ -- renames B;
+
+ Indent_Function_Return (Prec);
+ end if;
+
+ elsif Prev_Token = Tok_Is
+ and then not In_Generic
+ and then Top_Token.Token /= Tok_Type
+ and then (Top_Token.Token not in Tok_Task | Tok_Protected
+ or else Reserved = Tok_Separate)
+ and then Top_Token.Token /= Tok_Subtype
+ and then (Reserved = Tok_New
+ or else Reserved = Tok_In
+ or else Reserved = Tok_Abstract
+ or else Reserved = Tok_Separate
+ or else (Reserved = Tok_Null
+ and then not In_Generic
+ and then Top_Token.Token = Tok_Procedure))
+ then
+ -- Handle indentation of e.g.
+ --
+ -- function Abstract_Func
+ -- return String
+ -- is abstract;
+
+ if Top_Token.Token = Tok_Function
+ and then Reserved /= Tok_New
+ and then
+ (Reserved = Tok_Abstract
+ or else Reserved = Tok_Separate
+ or else
+ Start_Of_Line /= Line_Start (Buffer, Top_Token.Sloc.Index))
+ then
+ Indent_Function_Return (Prec);
+ Num_Spaces := Num_Spaces + Indent_Level;
+ end if;
+
+ -- Unindent since this is a declaration, e.g:
+ -- package ... is new ...;
+ -- function ... is abstract;
+ -- function ... is separate;
+ -- procedure ... is null;
+
+ -- Or a Gnatdist main procedure declaration :
+ -- procedure ... is in ...;
+
+ Num_Spaces := Num_Spaces - Indent_Level;
+
+ if Num_Spaces < 0 then
+ Num_Spaces := 0;
+ Syntax_Error := True;
+ end if;
+
+ elsif (Reserved in Tok_Function | Tok_Procedure | Tok_Protected
+ and then Top_Token.Token /= Tok_Type)
+ or else (Reserved in Tok_Package | Tok_Task | Tok_Entry
+ and then Prev_Token /= Tok_Is)
+ then
+ if In_Generic and then Prev_Token not in Tok_With | Tok_Access then
+ -- unindent after a generic declaration, e.g:
+ --
+ -- generic
+ -- with procedure xxx;
+ -- with function xxx;
+ -- with package xxx;
+ -- package xxx is
+
+ Num_Spaces := Num_Spaces - Indent_Level;
+
+ if Num_Spaces < 0 then
+ Num_Spaces := 0;
+ Syntax_Error := True;
+ end if;
+ end if;
+
+ elsif Reserved = Tok_Return
+ and then In_Declaration = Subprogram_Decl
+ then
+ Indent_Function_Return (Prec);
+
+ elsif Reserved = Tok_End
+ or else (Reserved = Tok_Elsif and then Num_Parens = 0)
+ or else (Reserved = Tok_Null
+ and then not In_Generic
+ and then Prev_Token = Tok_Is
+ and then Top_Token.Token = Tok_Procedure)
+ then
+ -- unindent after end of elsif, e.g:
+ --
+ -- if xxx then
+ -- xxx
+ -- elsif xxx then
+ -- xxx
+ -- end if;
+
+ if Reserved = Tok_End then
+ case Top_Token.Token is
+ when Tok_When | Tok_Exception =>
+ -- Undo additional level of indentation, as in:
+ -- ...
+ -- exception
+ -- when others =>
+ -- null;
+ -- end;
+
+ Num_Spaces := Num_Spaces - Indent_Level;
+
+ when Tok_Case =>
+ if Top_Token.Extra_Indent then
+ Num_Spaces := Num_Spaces - Indent_Level;
+ end if;
+
+ when Tok_Record =>
+ -- If the "record" keyword was on its own line
+
+ if Top_Token.Extra_Indent then
+ Do_Indent
+ (Prec, Line_Count, Num_Spaces - Indent_Level);
+ Num_Spaces := Num_Spaces - Indent_Record;
+ end if;
+
+ when others =>
+ null;
+ end case;
+ end if;
+
+ Num_Spaces := Num_Spaces - Indent_Level;
+
+ if Num_Spaces < 0 then
+ Num_Spaces := 0;
+ Syntax_Error := True;
+ end if;
+
+ elsif (Reserved = Tok_Is
+ and then Num_Parens = 0
+ and then not In_Generic)
+ or else Reserved in Tok_Declare | Tok_Begin | Tok_Do
+ or else (Prev_Token /= Tok_Or
+ and then Reserved = Tok_Else
+ and then Num_Parens = 0)
+ or else (Prev_Token /= Tok_And
+ and then Reserved = Tok_Then
+ and then Num_Parens = 0)
+ or else (Prev_Token /= Tok_End and then Reserved = Tok_Select)
+ or else (Reserved = Tok_Or
+ and then (Top_Token.Token = Tok_Select
+ or else Top_Token.Token = Tok_When))
+ or else (Prev_Token /= Tok_End and then Reserved = Tok_Loop)
+ or else (Prev_Token /= Tok_End and then Prev_Token /= Tok_Null
+ and then Reserved = Tok_Record)
+ or else ((Top_Token.Token = Tok_Exception
+ or else Top_Token.Token = Tok_Case
+ or else Top_Token.Token = Tok_Select)
+ and then Reserved = Tok_When
+ and then Prev_Token /= Tok_Exit
+ and then Prev_Prev_Token /= Tok_Exit)
+ or else (Top_Token.In_Declaration
+ and then Reserved = Tok_Private
+ and then
+ (Prev_Token /= Tok_Is
+ or else Top_Token.Token = Tok_Package)
+ and then Prev_Token /= Tok_Limited
+ and then Prev_Token /= Tok_With)
+ then
+ -- unindent for this reserved word, and then indent again, e.g:
+ --
+ -- procedure xxx is
+ -- ...
+ -- begin <--
+ -- ...
+
+ if Reserved = Tok_Declare then
+ if Align_On_Colons then
+ Temp.Align_Colon :=
+ Compute_Alignment
+ (Prec, Stop_On_Blank_Line => Stop_On_Blank_Line);
+ end if;
+
+ if Prev_Token = Tok_Colon then
+ -- Adjust status column of declare block to take into
+ -- account a label at start of the line by using the first
+ -- non blank character on the line.
+
+ Tmp_Index := Start_Of_Line;
+ Skip_Blanks (Buffer, Tmp_Index);
+ Temp.Sloc.Column := Tmp_Index - Start_Of_Line + 1;
+ Temp.Sloc.Index := Tmp_Index;
+ end if;
+
+ elsif Reserved = Tok_Is then
+ if not In_Generic then
+ case Top_Token.Token is
+ when Tok_Case | Tok_When | Tok_Type | Tok_Subtype =>
+ null;
+
+ when Tok_Task | Tok_Protected =>
+ if Align_On_Colons then
+ Top_Token.Align_Colon := Compute_Alignment
+ (Prec, Stop_On_Blank_Line => Stop_On_Blank_Line);
+ end if;
+
+ when others =>
+ if Top_Token.Token = Tok_Function then
+ Index_Next := Current + 1;
+
+ -- Skip blanks on current line
+
+ while Index_Next < Buffer'Last
+ and then Buffer (Index_Next) /= ASCII.LF
+ and then (Buffer (Index_Next) = ' '
+ or else Buffer (Index_Next) = ASCII.HT)
+ loop
+ Index_Next := Index_Next + 1;
+ end loop;
+ end if;
+
+ if Align_On_Colons then
+ Top_Token.Align_Colon := Compute_Alignment
+ (Prec, Stop_On_Blank_Line => Stop_On_Blank_Line);
+ end if;
+ end case;
+ end if;
+
+ elsif Reserved = Tok_Begin then
+ if Top_Token.In_Declaration then
+ Num_Spaces := Num_Spaces - Indent_Level;
+ Top_Token.Align_Colon := 0;
+ Top_Token.In_Declaration := False;
+ end if;
+
+ elsif Reserved = Tok_Record then
+ -- Is "record" the first keyword on the line ?
+ -- If True, we are in a case like:
+ -- type A is
+ -- record -- from Indent_Record
+ -- null;
+ -- end record;
+
+ if not Indent_Done then
+ Temp.Extra_Indent := True;
+ Num_Spaces := Num_Spaces + Indent_Record;
+ Do_Indent (Prec, Line_Count, Num_Spaces);
+ end if;
+
+ if Top_Token.Token = Tok_Type then
+ Num_Spaces := Num_Spaces + Indent_Level;
+
+ if Align_On_Colons then
+ Temp.Align_Colon := Compute_Alignment
+ (Prec, Stop_On_Blank_Line => Stop_On_Blank_Line);
+ end if;
+ end if;
+
+ elsif Reserved = Tok_Else
+ or else (Top_Token.Token = Tok_Select
+ and then Reserved = Tok_Then)
+ or else (Reserved = Tok_When and then Num_Parens = 0)
+ or else Reserved = Tok_Or
+ or else Reserved = Tok_Private
+ then
+ if (Reserved = Tok_Or or else Reserved = Tok_Else)
+ and then Top_Token.Token = Tok_When
+ and then (Next (Tokens) = null
+ or else Next (Tokens).Token /= Tok_Case)
+ then
+ Num_Spaces := Num_Spaces - Indent_Level;
+ end if;
+
+ if Reserved /= Tok_When
+ or else Top_Token.Token /= Tok_Select
+ then
+ Num_Spaces := Num_Spaces - Indent_Level;
+ end if;
+
+ if Reserved = Tok_When then
+ if Top_Token.Token = Tok_Case then
+ if Indent_Case_Extra = Automatic
+ and then not Top_Token.Extra_Indent
+ and then Prec - Start_Of_Line > Num_Spaces
+ then
+ Top_Token.Extra_Indent := True;
+ Num_Spaces := Num_Spaces + Indent_Level;
+ end if;
+ end if;
+ end if;
+ end if;
+
+ if Num_Spaces < 0 then
+ Num_Spaces := 0;
+ Syntax_Error := True;
+ end if;
+
+ if Top_Token.Token /= Tok_Type
+ and then Top_Token.Token /= Tok_Subtype
+ and then (Token /= Tok_Is
+ or else In_Generic
+ or else Top_Token.Token /= Tok_Function
+ or else not
+ (Look_For (Index_Next, "abstract")
+ or else Look_For (Index_Next, "separate")))
+ -- 'is abstract|separate' will be indented when handling
+ -- 'abstract|separate' for functions
+ then
+ Do_Indent (Prec, Line_Count, Num_Spaces);
+ Num_Spaces := Num_Spaces + Indent_Level;
+ end if;
+
+ elsif Reserved = Tok_Or
+ or else Reserved = Tok_And
+ or else Reserved = Tok_Xor
+ then
+ -- "and then", "or else", "and", "or" and "xor" should get an
+ -- extra indentation on line start, e.g:
+ -- if ...
+ -- and then ...
+
+ if Top (Indents).Level = None then
+ if Continuation_Val > 0 then
+ if Top (Tokens).Colon_Col = 0 then
+ Continuation_Val := Continuation_Val - Indent_Continue;
+ else
+ Continuation_Val := Continuation_Val + Indent_Continue;
+ end if;
+ end if;
+
+ Do_Indent (Prec, Line_Count, Num_Spaces, Continuation => True);
+ else
+ Do_Indent (Prec, Line_Count, Num_Spaces);
+ end if;
+
+ elsif Reserved = Tok_Generic then
+ -- Indent before a generic entity, e.g:
+ --
+ -- generic
+ -- type ...;
+
+ Do_Indent (Prec, Line_Count, Num_Spaces);
+ Num_Spaces := Num_Spaces + Indent_Level;
+
+ elsif Reserved = Tok_Exception then
+ if Top_Token.Token /= Tok_Colon then
+ Num_Spaces := Num_Spaces - Indent_Level;
+ Do_Indent (Prec, Line_Count, Num_Spaces);
+ Num_Spaces := Num_Spaces + 2 * Indent_Level;
+ end if;
+ end if;
+
+ exception
+ when Token_Stack.Stack_Empty =>
+ Syntax_Error := True;
+ end Handle_Word_Indent;
+
+ ---------------
+ -- Next_Word --
+ ---------------
+
+ procedure Next_Word
+ (P : in out Natural;
+ L : in out Natural;
+ Terminated : out Boolean;
+ End_Reached : out Boolean)
+ is
+ Comma : String := ", ";
+ Spaces : String := " ";
+ End_Of_Line : Natural;
+ Start_Of_Line : Natural;
+ Long : Natural;
+ First : Natural;
+ Last : Natural;
+ Offs : Natural;
+ Align : Natural;
+ Adjust : Natural;
+ Insert_Spaces : Boolean;
+ Char : Character;
+ Prev_Prev_Token : Token_Type := No_Token;
+ Prev3_Token : Token_Type;
+ Local_Top_Token : Token_Stack.Generic_Type_Access;
+ Tmp : Boolean;
+ Token_Found : Boolean;
+ Recompute_Align : Boolean;
+
+ procedure Close_Parenthesis;
+ -- Current buffer contents is a closed parenthesis,
+ -- reset stacks and states accordingly.
+
+ procedure Handle_Arrow;
+ -- Current buffer contents is an arrow colon, handle it.
+ -- In particular, align arrows in statements.
+
+ procedure Handle_Colon;
+ -- Current buffer contents is a colon, handle it.
+ -- In particular, align colons in declarations.
+
+ procedure Handle_Two_Chars (Second_Char : Character);
+ -- Handle a two char operator, whose second char is Second_Char
+
+ procedure Preprocessor_Directive;
+ -- Handle preprocessor directive.
+ -- Assume that Buffer (P) = '#'
+
+ procedure Skip_Blank_Lines;
+ -- Skip empty lines
+
+ procedure Skip_Comments;
+ -- Skip comment & blank lines
+
+ procedure Pop_And_Set_Local (Stack : in out Token_Stack.Simple_Stack);
+ -- Pops the last element of the stack and set Local_Top_Token
+ -- to the top element, null if the stack is empty.
+
+ -----------------------
+ -- Close_Parenthesis --
+ -----------------------
+
+ procedure Close_Parenthesis is
+ begin
+ if not Is_Empty (Paren_Stack) then
+ Pop (Paren_Stack);
+ end if;
+
+ if Is_Empty (Indents) or else Top (Indents).Level = None then
+ -- Syntax error
+ null;
+
+ else
+ if not Indent_Done then
+ -- Adjust indentation level for closing parenthesis at the
+ -- beginning of a line, e.g:
+ --
+ -- (x,
+ -- y
+ -- ); <-
+
+ Top (Indents).Level := Top (Indents).Level - 1;
+ Do_Indent (P, L, Num_Spaces);
+ Continuation_Val := Top (Indents).Continuation_Val;
+ end if;
+
+ Num_Parens := Num_Parens - 1;
+ Pop (Indents);
+ Local_Top_Token := Top (Tokens);
+
+ if Num_Parens = 0 then
+ Is_Parameter := False;
+ Is_Discriminant := False;
+ Right_Assignment := False;
+ Paren_In_Middle := False;
+
+ if Local_Top_Token.Token in Token_Class_Declk
+ and then Local_Top_Token.Profile_End = 0
+ and then In_Declaration = Subprogram_Decl
+ then
+ Local_Top_Token.Profile_End := P;
+ Local_Top_Token.Align_Colon := 0;
+ end if;
+ end if;
+ end if;
+ end Close_Parenthesis;
+
+ ------------------
+ -- Handle_Colon --
+ ------------------
+
+ procedure Handle_Colon is
+ Align_Colon : Natural := 0;
+ Non_Blank : Natural;
+ Offset_Align : Natural;
+ First_Paren : Natural;
+ Colon_Token : Token_Stack.Generic_Type_Access;
+ Char : Character;
+
+ begin
+ Prev_Token := Tok_Colon;
+ Non_Blank := Start_Of_Line;
+ Is_Parameter := False;
+ Is_Discriminant := False;
+
+ if Format then
+ Skip_Blanks (Buffer, Non_Blank);
+ end if;
+
+ if Local_Top_Token.In_Declaration
+ and then Local_Top_Token.Token = Tok_Identifier
+ then
+ Pop_And_Set_Local (Tokens);
+
+ declare
+ Val : Extended_Token;
+ begin
+ -- Create a dummy token to separate variables
+ -- declaration from their type.
+
+ Val.Token := Tok_Colon;
+
+ case In_Declaration is
+ when Subprogram_Decl =>
+ Val.Variable_Kind := Parameter_Kind;
+
+ when Type_Decl =>
+ Val.Variable_Kind := Discriminant_Kind;
+
+ when others =>
+ null;
+
+ end case;
+
+ if Align_Decl_On_Colon then
+ Val.Colon_Col := P - Non_Blank;
+ end if;
+
+ Push (Tokens, Val);
+ Colon_Token := Top (Tokens);
+ end;
+ end if;
+
+ if P > Buffer'First
+ and then P < Buffer'Last
+ and then Buffer (Prev_Char (P)) in '0' .. '9'
+ then
+ Char := Buffer (Next_Char (P));
+
+ if Char in '0' .. '9' or else Char = ';' then
+ -- Special case 16:12: obsolete format (equivalent to
+ -- 16#12#), e.g:
+ -- X : Integer := 16:12:;
+
+ Insert_Spaces := False;
+ end if;
+ end if;
+
+ -- Auto align colons in declarations (parameters, variables, ...)
+
+ if Local_Top_Token.Align_Colon = 0
+ or else Num_Parens > 1
+ then
+ return;
+ end if;
+
+ Align_Colon := Local_Top_Token.Align_Colon;
+
+ if Format_Operators then
+ if Buffer (Next_Char (P)) = ' '
+ or else Last - 1 = End_Of_Line
+ then
+ Long := 2;
+ else
+ Long := 3;
+ end if;
+
+ if Buffer (Prev_Char (P)) = ' ' then
+ Offs := 2;
+ Long := Long - 1;
+ else
+ Align_Colon := Align_Colon - 1;
+ end if;
+ else
+ Offs := 2;
+ Long := 1;
+ end if;
+
+ if Num_Parens /= 0 then
+ -- Handle properly alignment of first parameter in the
+ -- following case:
+ --
+ -- procedure F (X : Integer; <--
+ -- Foo : Integer);
+
+ First_Paren := Non_Blank;
+
+ while First_Paren < P
+ and then Buffer (First_Paren) /= '('
+ loop
+ First_Paren := First_Paren + 1;
+ end loop;
+
+ if Buffer (First_Paren) = '(' then
+ Align_Colon := Align_Colon + First_Paren - Non_Blank + 1;
+ end if;
+ end if;
+
+ -- In case Align_Colon is too small, avoid truncating non blank
+ -- characters by never using a negative offset.
+
+ Offset_Align :=
+ Integer'Max (0, Align_Colon - (P - Non_Blank + 1));
+
+ if Align_Decl_On_Colon
+ and then Colon_Token /= null
+ then
+ Colon_Token.Colon_Col := Colon_Token.Colon_Col + Offset_Align;
+ end if;
+
+ Replace_Text
+ (First, Last, L,
+ (1 .. Offset_Align => ' ')
+ & Spaces (Offs .. Offs + Long - 1));
+ Insert_Spaces := False;
+ end Handle_Colon;
+
+ ------------------
+ -- Handle_Arrow --
+ ------------------
+
+ procedure Handle_Arrow is
+ Align_Arrow : Natural := Top (Indents).Align_Arrow;
+ Non_Blank : Natural;
+ Offset_Align : Natural;
+ J : Natural;
+ First_Paren : Natural;
+ Next_Tok : Token_Stack.Generic_Type_Access;
+
+ begin
+ if Num_Parens > 0
+ and then Analyze_Ada_Source.Prev_Prev_Token
+ in Tok_When | Tok_Dot_Dot
+ then
+ -- Handle case expression:
+ -- (case X is
+ -- when 1
+ -- =>
+
+ Compute_Indentation
+ (Tok_Arrow, Prev_Token, Prev_Prev_Token,
+ P, L, Num_Spaces);
+ else
+ Do_Indent (P, L, Num_Spaces);
+ end if;
+
+ Prev_Token := Tok_Arrow;
+ Next_Tok := Next (Tokens);
+
+ if (Local_Top_Token.Token = Tok_When
+ and then (Next_Tok = null
+ or else Next_Tok.Token /= Tok_Select))
+ or else Local_Top_Token.Token = Tok_For
+ then
+ Pop_And_Set_Local (Tokens);
+ end if;
+
+ Handle_Two_Chars ('>');
+
+ if Align_Arrow = 0 then
+ return;
+ end if;
+
+ if not Is_Blank (Buffer (P - 2)) then
+ Align_Arrow := Align_Arrow - 1;
+ end if;
+
+ Non_Blank := Start_Of_Line;
+ Skip_Blanks (Buffer, Non_Blank);
+
+ -- Handle properly alignment of first parameter in the
+ -- following case:
+ --
+ -- Foo (X => 1, <--
+ -- Foo => 2);
+
+ First_Paren := 0;
+ J := Non_Blank;
+
+ while J < P - 1 loop
+ if Buffer (J) = '('
+ and then (Buffer (J - 1) /= '''
+ or else Buffer (J + 1) /= ''')
+ and then First_Paren = 0
+ then
+ First_Paren := J;
+ end if;
+
+ if Buffer (J) = ')'
+ and then (Buffer (J - 1) /= '''
+ or else Buffer (J + 1) /= ''')
+ then
+ First_Paren := 0;
+ end if;
+
+ J := J + 1;
+ end loop;
+
+ if First_Paren /= 0 and then Buffer (First_Paren) = '(' then
+ Align_Arrow := Align_Arrow + First_Paren - Non_Blank + 1;
+ end if;
+
+ -- In case Align_Arrow is too small, avoid truncating non blank
+ -- characters by never using a negative offset.
+
+ Offset_Align := Integer'Max (0, Align_Arrow - (P - Non_Blank + 1));
+
+ Replace_Text
+ (First, Last, L,
+ (1 .. Offset_Align => ' ')
+ & Spaces (Offs .. Offs + Long - 1));
+ Insert_Spaces := False;
+ end Handle_Arrow;
+
+ ----------------------
+ -- Handle_Two_Chars --
+ ----------------------
+
+ procedure Handle_Two_Chars (Second_Char : Character) is
+ Prev_Tmp : constant Integer := Prev_Char (P);
+ begin
+ Last := P + 2;
+
+ if Prev_Tmp < Buffer'First
+ or else Is_Blank (Buffer (Prev_Tmp))
+ then
+ Offs := 2;
+ Long := 2;
+
+ else
+ Long := 3;
+ end if;
+
+ P := Next_Char (P);
+
+ if P < Buffer_Last
+ and then not Is_Blank (Buffer (Next_Char (P)))
+ then
+ Long := Long + 1;
+ end if;
+
+ Spaces (3) := Second_Char;
+ end Handle_Two_Chars;
+
+ ----------------------
+ -- Skip_Blank_Lines --
+ ----------------------
+
+ procedure Skip_Blank_Lines is
+ begin
+ if P > Buffer_Last
+ or else (Buffer (P) /= ASCII.LF and then Buffer (P) /= ASCII.CR)
+ then
+ return;
+ end if;
+
+ while P < Buffer_Last and then
+ (Buffer (P) = ASCII.LF or else Buffer (P) = ASCII.CR)
+ loop
+ if Buffer (P) = ASCII.LF then
+ New_Line (L);
+ Indent_Done := False;
+ end if;
+
+ P := Next_Char (P);
+ end loop;
+
+ if P < Buffer_Last then
+ Start_Of_Line := P;
+ End_Of_Line := Line_End (Buffer, Start_Of_Line);
+ end if;
+ end Skip_Blank_Lines;
+
+ -------------------
+ -- Skip_Comments --
+ -------------------
+
+ procedure Skip_Comments is
+ Prev_Start_Line : Natural;
+ Last : Natural;
+ Ref_Indent : Natural;
+ Success : Boolean;
+ Entity : Language_Entity;
+ First_Indent : Boolean := True;
+
+ begin
+ Ref_Indent := Integer'Max (Num_Spaces, 0);
+
+ if not Indent_Done
+ and then Stick_Comments
+ and then (Prev_Token = Tok_Is or else Prev_Token = Tok_Record)
+ and then Start_Of_Line > Buffer'First + 2
+ and then Buffer (Start_Of_Line - 2) /= ASCII.LF
+ then
+ Ref_Indent := Integer'Max (Ref_Indent - Indent_Level, 0);
+ end if;
+
+ while P < Buffer_Last
+ and then Buffer (P) = '-'
+ and then Buffer (P + 1) = '-'
+ loop
+ Prev_Start_Line := Start_Of_Line;
+ Prev_Line := L;
+ First := P;
+ Comments_Skipped := True;
+
+ -- If we do not indent here, then automatic indentation
+ -- won't work for comments right after 'is' and 'begin',
+ -- e.g:
+ -- procedure Foo is
+ -- begin
+ -- -- comment
+
+ if Indent_Comments then
+ if First_Indent
+ and then not Indent_Done
+ and then
+ ((Prev_Token in Reserved_Token_Type
+ and then Prev_Token not in Token_Class_No_Cont)
+ or else (Prev_Token = Tok_Right_Paren
+ and then Top (Tokens).Token /= No_Token)
+ or else (Num_Parens > 0 and then Continuation_Val /= 0))
+ then
+ -- Add simple handling of comment and continuation lines
+
+ if Num_Parens > 0 then
+ Continuation_Val := Continuation_Val - Indent_Continue;
+ end if;
+
+ Do_Indent (P, L, Ref_Indent, Continuation => True);
+ Ref_Indent :=
+ Integer'Max (Ref_Indent + Continuation_Val, 0);
+ Continuation_Val := 0;
+ else
+ Do_Indent (P, L, Ref_Indent);
+ end if;
+
+ First_Indent := False;
+ end if;
+
+ -- Keep track of the indentation of the first comment line,
+ -- in case we're doing incremental reformatting: in this case,
+ -- we want to follow the indentation (possibly manual) of this
+ -- first line.
+
+ if Ref_Indent = Num_Spaces
+ and then To /= 0
+ and then L not in From .. To
+ then
+ Ref_Indent :=
+ Integer'Max (P - Start_Of_Line - Indent_Offset, 0);
+ end if;
+
+ Next_Line (Buffer, P + 1, P, Success);
+ Last := P;
+
+ if Success then
+ New_Line (L);
+ Last := Prev_Char (Last);
+ Indent_Done := False;
+ end if;
+
+ loop
+ -- Skip blank lines
+ -- ??? need to handle ASCII.CR as well, although we now
+ -- only use LF separators internally in GPS.
+
+ while P < Buffer_Last and then Buffer (P) = ASCII.LF loop
+ Ref_Indent := Integer'Max (Num_Spaces, 0);
+ New_Line (L);
+ P := P + 1;
+ end loop;
+
+ Start_Of_Line := P;
+
+ if P /= Buffer_Last then
+ while Buffer (P) = ' ' or else Buffer (P) = ASCII.HT loop
+ P := P + 1;
+
+ if P = Buffer_Last then
+ exit;
+ end if;
+ end loop;
+ end if;
+
+ exit when P = Buffer_Last or else Buffer (P) /= ASCII.LF;
+ end loop;
+
+ End_Of_Line := Line_End (Buffer, P);
+ Padding := 0;
+
+ if Indent_Comments and then Buffer (P) = ASCII.LF then
+ -- Indent last buffer line before exiting, to position
+ -- the cursor at the right location
+
+ pragma Assert (P = Buffer_Last);
+ Do_Indent (P, L, Ref_Indent);
+ end if;
+
+ if Callback /= null then
+ if First + 2 <= Buffer_Last
+ and then Buffer (First + 2) = '#'
+ then
+ Entity := Annotated_Comment_Text;
+ else
+ Entity := Comment_Text;
+ end if;
+
+ if Entity = Annotated_Comment_Text
+ and then Replace = null
+ then
+ -- Recognize and handle SPARK reserved words when parsing
+ -- constructs.
+
+ declare
+ Prev_Sloc : Source_Location;
+ Line : constant Natural := Prev_Line - 1;
+ Col : constant Natural :=
+ First + 2 - Prev_Start_Line + 1;
+
+ function Is_SPARK_Keyword (S : String) return Boolean;
+ -- Callback for Analyze_Ada_Source to recognize SPARK
+ -- keywords.
+
+ function Local_Callback
+ (Entity : Language_Entity;
+ Sloc_Start : Source_Location;
+ Sloc_End : Source_Location;
+ Partial_Entity : Boolean) return Boolean;
+ -- Wrapper around Callback
+
+ function Adjust
+ (Loc : Source_Location) return Source_Location;
+ -- Adjust Loc taking Line, Col and Offset into account
+
+ ----------------------
+ -- Is_SPARK_Keyword --
+ ----------------------
+
+ function Is_SPARK_Keyword
+ (S : String) return Boolean is
+ begin
+ return Match (SPARK_Keywords, S);
+ end Is_SPARK_Keyword;
+
+ ------------
+ -- Adjust --
+ ------------
+
+ function Adjust
+ (Loc : Source_Location) return Source_Location is
+ begin
+ return
+ (Loc.Line + Line, Loc.Column + Col, Loc.Index);
+ end Adjust;
+
+ --------------------
+ -- Local_Callback --
+ --------------------
+
+ function Local_Callback
+ (Entity : Language_Entity;
+ Sloc_Start : Source_Location;
+ Sloc_End : Source_Location;
+ Partial_Entity : Boolean) return Boolean
+ is
+ Ignore : Boolean;
+ pragma Unreferenced (Ignore);
+ Sloc1 : constant Source_Location :=
+ Adjust (Sloc_Start);
+ Sloc2 : constant Source_Location :=
+ Adjust (Sloc_End);
+
+ begin
+ if Entity = Keyword_Text
+ and then Is_SPARK_Keyword (Buffer
+ (Sloc_Start.Index .. Sloc_End.Index))
+ then
+ Ignore := Callback
+ (Annotated_Comment_Text,
+ Prev_Sloc,
+ (Sloc1.Line,
+ Sloc1.Column - 1,
+ Sloc1.Index - 1),
+ Partial_Entity);
+ Prev_Sloc := (Sloc2.Line, Sloc2.Column + 1,
+ Sloc2.Index + 1);
+
+ return Callback
+ (Annotated_Keyword_Text,
+ Sloc1, Sloc2, Partial_Entity);
+
+ else
+ return False;
+ end if;
+ end Local_Callback;
+
+ begin
+ Prev_Sloc :=
+ (Prev_Line, First - Prev_Start_Line + 1, First);
+
+ -- Call Analyze_Ada_Source recursively on the SPARK
+ -- annotations to highlight keywords.
+
+ Analyze_Ada_Source
+ (Buffer (First + 3 .. Last - 1),
+ Symbols,
+ Indent_Params => Indent_Params,
+ Format => Format,
+ Replace => null,
+ Constructs => null,
+ Callback => Local_Callback'Unrestricted_Access,
+ Indent_Offset => Indent_Offset,
+ Case_Exceptions => Case_Exceptions,
+ Is_Optional_Keyword => Is_SPARK_Keyword'Access);
+
+ if Prev_Sloc.Index <= Last then
+ if Callback
+ (Entity,
+ Prev_Sloc,
+ (Prev_Line, Last - Prev_Start_Line + 1, Last),
+ False)
+ then
+ Terminated := True;
+ return;
+ end if;
+ end if;
+ end;
+
+ else
+ if Call_Callback
+ (Entity,
+ (Prev_Line, First - Prev_Start_Line + 1, First),
+ (Prev_Line, Last - Prev_Start_Line + 1, Last),
+ False)
+ then
+ Terminated := True;
+ return;
+ end if;
+ end if;
+ end if;
+
+ if P = Buffer_Last then
+ -- In this case, the comment goes until the end of the
+ -- buffer. There's nothing more to be analyzed, so
+ -- put P beyond the last analyzed element.
+
+ P := P + 1;
+ end if;
+ end loop;
+
+ if P > Buffer_Last then
+ End_Reached := True;
+ end if;
+ end Skip_Comments;
+
+ ----------------------------
+ -- Preprocessor_Directive --
+ ----------------------------
+
+ procedure Preprocessor_Directive is
+ begin
+ -- Skip line
+
+ while P < Buffer'Last and then Buffer (P + 1) /= ASCII.LF loop
+ P := P + 1;
+ end loop;
+
+ -- Mark this line as indented, so that the current indentation is
+ -- kept.
+
+ Indent_Done := True;
+ end Preprocessor_Directive;
+
+ -----------------------
+ -- Pop_And_Set_Local --
+ -----------------------
+
+ procedure Pop_And_Set_Local
+ (Stack : in out Token_Stack.Simple_Stack) is
+ begin
+ Pop (Stack);
+
+ if not Is_Empty (Stack) then
+ Local_Top_Token := Top (Stack);
+ else
+ Local_Top_Token := null;
+ end if;
+ end Pop_And_Set_Local;
+
+ begin -- Next_Word
+ Start_Of_Line := Line_Start (Buffer, P);
+ End_Of_Line := Line_End (Buffer, Start_Of_Line);
+ Terminated := False;
+ End_Reached := False;
+
+ loop
+ declare
+ L1, L2 : Natural;
+ begin
+ L1 := L;
+ Skip_Blank_Lines;
+ Skip_Comments;
+ L2 := L;
+ -- If we have blank lines and/or comment line we need to
+ -- recompute the alignment for the next block of code.
+ Recompute_Align := L2 > L1 + 1;
+ end;
+
+ if (End_Reached and then Buffer (Buffer_Last) /= ASCII.LF)
+ or else Terminated
+ then
+ return;
+ end if;
+
+ exit when P > Buffer_Last
+ or else Is_Entity_Letter
+ (UTF8_Get_Char (Buffer (P .. Buffer_Last)));
+
+ -- WARNING: any call to Pop (Token) during the case statement
+ -- below should be followed by a recomputation of Top_Token.
+ -- See e.g. Handle_Arrow where this is done.
+ -- Only if Top_Token is not accessed further down this procedure
+ -- can the recomputation be omitted.
+
+ Local_Top_Token := Top (Tokens);
+
+ if Align_On_Colons and then Recompute_Align then
+ Local_Top_Token.Align_Colon := Compute_Alignment
+ (P,
+ Stop_On_Blank_Line => True,
+ Skip_First_Line => False);
+ end if;
+
+ Prev3_Token := Prev_Prev_Token;
+ Prev_Prev_Token := Prev_Token;
+ Token_Found := True;
+
+ case Buffer (P) is
+ when '#' =>
+ First := P;
+ Prev_Token := Tok_Pound;
+
+ if (P = Buffer'First
+ or else not Is_Alphanumeric (Buffer (P - 1)))
+ and then P < Buffer'Last
+ and then (Is_Letter (Buffer (P + 1))
+ or else Buffer (P + 1) = ' ')
+ then
+ Preprocessor_Directive;
+ end if;
+
+ when '[' =>
+ First := P;
+ Prev_Token := Tok_Left_Square_Bracket;
+
+ when ']' =>
+ First := P;
+ Prev_Token := Tok_Right_Square_Bracket;
+
+ when '(' =>
+ First := P;
+ Prev_Token := Tok_Left_Paren;
+
+ if Num_Parens = 0 then
+ if In_Declaration = Subprogram_Decl
+ and then
+ (Top_Token = null
+ or else not Top_Token.Attributes (Ada_New_Attribute))
+ then
+ Is_Parameter := True;
+ elsif In_Declaration = Type_Decl then
+ Is_Discriminant := True;
+ elsif Prev_Prev_Token = Tok_Is
+ and then Local_Top_Token.Token = Tok_Function
+ then
+ -- This is an expression function so we won't have
+ -- and 'end function', unindent accordingly.
+
+ Num_Spaces := Num_Spaces - Indent_Level;
+
+ -- ??? The code below is not quite right: ideally we
+ -- want to register the end of the expression function
+ -- at the semicolon.
+
+ Pop_And_Set_Local (Tokens);
+ end if;
+ end if;
+
+ if not Is_Empty (Paren_Stack) then
+ Push (Paren_Stack, Top (Paren_Stack).all);
+ elsif Local_Top_Token.Token = Tok_Type then
+ Push (Paren_Stack, Type_Declaration);
+ elsif Prev_Prev_Token = Tok_Return then
+ Push (Paren_Stack, Aggregate);
+ elsif Prev_Prev_Token in Reserved_Token_Type then
+ Push (Paren_Stack, Conditional);
+ elsif Prev_Prev_Token = Tok_Identifier then
+ Push (Paren_Stack, Function_Call);
+ else
+ Push (Paren_Stack, Aggregate);
+ end if;
+
+ if Continuation_Val > Indent_Continue
+ and then Top (Indents).Level /= None
+ then
+ Continuation_Val := 0;
+ end if;
+
+ if P > Buffer'First then
+ Char := Buffer (Prev_Char (P));
+ else
+ Char := ' ';
+ end if;
+
+ if Indent_Done then
+ Adjust := Indent_Continue + Continuation_Val;
+ Paren_In_Middle := True;
+
+ -- If Prev_Prev_Token is an operator, it means that
+ -- spaces have already been inserted.
+
+ if Format_Operators
+ and then not Is_Blank (Char)
+ and then Char /= '('
+ and then Char /= '''
+ and then not Is_Extended_Operator (Prev_Prev_Token)
+ then
+ Spaces (2) := Buffer (P);
+ Replace_Text (P, P + 1, L, Spaces (1 .. 2));
+ end if;
+
+ else
+ -- Indent with extra spaces if the '(' is the first
+ -- non blank character on the line
+
+ if Prev_Prev_Token = Tok_Comma then
+ Adjust := 1;
+ else
+ Adjust := Indent_Continue + 1;
+ end if;
+
+ if Prev_Prev_Token = Tok_Comma
+ or else Prev_Prev_Token = Tok_Ampersand
+ then
+ Do_Indent (P, L, Num_Spaces);
+ else
+ if Prev_Prev_Token = Tok_Colon_Equal
+ and then Local_Top_Token.Colon_Col /= 0
+ and then Continuation_Val = 0
+ then
+ Continuation_Val :=
+ Top (Tokens).Colon_Col + 4 - Indent_Continue;
+ end if;
+
+ Adjust := Adjust + Continuation_Val;
+ Tmp := Paren_In_Middle;
+ Do_Indent
+ (P, L, Num_Spaces,
+ Continuation =>
+ Prev_Prev_Token = Tok_Apostrophe
+ or else Prev_Prev_Token = Tok_Arrow
+ or else not Paren_In_Middle
+ or else Prev_Prev_Token in Reserved_Token_Type);
+ Paren_In_Middle := Tmp;
+ end if;
+ end if;
+
+ Num_Parens := Num_Parens + 1;
+ Align := 0;
+
+ if Num_Parens = 1
+ and then Local_Top_Token.Token in Token_Class_Declk
+ and then Local_Top_Token.Profile_Start = 0
+ and then not Local_Top_Token.Attributes (Ada_New_Attribute)
+ then
+ if In_Declaration = Subprogram_Decl then
+ Local_Top_Token.Profile_Start := P;
+ end if;
+
+ if Align_On_Colons then
+ Local_Top_Token.Align_Colon := Compute_Alignment
+ (P + 1, Skip_First_Line => False);
+ end if;
+
+ else
+ if Align_On_Arrows then
+ Align := Compute_Alignment
+ (P + 1,
+ Skip_First_Line => False,
+ Align_On => Tok_Arrow);
+ end if;
+ end if;
+
+ -- Indent on the left parenthesis for subprogram & type
+ -- declarations, and for subprogram calls/aggregates with no
+ -- nested parenthesis except on the same line and for
+ -- arrows+paren as in:
+ -- X := (Foo => (Y,
+ -- Z));
+ -- In other cases (complex subprogram call),
+ -- indent as for continuation lines.
+
+ declare
+ Level, Tmp_Index, Val : Integer;
+ begin
+ if Top (Paren_Stack).all = Conditional then
+ Level := P - Start_Of_Line + Padding
+ + Indent_Conditional;
+
+ else
+ -- ../test/ada-gps/ada_gps_bug_006.adb
+ -- The_TV := E (Query,
(Def_Restriction.Traffic_Volume,
+ Tmp_Index := P + 1;
+
+ while Tmp_Index <= Buffer'Last
+ and then Buffer (Tmp_Index) = ' '
+ loop
+ Tmp_Index := Tmp_Index + 1;
+ end loop;
+
+ Level := Tmp_Index - Start_Of_Line + Padding;
+ end if;
+
+ Val := Top (Indents).Continuation_Val;
+ Push (Indents, (Level, Align, L, Continuation_Val));
+
+ -- If Align_Decl_On_Colon is set and Colon_Col is set
+ -- then ignore Val and continue indenting based on
+ -- the current Continuation_Val since the saved value
+ -- does not take Colon_Col into account.
+
+ if Local_Top_Token.Colon_Col /= 0 then
+ if Continuation_Val > 0 then
+ Continuation_Val :=
+ Continuation_Val - Indent_Continue;
+ end if;
+
+ else
+ Continuation_Val := Val;
+ end if;
+ end;
+
+ when ')' =>
+ if (Local_Top_Token.Token = Tok_Colon
+ or else Local_Top_Token.Token = Tok_Identifier)
+ and then
+ (Local_Top_Token.Variable_Kind
+ in Parameter_Kind .. Discriminant_Kind
+ or else
+ (Local_Top_Token.Is_In_Type_Definition
+ and then not
+ Local_Top_Token.Attributes (Ada_Record_Attribute)
+ and then not Local_Top_Token.Type_Declaration))
+ then
+ if Local_Top_Token.Token = Tok_Identifier
+ and then not
+ (Local_Top_Token.Is_In_Type_Definition
+ and then not Local_Top_Token.Attributes
+ (Ada_Record_Attribute)
+ and then not Local_Top_Token.Type_Declaration)
+ then
+ -- This handles cases where we have a family entry.
+ -- For example:
+ -- entry E (Integer);
+ -- here Integer is a type, so we don't want it in the
+ -- constructs. But is has already been pushed. The
+ -- code below disactivate its addition to the
+ -- constructs
+
+ Local_Top_Token.Token := Tok_Colon;
+ end if;
+
+ Pop_And_Set_Local (Tokens);
+ end if;
+
+ First := P;
+ Prev_Token := Tok_Right_Paren;
+ Close_Parenthesis;
+
+ when '"' =>
+ declare
+ Len : Natural;
+ Entity : Language_Entity;
+ begin
+ First := P;
+
+ while P < End_Of_Line loop
+ P := Next_Char (P);
+
+ exit when Buffer (P) = '"';
+ end loop;
+
+ if Buffer (P) /= '"' then
+ -- Syntax error: the string was not terminated
+ -- Try to recover properly, and in particular, try
+ -- to reset the parentheses stack.
+
+ if Num_Parens > 0 then
+ Close_Parenthesis;
+ end if;
+ end if;
+
+ if (Local_Top_Token.Token in Token_Class_Declk
+ and then Local_Top_Token.Ident_Len = 0)
+ or else Prev_Token in Tok_End | Tok_Dot
+ or else Local_Top_Token.Token = Tok_With
+ then
+ -- This is an operator symbol, e.g function ">=" (...)
+ -- Or we're parsing a GNAT Project file and this is
+ -- a dependency declaration (with "bla.gpr")
+
+ if Prev_Token not in Tok_End | Tok_Dot then
+ Len := P - First + 1;
+ Local_Top_Token.Identifier (1 .. Len) :=
+ Buffer (First .. P);
+ Local_Top_Token.Ident_Len := Len;
+ Local_Top_Token.Sloc_Name.Line := L;
+ Local_Top_Token.Sloc_Name.Column :=
+ First - Start_Of_Line + 1;
+ Local_Top_Token.Sloc_Name.Index := First;
+ end if;
+
+ Prev_Token := Tok_Operator_Symbol;
+ Entity := Block_Text;
+ else
+ Prev_Token := Tok_String_Literal;
+ Entity := String_Text;
+ end if;
+
+ Compute_Indentation
+ (Prev_Token, Prev_Prev_Token, Prev3_Token,
+ P, L, Num_Spaces);
+
+ if Callback /= null then
+ if Call_Callback
+ (Entity,
+ (L, First - Start_Of_Line + 1,
+ First),
+ (L, P - Start_Of_Line + 1, P),
+ False)
+ then
+ Terminated := True;
+ return;
+ end if;
+ end if;
+ end;
+
+ when '&' | '+' | '-' | '*' | '/' | ':' | '<' | '>' | '=' |
+ '|' | '.'
+ =>
+ Spaces (2) := Buffer (P);
+ Spaces (3) := ' ';
+ First := P;
+ Last := P + 1;
+ Offs := 1;
+
+ case Buffer (P) is
+ when '+' | '-' =>
+ if Buffer (P) = '-' then
+ Prev_Token := Tok_Minus;
+ else
+ Prev_Token := Tok_Plus;
+ end if;
+
+ if Prev_Prev_Token = Tok_Identifier
+ and then
+ (P <= Buffer'First + 1
+ or else To_Upper (Buffer (P - 1)) /= 'E'
+ or else
+ (Buffer (P - 2) /= '#'
+ and then Buffer (P - 2) not in '0' .. '9'))
+ and then
+ (P = Buffer'Last
+ or else (Buffer (P + 1) /= '"'
+ and then Buffer (P + 1) /= '('))
+ then
+ Insert_Spaces := True;
+ else
+ Insert_Spaces := False;
+ end if;
+
+ when '&' | '|' =>
+ if Buffer (P) = '&' then
+ Prev_Token := Tok_Ampersand;
+ else
+ Prev_Token := Tok_Vertical_Bar;
+ end if;
+
+ Insert_Spaces := True;
+
+ when '/' | ':' =>
+ Insert_Spaces := True;
+
+ if P < Buffer'Last
+ and then Buffer (P + 1) = '='
+ then
+ if Buffer (P) = ':'
+ and then Local_Top_Token.Token = Tok_Colon
+ then
+ Right_Assignment := True;
+ Local_Top_Token.Attributes
+ (Ada_Assign_Attribute) := True;
+
+ if Local_Top_Token.Variable_Kind
+ in Parameter_Kind .. Discriminant_Kind
+ then
+ Pop_And_Set_Local (Tokens);
+ end if;
+ end if;
+
+ Handle_Two_Chars ('=');
+
+ if Buffer (P) = '/' then
+ Prev_Token := Tok_Not_Equal;
+ else
+ Prev_Token := Tok_Colon_Equal;
+ end if;
+
+ elsif Buffer (P) = '/' then
+ Prev_Token := Tok_Slash;
+ else
+ Handle_Colon;
+ end if;
+
+ when '*' =>
+ declare
+ Prev_Tmp : constant Integer := Prev_Char (P);
+ begin
+ Insert_Spaces :=
+ Prev_Tmp >= Buffer'First
+ and then Buffer (Prev_Tmp) /= '*';
+ end;
+
+ if P < Buffer'Last
+ and then Buffer (Next_Char (P)) = '*'
+ then
+ Handle_Two_Chars ('*');
+ Prev_Token := Tok_Double_Asterisk;
+ else
+ Prev_Token := Tok_Asterisk;
+ end if;
+
+ when '.' =>
+ declare
+ Next_Tmp : constant Natural := Next_Char (P);
+ begin
+ Insert_Spaces :=
+ Next_Tmp <= Buffer'Last
+ and then Buffer (Next_Tmp) = '.';
+ end;
+
+ if Insert_Spaces then
+ Handle_Two_Chars ('.');
+ Prev_Token := Tok_Dot_Dot;
+ else
+ Prev_Token := Tok_Dot;
+ end if;
+
+ when '<' =>
+ declare
+ Next_Tmp : constant Natural := Next_Char (P);
+ begin
+ if Next_Tmp <= Buffer'Last then
+ case Buffer (Next_Tmp) is
+ when '=' =>
+ Insert_Spaces := True;
+ Prev_Token := Tok_Less_Equal;
+ Handle_Two_Chars ('=');
+
+ when '<' =>
+ Prev_Token := Tok_Less_Less;
+ Insert_Spaces := False;
+ Handle_Two_Chars ('<');
+
+ when '>' =>
+ Prev_Token := Tok_Box;
+ Insert_Spaces := False;
+ Handle_Two_Chars ('>');
+
+ when others =>
+ Prev_Token := Tok_Less;
+ Insert_Spaces := True;
+ end case;
+ else
+ Prev_Token := Tok_Less;
+ Insert_Spaces := True;
+ end if;
+ end;
+
+ when '>' =>
+ declare
+ Next_Tmp : constant Natural := Next_Char (P);
+ begin
+ if Next_Tmp <= Buffer'Last then
+ case Buffer (Next_Tmp) is
+ when '=' =>
+ Insert_Spaces := True;
+ Prev_Token := Tok_Greater_Equal;
+ Handle_Two_Chars ('=');
+
+ when '>' =>
+ Prev_Token := Tok_Greater_Greater;
+ Insert_Spaces := False;
+ Handle_Two_Chars ('>');
+
+ when others =>
+ Prev_Token := Tok_Greater;
+ Insert_Spaces := True;
+ end case;
+ else
+ Prev_Token := Tok_Greater;
+ Insert_Spaces := True;
+ end if;
+ end;
+
+ when '=' =>
+ Insert_Spaces := True;
+
+ if P + 1 <= Buffer'Last
+ and then Buffer (P + 1) = '>'
+ then
+ Handle_Arrow;
+ else
+ Prev_Token := Tok_Equal;
+ end if;
+
+ when others =>
+ null;
+ end case;
+
+ if Spaces (3) = ' ' then
+ if P + 1 > Buffer'Last
+ or else Is_Blank (Buffer (P + 1))
+ or else Last - 1 = End_Of_Line
+ then
+ Long := 2;
+ else
+ Long := 3;
+ end if;
+ end if;
+
+ if P > Buffer'First and then Is_Blank (Buffer (P - 1)) then
+ Offs := 2;
+ Long := Long - 1;
+ end if;
+
+ if (Num_Parens = 0
+ or else Prev_Token in Tok_Ampersand | Tok_Vertical_Bar
+ or else Prev_Prev_Token
+ in Tok_Arrow | Tok_Then | Tok_Else)
+ and then Local_Top_Token.Token /= Tok_When
+ then
+ -- If we're not inside parens or if we're in a
+ -- conditional expression, then handle continuation
+ -- lines here. Otherwise, continuation lines are already
+ -- handled separately.
+
+ Compute_Indentation
+ (Prev_Token, Prev_Prev_Token, Prev3_Token,
+ P, L, Num_Spaces);
+ else
+ Do_Indent (P, L, Num_Spaces);
+ end if;
+
+ if Format_Operators and then Insert_Spaces then
+ Replace_Text
+ (First, Last, L, Spaces (Offs .. Offs + Long - 1));
+ end if;
+
+ when ',' | ';' =>
+ First := P;
+
+ if Buffer (P) = ';' then
+ Prev_Token := Tok_Semicolon;
+ Right_Assignment := False;
+
+ if Aspect_Clause then
+ Finish_Aspect_Clause (P, L, Done => Terminated);
+ Local_Top_Token := Top (Tokens);
+
+ if Terminated then
+ return;
+ end if;
+ end if;
+
+ if Local_Top_Token.Token = Tok_Colon then
+ Pop_And_Set_Local (Tokens);
+
+ elsif Num_Parens = 0 then
+ if In_Declaration /= No_Decl
+ or else
+ (Local_Top_Token.Token = Tok_Task
+ and then In_Declaration = Type_Decl)
+ or else Local_Top_Token.Token = Tok_Subtype
+ or else Local_Top_Token.Token = Tok_For
+ then
+ -- subprogram spec or type decl or repr. clause,
+ -- e.g:
+ -- procedure xxx (...);
+ -- type ... is ...;
+ -- for ... use ...;
+
+ Pop_And_Set_Local (Tokens);
+ In_Declaration := No_Decl;
+
+ elsif Local_Top_Token.Token = Tok_With
+ or else Local_Top_Token.Token = Tok_Use
+ or else Local_Top_Token.Token = Tok_Identifier
+ or else Local_Top_Token.Token = Tok_Type
+ or else Local_Top_Token.Token = Tok_Accept
+ or else Local_Top_Token.Token = Tok_Pragma
+ then
+ Pop_And_Set_Local (Tokens);
+ end if;
+
+ end if;
+
+ if In_Declaration = Subprogram_Decl
+ and then not
+ (Top_Token /= null
+ and then Top_Token.Attributes (Ada_New_Attribute))
+ then
+ Is_Parameter := True;
+ elsif In_Declaration = Type_Decl then
+ Is_Discriminant := True;
+ end if;
+
+ else
+ Prev_Token := Tok_Comma;
+
+ if Local_Top_Token.In_Declaration
+ and then Local_Top_Token.Token = Tok_Identifier
+ then
+ Pop_And_Set_Local (Tokens);
+
+ elsif Local_Top_Token.Token = Tok_With
+ or else Local_Top_Token.Token = Tok_Use
+ then
+ declare
+ Val : Extended_Token;
+ begin
+ -- Create a separate entry for each with clause:
+ -- with a, b;
+ -- will get two entries: one for a, one for b.
+
+ Val.Token := Local_Top_Token.Token;
+ Pop_And_Set_Local (Tokens);
+ Val.Sloc.Line := L;
+ Val.Sloc.Column :=
+ Prec - Line_Start (Buffer, Prec) + 2;
+ Val.Sloc.Index := Prec + 1;
+ Val.Ident_Len := 0;
+ Push (Tokens, Val);
+ end;
+ end if;
+ end if;
+
+ if Format_Operators and then P /= End_Of_Line then
+ Char := Buffer (P + 1);
+
+ if Char /= ' ' then
+ Do_Indent (P, L, Num_Spaces);
+ Comma (1) := Buffer (P);
+ Replace_Text (P, P + 1, L, Comma (1 .. 2));
+ end if;
+ end if;
+
+ when ''' =>
+ -- Apostrophe. This can either be the start of a character
+ -- literal, an isolated apostrophe used in a qualified
+ -- expression or an attribute. We treat it as a character
+ -- literal if it does not follow a right parenthesis,
+ -- identifier, the keyword ALL or a literal. This means that
+ -- we correctly treat constructs like:
+ -- A := Character'('A');
+
+ First := P;
+
+ if Prev_Token = Tok_Identifier
+ or else Prev_Token = Tok_Right_Paren
+ or else Prev_Token = Tok_All
+ or else Prev_Token in Token_Class_Literal
+ or else P = End_Of_Line
+ then
+ Prev_Token := Tok_Apostrophe;
+ else
+ if P = End_Of_Line - 1 then
+ P := P + 1;
+ else
+ P := P + 2;
+ end if;
+
+ while P < End_Of_Line
+ and then Buffer (P) /= '''
+ loop
+ P := Next_Char (P);
+ end loop;
+
+ Prev_Token := Tok_Char_Literal;
+
+ if Callback /= null then
+ if Call_Callback
+ (Character_Text,
+ (L, First - Start_Of_Line + 1, First),
+ (L, P - Start_Of_Line + 1, P),
+ False)
+ then
+ Terminated := True;
+ Comments_Skipped := False;
+ return;
+ end if;
+ end if;
+ end if;
+
+ when others =>
+ Token_Found := False;
+ end case;
+
+ if Buffer (P) /= ' ' and then not Is_Control (Buffer (P)) then
+ Comments_Skipped := False;
+ end if;
+
+ if Token_Found
+ and then (Prev_Token in Tok_Double_Asterisk .. Tok_Colon_Equal
+ or else Prev_Token in Tok_Semicolon .. Tok_Dot_Dot)
+ then
+ if Callback /= null then
+ if Call_Callback
+ (Operator_Text,
+ (L, First - Start_Of_Line + 1, First),
+ (L, P - Start_Of_Line + 1, P),
+ False)
+ then
+ Terminated := True;
+ Comments_Skipped := False;
+ return;
+ end if;
+ end if;
+ end if;
+
+ P := Next_Char (P);
+ end loop;
+
+ Comments_Skipped := False;
+ Terminated := False;
+ end Next_Word;
+
+ ------------------
+ -- Replace_Text --
+ ------------------
+
+ procedure Replace_Text
+ (First : Natural;
+ Last : Natural;
+ Line : Natural;
+ Str : String)
+ is
+ Start : Natural;
+ begin
+ if Replace /= null
+ and then (To = 0 or else Line in From .. To)
+ then
+ if Last_Replace_Line /= Line then
+ Last_Replace_Line := Line;
+ Padding := 0;
+ end if;
+
+ Start := Line_Start (Buffer, First);
+ Replace
+ (Line,
+ Padding + First - Start + 1,
+ Padding + Last - Start + 1, Str);
+
+ Padding := Padding + Str'Length - (Last - First);
+ end if;
+ end Replace_Text;
+
+ -------------------
+ -- Call_Callback --
+ -------------------
+
+ function Call_Callback
+ (Entity : Language_Entity;
+ Sloc_Start : Source_Location;
+ Sloc_End : Source_Location;
+ Partial_Entity : Boolean) return Boolean
+ is
+ Ignore : Boolean;
+ pragma Unreferenced (Ignore);
+ Ent : Language_Entity := Entity;
+
+ begin
+ if Aspect_Clause then
+ case Entity is
+ when Keyword_Text =>
+ Ent := Aspect_Keyword_Text;
+ when Comment_Text | Annotated_Comment_Text =>
+ Ent := Aspect_Comment_Text;
+ when others =>
+ -- Highlight everything else with Aspect_Text,
+ -- which will be done next time Call_Callback is called.
+ return False;
+ end case;
+
+ Ignore := Callback
+ (Aspect_Text,
+ Aspect_Clause_Sloc,
+ (Sloc_Start.Line,
+ Sloc_Start.Column - 1,
+ Sloc_Start.Index - 1),
+ Partial_Entity);
+ Aspect_Clause_Sloc :=
+ (Sloc_End.Line, Sloc_End.Column + 1, Sloc_End.Index + 1);
+
+ end if;
+
+ return Callback (Ent, Sloc_Start, Sloc_End, Partial_Entity);
+ end Call_Callback;
+
+ begin -- Analyze_Ada_Source
+ if Buffer'Length = 0 then
+ return;
+ end if;
+
+ -- Push a dummy token so that stack will never be empty
+
+ Push (Tokens, Default_Extended);
+
+ -- Push a dummy indentation so that stack will never be empty
+
+ Push (Indents, (None, 0, 0, 0));
+
+ Next_Word (Prec, Line_Count, Terminated, End_Reached);
+
+ -- If there is only one character in the buffer and the end of the
+ -- buffer has been reached, enter the main loop anyway. Otherwise,
+ -- the on-the-fly auto-casing will not work when adding a space after
+ -- single character identifier.
+
+ if (End_Reached
+ and then Buffer_Last > 1
+ and then Buffer (Buffer_Last) /= ASCII.LF)
+ or else Terminated
+ then
+ Clear (Paren_Stack);
+ Clear (Tokens);
+ Clear (Indents);
+ return;
+ end if;
+
+ Current := End_Of_Word (Prec);
+
+ Main_Loop :
+ loop
+ Str_Len := Current - Prec + 1;
+
+ Str (1 .. Str_Len) := Buffer (Prec .. Current);
+
+ Token := Get_Token (Str (1 .. Str_Len), Prev_Token);
+
+ if Token = Tok_Identifier then
+ -- Handle dotted names, e.g Foo.Bar.X
+
+ Prev_Line := Line_Count;
+
+ if Current < Buffer_Last then
+ Index_Ident := End_Of_Identifier (Current + 1);
+
+ if Index_Ident /= Current then
+ -- We have a dotted name, update indexes
+
+ Str_Len := Index_Ident - Prec + 1;
+
+ Str (Current - Prec + 2 .. Index_Ident - Prec + 1) :=
+ Buffer (Current + 1 .. Index_Ident);
+
+ Current := Index_Ident;
+ end if;
+ end if;
+
+ Top_Token := Top (Tokens);
+ Start_Of_Line := Line_Start (Buffer, Prec);
+
+ if Top_Token.Ident_Len = 0
+ and then (Top_Token.Token in Token_Class_Declk
+ or else Top_Token.Token = Tok_With
+ or else Top_Token.Token = Tok_Pragma)
+ then
+ -- Store enclosing entity name
+
+ Top_Token.Identifier (1 .. Str_Len) := Buffer (Prec .. Current);
+ Top_Token.Ident_Len := Str_Len;
+ Top_Token.Sloc_Name.Line := Prev_Line;
+ Top_Token.Sloc_Name.Column := Prec - Start_Of_Line + 1;
+ Top_Token.Sloc_Name.Index := Prec;
+ end if;
+
+ if (Top_Token.In_Declaration
+ or else
+ (Top_Token.Token = Tok_For
+ and then Prev_Token = Tok_For)
+ or else Top_Token.Type_Declaration
+ or else (Top_Token.Attributes (Ada_Record_Attribute)
+ and then (Top_Token.Token = Tok_Case
+ or else Prev_Token /= Tok_Arrow))
+ or else Is_Parameter
+ or else Is_Discriminant
+ or else
+ (Top_Token.Type_Definition_Section
+ and then Top_Token.Token = Tok_Type
+ and then Top_Token.Attributes = No_Attribute))
+ and then (Num_Parens = 0
+ or else Is_Parameter
+ or else Is_Discriminant
+ or else Top_Token.Type_Definition_Section)
+ and then (Prev_Token not in Reserved_Token_Type
+ or else Prev_Token = Tok_Declare
+ or else Prev_Token = Tok_Private
+ or else Prev_Token = Tok_Record
+ or else Prev_Token = Tok_Generic
+ or else Prev_Token = Tok_For
+ or else (Prev_Token = Tok_Is and then not In_Generic))
+ and then Prev_Token /= Tok_Dot
+ and then Prev_Token /= Tok_Apostrophe
+ and then not Aspect_Clause
+ then
+ -- This is a variable, a field declaration or a enumeration
+ -- literal
+
+ declare
+ Val : Extended_Token;
+ begin
+ Val.Token := Tok_Identifier;
+ Val.Sloc.Line := Prev_Line;
+ Val.Sloc.Column := Prec - Start_Of_Line + 1;
+ Val.Sloc.Index := Prec;
+ Val.Identifier (1 .. Str_Len) := Str (1 .. Str_Len);
+ Val.Ident_Len := Str_Len;
+ Val.Sloc_Name := Val.Sloc;
+ Val.In_Declaration := True;
+ Val.Visibility := Top_Token.Visibility_Section;
+
+ if Is_Parameter then
+ Val.Variable_Kind := Parameter_Kind;
+ elsif Is_Discriminant then
+ Val.Variable_Kind := Discriminant_Kind;
+ end if;
+
+ Val.Is_In_Type_Definition :=
+ Top_Token.Type_Definition_Section;
+ Val.Is_Generic_Param := In_Generic;
+ Push (Tokens, Val);
+
+ if Prev_Token = Tok_For then
+ Pop (Tokens);
+ end if;
+ end;
+ end if;
+
+ declare
+ Entity : Language_Entity;
+ begin
+ Entity := Identifier_Text;
+ Casing := Ident_Casing;
+
+ if Is_Digit (Str (1))
+ or else (Prev_Token = Tok_Pound
+ and then Is_Hexadecimal_Digit (Str (1)))
+ then
+ -- Recognize simple cases of numeric values
+ -- ??? recognizing more cases would require changing
+ -- Next_Word parsing.
+
+ Entity := Number_Text;
+
+ elsif Is_Optional_Keyword /= null
+ and then Is_Optional_Keyword (Str (1 .. Str_Len))
+ then
+ Entity := Keyword_Text;
+ Casing := Reserved_Casing;
+
+ -- Try to differentiate type identifiers and block identifiers
+ -- from others in declarations.
+
+ elsif ((Prev_Token = Tok_In
+ or else Prev_Token = Tok_Access
+ or else Prev_Token = Tok_Aliased
+ or else Prev_Token = Tok_Constant)
+ and then (Prev_Prev_Token = Tok_Colon
+ or else Prev_Prev_Token = Tok_Null
+ or else Prev_Prev_Token = Tok_Is))
+ or else (Prev_Token = Tok_All
+ and then Prev_Prev_Token = Tok_Access)
+ or else (Prev_Token = Tok_Is
+ and then Prev_Prev_Token = Tok_Identifier
+ and then Top_Token.Type_Declaration)
+ or else (Prev_Token = Tok_Out
+ and then (Prev_Prev_Token = Tok_Colon
+ or else Prev_Prev_Token = Tok_In))
+ or else Prev_Token = Tok_Colon
+ or else (In_Declaration = Subprogram_Decl
+ and then Prev_Token = Tok_Return)
+ then
+ Entity := Type_Text;
+ elsif (Prev_Token = Tok_Type
+ and then Prev_Prev_Token /= Tok_Use)
+ or else Prev_Token = Tok_Subtype
+ or else Prev_Token = Tok_End
+ or else Prev_Token = Tok_Procedure
+ or else Prev_Token = Tok_Function
+ or else Prev_Token = Tok_Task
+ or else Prev_Token = Tok_Body
+ or else Prev_Token = Tok_Entry
+ or else Prev_Token = Tok_Accept
+ or else Prev_Token = Tok_Package
+ or else (Prev_Token = Tok_Renames
+ and then Prev_Prev_Token = Tok_Right_Paren)
+ or else (Current + 8 <= Buffer_Last
+ and then Buffer (Current + 2) = ':'
+ and then (Look_For (Current + 4, "begin")
+ or else Look_For (Current + 4, "declare")))
+ then
+ Entity := Block_Text;
+ end if;
+
+ if Prev_Token = Tok_Apostrophe
+ and then To_Upper (Str (1 .. Str_Len)) = "CLASS"
+ and then Top_Token.In_Entity_Profile
+ then
+ Top_Token.Attributes (Ada_Class_Attribute) := True;
+ end if;
+
+ if Callback /= null then
+ exit Main_Loop when Call_Callback
+ (Entity,
+ (Prev_Line, Prec - Start_Of_Line + 1, Prec),
+ (Line_Count,
+ Current - Line_Start (Buffer, Current) + 1,
+ Current),
+ False);
+ end if;
+ end;
+
+ elsif Prev_Token = Tok_Apostrophe
+ and then (Token = Tok_Delta or else Token = Tok_Digits
+ or else Token = Tok_Mod or else Token = Tok_Range
+ or else Token = Tok_Access)
+ then
+ -- This token should not be considered as a reserved word
+ Casing := Ident_Casing;
+
+ if Callback /= null then
+ Start_Of_Line := Line_Start (Buffer, Prec);
+
+ exit Main_Loop when Call_Callback
+ (Identifier_Text,
+ (Line_Count, Prec - Start_Of_Line + 1, Prec),
+ (Line_Count, Current - Start_Of_Line + 1, Current),
+ False);
+ end if;
+
+ elsif Token = No_Token then
+ Casing := Unchanged;
+
+ else
+ -- We have a reserved word
+ Casing := Reserved_Casing;
+
+ declare
+ Temp : aliased Extended_Token;
+ Do_Push : Boolean;
+ Do_Pop : Integer;
+ Do_Finish : Boolean;
+ begin
+ Handle_Word_Token (Token, Temp, Do_Pop, Do_Push, Do_Finish);
+
+ exit Main_Loop when Do_Finish;
+
+ Handle_Word_Indent (Token, Temp);
+
+ for J in 1 .. Do_Pop loop
+ Pop (Tokens);
+ end loop;
+
+ -- Handles In_Generic
+
+ if not In_Generic
+ and then Token = Tok_Generic
+ then
+ In_Generic := True;
+ elsif In_Generic
+ and then Prev_Token
+ not in Tok_With | Tok_Access | Tok_Protected
+ and then Token in Tok_Function | Tok_Procedure | Tok_Package
+ then
+ In_Generic := False;
+ end if;
+
+ if Do_Push then
+ Temp.Is_Generic_Param := In_Generic;
+ Push (Tokens, Temp);
+ else
+ null;
+ end if;
+
+ -- Computes In_Declaration
+ -- ??? There is still some computation of this done in
+ -- Handle_Word_Token. It would be nice to have all of it here.
+
+ if Token = Tok_Body
+ or else Token = Tok_Renames
+ or else (Token = Tok_Is and then not In_Generic)
+ then
+ In_Declaration := No_Decl;
+ elsif In_Declaration = Subprogram_Decl
+ and then Token = Tok_With
+ then
+ In_Declaration := Subprogram_Aspect;
+ end if;
+ end;
+ end if;
+
+ if Indent_Params.Casing_Policy /= Disabled
+ and then Prev_Token /= Tok_Pound
+ -- Disable casing for based literal (so if a word is preceded by
+ -- a pound sign).
+ then
+ case Casing is
+ when Unchanged =>
+ null;
+
+ when Upper | Lower | Mixed | Smart_Mixed =>
+ -- We do not want to case some as this is a new keyword in
+ -- Ada 2012 but for upward compatibility issue GNAT does not
+ -- forbid some as identifier. Without context it is not
+ -- possible to determine if some is used as identifier or as
+ -- keyword, so to avoid upsetting users we never change
+ -- casing of some.
+ if To_Lower (Str (1 .. Str_Len)) /= "some" then
+ Replace_Text
+ (Prec,
+ Current + 1,
+ Line_Count,
+ Set_Case (Case_Exceptions,
+ Str (1 .. Str_Len),
+ Casing));
+ end if;
+ end case;
+ end if;
+
+ -- 'is' is handled specially, so nothing is needed here except
+ -- for type declarations, e.g:
+ -- type T
+ -- is ...
+
+ if Token /= Tok_Is
+ or else (Top_Token /= null and then Top_Token.Token = Tok_Type)
+ then
+ Compute_Indentation
+ (Token, Prev_Token, Prev_Prev_Token,
+ Current, Line_Count, Num_Spaces);
+ end if;
+
+ Prec := Current + 1;
+ Prev_Prev_Token := Prev_Token;
+ Prev_Token := Token;
+
+ exit Main_Loop when Prec > Buffer_Last;
+
+ Next_Word (Prec, Line_Count, Terminated, End_Reached);
+
+ exit Main_Loop when
+ Terminated
+ or else (End_Reached and then Buffer (Buffer_Last) /= ASCII.LF);
+
+ Current := End_Of_Word (Prec);
+ end loop Main_Loop;
+
+ -- Try to register partial constructs, friendlier
+
+ Prec := Integer'Min (Prec, Buffer'Last);
+
+ if Constructs /= null then
+ while Top (Tokens).Token /= No_Token loop
+ Pop (Tokens);
+ end loop;
+ end if;
+
+ Clear (Paren_Stack);
+ Clear (Tokens);
+ Clear (Indents);
+
+ exception
+ when E : others =>
+ Trace (Me, E);
+ raise;
+ end Analyze_Ada_Source;
+
+end Ada_Analyzer;
diff --git a/packages/ada-mode/gps_source/ada_analyzer.ads
b/packages/ada-mode/gps_source/ada_analyzer.ads
new file mode 100755
index 0000000..b88f3c8
--- /dev/null
+++ b/packages/ada-mode/gps_source/ada_analyzer.ads
@@ -0,0 +1,76 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2001-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+-- This package provides a multi-purpose Ada parser designed to be very
+-- fast and usable on non compilable sources.
+-- Typical use of this package includes: source highlighting, block folding,
+-- source reformatting, ...
+
+with Basic_Types; use Basic_Types;
+with Language; use Language;
+with Case_Handling; use Case_Handling;
+with GNATCOLL.Symbols;
+
+package Ada_Analyzer is
+
+ ----------------------
+ -- Parsing Routines --
+ ----------------------
+
+ procedure Analyze_Ada_Source
+ (Buffer : UTF8_String;
+ Symbols : GNATCOLL.Symbols.Symbol_Table_Access;
+ Indent_Params : Indent_Parameters;
+ Format : Boolean := True;
+ From, To : Natural := 0;
+ Replace : Replace_Text_Callback := null;
+ Constructs : Construct_List_Access := null;
+ Callback : Entity_Callback := null;
+ Indent_Offset : Natural := 0;
+ Case_Exceptions : Casing_Exceptions := No_Casing_Exception;
+ Is_Optional_Keyword : access function (S : String)
+ return Boolean := null);
+ -- Analyze a given Ada source in Buffer, and perform source reformatting
+ -- between lines From .. To if Format is True.
+ -- If Constructs is not null, store the list of constructs analyzed.
+ -- If Callback is not null, call it for each Source_Entity_Kind.
+ -- Case_Exceptions is the handler containing all the casing exceptions
+ -- to be used while reformatting the code.
+
+ Ada_Abstract_Attribute : constant Construct_Att_Key := Last_Gen_Att + 1;
+ Ada_Access_Attribute : constant Construct_Att_Key := Access_Attribute;
+ Ada_Aliased_Attribute : constant Construct_Att_Key := Last_Gen_Att + 2;
+ Ada_Array_Attribute : constant Construct_Att_Key := Array_Attribute;
+ Ada_Assign_Attribute : constant Construct_Att_Key := Last_Gen_Att + 3;
+ Ada_Constant_Attribute : constant Construct_Att_Key := Last_Gen_Att + 4;
+ Ada_Delta_Attribute : constant Construct_Att_Key := Last_Gen_Att + 5;
+ Ada_Digits_Attribute : constant Construct_Att_Key := Last_Gen_Att + 6;
+ Ada_In_Attribute : constant Construct_Att_Key := Last_Gen_Att + 7;
+ Ada_Interface_Attribute : constant Construct_Att_Key := Last_Gen_Att + 8;
+ Ada_Mod_Attribute : constant Construct_Att_Key := Last_Gen_Att + 9;
+ Ada_New_Attribute : constant Construct_Att_Key := Last_Gen_Att + 10;
+ Ada_Not_Attribute : constant Construct_Att_Key := Last_Gen_Att + 11;
+ Ada_Null_Attribute : constant Construct_Att_Key := Last_Gen_Att + 12;
+ Ada_Out_Attribute : constant Construct_Att_Key := Last_Gen_Att + 13;
+ Ada_Range_Attribute : constant Construct_Att_Key := Last_Gen_Att + 14;
+ Ada_Record_Attribute : constant Construct_Att_Key := Last_Gen_Att + 15;
+ Ada_Tagged_Attribute : constant Construct_Att_Key := Last_Gen_Att + 16;
+ Ada_Class_Attribute : constant Construct_Att_Key := Last_Gen_Att + 17;
+ Ada_Renames_Attribute : constant Construct_Att_Key := Last_Gen_Att + 18;
+ Ada_Generic_Attribute : constant Construct_Att_Key := Last_Gen_Att + 19;
+
+end Ada_Analyzer;
diff --git a/packages/ada-mode/gps_source/basic_types.adb
b/packages/ada-mode/gps_source/basic_types.adb
new file mode 100755
index 0000000..31678f1
--- /dev/null
+++ b/packages/ada-mode/gps_source/basic_types.adb
@@ -0,0 +1,147 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2000-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+with GNAT.Strings; use GNAT.Strings;
+with Ada.Characters.Handling; use Ada.Characters.Handling;
+
+package body Basic_Types is
+
+ --------------
+ -- Is_Equal --
+ --------------
+
+ function Is_Equal
+ (List1, List2 : GNAT.OS_Lib.Argument_List;
+ Case_Sensitive : Boolean := True;
+ Ordered : Boolean := False) return Boolean is
+ begin
+ if List1'Length /= List2'Length then
+ return False;
+
+ elsif Ordered then
+ for L in List1'Range loop
+ if List1 (L).all /= List2 (L - List1'First + List2'First).all then
+ return False;
+ end if;
+ end loop;
+ return True;
+
+ else
+ declare
+ L1 : GNAT.OS_Lib.Argument_List := List1;
+ L2 : GNAT.OS_Lib.Argument_List := List2;
+ begin
+ for A in L1'Range loop
+ for B in L2'Range loop
+ if L2 (B) /= null and then
+ ((Case_Sensitive and then L1 (A).all = L2 (B).all)
+ or else
+ (not Case_Sensitive
+ and then To_Lower (L1 (A).all) = To_Lower (L2 (B).all)))
+ then
+ L1 (A) := null;
+ L2 (B) := null;
+ exit;
+ end if;
+ end loop;
+ end loop;
+
+ return L1 = (L1'Range => null)
+ and then L2 = (L2'Range => null);
+ end;
+ end if;
+ end Is_Equal;
+
+ --------------
+ -- Contains --
+ --------------
+
+ function Contains
+ (List : GNAT.OS_Lib.Argument_List;
+ Str : String;
+ Case_Sensitive : Boolean := True) return Boolean is
+ begin
+ if not Case_Sensitive then
+ declare
+ S : constant String := To_Lower (Str);
+ begin
+ for L in List'Range loop
+ if To_Lower (List (L).all) = S then
+ return True;
+ end if;
+ end loop;
+ end;
+ else
+ for L in List'Range loop
+ if List (L).all = Str then
+ return True;
+ end if;
+ end loop;
+ end if;
+
+ return False;
+ end Contains;
+
+ ---------
+ -- "<" --
+ ---------
+
+ function "<" (Left, Right : Date_Type) return Boolean is
+ begin
+ if Left.Year < Right.Year then
+ return True;
+ elsif Left.Year = Right.Year then
+ if Left.Month < Right.Month then
+ return True;
+ elsif Left.Month = Right.Month then
+ if Left.Day < Right.Day then
+ return True;
+ end if;
+ end if;
+ end if;
+
+ return False;
+ end "<";
+
+ ----------
+ -- "<=" --
+ ----------
+
+ function "<=" (Left, Right : Date_Type) return Boolean is
+ begin
+ return Left < Right or else Left = Right;
+ end "<=";
+
+ ---------
+ -- ">" --
+ ---------
+
+ function ">" (Left, Right : Date_Type) return Boolean is
+ begin
+ return not (Left < Right or else Left = Right);
+ end ">";
+
+ ----------
+ -- ">=" --
+ ----------
+
+ function ">=" (Left, Right : Date_Type) return Boolean is
+ begin
+ return not (Left < Right);
+ end ">=";
+
+end Basic_Types;
diff --git a/packages/ada-mode/gps_source/basic_types.ads
b/packages/ada-mode/gps_source/basic_types.ads
new file mode 100755
index 0000000..353f3eb
--- /dev/null
+++ b/packages/ada-mode/gps_source/basic_types.ads
@@ -0,0 +1,166 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2000-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+with Ada.Calendar;
+with Ada.Strings.Unbounded;
+with Ada.Unchecked_Deallocation;
+with Ada.Unchecked_Conversion;
+with Interfaces.C.Strings;
+with System;
+
+with GNAT.OS_Lib;
+with GNAT.Expect;
+with GNAT.Regpat;
+with GNAT.Strings;
+with GNATCOLL.VFS;
+with GNATCOLL.Xref;
+
+package Basic_Types is
+
+ subtype Pixmap_Array is Interfaces.C.Strings.chars_ptr_array (0 .. 0);
+ type Pixmap_Access is access all Pixmap_Array;
+
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (GNAT.Strings.String_List, GNAT.Strings.String_List_Access);
+ -- Free the array, but not the strings it contains.
+
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (GNAT.Regpat.Pattern_Matcher, GNAT.Expect.Pattern_Matcher_Access);
+
+ subtype Unchecked_String is String (Positive);
+ pragma Suppress (All_Checks, Unchecked_String);
+ -- Do not use this type directly, use Unchecked_String_Access instead.
+
+ type Unchecked_String_Access is access all Unchecked_String;
+ -- For efficiency reasons, use this type compatible with C char*,
+ -- so that C strings can be reused without making extra copies.
+
+ function To_Unchecked_String is new Ada.Unchecked_Conversion
+ (System.Address, Unchecked_String_Access);
+
+ function To_Unchecked_String is new Ada.Unchecked_Conversion
+ (Interfaces.C.Strings.chars_ptr, Unchecked_String_Access);
+
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Unchecked_String, Unchecked_String_Access);
+
+ subtype UTF8_String is String;
+ subtype UTF8_Unbounded_String is Ada.Strings.Unbounded.Unbounded_String;
+
+ function Is_Equal
+ (List1, List2 : GNAT.OS_Lib.Argument_List;
+ Case_Sensitive : Boolean := True;
+ Ordered : Boolean := False) return Boolean;
+ -- Return True if List1 has the same contents of List2 (no matter the order
+ -- of the strings in both arrays).
+ -- If Ordered is true, then each item of List1 much match the
+ -- corresponoding item of List2
+
+ function Contains
+ (List : GNAT.OS_Lib.Argument_List;
+ Str : String;
+ Case_Sensitive : Boolean := True) return Boolean;
+ -- Return True if List contains Str
+
+ type Date_Type is record
+ Year : Ada.Calendar.Year_Number;
+ Month : Ada.Calendar.Month_Number;
+ Day : Ada.Calendar.Day_Number;
+ end record;
+
+ Null_Date : constant Date_Type := Date_Type'
+ (Year => Ada.Calendar.Year_Number'First,
+ Month => Ada.Calendar.Month_Number'First,
+ Day => Ada.Calendar.Day_Number'First);
+
+ function "<" (Left, Right : Date_Type) return Boolean;
+ -- Compares the two dates, return true if left is before right
+
+ function "<=" (Left, Right : Date_Type) return Boolean;
+ function ">" (Left, Right : Date_Type) return Boolean;
+ function ">=" (Left, Right : Date_Type) return Boolean;
+
+ --------------
+ -- Entities --
+ --------------
+
+ type File_Error_Reporter_Record is abstract tagged null record;
+ type File_Error_Reporter is access all File_Error_Reporter_Record'Class;
+ procedure Error
+ (Report : in out File_Error_Reporter_Record;
+ File : GNATCOLL.VFS.Virtual_File) is abstract;
+ -- Used to report errors while parsing files
+
+ ------------------
+ -- Column types --
+ ------------------
+
+ subtype Visible_Column_Type is GNATCOLL.Xref.Visible_Column;
+ -- Visible_Column_Type correspond to user perception of the columns, ie,
+ -- after TAB expansion. The first character in the line has a value of 1.
+ -- Columns are counted in terms of UT8 characters.
+
+ type Character_Offset_Type is new Integer;
+ -- Character_Offset_Type indicates the number of characters between the
+ -- beginning of the line and the character. First character has offset 0.
+
+ type String_Index_Type is new Natural;
+ -- String_Index_Type indicates a index in a string, in bytes, starts at 1.
+
+ -----------------
+ -- File caches --
+ -----------------
+
+ type Packed_Boolean_Array is array (Positive range <>) of Boolean;
+ pragma Pack (Packed_Boolean_Array);
+ type Packed_Boolean_Access is access Packed_Boolean_Array;
+
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Packed_Boolean_Array, Packed_Boolean_Access);
+
+ type File_Cache;
+ type File_Cache_List is access File_Cache;
+ type File_Cache is record
+ File_Name : GNAT.Strings.String_Access := null;
+ -- The full name (including directory) for the file associated with
+ -- this record.
+
+ Line_Has_Code : Packed_Boolean_Access := null;
+ Line_Parsed : Packed_Boolean_Access := null;
+
+ File_Contents : GNAT.Strings.String_Access := null;
+ -- The contents of the file. To save some memory, this is not allocated
+ -- for files that can be found on the local disk. However, it is used
+ -- for files that had to be downloaded from a remote machine.
+
+ CR_Stripped : Boolean := False;
+ -- True if the carriage return characters were stripped when the file
+ -- was read.
+
+ Next : File_Cache_List := null;
+ -- Next file in the cache list
+ end record;
+ -- Data associated with each file, and that contain cached data for the
+ -- file.
+ -- Line_Parsed indicates whether the line at a given index has been parsed.
+ -- This array is freed once the parsing has been finished (and in the
+ -- case Current_Line points to the last line with a breakpoint.
+
+ procedure Free is new
+ Ada.Unchecked_Deallocation (File_Cache, File_Cache_List);
+
+end Basic_Types;
diff --git a/packages/ada-mode/gps_source/case_handling.adb
b/packages/ada-mode/gps_source/case_handling.adb
new file mode 100755
index 0000000..63b14ab
--- /dev/null
+++ b/packages/ada-mode/gps_source/case_handling.adb
@@ -0,0 +1,314 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2004-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Deallocation;
+with Ada.Characters.Wide_Wide_Latin_1;
+
+with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
+use Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
+
+with Ada.Strings.Wide_Wide_Unbounded; use Ada.Strings.Wide_Wide_Unbounded;
+with Ada.Wide_Wide_Characters.Handling; use Ada.Wide_Wide_Characters.Handling;
+
+package body Case_Handling is
+
+ procedure Add_Exception
+ (HTable : Exceptions_Table;
+ Str : String;
+ Read_Only : Boolean);
+ -- Add Str exception in HTable
+
+ procedure Remove_Exception (HTable : Exceptions_Table; Str : String);
+ -- Remove str exception from the HTable
+
+ function Mixed_Case
+ (Image : Wide_Wide_String;
+ Smart : Boolean := False) return Wide_Wide_String;
+ -- The same as one in package specification, but on Wide_Wide_String.
+
+ ----------------
+ -- Mixed_Case --
+ ----------------
+
+ function Mixed_Case
+ (Image : Wide_Wide_String;
+ Smart : Boolean := False) return Wide_Wide_String
+ is
+ package Latin_1 renames Ada.Characters.Wide_Wide_Latin_1;
+
+ Do_Upper : Boolean;
+ C : Wide_Wide_Character;
+ Result : Unbounded_Wide_Wide_String;
+ begin
+ if Image'Length = 0 then
+ return Image;
+ end if;
+
+ Do_Upper := True;
+
+ for Index in Image'Range loop
+ C := Image (Index);
+
+ if C = '.'
+ or else C = '_'
+ or else C = ' '
+ or else C = '('
+ or else C = ')'
+ or else C = '+'
+ or else C = '-'
+ or else C = '*'
+ or else C = '/'
+ or else C = ','
+ or else C = ';'
+ or else C = '''
+ or else C = Latin_1.HT
+ or else C = Latin_1.LF
+ or else C = Latin_1.CR
+ then
+ Do_Upper := True;
+ Append (Result, C);
+ else
+ if Do_Upper then
+ Append (Result, Ada.Wide_Wide_Characters.Handling.To_Upper (C));
+ elsif not Smart then
+ Append (Result, To_Lower (C));
+ else
+ Append (Result, C);
+ end if;
+
+ Do_Upper := False;
+ end if;
+ end loop;
+
+ return To_Wide_Wide_String (Result);
+ end Mixed_Case;
+
+ ----------------
+ -- Mixed_Case --
+ ----------------
+
+ function Mixed_Case
+ (S : UTF8_String; Smart : Boolean := False) return UTF8_String
+ is
+ Image : constant Wide_Wide_String := Decode (S);
+ begin
+ return Encode (Mixed_Case (Image, Smart));
+ end Mixed_Case;
+
+ ---------------
+ -- Set_Case --
+ ---------------
+
+ function Set_Case
+ (C : Casing_Exceptions;
+ Word : UTF8_String;
+ Casing : Casing_Type) return UTF8_String
+ is
+ function Set_Substring_Exception
+ (Word : Wide_Wide_String) return UTF8_String;
+ -- Apply substring exception to word if possible.
+
+ -----------------------------
+ -- Set_Substring_Exception --
+ -----------------------------
+
+ function Set_Substring_Exception
+ (Word : Wide_Wide_String) return UTF8_String
+ is
+ procedure Apply (Substring : Wide_Wide_String);
+ -- Check if a substring exception exists for this substring and
+ -- apply it.
+
+ Result : Unbounded_Wide_Wide_String;
+
+ -----------
+ -- Apply --
+ -----------
+
+ procedure Apply (Substring : Wide_Wide_String) is
+ -- Set L_Str with the key for Str in the exception hash table
+ L_Word : constant Wide_Wide_String := To_Lower (Substring);
+
+ Pos : Cursor;
+ begin
+ Pos := C.S.Find (L_Word);
+
+ if Has_Element (Pos) then
+ Append (Result, Element (Pos).Word);
+ else
+ Append (Result, Substring);
+ end if;
+ end Apply;
+
+ First : Natural := Word'First - 1;
+ begin
+ if C.S = null then
+ return Encode (Word);
+ end if;
+
+ -- Look for all substring in this word
+
+ for K in Word'Range loop
+ if Word (K) = '_' then
+ Apply (Word (First + 1 .. K - 1));
+ First := K;
+ Append (Result, '_');
+ end if;
+ end loop;
+
+ -- Apply to the last one
+
+ Apply (Word (First + 1 .. Word'Last));
+
+ return Encode (To_Wide_Wide_String (Result));
+ end Set_Substring_Exception;
+
+ Image : constant Wide_Wide_String := Decode (Word);
+ L_Str : constant Wide_Wide_String := To_Lower (Image);
+ N : Cursor;
+ begin
+ if Casing = Unchanged then
+ -- Nothing to do in this case
+ return Word;
+ end if;
+
+ -- Now we check for the case exception for this word. If found we
+ -- just return the record casing, if not set we set the word casing
+ -- according to the rule set in Casing.
+
+ if C.E /= null then
+ N := C.E.Find (L_Str);
+ end if;
+
+ if not Has_Element (N) then
+ -- No case exception for this word, apply standard rules
+
+ case Casing is
+ when Unchanged =>
+ return Set_Substring_Exception (Image);
+
+ when Upper =>
+ return Set_Substring_Exception (To_Upper (Image));
+
+ when Lower =>
+ return Set_Substring_Exception (L_Str);
+
+ when Mixed =>
+ return Set_Substring_Exception (Mixed_Case (Image));
+
+ when Smart_Mixed =>
+ return Set_Substring_Exception
+ (Mixed_Case (Image, Smart => True));
+ end case;
+
+ else
+ -- We have found a case exception
+ return Encode (Element (N).Word);
+ end if;
+ end Set_Case;
+
+ -------------------
+ -- Add_Exception --
+ -------------------
+
+ procedure Add_Exception
+ (HTable : Exceptions_Table;
+ Str : String;
+ Read_Only : Boolean)
+ is
+ Image : constant Wide_Wide_String := Decode (Str);
+ begin
+ HTable.Include (To_Lower (Image), (Image'Length, Read_Only, Image));
+ end Add_Exception;
+
+ procedure Add_Exception
+ (C : in out Casing_Exceptions;
+ Word : String;
+ Read_Only : Boolean) is
+ begin
+ Add_Exception (C.E, Word, Read_Only);
+ end Add_Exception;
+
+ -----------------------------
+ -- Add_Substring_Exception --
+ -----------------------------
+
+ procedure Add_Substring_Exception
+ (C : in out Casing_Exceptions;
+ Substring : String;
+ Read_Only : Boolean) is
+ begin
+ Add_Exception (C.S, Substring, Read_Only);
+ end Add_Substring_Exception;
+
+ ----------------------
+ -- Remove_Exception --
+ ----------------------
+
+ procedure Remove_Exception
+ (HTable : Exceptions_Table;
+ Str : String)
+ is
+ Image : constant Wide_Wide_String := Decode (Str);
+ L_Str : constant Wide_Wide_String := To_Lower (Image);
+ Pos : Cursor := HTable.Find (L_Str);
+ begin
+ if Has_Element (Pos) and then not Element (Pos).Read_Only then
+ HTable.Delete (Pos);
+ end if;
+ end Remove_Exception;
+
+ procedure Remove_Exception (C : in out Casing_Exceptions; Word : String) is
+ begin
+ Remove_Exception (C.E, Word);
+ end Remove_Exception;
+
+ --------------------------------
+ -- Remove_Substring_Exception --
+ --------------------------------
+
+ procedure Remove_Substring_Exception
+ (C : in out Casing_Exceptions;
+ Substring : String) is
+ begin
+ Remove_Exception (C.S, Substring);
+ end Remove_Substring_Exception;
+
+ -------------
+ -- Destroy --
+ -------------
+
+ procedure Destroy (C : in out Casing_Exceptions) is
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Map, Exceptions_Table);
+ begin
+ -- Word exceptions
+
+ if C.E /= null then
+ C.E.Clear;
+ Unchecked_Free (C.E);
+ end if;
+
+ -- Substring exceptions
+
+ if C.S /= null then
+ C.S.Clear;
+ Unchecked_Free (C.S);
+ end if;
+ end Destroy;
+
+end Case_Handling;
diff --git a/packages/ada-mode/gps_source/case_handling.ads
b/packages/ada-mode/gps_source/case_handling.ads
new file mode 100755
index 0000000..9e64e96
--- /dev/null
+++ b/packages/ada-mode/gps_source/case_handling.ads
@@ -0,0 +1,124 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2004-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+-- Case support for case insensitive languages. This package has
+-- services to change the casing of a word (identifier or keyword) and
+-- to handle a set of casing exceptions.
+
+with Basic_Types; use Basic_Types;
+
+with Ada.Containers.Indefinite_Hashed_Maps;
+with Ada.Strings.Wide_Wide_Hash;
+
+package Case_Handling is
+
+ type Casing_Policy is (Disabled, End_Of_Line, End_Of_Word, On_The_Fly);
+ for Casing_Policy'Size use Integer'Size;
+ pragma Convention (C, Casing_Policy);
+ -- The list of supported casing policies.
+ -- - Disable means that no auto-casing will be applied to the buffer
+ -- - End_Of_Line casing done when pressing return
+ -- - On_The_Fly casing is done when inserting a word separator
+
+ type Casing_Type is (Unchanged, Upper, Lower, Mixed, Smart_Mixed);
+ for Casing_Type'Size use Integer'Size;
+ pragma Convention (C, Casing_Type);
+ -- Casing used for identifiers and reserved words.
+ -- Only relevant for case insensitive languages.
+ -- - Mixed: Set first character of each word and characters after an
+ -- underscore to upper-case, all other characters are set to lower-case.
+ -- - Smart_Mixed: As Mixed but never force an upper-case to lower-case.
+
+ function Mixed_Case
+ (S : UTF8_String; Smart : Boolean := False) return UTF8_String;
+ -- Return S with a casing matching Ada style: upper case after an
+ -- underscore or a dot.
+ -- If smart is set, do not change upper-case letters in S
+
+ ---------------------
+ -- Case Exceptions --
+ ---------------------
+
+ type Casing_Exceptions is private;
+ -- This is the case exceptions handler, a set of exceptions to the
+ -- standard casing rule can be recorded into this object.
+
+ No_Casing_Exception : aliased constant Casing_Exceptions;
+
+ function Set_Case
+ (C : Casing_Exceptions;
+ Word : UTF8_String;
+ Casing : Casing_Type) return UTF8_String;
+ -- Change the case of Str as specified by Casing. This routine also
+ -- checks for case exceptions.
+
+ procedure Add_Exception
+ (C : in out Casing_Exceptions;
+ Word : String;
+ Read_Only : Boolean);
+ -- Add a case exception into the container. Read_Only must be set for
+ -- case exception that can't be removed interactively.
+
+ procedure Add_Substring_Exception
+ (C : in out Casing_Exceptions;
+ Substring : String;
+ Read_Only : Boolean);
+ -- Add a substring case exception into the container. Read_Only must be set
+ -- for case exception that can't be removed interactively.
+
+ procedure Remove_Exception (C : in out Casing_Exceptions; Word : String);
+ -- Remove a case exception from the container
+
+ procedure Remove_Substring_Exception
+ (C : in out Casing_Exceptions;
+ Substring : String);
+ -- Remove a substring case exception from the container
+
+ procedure Destroy (C : in out Casing_Exceptions);
+ -- Destroy the case exceptions handler, release all memory associated
+ -- with this object.
+
+private
+
+ type W_Node (Size : Natural) is record
+ Read_Only : Boolean;
+ -- Set to True if this case exception is read only (can't be removed).
+ -- Such case exception comes from a global .xml files.
+ Word : Wide_Wide_String (1 .. Size);
+ end record;
+
+ package Casing_Exception_Table is new Ada.Containers.Indefinite_Hashed_Maps
+ (Key_Type => Wide_Wide_String,
+ Element_Type => W_Node,
+ Hash => Ada.Strings.Wide_Wide_Hash,
+ Equivalent_Keys => "=");
+ use Casing_Exception_Table;
+
+ type Exceptions_Table is access Map;
+ -- Exception Word handler, each exception is inserted into this hash
+ -- table. The key is the word in lower-case, the associated
+ -- value is the word with the right casing.
+
+ type Casing_Exceptions is record
+ E : Exceptions_Table := new Map;
+ S : Exceptions_Table := new Map;
+ end record;
+
+ No_Casing_Exception : aliased constant Casing_Exceptions :=
+ (E => null, S => null);
+
+end Case_Handling;
diff --git a/packages/ada-mode/gps_source/config.ads
b/packages/ada-mode/gps_source/config.ads
new file mode 100755
index 0000000..83c3fa5
--- /dev/null
+++ b/packages/ada-mode/gps_source/config.ads
@@ -0,0 +1,34 @@
+-----------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2001-2010, AdaCore --
+-- --
+-- GPS is free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this library; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+-- This package contains target specific parameters that are set at configure
+-- time.
+
+package Config is
+ pragma Pure;
+
+ pragma Style_Checks (Off);
+
+
+ Default_Charset : constant String := "ISO-8859-1";
+ -- Default charset for the host, used throughout GPS to convert strings
+ -- from outside GPS (e.g. pathnames, compiler output, file contents, ...)
+ -- to UTF-8 internally.
+
+end Config;
diff --git a/packages/ada-mode/gps_source/generic_stack.adb
b/packages/ada-mode/gps_source/generic_stack.adb
new file mode 100755
index 0000000..9564a04
--- /dev/null
+++ b/packages/ada-mode/gps_source/generic_stack.adb
@@ -0,0 +1,126 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2001-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Deallocation;
+
+package body Generic_Stack is
+
+ procedure Unchecked_Free is new
+ Ada.Unchecked_Deallocation (Type_Array, Type_Array_Access);
+
+ -----------
+ -- Clear --
+ -----------
+
+ procedure Clear (Stack : in out Simple_Stack) is
+ begin
+ Unchecked_Free (Stack.Values);
+ Stack.Last := 0;
+ end Clear;
+
+ ----------
+ -- Push --
+ ----------
+
+ Minimal_Array_Length : constant := 64;
+ -- Minimal length to allocate on an array
+
+ procedure Push (Stack : in out Simple_Stack; Value : Generic_Type) is
+ Tmp : Type_Array_Access;
+ begin
+ if Stack.Values = null then
+ Stack.Values := new Type_Array (1 .. Minimal_Array_Length);
+ elsif Stack.Last >= Stack.Values'Last then
+ Tmp := Stack.Values;
+ Stack.Values := new Type_Array (1 .. Tmp'Length * 2);
+ Stack.Values (Tmp'Range) := Tmp.all;
+ Unchecked_Free (Tmp);
+ end if;
+
+ Stack.Last := Stack.Last + 1;
+ Stack.Values (Stack.Last) := Value;
+ end Push;
+
+ ---------
+ -- Pop --
+ ---------
+
+ procedure Pop (Stack : in out Simple_Stack; Value : out Generic_Type) is
+ begin
+ if Stack.Last = 0 then
+ raise Stack_Empty;
+ else
+ Value := Stack.Values (Stack.Last);
+ Stack.Last := Stack.Last - 1;
+ end if;
+ end Pop;
+
+ procedure Pop (Stack : in out Simple_Stack) is
+ Value : Generic_Type;
+ begin
+ Pop (Stack, Value);
+ end Pop;
+
+ ---------
+ -- Top --
+ ---------
+
+ function Top (Stack : Simple_Stack) return Generic_Type_Access is
+ begin
+ if Stack.Last = 0 then
+ raise Stack_Empty;
+ else
+ return Stack.Values (Stack.Last)'Access;
+ end if;
+ end Top;
+
+ ----------
+ -- Next --
+ ----------
+
+ function Next (Stack : Simple_Stack) return Generic_Type_Access is
+ begin
+ if Stack.Last <= 1 then
+ return null;
+ else
+ return Stack.Values (Stack.Last - 1)'Access;
+ end if;
+ end Next;
+
+ --------------
+ -- Is_Empty --
+ --------------
+
+ function Is_Empty (Stack : Simple_Stack) return Boolean is
+ begin
+ return Stack.Last = 0;
+ end Is_Empty;
+
+ --------------------
+ -- Traverse_Stack --
+ --------------------
+
+ procedure Traverse_Stack
+ (Stack : Simple_Stack;
+ Callback : access function (Obj : Generic_Type) return Boolean) is
+ begin
+ for J in 1 .. Stack.Last loop
+ exit when not Callback (Stack.Values (J));
+ end loop;
+ end Traverse_Stack;
+
+end Generic_Stack;
diff --git a/packages/ada-mode/gps_source/generic_stack.ads
b/packages/ada-mode/gps_source/generic_stack.ads
new file mode 100755
index 0000000..167fa2b
--- /dev/null
+++ b/packages/ada-mode/gps_source/generic_stack.ads
@@ -0,0 +1,74 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2001-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+generic
+ type Generic_Type is private;
+package Generic_Stack is
+ type Simple_Stack is private;
+
+ type Generic_Type_Access is access all Generic_Type;
+
+ Stack_Empty : exception;
+ -- Raised by the functions below when stack is empty.
+
+ procedure Push (Stack : in out Simple_Stack; Value : Generic_Type);
+ -- Push Value on top of Stack.
+
+ procedure Pop (Stack : in out Simple_Stack; Value : out Generic_Type);
+ -- Remove the value on top of Stack and return it in Value.
+ -- Raise Stack_Empty if Stack is empty.
+
+ procedure Pop (Stack : in out Simple_Stack);
+ -- Remove the value on top of Stack.
+ -- Raise Stack_Empty if Stack is empty.
+
+ function Top (Stack : Simple_Stack) return Generic_Type_Access;
+ -- Return a pointer to the top of the stack.
+ -- Note that modifying the contents of the returned pointer will
+ -- modify the contents of the stack.
+ -- Raise Stack_Empty if Stack is empty.
+
+ function Next (Stack : Simple_Stack) return Generic_Type_Access;
+ -- Return a pointer to the next item of the stack, or null if none.
+
+ procedure Traverse_Stack
+ (Stack : Simple_Stack;
+ Callback : access function (Obj : Generic_Type) return Boolean);
+ -- Traverse Stack and call Callback on each element of the stack.
+ -- Stop when Stack is traversed or when Callback returns False.
+
+ procedure Clear (Stack : in out Simple_Stack);
+ -- Clear the contents of stack. This automatically frees memory for Stack
+ -- as well.
+
+ function Is_Empty (Stack : Simple_Stack) return Boolean;
+ -- Returns True if the stack is empty.
+
+private
+ type Type_Array is array (Positive range <>) of aliased Generic_Type;
+ type Type_Array_Access is access all Type_Array;
+
+ type Simple_Stack is record
+ Values : Type_Array_Access; -- Index starts at 1
+ Last : Natural := 0; -- Last significant element in Values
+ end record;
+
+ pragma Inline (Push);
+ pragma Inline (Pop);
+ pragma Inline (Top);
+ pragma Inline (Next);
+end Generic_Stack;
diff --git a/packages/ada-mode/gps_source/indent_stack.ads
b/packages/ada-mode/gps_source/indent_stack.ads
new file mode 100755
index 0000000..9f3c6ae
--- /dev/null
+++ b/packages/ada-mode/gps_source/indent_stack.ads
@@ -0,0 +1,32 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2002-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+with Generic_Stack;
+
+package Indent_Stack is
+
+ type Indent_Type is record
+ Level : Integer;
+ Align_Arrow : Natural;
+ -- The column on which to align arrow delimiters
+ Line : Natural;
+ Continuation_Val : Natural;
+ end record;
+
+ package Stack is new Generic_Stack (Indent_Type);
+
+end Indent_Stack;
diff --git a/packages/ada-mode/gps_source/language.adb
b/packages/ada-mode/gps_source/language.adb
new file mode 100755
index 0000000..0e7a6f9
--- /dev/null
+++ b/packages/ada-mode/gps_source/language.adb
@@ -0,0 +1,1052 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2000-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Deallocation;
+with Ada.Strings.Maps.Constants;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with Ada.Wide_Wide_Characters.Unicode; use Ada.Wide_Wide_Characters.Unicode;
+with Ada.Characters.Wide_Wide_Latin_1;
+with GNAT.Expect; use GNAT.Expect;
+with GNAT.Regpat; use GNAT.Regpat;
+with GNATCOLL.Symbols; use GNATCOLL.Symbols;
+with GNATCOLL.Utils; use GNATCOLL.Utils;
+with String_Utils; use String_Utils;
+with UTF8_Utils; use UTF8_Utils;
+
+package body Language is
+
+ Default_Word_Character_Set : constant Character_Set :=
+ Constants.Letter_Set or Constants.Decimal_Digit_Set or To_Set ("_");
+ -- Default character set for keywords and indentifiers
+
+ procedure Looking_At
+ (Lang : access Language_Root;
+ Buffer : String;
+ First : Natural;
+ Entity : out Language_Entity;
+ Next_Char : out Positive;
+ Line : out Natural;
+ Column : out Natural);
+ -- Internal version of Looking_At, which also returns the Line and Column,
+ -- considering that Buffer (First) is at line 1 column 1.
+ -- Column is a byte index, not a character index.
+
+ ---------------------------
+ -- Can_Tooltip_On_Entity --
+ ---------------------------
+
+ function Can_Tooltip_On_Entity
+ (Lang : access Language_Root;
+ Entity : String) return Boolean
+ is
+ pragma Unreferenced (Lang, Entity);
+ begin
+ return True;
+ end Can_Tooltip_On_Entity;
+
+ ---------------------
+ -- Scope_Separator --
+ ---------------------
+
+ function Scope_Separator
+ (Lang : access Language_Root) return String
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return ".";
+ end Scope_Separator;
+
+ ----------------------
+ -- Explorer_Regexps --
+ ----------------------
+
+ function Explorer_Regexps
+ (Lang : access Language_Root) return Explorer_Categories
+ is
+ pragma Unreferenced (Lang);
+ E : Explorer_Categories (1 .. 0);
+ begin
+ return E;
+ end Explorer_Regexps;
+
+ ----------
+ -- Free --
+ ----------
+
+ procedure Free (Context : in out Language_Context_Access) is
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Language_Context, Language_Context_Access);
+
+ Var : GNAT.Expect.Pattern_Matcher_Access :=
+ GNAT.Expect.Pattern_Matcher_Access
+ (Context.Syntax.New_Line_Comment_Start_Regexp);
+ begin
+ if Context /= null then
+ GNAT.Strings.Free (Context.Syntax.Comment_Start);
+ GNAT.Strings.Free (Context.Syntax.Comment_End);
+ Basic_Types.Unchecked_Free (Var);
+ GNAT.Strings.Free (Context.Syntax.New_Line_Comment_Start);
+ Unchecked_Free (Context);
+ end if;
+ end Free;
+
+ ----------
+ -- Free --
+ ----------
+
+ procedure Free (Lang : in out Language_Access) is
+ procedure Internal is new Ada.Unchecked_Deallocation
+ (Language_Root'Class, Language_Access);
+ begin
+ if Lang /= null then
+ Free (Lang.all);
+ Internal (Lang);
+ end if;
+ end Free;
+
+ procedure Free (List : in out Construct_List) is
+ Info, Tmp : Construct_Access;
+
+ procedure Free is new
+ Ada.Unchecked_Deallocation (Construct_Information, Construct_Access);
+
+ begin
+ Info := List.First;
+
+ loop
+ exit when Info = null;
+
+ GNAT.Strings.Free (Info.Profile);
+ Tmp := Info;
+ Info := Info.Next;
+ Free (Tmp);
+ end loop;
+
+ List.First := null;
+ List.Current := null;
+ List.Last := null;
+ end Free;
+
+ ----------
+ -- Free --
+ ----------
+
+ procedure Free (Category : in out Explorer_Category) is
+ begin
+ Basic_Types.Unchecked_Free (Category.Regexp);
+ end Free;
+
+ ----------
+ -- Free --
+ ----------
+
+ procedure Free (Categories : in out Explorer_Categories) is
+ begin
+ for C in Categories'Range loop
+ Free (Categories (C));
+ end loop;
+ end Free;
+
+ --------------------
+ -- Is_System_File --
+ --------------------
+
+ function Is_System_File
+ (Lang : access Language_Root;
+ File_Name : String) return Boolean
+ is
+ pragma Unreferenced (Lang, File_Name);
+ begin
+ return False;
+ end Is_System_File;
+
+ ----------------
+ -- Looking_At --
+ ----------------
+
+ procedure Looking_At
+ (Lang : access Language_Root;
+ Buffer : String;
+ First : Natural;
+ Entity : out Language_Entity;
+ Next_Char : out Positive)
+ is
+ Line, Column : Natural;
+ begin
+ Looking_At (Lang, Buffer, First, Entity, Next_Char, Line, Column);
+ end Looking_At;
+
+ procedure Looking_At
+ (Lang : access Language_Root;
+ Buffer : String;
+ First : Natural;
+ Entity : out Language_Entity;
+ Next_Char : out Positive;
+ Line : out Natural;
+ Column : out Natural)
+ is
+ Context : constant Language_Context_Access :=
+ Get_Language_Context (Language_Access (Lang));
+ Keys : constant GNAT.Expect.Pattern_Matcher_Access :=
+ Keywords (Language_Access (Lang));
+ Buffer_Length : constant Natural := Buffer'Last - First + 1;
+ Matched : Match_Array (0 .. 1);
+ C : Wide_Wide_Character;
+ Tmp : Natural;
+ Found : Boolean;
+
+ use GNAT.Strings;
+
+ begin
+ Line := 1;
+ Column := 1;
+
+ if Buffer (First) = ASCII.LF then
+ Next_Char := First + 1;
+ Line := Line + 1;
+ Column := 1;
+ Entity := Normal_Text;
+ return;
+ end if;
+
+ -- Do we have a comment ?
+
+ if Context.Syntax.Comment_Start /= null
+ and then Starts_With
+ (Buffer (First .. Buffer'Last), Context.Syntax.Comment_Start.all)
+ then
+ Entity := Comment_Text;
+ Next_Char := First + Context.Syntax.Comment_Start'Length;
+ Column := Column + Context.Syntax.Comment_Start'Length;
+
+ while Starts_With
+ (Buffer (Next_Char .. Buffer'Last), Context.Syntax.Comment_End.all)
+ loop
+ Tmp := UTF8_Next_Char (Buffer, Next_Char);
+ Column := Column + (Tmp - Next_Char);
+ Next_Char := Tmp;
+
+ if Next_Char <= Buffer'Last
+ and then Buffer (Next_Char) = ASCII.LF
+ then
+ Column := 1;
+ Line := Line + 1;
+ end if;
+ end loop;
+
+ Next_Char := Next_Char + Context.Syntax.Comment_End'Length;
+ Column := Column + Context.Syntax.Comment_End'Length;
+ return;
+ end if;
+
+ -- Do we have a comment that ends on newline ?
+
+ if Context.Syntax.New_Line_Comment_Start /= null then
+ Found := Starts_With
+ (Buffer (First .. Buffer'Last),
+ Context.Syntax.New_Line_Comment_Start.all);
+ elsif Context.Syntax.New_Line_Comment_Start_Regexp /= null then
+ Found := Match (Context.Syntax.New_Line_Comment_Start_Regexp.all,
+ Buffer (First .. Buffer'Last));
+ else
+ Found := False;
+ end if;
+
+ if Found then
+ Entity := Comment_Text;
+ Next_Char := UTF8_Next_Char (Buffer, First);
+
+ while Next_Char <= Buffer'Last
+ and then Buffer (Next_Char) /= ASCII.LF
+ loop
+ Tmp := UTF8_Next_Char (Buffer, Next_Char);
+ Column := Column + (Tmp - Next_Char);
+ Next_Char := Tmp;
+ end loop;
+
+ return;
+ end if;
+
+ -- Do we have a string ?
+ -- Note that we consider that strings never span over multiple lines...
+
+ if Buffer (First) = Context.String_Delimiter then
+ Entity := String_Text;
+ Next_Char := First;
+
+ if Next_Char < Buffer'Last
+ and then Buffer (Next_Char + 1) /= ASCII.LF
+ then
+ loop
+ Next_Char := UTF8_Next_Char (Buffer, Next_Char);
+ Column := Column + 1;
+
+ exit when Next_Char >= Buffer'Last
+ or else Buffer (Next_Char + 1) = ASCII.LF
+ or else
+ (Buffer (Next_Char) = Context.String_Delimiter
+ and then
+ (Context.Quote_Character = ASCII.NUL
+ or else
+ Buffer (Next_Char - 1) /= Context.Quote_Character));
+ end loop;
+ end if;
+
+ if Next_Char <= Buffer'Last then
+ Tmp := UTF8_Next_Char (Buffer, Next_Char);
+ Column := Column + (Tmp - Next_Char);
+ Next_Char := Tmp;
+ end if;
+
+ return;
+ end if;
+
+ -- A protected constant character
+ -- ??? The following test still does not handle cases such as
+ -- '\012' for instance, or multi-byte character constants.
+
+ if Buffer_Length > 4
+ and then Buffer (First) = Context.Constant_Character
+ and then Buffer (First + 1) = Context.Quote_Character
+ and then Buffer (First + 3) = Context.Constant_Character
+ then
+ Entity := Character_Text;
+ Next_Char := First + 4;
+ Column := Column + 4;
+ return;
+ end if;
+
+ -- A constant character
+
+ if Buffer_Length > 3
+ and then Buffer (First) = Context.Constant_Character
+ and then Buffer (First + 2) = Context.Constant_Character
+ then
+ Entity := Character_Text;
+ Next_Char := First + 3;
+ Column := Column + 3;
+ return;
+ end if;
+
+ -- Do we have a keyword ?
+ -- ??? It is assumed the regexp should check at the current char
+ -- only, not beyond for efficiency...
+
+ if Keys /= null then
+ Match (Keys.all, Buffer (First .. Buffer'Last), Matched);
+ if Matched (0) /= No_Match then
+ Next_Char := UTF8_Next_Char (Buffer, Matched (0).Last);
+ Column := Column + Matched (0).Last - Matched (0).First + 1;
+ Entity := Keyword_Text;
+ return;
+ end if;
+ end if;
+
+ -- Another special character, not part of a word: just skip it, before
+ -- doing some regexp matching
+ -- It is better to return a pointer to the newline, so that the icons
+ -- on the side might be displayed properly.
+
+ if not Is_Word_Char
+ (Language_Access (Lang),
+ UTF8_Get_Char (Buffer (First .. Buffer'Last)))
+ then
+ Entity := Normal_Text;
+ Next_Char := UTF8_Next_Char (Buffer, First);
+ Column := Column + (Next_Char - First);
+
+ while Next_Char <= Buffer'Last loop
+ C := UTF8_Get_Char (Buffer (Next_Char .. Buffer'Last));
+
+ exit when C = Ada.Characters.Wide_Wide_Latin_1.LF
+ or else not Is_Space (C);
+
+ Tmp := UTF8_Next_Char (Buffer, Next_Char);
+ Column := Column + (Tmp - Next_Char);
+ Next_Char := Tmp;
+ end loop;
+
+ return;
+ end if;
+
+ -- Skip to the next meaningful character. we know we are
+ -- starting with a letter
+
+ Next_Char := UTF8_Next_Char (Buffer, First);
+ Column := Column + (Next_Char - First);
+ Entity := Normal_Text;
+
+ if Buffer (Next_Char) = ASCII.LF then
+ return;
+ end if;
+
+ -- Skip the current word. We only take into account Is_Entity_Letter,
+ -- not the full set of chars supported by the language for its keywords
+ -- because of cases like "<foo>bar</foo>" in XML, which would otherwise
+ -- consider this as a single word when they are in fact several.
+
+ while Next_Char <= Buffer'Last
+ and then Is_Entity_Letter
+ (UTF8_Get_Char (Buffer (Next_Char .. Buffer'Last)))
+ loop
+ Tmp := UTF8_Next_Char (Buffer, Next_Char);
+ Column := Column + (Tmp - Next_Char);
+ Next_Char := Tmp;
+ end loop;
+ end Looking_At;
+
+ -------------------------------------
+ -- To_Simple_Construct_Information --
+ -------------------------------------
+
+ procedure To_Simple_Construct_Information
+ (Construct : Construct_Information;
+ Simple : out Simple_Construct_Information;
+ Full_Copy : Boolean)
+ is
+ pragma Unreferenced (Full_Copy);
+ begin
+ Simple :=
+ (Category => Construct.Category,
+ Is_Declaration => Construct.Is_Declaration,
+ Is_Generic_Spec => Construct.Is_Generic_Spec,
+ Visibility => Construct.Visibility,
+ Name => Construct.Name,
+ Sloc_Start => Construct.Sloc_Start,
+ Sloc_Entity => Construct.Sloc_Entity,
+ Sloc_End => Construct.Sloc_End,
+ Attributes => Construct.Attributes,
+ Profile_Cache => null);
+ end To_Simple_Construct_Information;
+
+ ------------------
+ -- Comment_Line --
+ ------------------
+
+ function Comment_Line
+ (Lang : access Language_Root;
+ Line : String;
+ Comment : Boolean := True;
+ Clean : Boolean := False) return String
+ is
+ pragma Unreferenced (Lang, Comment, Clean);
+ begin
+ return Line;
+ end Comment_Line;
+
+ ------------------
+ -- Comment_Block --
+ ------------------
+
+ function Comment_Block
+ (Lang : access Language_Root;
+ Block : String;
+ Comment : Boolean := True;
+ Clean : Boolean := False) return String
+ is
+ Start_Of_Line : Natural := Block'First;
+ End_Of_Line : Natural;
+ New_Block : Unbounded_String := Null_Unbounded_String;
+ begin
+ loop
+ End_Of_Line := Next_Line (Block, Start_Of_Line);
+ if End_Of_Line /= Block'Last and then End_Of_Line /= Block'First then
+ End_Of_Line := End_Of_Line - 1;
+ end if;
+
+ Append
+ (New_Block,
+ Comment_Line
+ (Language_Access (Lang),
+ Block (Start_Of_Line .. End_Of_Line),
+ Comment,
+ Clean));
+
+ Start_Of_Line := Next_Line (Block, Start_Of_Line);
+ exit when Start_Of_Line = Block'Last;
+ end loop;
+
+ return To_String (New_Block);
+ end Comment_Block;
+
+ ----------------------
+ -- Parse_Constructs --
+ ----------------------
+
+ procedure Parse_Constructs
+ (Lang : access Language_Root;
+ File : GNATCOLL.VFS.Virtual_File;
+ Buffer : UTF8_String;
+ Result : out Construct_List)
+ is
+ pragma Unreferenced (File);
+ Matches : Match_Array (0 .. 10);
+ Categories : constant Explorer_Categories :=
+ Explorer_Regexps (Language_Access (Lang));
+ First : Natural;
+ Line : Natural;
+ Line_Pos : Natural;
+ Sloc_Entity : Source_Location;
+ Sloc_Start : Source_Location;
+ Sloc_End : Source_Location;
+ Info : Construct_Access;
+ Match_Index : Natural;
+ End_Index : Natural;
+
+ procedure Forward
+ (Index : Natural;
+ Sloc : in out Source_Location);
+ -- Compute Line and Column fields in Sloc and update Line and Line_Pos
+
+ -------------
+ -- Forward --
+ -------------
+
+ procedure Forward
+ (Index : Natural;
+ Sloc : in out Source_Location) is
+ begin
+ for J in Index .. Sloc.Index loop
+ if Buffer (J) = ASCII.LF then
+ Line := Line + 1;
+ Line_Pos := J;
+ end if;
+ end loop;
+
+ Sloc.Line := Line;
+ Sloc.Column := Sloc.Index - Line_Pos;
+ end Forward;
+
+ begin
+ Result := (null, null, null, 0);
+
+ -- For each category, parse the buffer
+
+ for C in Categories'Range loop
+ First := Buffer'First;
+ Line := 1;
+ Line_Pos := 0;
+
+ loop
+ Match (Categories (C).Regexp.all,
+ Buffer (First .. Buffer'Last),
+ Matches);
+
+ exit when Matches (0) = No_Match;
+
+ Match_Index := Categories (C).Position_Index;
+ End_Index := Categories (C).End_Index;
+
+ if Matches (Match_Index) /= No_Match then
+ Sloc_Start.Index := Matches (0).First;
+ Sloc_Entity.Index := Matches (Match_Index).First;
+ Sloc_End.Index := Matches (End_Index).Last;
+
+ Forward (First, Sloc_Start);
+ Forward (Sloc_Start.Index + 1, Sloc_Entity);
+ Forward (Sloc_Entity.Index + 1, Sloc_End);
+
+ Info := Result.Current;
+ Result.Current := new Construct_Information;
+
+ if Result.First = null then
+ Result.First := Result.Current;
+ else
+ Result.Current.Prev := Info;
+ Result.Current.Next := Info.Next;
+ Info.Next := Result.Current;
+ end if;
+
+ Result.Last := Result.Current;
+ Result.Current.Category := Categories (C).Category;
+ Result.Current.Category_Name := Categories (C).Category_Name;
+ Result.Size := Result.Size + 1;
+
+ if Categories (C).Make_Entry /= null then
+ Result.Current.Name := Lang.Symbols.Find
+ (Categories (C).Make_Entry (Buffer, Matches));
+ else
+ Result.Current.Name := Lang.Symbols.Find
+ (Buffer (Matches (Match_Index).First ..
+ Matches (Match_Index).Last));
+ end if;
+
+ -- Result.Current.Profile := ???
+
+ Result.Current.Sloc_Entity := Sloc_Entity;
+ Result.Current.Sloc_Start := Sloc_Start;
+ Result.Current.Sloc_End := Sloc_End;
+ Result.Current.Is_Declaration := False;
+ end if;
+
+ First := Matches (End_Index).Last + 1;
+ end loop;
+ end loop;
+ end Parse_Constructs;
+
+ --------------------
+ -- Parse_Entities --
+ --------------------
+
+ procedure Parse_Entities
+ (Lang : access Language_Root;
+ Buffer : String;
+ Callback : Entity_Callback)
+ is
+ use type GNAT.Strings.String_Access;
+ Index : Natural := Buffer'First;
+ Next_Char : Natural;
+ End_Char : Natural;
+ Entity : Language_Entity;
+ Line : Natural;
+ Line_Inc : Natural;
+ Col : Natural;
+ Column : Natural;
+ Column_Inc : Natural;
+
+ begin
+ Line := 1;
+ Column := 1;
+
+ while Index < Buffer'Last loop
+ Looking_At
+ (Lang, Buffer, Index, Entity, Next_Char, Line_Inc, Column_Inc);
+
+ if Next_Char = Buffer'Last then
+ End_Char := Buffer'Last;
+ else
+ End_Char := Next_Char - 1;
+ end if;
+
+ -- If we are still on the same line, Column_Inc is an increment
+ -- compared to what we have initially, otherwise it is an absolute
+ -- column.
+
+ if Line_Inc = 1 then
+ Column_Inc := Column + Column_Inc - 1;
+ end if;
+
+ -- Looking_At goes always one character beyond characters and
+ -- strings, otherwise next call to Looking_At would start on
+ -- a string or character delimiter. Keywords are also set one
+ -- character beyond.
+
+ if Column_Inc > 1
+ and then (Entity = String_Text
+ or else Entity = Character_Text
+ or else Entity = Keyword_Text)
+ then
+ Col := Column_Inc - 1;
+ else
+ Col := Column_Inc;
+ end if;
+
+ exit when Callback
+ (Entity,
+ (Line, Column, Index),
+ (Line + Line_Inc - 1, Col, End_Char),
+ Get_Language_Context
+ (Language_Access (Lang)).Syntax.Comment_Start /= null
+ and then Entity = Comment_Text and then Next_Char > Buffer'Last);
+
+ Line := Line + Line_Inc - 1;
+ Column := Column_Inc;
+
+ Index := Next_Char;
+ end loop;
+ end Parse_Entities;
+
+ ---------------------------
+ -- Get_Referenced_Entity --
+ ---------------------------
+
+ procedure Get_Referenced_Entity
+ (Lang : access Language_Root;
+ Buffer : String;
+ Construct : Simple_Construct_Information;
+ Sloc_Start : out Source_Location;
+ Sloc_End : out Source_Location;
+ Success : out Boolean;
+ From_Index : Natural := 0)
+ is
+ pragma Unreferenced
+ (Lang, Buffer, Construct, Sloc_Start, Sloc_End, From_Index);
+ begin
+ Success := False;
+ end Get_Referenced_Entity;
+
+ -------------------
+ -- Format_Buffer --
+ -------------------
+
+ procedure Format_Buffer
+ (Lang : access Language_Root;
+ Buffer : String;
+ Replace : Replace_Text_Callback;
+ From, To : Natural := 0;
+ Indent_Params : Indent_Parameters := Default_Indent_Parameters;
+ Indent_Offset : Natural := 0;
+ Case_Exceptions : Case_Handling.Casing_Exceptions :=
+ Case_Handling.No_Casing_Exception;
+ Is_Optional_Keyword : access function (S : String)
+ return Boolean := null)
+ is
+ pragma Unreferenced
+ (Lang, Indent_Offset, Case_Exceptions, Is_Optional_Keyword);
+
+ Use_Tabs : Boolean renames Indent_Params.Use_Tabs;
+ Index : Natural;
+ Indent : Natural := 0;
+ Start_Of_Line : Natural;
+ Start_Prev_Line : Natural;
+
+ function Find_Line_Start
+ (Buffer : String; Index : Natural) return Natural;
+ -- Find the starting ASCII.LF character of the line positioned at
+ -- Buffer (Index).
+
+ ---------------------
+ -- Find_Line_Start --
+ ---------------------
+
+ function Find_Line_Start
+ (Buffer : String; Index : Natural) return Natural
+ is
+ Result : Natural := Index;
+ begin
+ while Result > Buffer'First
+ and then Buffer (Result) /= ASCII.LF
+ loop
+ Result := Result - 1;
+ end loop;
+
+ return Result;
+ end Find_Line_Start;
+
+ begin
+ if Buffer'Length <= 1 or else To > From + 1 then
+ return;
+ end if;
+
+ Start_Of_Line := Find_Line_Start (Buffer, Buffer'Last - 1);
+ Start_Prev_Line := Find_Line_Start (Buffer, Start_Of_Line - 1);
+
+ -- Compute the indentation level
+
+ for J in Start_Prev_Line + 1 .. Start_Of_Line - 1 loop
+ if Buffer (J) = ' ' then
+ Indent := Indent + 1;
+ elsif Buffer (J) = ASCII.HT then
+ Indent := Indent + Tab_Width - (Indent mod Tab_Width);
+ else
+ exit;
+ end if;
+ end loop;
+
+ -- Find the blank slice to replace
+
+ Index := Start_Of_Line + 1;
+
+ while Index < Buffer'Last
+ and then (Buffer (Index) = ' ' or else Buffer (Index) = ASCII.HT)
+ loop
+ Index := Index + 1;
+ end loop;
+
+ Replace
+ (To, 1, Index - Start_Of_Line,
+ Blank_Slice (Indent, Use_Tabs, Tab_Width));
+ end Format_Buffer;
+
+ -------------------
+ -- Category_Name --
+ -------------------
+
+ function Category_Name
+ (Category : Language.Language_Category;
+ Name : GNATCOLL.Symbols.Symbol := GNATCOLL.Symbols.No_Symbol)
+ return String
+ is
+ use type Strings.String_Access;
+ begin
+ if Name /= No_Symbol then
+ return Get (Name).all;
+ end if;
+
+ case Category is
+ when Cat_Unknown => return "";
+ when Cat_Custom => return "custom";
+ when Cat_Package => return "package";
+ when Cat_Namespace => return "namespace";
+ when Cat_Task => return "task";
+ when Cat_Procedure => return "subprogram";
+ when Cat_Function => return "subprogram";
+ when Cat_Method => return "method";
+ when Cat_Constructor => return "constructor";
+ when Cat_Destructor => return "destructor";
+ when Cat_Protected => return "protected";
+ when Cat_Entry => return "entry";
+ when Cat_Class => return "class";
+ when Cat_Structure => return "structure";
+ when Cat_Case_Inside_Record => return "structure variant part";
+ when Cat_Union => return "union";
+ when Cat_Type => return "type";
+ when Cat_Subtype => return "subtype";
+ when Cat_Variable => return "variable";
+ when Cat_Local_Variable => return "variable";
+ when Cat_Parameter => return "parameter";
+ when Cat_Discriminant => return "discriminant";
+ when Cat_Field => return "field";
+ when Cat_Literal => return "literal";
+ when Cat_Representation_Clause => return "representation clause";
+ when Cat_With => return "with";
+ when Cat_Use => return "use";
+ when Cat_Include => return "include";
+ when Construct_Category => return "";
+ when Cat_Exception_Handler => return "";
+ when Cat_Pragma => return "pragma";
+ when Cat_Aspect => return "aspect";
+ end case;
+ end Category_Name;
+
+ --------------------------------
+ -- Get_Indentation_Parameters --
+ --------------------------------
+
+ procedure Get_Indentation_Parameters
+ (Lang : access Language_Root;
+ Params : out Indent_Parameters;
+ Indent_Style : out Indentation_Kind) is
+ begin
+ Params := Lang.Indent_Params;
+ Indent_Style := Lang.Indent_Style;
+ end Get_Indentation_Parameters;
+
+ --------------------------------
+ -- Set_Indentation_Parameters --
+ --------------------------------
+
+ procedure Set_Indentation_Parameters
+ (Lang : access Language_Root;
+ Params : Indent_Parameters;
+ Indent_Style : Indentation_Kind) is
+ begin
+ Lang.Indent_Params := Params;
+ Lang.Indent_Style := Indent_Style;
+ end Set_Indentation_Parameters;
+
+ ----------
+ -- Free --
+ ----------
+
+ procedure Free (Fields : in out Project_Field_Array) is
+ begin
+ for F in Fields'Range loop
+ Strings.Free (Fields (F).Attribute_Name);
+ Strings.Free (Fields (F).Attribute_Index);
+ Strings.Free (Fields (F).Description);
+ end loop;
+ end Free;
+
+ ------------------------
+ -- Word_Character_Set --
+ ------------------------
+
+ function Word_Character_Set
+ (Lang : access Language_Root)
+ return Character_Set
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return Default_Word_Character_Set;
+ end Word_Character_Set;
+
+ ------------------
+ -- Is_Word_Char --
+ ------------------
+
+ function Is_Word_Char
+ (Lang : access Language_Root; Char : Wide_Wide_Character) return Boolean
+ is
+ pragma Unreferenced (Lang);
+ begin
+ return Is_Entity_Letter (Char);
+ end Is_Word_Char;
+
+ ---------
+ -- "=" --
+ ---------
+
+ overriding function "=" (S1, S2 : Source_Location) return Boolean is
+ begin
+ if S1.Index > 0 and then S2.Index > 0 then
+ return S1.Index = S2.Index;
+ else
+ return S1.Line = S2.Line
+ and then S1.Column = S2.Column;
+ end if;
+ end "=";
+
+ ---------
+ -- "<" --
+ ---------
+
+ function "<" (S1, S2 : Source_Location) return Boolean is
+ begin
+ if S1.Index > 0 and then S2.Index > 0 then
+ return S1.Index < S2.Index;
+ elsif S1.Line = S2.Line then
+ return S1.Column < S2.Column;
+ else
+ return S1.Line < S2.Line;
+ end if;
+ end "<";
+
+ ----------
+ -- "<=" --
+ ----------
+
+ function "<=" (S1, S2 : Source_Location) return Boolean is
+ begin
+ return S1 = S2 or else S1 < S2;
+ end "<=";
+
+ ---------
+ -- ">" --
+ ---------
+
+ function ">" (S1, S2 : Source_Location) return Boolean is
+ begin
+ return S2 < S1;
+ end ">";
+
+ ----------
+ -- ">=" --
+ ----------
+
+ function ">=" (S1, S2 : Source_Location) return Boolean is
+ begin
+ return not (S1 < S2);
+ end ">=";
+
+ ---------------------------
+ -- Parse_Tokens_Backward --
+ ---------------------------
+
+ procedure Parse_Tokens_Backwards
+ (Lang : access Language_Root;
+ Buffer : UTF8_String;
+ Start_Offset : String_Index_Type;
+ End_Offset : String_Index_Type := 0;
+ -- ??? This analysis should be done when looking for comments !!!
+ Callback :
+ access procedure (Token : Token_Record;
+ Stop : in out Boolean))
+ is
+ pragma Unreferenced (Lang);
+ Lowest : constant String_Index_Type :=
+ String_Index_Type'Max (End_Offset, String_Index_Type (Buffer'First));
+ Index : String_Index_Type := Start_Offset;
+ Stop : Boolean := False;
+ begin
+ if Index not in Lowest .. String_Index_Type (Buffer'Last) then
+ return;
+ else
+ Skip_Word
+ (Buffer (Natural (Lowest) .. Natural (Index)),
+ Natural (Index),
+ Step => -1);
+
+ Callback
+ ((Tok_Type => No_Token,
+ Token_First => Index + 1,
+ Token_Last => Start_Offset),
+ Stop);
+ end if;
+ end Parse_Tokens_Backwards;
+
+ ------------------------------
+ -- Parse_Reference_Backward --
+ ------------------------------
+
+ function Parse_Reference_Backwards
+ (Lang : access Language_Root;
+ Buffer : UTF8_String;
+ Start_Offset : String_Index_Type;
+ End_Offset : String_Index_Type := 0) return String
+ is
+ Buf_Start : Integer := 1;
+ Buf_End : Integer := 0;
+
+ procedure Callback
+ (Token : Token_Record;
+ Stop : in out Boolean);
+
+ procedure Callback
+ (Token : Token_Record;
+ Stop : in out Boolean)
+ is
+ begin
+ Buf_End := Integer (Token.Token_Last);
+ Buf_Start := Integer (Token.Token_First);
+ Stop := True;
+ end Callback;
+
+ begin
+
+ Lang.Parse_Tokens_Backwards
+ (Buffer => Buffer,
+ Start_Offset => Start_Offset,
+ End_Offset => End_Offset,
+ Callback => Callback'Access);
+
+ return Buffer (Buf_Start .. Buf_End);
+ end Parse_Reference_Backwards;
+
+ -----------------
+ -- Set_Symbols --
+ -----------------
+
+ procedure Set_Symbols
+ (Self : access Language_Root'Class;
+ Symbols : not null access GNATCOLL.Symbols.Symbol_Table_Record'Class) is
+ begin
+ Self.Symbols := Symbol_Table_Access (Symbols);
+ end Set_Symbols;
+
+ -------------
+ -- Symbols --
+ -------------
+
+ function Symbols
+ (Self : access Language_Root'Class)
+ return GNATCOLL.Symbols.Symbol_Table_Access is
+ begin
+ return Self.Symbols;
+ end Symbols;
+
+ ----------------------
+ -- Entities_Indexed --
+ ----------------------
+
+ function Entities_Indexed (Self : Language_Root) return Boolean is
+ pragma Unreferenced (Self);
+ begin
+ return False;
+ end Entities_Indexed;
+
+end Language;
diff --git a/packages/ada-mode/gps_source/language.ads
b/packages/ada-mode/gps_source/language.ads
new file mode 100755
index 0000000..f4d2820
--- /dev/null
+++ b/packages/ada-mode/gps_source/language.ads
@@ -0,0 +1,864 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2000-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+with Ada.Strings.Maps; use Ada.Strings.Maps;
+with Case_Handling;
+with GNAT.Expect;
+with GNAT.Regpat; use GNAT;
+with GNAT.Strings;
+with GNATCOLL.Symbols;
+with GNATCOLL.Xref;
+with Basic_Types; use Basic_Types;
+with GNATCOLL.Traces; use GNATCOLL.Traces;
+with GNATCOLL.VFS;
+with Ada.Strings.Unbounded;
+
+package Language is
+
+ Clang_Support : GNATCOLL.Traces.Trace_Handle := GNATCOLL.Traces.Create
+ ("libclang_backend", GNATCOLL.Traces.On);
+
+ type Language_Root is abstract tagged limited private;
+ type Language_Access is access all Language_Root'Class;
+
+ Unexpected_Type : exception;
+
+ procedure Free (Lang : in out Language_Root) is null;
+ procedure Free (Lang : in out Language_Access);
+ -- Free the memory pointed to by Lang and set it to null
+
+ function Get_Name (Lang : access Language_Root) return String is abstract;
+ -- Return the name of the language
+
+ procedure Set_Symbols
+ (Self : access Language_Root'Class;
+ Symbols : not null access GNATCOLL.Symbols.Symbol_Table_Record'Class);
+ function Symbols
+ (Self : access Language_Root'Class)
+ return GNATCOLL.Symbols.Symbol_Table_Access;
+ -- Get the symbol table.
+ -- The symbol table is set automatically when the language is registered in
+ -- the language_handler.
+
+ function Entities_Indexed (Self : Language_Root) return Boolean;
+ -- Should the entities of this language be indexed in the entities
+ -- database? This concerns only the ALI or LI information, used for the
+ --- purpose of e.g. completion for languages others than Ada. False by
+ -- default.
+
+ ------------------------
+ -- Types manipulation --
+ ------------------------
+ -- The following functions are provided to manipulate types and variables
+ -- for each language.
+
+ function Is_Simple_Type
+ (Lang : access Language_Root; Str : String) return Boolean is abstract;
+ -- Return True if Str is a simple type, like integer, ...
+ -- These are the types that don't need information from the debugger to
+ -- be known, ie we can save a call to the debugger when parsing the value
+ -- of a variable.
+
+ --------------------------------
+ -- Highlighting in the editor --
+ --------------------------------
+
+ type Language_Entity is
+ (Normal_Text,
+ Identifier_Text,
+ Partial_Identifier_Text,
+ Block_Text,
+ Type_Text,
+ Number_Text,
+ Keyword_Text,
+ Comment_Text,
+ Annotated_Keyword_Text,
+ Annotated_Comment_Text,
+ Aspect_Keyword_Text,
+ Aspect_Comment_Text,
+ Aspect_Text,
+ Character_Text,
+ String_Text,
+ Operator_Text);
+ pragma Convention (C, Language_Entity);
+ -- The entities found in a language.
+ -- Block_Text represents a block (subprogram, task, entry, declare block,
+ -- ...), and Type_Text represents a type. Block_Text and Type_Text are
+ -- currently triggered only in declarations and not in statements.
+ -- Annotated_Comment_Text represents special comments that contain
+ -- annotations, e.g. SPARK annotations.
+ -- Aspect_Text represents Ada 2012 or SPARK 2014 aspects.
+
+ subtype Identifier_Entity is Language_Entity
+ range Identifier_Text .. Type_Text;
+ -- All the entities that represent an identifier
+
+ subtype Standout_Language_Entity is Language_Entity
+ range Block_Text .. String_Text;
+ -- All the entities that have a special meaning. Used for syntax
+ -- highlighting for example.
+
+ procedure Looking_At
+ (Lang : access Language_Root;
+ Buffer : String;
+ First : Natural;
+ Entity : out Language_Entity;
+ Next_Char : out Positive);
+ -- Should return the type of entity that is present at the first position
+ -- in the buffer (starting at First).
+ -- Next_Char should be set to the index of the first character after the
+ -- entity.
+ -- First is required so that regexps can be used to match on e.g. start
+ -- of lines.
+
+ function Keywords
+ (Lang : access Language_Root) return Strings.String_Access is abstract;
+ -- Returns the uncompiled keyword regular expression. This string is used
+ -- to create the pattern matcher as returned by the version below.
+
+ function Keywords
+ (Lang : access Language_Root)
+ return GNAT.Expect.Pattern_Matcher_Access is abstract;
+ -- Return a regular expression that matches the keywords for the current
+ -- language.
+ -- Note: we return an access type (instead of a Pattern_Matcher) for
+ -- efficiency.
+
+ function Is_Word_Char
+ (Lang : access Language_Root; Char : Wide_Wide_Character) return Boolean;
+ -- Return True if Char belongs to the set of characters that compose a
+ -- keyword for this language. By default, this returns true for letters,
+ -- digits and underscore characters.
+
+ function Keywords
+ (Lang : access Language_Root) return GNAT.Strings.String_List is abstract;
+ -- Return a list of keywords, encoded in UTF-8.
+ -- For case-insensitive languages, the keywords are listed in lower case.
+ -- Caller must not free the results.
+
+ ----------------------------
+ -- Tooltips in the editor --
+ ----------------------------
+
+ function Can_Tooltip_On_Entity
+ (Lang : access Language_Root;
+ Entity : String) return Boolean;
+ -- Return True if we should display a tooltip for the Entity.
+ -- Note that Entity is analyzed in the current context. This is used at
+ -- least for the gdb Ada mode, since we don't want to evaluate subprograms
+ -- when the type of tooltips in Simple.
+ -- By default, this simply returns True.
+
+ ------------------------
+ -- Naming conventions --
+ ------------------------
+
+ function Dereference_Name
+ (Lang : access Language_Root;
+ Name : String) return String is abstract;
+ -- Return the name to use to dereference Name (ie in Ada "Name.all", in
+ -- C "*Name", ...). Note that Name can be a composite name (Name.Field),
+ -- and thus might have to be protected with parentheses.
+
+ function Array_Item_Name
+ (Lang : access Language_Root;
+ Name : String;
+ Index : String) return String is abstract;
+ -- Return the name to use to access a specific element of an array.
+ -- Index is a comma-separated list of the indexes for all the dimensions,
+ -- as in "1,2".
+
+ function Record_Field_Name
+ (Lang : access Language_Root;
+ Name : String;
+ Field : String) return String is abstract;
+ -- Return the name to use for a specific field of a record.
+
+ function Scope_Separator
+ (Lang : access Language_Root) return String;
+ -- Return the scope separator for the language.
+ -- e.g. "." for Ada, "::" for C++
+ -- Default implementation return ".", so is suitable for Ada, Java.
+
+ ---------------------
+ -- Project support --
+ ---------------------
+
+ type Project_Field is record
+ Attribute_Name : Strings.String_Access;
+ Attribute_Index : Strings.String_Access := null;
+ Description : Strings.String_Access;
+ Values : Strings.String_List_Access := null;
+ Editable : Boolean := True;
+ end record;
+ No_Project_Field : constant Project_Field := (null, null, null, null, True);
+ type Project_Field_Array is array (Natural range <>) of Project_Field;
+
+ procedure Free (Fields : in out Project_Field_Array);
+ -- Free the contents of the array
+
+ ----------------------
+ -- Language Context --
+ ----------------------
+
+ type Language_Context is record
+ Syntax : GNATCOLL.Xref.Language_Syntax;
+ -- Syntax information that is also useful in the context of the
+ -- cross references.
+
+ String_Delimiter : Character;
+ -- How strings start and end
+
+ Quote_Character : Character;
+ -- The character used to quote (protect) the following one. If this
+ -- is set to ASCII.NUL, then there is no such character in the
+ -- language. For instance, it should be set to \ for C.
+
+ Constant_Character : Character;
+ -- The character that starts and ends constant characters
+
+ Can_Indent : Boolean;
+ -- Whether indentation is supported by this language
+
+ Syntax_Highlighting : Boolean;
+ -- Whether syntax highlighting is relevant to this language
+
+ Case_Sensitive : Boolean;
+ -- Whether the language is case sensitive
+
+ Accurate_Xref : Boolean;
+ -- Whether cross reference information for this language is supposed
+ -- to be fully accurate (and therefore any mismatch means the xref info
+ -- is not up-to-date) or not.
+
+ Use_Semicolon : Boolean;
+ -- Whether semicolons are expected in sources and may be used as a
+ -- delimiter for syntax highlighting purposes.
+ end record;
+ -- This record describes the syntax of the language (for color
+ -- highlighting purposes). All the fields in this record are language
+ -- specific, and do not depend on the debugger used.
+
+ type Language_Context_Access is access all Language_Context;
+
+ function Get_Language_Context
+ (Lang : access Language_Root) return Language_Context_Access is abstract;
+ -- Return the context to use for a specific language
+
+ procedure Free (Context : in out Language_Context_Access);
+ -- Free the memory allocated for Context
+
+ ----------------------
+ -- Source Analyzing --
+ ----------------------
+
+ type Source_Location is record
+ Line : Natural := 0;
+ -- Line number for this entity. Line numbers start at 1.
+
+ Column : Natural := 0;
+ -- Column number for this entity. This is an index in bytes, not
+ -- characters. This is set to 0 if the end is on the last character of
+ -- the previous line.
+ -- Column numbers start at 1 otherwise.
+
+ Index : Natural := 0;
+ -- Index in the buffer for this entity
+ end record;
+ pragma Convention (C, Source_Location);
+
+ function ">" (S1, S2 : Source_Location) return Boolean;
+ function ">=" (S1, S2 : Source_Location) return Boolean;
+ function "<" (S1, S2 : Source_Location) return Boolean;
+ function "<=" (S1, S2 : Source_Location) return Boolean;
+ overriding function "=" (S1, S2 : Source_Location) return Boolean;
+
+ type Indent_Style is (Automatic, RM_Style, Non_RM_Style);
+ -- Indentation style used by some constructs (e.g. case statements in
+ -- Ada).
+ -- Automatic means that the engine will guess the best value.
+ -- RM_Style means follows the style recommended by the RM, if any
+ -- Non_RM_Style means do not follow the style recommended by the RM.
+
+ type Indent_Parameters is record
+ Indent_Level : Natural;
+ Indent_Continue : Natural;
+ Indent_Decl : Natural;
+ Indent_Conditional : Natural;
+ Indent_Record : Natural;
+ Indent_Case_Extra : Indent_Style;
+ Casing_Policy : Case_Handling.Casing_Policy;
+ Reserved_Casing : Case_Handling.Casing_Type;
+ Ident_Casing : Case_Handling.Casing_Type;
+ Format_Operators : Boolean;
+ Use_Tabs : Boolean;
+ Align_On_Colons : Boolean;
+ Align_On_Arrows : Boolean;
+ Align_Decl_On_Colon : Boolean;
+ -- ??? Missing alignment parameters:
+ -- - assignments in declarations
+ -- - assignments in assignment statements
+
+ Indent_Comments : Boolean;
+ Stick_Comments : Boolean;
+ end record;
+ pragma Convention (C, Indent_Parameters);
+ -- Define all parameters to indent a source code.
+ -- Note that some of these parameters will be ignored, depending on the
+ -- actual language.
+ --
+ -- Indent_Level number of spaces when indenting a block.
+ -- Indent_Continue number of spaces for a continuation line.
+ -- Indent_Decl number of spaces for multi-line variables
+ -- declaration.
+ -- Indent_Conditional extra number of spaces when indenting multi-line
+ -- conditionals.
+ -- Indent_Record extra number of spaces when indenting record types
+ -- Tab_Width number of spaces for a tab character.
+ -- Indent_Case_Extra whether to add extra indent level for case
+ -- statements
+ -- Reserved_Casing casing of reserved words.
+ -- Indent_Casing casing of identifiers.
+ -- Format_Operators whether operators should be reformatted (e.g. spaces
+ -- added around "<")
+ -- Use_Tabs whether tabs should be used instead of spaces.
+ -- Align_On_Colons perform alignment on colons in declarations (Ada)
+ -- whether to indent if/for/while constructs an extra
+ -- level after '{' (C/C++/Java)
+ -- Align_On_Arrows perform alignment on arrows in associations
+ -- Align_Decl_On_Colon align variable declarations based on the ':' of the
+ -- variable decl.
+ -- Indent_Comments whether comments should be indented or left as is
+ -- Stick_Comments whether comments should stick to previous line
+ -- indentation in some cases (language defined).
+
+ Default_Indent_Parameters : constant Indent_Parameters :=
+ (Indent_Level => 8,
+ Indent_Continue => 2,
+ Indent_Decl => 0,
+ Indent_Conditional => 0,
+ Indent_Record => 8,
+ Indent_Case_Extra => Automatic,
+ Casing_Policy => Case_Handling.Disabled,
+ Reserved_Casing => Case_Handling.Unchanged,
+ Ident_Casing => Case_Handling.Unchanged,
+ Format_Operators => False,
+ Use_Tabs => False,
+ Align_On_Colons => False,
+ Align_On_Arrows => False,
+ Align_Decl_On_Colon => False,
+ Indent_Comments => True,
+ Stick_Comments => False);
+
+ type Indentation_Kind is (None, Simple, Extended);
+ -- Indentation kinds:
+ -- None: no indentation should be performed
+ -- Simple: use the amount of white spaces from previous line
+ -- Extended: use a language specific parser to compute indentation
+
+ procedure Get_Indentation_Parameters
+ (Lang : access Language_Root;
+ Params : out Indent_Parameters;
+ Indent_Style : out Indentation_Kind);
+ -- Return the indentation parameters for this language
+
+ procedure Set_Indentation_Parameters
+ (Lang : access Language_Root;
+ Params : Indent_Parameters;
+ Indent_Style : Indentation_Kind);
+ -- Set the indentation parameters to use for this language.
+ -- ??? This wouldn't be necessary if we had access to the preferences from
+ -- the language hierarchy.
+
+ type Language_Category is
+ (Cat_Unknown,
+
+ ------------------------
+ -- Enclosing Entities --
+ ------------------------
+
+ Cat_Package,
+ Cat_Namespace,
+ Cat_Task, -- Subprogram
+ Cat_Procedure, -- Subprogram, Subprogram_Explorer
+ Cat_Function, -- Subprogram, Subprogram_Explorer
+ Cat_Method, -- Subprogram, Subprogram_Explorer
+ Cat_Constructor, -- Subprogram, Subprogram_Explorer
+ Cat_Destructor, -- Subprogram, Subprogram_Explorer
+ Cat_Protected, -- Subprogram
+ Cat_Entry, -- Subprogram
+
+ ----------------
+ -- Data/Types --
+ ----------------
+
+ Cat_Class,
+ Cat_Structure,
+ Cat_Case_Inside_Record,
+ Cat_Union,
+ Cat_Type,
+ Cat_Subtype,
+ Cat_Variable,
+ Cat_Local_Variable,
+ Cat_Parameter,
+ Cat_Discriminant,
+ Cat_Field,
+ Cat_Literal,
+ Cat_Representation_Clause,
+
+ ----------------
+ -- Dependency --
+ ----------------
+
+ Cat_With,
+ Cat_Use,
+ Cat_Include,
+
+ ----------------
+ -- Constructs --
+ ----------------
+
+ Cat_Loop_Statement,
+ Cat_If_Statement,
+ Cat_Case_Statement,
+ Cat_Select_Statement,
+ Cat_Accept_Statement,
+ Cat_Declare_Block,
+ Cat_Return_Block,
+ Cat_Simple_Block,
+
+ --------------------
+ -- Sub-constructs --
+ --------------------
+
+ Cat_Exception_Handler,
+ Cat_Pragma,
+ Cat_Aspect, -- Ada 2012 or SPARK 2014 aspect clauses
+
+ ----------------------
+ -- Custom construct --
+ ----------------------
+
+ Cat_Custom);
+ -- Keep the above synchronized with completion.py
+
+ subtype Enclosing_Entity_Category is Language_Category
+ range Cat_Package .. Cat_Union;
+
+ subtype Namespace_Category is Enclosing_Entity_Category
+ range Cat_Package .. Cat_Namespace;
+
+ subtype Subprogram_Category is Enclosing_Entity_Category
+ range Cat_Task .. Cat_Entry;
+
+ subtype Subprogram_Explorer_Category is Subprogram_Category
+ range Cat_Procedure .. Cat_Destructor;
+ -- Subprograms, as displayed in the explorer
+
+ subtype Data_Type_Category is Language_Category
+ range Cat_Class .. Cat_Variable;
+
+ subtype Type_Category is Data_Type_Category
+ range Cat_Class .. Cat_Subtype;
+
+ subtype Data_Category is Language_Category
+ range Cat_Variable .. Cat_Field;
+
+ subtype Dependency_Category is Language_Category
+ range Cat_With .. Cat_Include;
+
+ subtype Construct_Category is Language_Category
+ range Cat_Loop_Statement .. Cat_Simple_Block;
+
+ function Category_Name
+ (Category : Language.Language_Category;
+ Name : GNATCOLL.Symbols.Symbol := GNATCOLL.Symbols.No_Symbol)
+ return String;
+ -- Return the external name to display in GUIs for a given category.
+ -- Name is an optional value, which is returned by this function if
+ -- not null.
+
+ type Construct_Visibility is
+ (Visibility_Private,
+ Visibility_Protected,
+ Visibility_Public);
+ -- Represents the visibility of a construct from the enclosing entity.
+
+ type Construct_Att_Key is range 1 .. 32;
+ -- This is the type of keys attributes. In order to minimize size, there
+ -- cannot be more than 32 attributes at all for a given language. Some
+ -- of them are language independent (up to Last_Gen_Att).
+ -- Specific languages might want to implement they own keys, which have to
+ -- start at Last_Gen_Att + 1.
+ -- We might consider raising the limit if we have specific needs.
+
+ type Construct_Attribute_Map is array (Construct_Att_Key) of Boolean;
+ pragma Pack (Construct_Attribute_Map);
+
+ No_Attribute : constant Construct_Attribute_Map := (others => False);
+
+ Access_Attribute : constant Construct_Att_Key := 1;
+ Array_Attribute : constant Construct_Att_Key := 2;
+ -- ??? This list is currently incomplete. To be completed.
+
+ Last_Gen_Att : constant Construct_Att_Key := 2;
+
+ type Construct_Information;
+ type Construct_Access is access all Construct_Information;
+
+ type Construct_Information is record
+ Category : Language_Category;
+ -- Define the kind of construct
+
+ Category_Name : GNATCOLL.Symbols.Symbol := GNATCOLL.Symbols.No_Symbol;
+ -- Optional category name. Used if Category = Cat_Custom.
+
+ Is_Declaration : Boolean;
+ -- Is this a declaration (e.g function specification) ?
+
+ Is_Generic_Spec : Boolean := False;
+ -- Is this in a generic parameter?
+
+ Visibility : Construct_Visibility := Visibility_Public;
+ -- Is the construct public, private or protected ?
+
+ Name : GNATCOLL.Symbols.Symbol := GNATCOLL.Symbols.No_Symbol;
+ -- Name of the enclosing token. Null if not relevant for Token
+ -- This is encoded in UTF-8
+
+ Profile : Strings.String_Access;
+ -- Subprogram profile, if Category is in Subprogram_Category.
+ -- Note that even for Subprogram_Category, Profile can be null if the
+ -- subprogram does not have any parameter.
+ -- This is encoded in UTF-8.
+
+ Sloc_Start : Source_Location;
+ -- Location of beginning of the construct
+
+ Sloc_Entity : Source_Location;
+ -- Location of beginning of the name of the entity. Only relevant if
+ -- Name is non null. This is different from Sloc_Start since Sloc_Start
+ -- is the beginning of the construct itself, e.g for
+ -- "procedure Foo;", Sloc_Start will point to the first character, while
+ -- Sloc_Entity will point to the 11th character.
+
+ Sloc_End : Source_Location;
+ -- Location of end of the construct
+
+ Prev, Next : Construct_Access;
+ -- Links to the previous and the next construct info
+
+ Attributes : Construct_Attribute_Map := (others => False);
+ -- Set of construct attributes
+ end record;
+ -- Information needed to define a language construct (e.g procedure,
+ -- loop statement, ...).
+
+ type Simple_Construct_Information is record
+ Category : Language_Category;
+ Is_Declaration : Boolean;
+ Is_Generic_Spec : Boolean := False;
+ Visibility : Construct_Visibility := Visibility_Public;
+ Name : aliased GNATCOLL.Symbols.Symbol;
+ Sloc_Start : aliased Source_Location;
+ Sloc_Entity : aliased Source_Location;
+ Sloc_End : aliased Source_Location;
+ Attributes : aliased Construct_Attribute_Map;
+ Profile_Cache : Ada.Strings.Unbounded.String_Access := null;
+ end record;
+ -- Same as above, but containing only the needed construct information, no
+ -- list constructions.
+
+ procedure To_Simple_Construct_Information
+ (Construct : Construct_Information;
+ Simple : out Simple_Construct_Information;
+ Full_Copy : Boolean);
+ -- Convert a Construct_Information into a simple construct information
+
+ Null_Construct_Info : constant Construct_Information;
+
+ Null_Simple_Construct_Info : constant Simple_Construct_Information;
+
+ type Construct_List is record
+ First, Current, Last : Construct_Access;
+ Size : Integer := 0;
+ end record;
+
+ type Construct_List_Access is access all Construct_List;
+
+ procedure Free (List : in out Construct_List);
+ -- Free the contents of List.
+
+ function Word_Character_Set
+ (Lang : access Language_Root) return Character_Set;
+ -- Returns the character set used for the language identifiers
+
+ function Comment_Block
+ (Lang : access Language_Root;
+ Block : String;
+ Comment : Boolean := True;
+ Clean : Boolean := False) return String;
+ -- Comment or uncomment (if Comment is false) a text block
+ -- Comment_Block (L, Comment_Block (L, A), Comment => False)
+ -- should return A.
+ -- If Clean is True, a clean up of of the block should be performed
+ -- (e.g. leading spaces are removed for each line).
+
+ procedure Parse_Constructs
+ (Lang : access Language_Root;
+ File : GNATCOLL.VFS.Virtual_File;
+ Buffer : UTF8_String;
+ Result : out Construct_List);
+ -- Parse the constructs contained in Buffer and store all the language
+ -- constructs with their source location in Result.
+
+ type Replace_Text_Callback is access procedure
+ (Line : Natural;
+ First : Natural;
+ Last : Natural;
+ Replace : String);
+ -- Replacement procedure used by Format_Buffer below.
+ -- Replace the slice First .. Last by contents of Replace.
+ -- First and Last are byte offsets from the start of the line, not
+ -- character counts.
+
+ procedure Format_Buffer
+ (Lang : access Language_Root;
+ Buffer : String;
+ Replace : Replace_Text_Callback;
+ From, To : Natural := 0;
+ Indent_Params : Indent_Parameters := Default_Indent_Parameters;
+ Indent_Offset : Natural := 0;
+ Case_Exceptions : Case_Handling.Casing_Exceptions :=
+ Case_Handling.No_Casing_Exception;
+ Is_Optional_Keyword : access function (S : String)
+ return Boolean := null);
+ -- Given a Buffer, reformat it, based on Indent_Params.
+ -- Reformat only lines comprised between From and To.
+ -- If Indent_Offset is > 0, it represents an additional level of
+ -- indentation when e.g. formatting a substring within a bigger
+ -- construct. Format_Buffer will take this value into account when
+ -- calling the Replace callback.
+ -- Is_Keyword is an optional parameter, used to customize the behavior
+ -- of the parser, by providing a way to specify additional keywords.
+ -- This is useful in particular when defining custom languages that are
+ -- derived from existing languages, e.g. GPR which derives from Ada.
+
+ type Entity_Callback is access function
+ (Entity : Language_Entity;
+ Sloc_Start : Source_Location;
+ Sloc_End : Source_Location;
+ Partial_Entity : Boolean) return Boolean;
+ -- Callback during parsing of entities.
+ -- Partial_Entity is True if parsing is at the end of the string with a
+ -- non terminated entity (e.g string or multi-line comment).
+ -- If Callback returns True, the parsing should be stopped.
+
+ procedure Parse_Entities
+ (Lang : access Language_Root;
+ Buffer : String;
+ Callback : Entity_Callback);
+ -- Parse entities (as defined by Language_Entity) contained in buffer.
+ -- For each match, call Callback. Stops at the end of Buffer or when
+ -- callback returns True.
+
+ -- These functions are provided as a support for the source code explorer.
+
+ procedure Get_Referenced_Entity
+ (Lang : access Language_Root;
+ Buffer : String;
+ Construct : Simple_Construct_Information;
+ Sloc_Start : out Source_Location;
+ Sloc_End : out Source_Location;
+ Success : out Boolean;
+ From_Index : Natural := 0);
+ -- Some constructs are referencing one or more entities. The purpose of
+ -- this procedure is to extract them. It can be the type of a variable,
+ -- the parent type of a class, the generic package from wich a package is
+ -- instantiated, the returned type of a subprogram... If no reference
+ -- entity is found, then Success is set to False, True otherwise. The
+ -- From_Index parameter is used to initialize the search at a given offset
+ -- (in bytes). It helps to handle cases where the construct is referencing
+ -- more than one element (e.g. extension from interfaces in Java and Ada,
+ -- multiple inheritance in C++). If From_Index is 0 the search will start
+ -- at the begining of the construct.
+
+ type Make_Entry_Func is access function
+ (Str : String;
+ Matched : Regpat.Match_Array) return String;
+ -- Function that builds the string to be inserted in the tree.
+
+ type Explorer_Category is record
+ Category : Language_Category;
+ Category_Name : GNATCOLL.Symbols.Symbol;
+ Regexp : GNAT.Expect.Pattern_Matcher_Access;
+ Position_Index : Natural;
+ End_Index : Natural;
+ Make_Entry : Make_Entry_Func;
+ end record;
+ -- Definition for a category (ie one of the subtrees of the explorer).
+ -- Icon is the icon to use for items in this category.
+ -- Regexp is the general regular expression to use for entries in this
+ -- category, while Make_Entry is the function that will return the
+ -- actual string to be displayed in the explorer.
+ -- Position_Index is the index of the parenthesis-pair that the entity
+ -- name starts at. When the user clicks on this item in the explorer,
+ -- the cursor will be moved to that location in the editor.
+ -- End_Index is the index of the parenthesis-pair after that the
+ -- next search will begin.
+ --
+ -- If Make_Entry is null, then Position_Index is used to compute the
+ -- string to display.
+
+ type Explorer_Categories is
+ array (Positive range <>) of Explorer_Category;
+ -- A list of categories. Each category is assigned an internal number which
+ -- is the index in this table, and is passed to each Make_Entry_Func
+ -- functions.
+
+ procedure Free (Category : in out Explorer_Category);
+ procedure Free (Categories : in out Explorer_Categories);
+ -- Free the memory allocated for the parameter
+
+ function Explorer_Regexps
+ (Lang : access Language_Root) return Explorer_Categories;
+ -- Return the list of categories for a given language.
+ -- By default, no category is defined, and thus the explorer is empty.
+
+ function Is_System_File
+ (Lang : access Language_Root;
+ File_Name : String) return Boolean;
+ -- Return True if File_Name is the name of a system file (standard include
+ -- files in C or run-time file in Ada). These files are displayed
+ -- separately in the explorer.
+
+ -------------------------
+ -- Parsing expressions --
+ -------------------------
+ -- The following types and subprograms are used to manipulate expressions
+ -- in a specific language (as opposed to a whole file as in the subprograms
+ -- above). They are used in particular by the completion module to find out
+ -- the current context, and for similar reasons by the debugger module.
+
+ type Token_Type is range 0 .. Integer'Last;
+ -- This is a type of token. Languages may define dedicated constant for
+ -- this type to represent what can be parsed.
+
+ overriding
+ function "+" (Left, Right : Token_Type) return Token_Type is abstract;
+ overriding
+ function "-" (Left, Right : Token_Type) return Token_Type is abstract;
+ overriding
+ function "*" (Left, Right : Token_Type) return Token_Type is abstract;
+ overriding
+ function "/" (Left, Right : Token_Type) return Token_Type is abstract;
+ overriding
+ function ">" (Left, Right : Token_Type) return Boolean is abstract;
+ overriding
+ function "<" (Left, Right : Token_Type) return Boolean is abstract;
+ overriding
+ function ">=" (Left, Right : Token_Type) return Boolean is abstract;
+ overriding
+ function "<=" (Left, Right : Token_Type) return Boolean is abstract;
+
+ No_Token : constant Token_Type := 0;
+
+ type Token_Record is record
+ Tok_Type : Token_Type := No_Token;
+ Token_First : String_Index_Type := 0;
+ Token_Last : String_Index_Type := 0;
+ end record;
+ Null_Token : constant Token_Record;
+ -- This record holds the informations concerning one specific token.
+ -- (Token_First .. Token_Last) is the range of text in the source code for
+ -- that token. The buffer is available through the Parsed_Expression record
+ -- below.
+
+ procedure Free (This : in out Token_Record) is null;
+ -- Used to instantiate the generic list, does not actually do anything
+
+ procedure Parse_Tokens_Backwards
+ (Lang : access Language_Root;
+ Buffer : UTF8_String;
+ Start_Offset : String_Index_Type;
+ End_Offset : String_Index_Type := 0;
+ Callback : access procedure (Token : Token_Record;
+ Stop : in out Boolean));
+ -- Parses the tokens from the Start_Offset backwards to end offset. Calls
+ -- Callback on each token. If Stop is True on the callback, then the
+ -- parsing is stoped.
+
+ function Parse_Reference_Backwards
+ (Lang : access Language_Root;
+ Buffer : UTF8_String;
+ Start_Offset : String_Index_Type;
+ End_Offset : String_Index_Type := 0) return String;
+ -- Return a string containing a reference to a value, looking backwards
+ -- from End_Offset. E.g., for Ada, if the code is something like:
+ -- A := B (C.D (X).E)
+ -- and End_Offset is place after E, this will return "C.D(X).E".
+
+private
+ type Language_Root is abstract tagged limited record
+ Symbols : GNATCOLL.Symbols.Symbol_Table_Access;
+ Indent_Params : Indent_Parameters := Default_Indent_Parameters;
+ Indent_Style : Indentation_Kind := Extended;
+ end record;
+
+ function Comment_Line
+ (Lang : access Language_Root;
+ Line : String;
+ Comment : Boolean := True;
+ Clean : Boolean := False) return String;
+ -- Comment or uncomment (if Comment is false) one line of code.
+ -- Comment_Line (Comment_Line (A), Comment => False) should return A.
+ -- If Clean is True, a clean up of of the line should be performed
+ -- (e.g. leading spaces are removed).
+
+ Null_Token : constant Token_Record :=
+ (Tok_Type => No_Token,
+ Token_First => 0,
+ Token_Last => 0);
+
+ Null_Construct_Info : constant Construct_Information :=
+ (Category => Cat_Unknown,
+ Category_Name => GNATCOLL.Symbols.No_Symbol,
+ Is_Declaration => False,
+ Is_Generic_Spec => False,
+ Visibility => Visibility_Public,
+ Name => GNATCOLL.Symbols.No_Symbol,
+ Profile => null,
+ Sloc_Start => (0, 0, 0),
+ Sloc_Entity => (0, 0, 0),
+ Sloc_End => (0, 0, 0),
+ Prev => null,
+ Next => null,
+ Attributes => (others => False));
+
+ Null_Simple_Construct_Info : constant Simple_Construct_Information :=
+ (Category => Cat_Unknown,
+ Is_Declaration => False,
+ Is_Generic_Spec => False,
+ Visibility => Visibility_Public,
+ Name => GNATCOLL.Symbols.No_Symbol,
+ Sloc_Start => (0, 0, 0),
+ Sloc_Entity => (0, 0, 0),
+ Sloc_End => (0, 0, 0),
+ Attributes => (others => False),
+ Profile_Cache => null);
+
+end Language;
diff --git a/packages/ada-mode/gps_source/string_utils.adb
b/packages/ada-mode/gps_source/string_utils.adb
new file mode 100755
index 0000000..70bae1d
--- /dev/null
+++ b/packages/ada-mode/gps_source/string_utils.adb
@@ -0,0 +1,1364 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2000-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+with Ada.Characters.Handling; use Ada.Characters.Handling;
+with Ada.Containers; use Ada.Containers;
+with Ada.Strings.Hash;
+with Ada.Strings.Hash_Case_Insensitive;
+with Ada.Strings.Fixed;
+with Ada.Unchecked_Deallocation;
+with Ada.Wide_Wide_Characters.Handling; use Ada.Wide_Wide_Characters.Handling;
+with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
+use Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
+
+with GNAT.Strings; use GNAT.Strings;
+with GNATCOLL.Scripts.Utils; use GNATCOLL.Scripts.Utils;
+with GNATCOLL.Utils; use GNATCOLL.Utils;
+with GNATCOLL.Xref;
+
+with UTF8_Utils; use UTF8_Utils;
+
+package body String_Utils is
+ use type GNATCOLL.Xref.Visible_Column;
+
+ -----------------
+ -- Lines_Count --
+ -----------------
+
+ function Lines_Count (Text : String) return Natural is
+ Count : Natural := 1;
+ begin
+ for T in Text'Range loop
+ if Text (T) = ASCII.LF then
+ Count := Count + 1;
+ end if;
+ end loop;
+ return Count;
+ end Lines_Count;
+
+ -----------------
+ -- Blank_Slice --
+ -----------------
+
+ function Blank_Slice
+ (Count : Integer;
+ Use_Tabs : Boolean := False;
+ Tab_Width : Positive := 8) return String is
+ begin
+ if Count <= 0 then
+ return "";
+ elsif Use_Tabs then
+ return (1 .. Count / Tab_Width => ASCII.HT) &
+ (1 .. Count mod Tab_Width => ' ');
+ else
+ return (1 .. Count => ' ');
+ end if;
+ end Blank_Slice;
+
+ -------------
+ -- Replace --
+ -------------
+
+ procedure Replace
+ (S : in out GNAT.Strings.String_Access;
+ Value : String) is
+ begin
+ if S /= null then
+ if S'Length = Value'Length then
+ -- Let's try to avoid memory fragmentation
+ S.all := Value;
+ return;
+ else
+ GNAT.Strings.Free (S);
+ end if;
+ end if;
+
+ S := new String'(Value);
+ end Replace;
+
+ procedure Replace
+ (S : in out GNAT.Strings.String_Access;
+ Value : GNAT.Strings.String_Access) is
+ begin
+ if Value = null then
+ GNAT.Strings.Free (S);
+ else
+ Replace (S, Value.all);
+ end if;
+ end Replace;
+
+ -------------------
+ -- Skip_To_Blank --
+ -------------------
+
+ procedure Skip_To_Blank
+ (Type_Str : String;
+ Index : in out Natural) is
+ begin
+ while Index <= Type_Str'Last
+ and then Type_Str (Index) /= ' '
+ and then Type_Str (Index) /= ASCII.HT
+ and then Type_Str (Index) /= ASCII.LF
+ and then Type_Str (Index) /= ASCII.CR
+ loop
+ Index := Index + 1;
+ end loop;
+ end Skip_To_Blank;
+
+ --------------
+ -- Is_Blank --
+ --------------
+
+ function Is_Blank (C : Character) return Boolean is
+ begin
+ return C = ' ' or else C = ASCII.LF
+ or else C = ASCII.CR or else C = ASCII.HT;
+ end Is_Blank;
+
+ -------------------
+ -- Skip_To_Index --
+ -------------------
+
+ procedure Skip_To_Index
+ (Buffer : String;
+ Columns : out Visible_Column_Type;
+ Index_In_Line : String_Index_Type;
+ Index : in out String_Index_Type;
+ Tab_Width : Positive := 8)
+ is
+ Start_Of_Line : constant String_Index_Type := Index;
+ begin
+ Columns := 1;
+
+ loop
+ exit when Index - Start_Of_Line + 1 >= Index_In_Line;
+
+ if Natural (Index) <= Buffer'Last
+ and then Buffer (Natural (Index)) = ASCII.HT
+ then
+ Columns := Columns +
+ Visible_Column_Type
+ (Tab_Width -
+ ((Positive (Columns) - 1) mod Tab_Width));
+ else
+ Columns := Columns + 1;
+ end if;
+
+ Index := String_Index_Type (UTF8_Next_Char (Buffer, Natural (Index)));
+ end loop;
+ end Skip_To_Index;
+
+ -------------------
+ -- Skip_To_Index --
+ -------------------
+
+ procedure Skip_To_Index
+ (Buffer : Unbounded_String;
+ Columns : out Visible_Column_Type;
+ Index_In_Line : String_Index_Type;
+ Index : in out String_Index_Type;
+ Tab_Width : Positive := 8)
+ is
+ Start_Of_Line : constant String_Index_Type := Index;
+ begin
+ Columns := 1;
+
+ loop
+ exit when Index - Start_Of_Line + 1 >= Index_In_Line;
+
+ if Natural (Index) <= Length (Buffer)
+ and then Element (Buffer, Natural (Index)) = ASCII.HT
+ then
+ Columns := Columns +
+ Visible_Column_Type
+ (Tab_Width -
+ ((Positive (Columns) - 1) mod Tab_Width));
+ else
+ Columns := Columns + 1;
+ end if;
+
+ Index := String_Index_Type (UTF8_Next_Char (Buffer, Natural (Index)));
+ end loop;
+ end Skip_To_Index;
+
+ ---------------
+ -- Tab_Width --
+ ---------------
+
+ function Tab_Width return Positive is
+ begin
+ return 8;
+ end Tab_Width;
+
+ ---------------
+ -- Next_Line --
+ ---------------
+
+ procedure Next_Line
+ (Buffer : String;
+ P : Natural;
+ Next : out Natural;
+ Success : out Boolean) is
+ begin
+ for J in P .. Buffer'Last - 1 loop
+ if Buffer (J) = ASCII.LF then
+ Next := J + 1;
+ Success := True;
+ return;
+ end if;
+ end loop;
+
+ Success := False;
+ Next := Buffer'Last;
+ end Next_Line;
+
+ ---------------------
+ -- Skip_Hexa_Digit --
+ ---------------------
+
+ procedure Skip_Hexa_Digit
+ (Type_Str : String;
+ Index : in out Natural) is
+ begin
+ -- skips initial 0x if present
+
+ if Index + 1 <= Type_Str'Last
+ and then Type_Str (Index) = '0'
+ and then Type_Str (Index + 1) = 'x'
+ then
+ Index := Index + 2;
+ end if;
+
+ while Index <= Type_Str'Last
+ and then Is_Hexadecimal_Digit (Type_Str (Index))
+ loop
+ Index := Index + 1;
+ end loop;
+ end Skip_Hexa_Digit;
+
+ ------------------
+ -- Skip_To_Char --
+ ------------------
+
+ procedure Skip_To_Char
+ (Type_Str : String;
+ Index : in out Natural;
+ Char : Character;
+ Step : Integer := 1) is
+ begin
+ while Index <= Type_Str'Last
+ and then Index >= Type_Str'First
+ and then Type_Str (Index) /= Char
+ loop
+ Index := Index + Step;
+ end loop;
+ end Skip_To_Char;
+
+ ------------------
+ -- Skip_To_Char --
+ ------------------
+
+ procedure Skip_To_Char
+ (Type_Str : Unbounded_String;
+ Index : in out Natural;
+ Char : Character;
+ Step : Integer := 1) is
+ begin
+ while Index <= Length (Type_Str)
+ and then Index >= 1
+ and then Element (Type_Str, Index) /= Char
+ loop
+ Index := Index + Step;
+ end loop;
+ end Skip_To_Char;
+
+ ---------------
+ -- Parse_Num --
+ ---------------
+
+ procedure Parse_Num
+ (Type_Str : String;
+ Index : in out Natural;
+ Result : out Long_Integer)
+ is
+ Tmp_Index : constant Natural := Index;
+ begin
+ -- Recognize negative numbers as well
+
+ if Type_Str (Index) = '-' then
+ Index := Index + 1;
+ end if;
+
+ while Index <= Type_Str'Last
+ and then Type_Str (Index) in '0' .. '9'
+ loop
+ Index := Index + 1;
+ end loop;
+
+ -- If at least one valid character was found, we have a number
+
+ if Index > Tmp_Index then
+ Result := Long_Integer'Value (Type_Str (Tmp_Index .. Index - 1));
+ else
+ Result := 0;
+ end if;
+
+ exception
+ when Constraint_Error =>
+ Result := -1;
+ end Parse_Num;
+
+ ----------------
+ -- Looking_At --
+ ----------------
+
+ function Looking_At
+ (Type_Str : String;
+ Index : Natural;
+ Substring : String) return Boolean is
+ begin
+ return Index + Substring'Length - 1 <= Type_Str'Last
+ and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
+ end Looking_At;
+
+ ----------------------
+ -- Parse_Cst_String --
+ ----------------------
+
+ procedure Parse_Cst_String
+ (Type_Str : String;
+ Index : in out Natural;
+ Str : out String;
+ Str_Last : out Natural;
+ Backslash_Special : Boolean := True)
+ is
+ procedure Parse_Next_Char
+ (Index : in out Natural;
+ Char : out Character);
+ -- Parse the character pointed to by Index, including special characters
+
+ In_String : Boolean;
+
+ ---------------------
+ -- Parse_Next_Char --
+ ---------------------
+
+ procedure Parse_Next_Char
+ (Index : in out Natural;
+ Char : out Character)
+ is
+ Int : Natural;
+ begin
+ -- Special characters are represented as ["00"] or ["""]
+ -- Note that we can have '[" ' that represents the character
+ -- '[' followed by the end of the string
+
+ if Index + 4 <= Type_Str'Last
+ and then Type_Str (Index) = '['
+ and then Type_Str (Index + 1) = '"'
+ and then (Type_Str (Index + 2 .. Index + 4) = """""]"
+ or else Type_Str (Index + 2) in '0' .. '9'
+ or else Type_Str (Index + 2) in 'a' .. 'f')
+ then
+ if Type_Str (Index + 2) = '"' then
+ Index := Index + 5;
+ Char := '"';
+
+ else
+ if Type_Str (Index + 2) in 'a' .. 'f' then
+ Int := 16 * (Character'Pos (Type_Str (Index + 2))
+ - Character'Pos ('a') + 10);
+ else
+ Int := 16 * (Character'Pos (Type_Str (Index + 2))
+ - Character'Pos ('0'));
+ end if;
+
+ if Type_Str (Index + 3) in 'a' .. 'f' then
+ Int := Int + Character'Pos (Type_Str (Index + 3))
+ - Character'Pos ('a') + 10;
+ else
+ Int := Int + Character'Pos (Type_Str (Index + 3))
+ - Character'Pos ('0');
+ end if;
+
+ Char := Character'Val (Int);
+ Index := Index + 6;
+ end if;
+
+ -- Else, a standard character
+
+ else
+ Char := Type_Str (Index);
+ Index := Index + 1;
+ end if;
+ end Parse_Next_Char;
+
+ S_Index : Natural := Str'First;
+ Char : Character;
+ Num : Long_Integer;
+ Last : Natural;
+
+ begin -- Parse_Cst_String
+ if Str'Length = 0 then
+ Last := Natural'Last;
+ else
+ Last := Str'Last;
+ end if;
+
+ In_String := Type_Str (Index) = '"';
+ if In_String then
+ Index := Index + 1;
+ end if;
+
+ -- Note: this is a slightly complex loop, since a string might not
+ -- appear as a single string in gdb, but can be made of multiple
+ -- elements, including characters repeated a number of times, as in:
+ -- "["af"]["c7"]", '["00"]' <repeats 12 times>, "BA"
+
+ while S_Index <= Last
+ and then Index <= Type_Str'Last
+ and then Type_Str (Index) /= ASCII.LF
+ loop
+ case Type_Str (Index) is
+ when '"' =>
+ -- Handling of Ada-style strings: A""double quote
+ if In_String
+ and then Index < Type_Str'Last
+ and then Type_Str (Index + 1) = '"'
+ then
+ Index := Index + 2;
+ Str (S_Index) := '"';
+ S_Index := S_Index + 1;
+
+ else
+ In_String := not In_String;
+ Index := Index + 1;
+
+ -- In cases like {field = 0x8048f88 "bar"}, we need to
+ -- consider the string finished, but not for
+ -- "bar", 'cd' <repeats 12 times>
+ if not In_String
+ and then Index <= Type_Str'Last
+ and then Type_Str (Index) /= ' '
+ and then Type_Str (Index) /= ','
+ then
+ Index := Index + 1;
+ Str_Last := S_Index - 1;
+ return;
+ end if;
+ end if;
+
+ when ''' =>
+ if In_String then
+ if Str'Length /= 0 then
+ Str (S_Index) := ''';
+ end if;
+
+ S_Index := S_Index + 1;
+ Index := Index + 1;
+
+ else
+ Index := Index + 1; -- skips initial '''
+ Parse_Next_Char (Index, Char);
+
+ if Str'Length /= 0 then
+ Str (S_Index) := Char;
+ end if;
+
+ Index := Index + 2; -- skips "' " at the end
+
+ if Looking_At (Type_Str, Index, "<repeats ") then
+ Index := Index + 9;
+ Parse_Num (Type_Str, Index, Num);
+
+ if Str'Length /= 0 then
+ Str (S_Index .. S_Index + Integer (Num) - 1) :=
+ (others => Char);
+ end if;
+
+ S_Index := S_Index + Integer (Num);
+ Index := Index + 7; -- skips " times>"
+
+ else
+ S_Index := S_Index + 1;
+ end if;
+ end if;
+
+ when '\' =>
+ if Backslash_Special then
+ if Str'Length /= 0 then
+ Str (S_Index) := Type_Str (Index + 1);
+ S_Index := S_Index + 1;
+ end if;
+
+ Index := Index + 2;
+
+ else
+ Str (S_Index) := Type_Str (Index);
+ S_Index := S_Index + 1;
+ Index := Index + 1;
+ end if;
+
+ when ' ' | ',' =>
+ if In_String then
+ if Str'Length /= 0 then
+ Str (S_Index) := ' ';
+ end if;
+
+ S_Index := S_Index + 1;
+
+ -- ',' is still part of the string output only if it is
+ -- followed by a constant string or character (repeats).
+ -- Otherwise, ',' simply denotes the end of a struct field,
+ -- as in "field3 = "ab", field4 = 1"
+
+ elsif Type_Str (Index) = ','
+ and then
+ (Index >= Type_Str'Last - 1
+ or else (Type_Str (Index + 2) /= '''
+ and then Type_Str (Index + 2) /= '"'))
+ then
+ Index := Index + 1;
+ Str_Last := S_Index - 1;
+ return;
+ end if;
+
+ Index := Index + 1;
+
+ when others =>
+ Parse_Next_Char (Index, Char);
+
+ if Str'Length /= 0 then
+ Str (S_Index) := Char;
+ end if;
+
+ S_Index := S_Index + 1;
+ end case;
+ end loop;
+
+ Index := Index + 1;
+ Str_Last := S_Index - 1;
+ end Parse_Cst_String;
+
+ -----------------------
+ -- Skip_Simple_Value --
+ -----------------------
+
+ procedure Skip_Simple_Value
+ (Type_Str : String;
+ Index : in out Natural;
+ Array_Item_Separator : Character := ',';
+ End_Of_Array : Character := ')';
+ Repeat_Item_Start : Character := '<') is
+ begin
+ while Index <= Type_Str'Last
+ and then Type_Str (Index) /= Array_Item_Separator
+ and then Type_Str (Index) /= End_Of_Array
+ and then Type_Str (Index) /= ASCII.LF -- always the end of a field
+ and then Type_Str (Index) /= Repeat_Item_Start
+ loop
+ Index := Index + 1;
+ end loop;
+ end Skip_Simple_Value;
+
+ ---------------
+ -- Skip_Word --
+ ---------------
+
+ procedure Skip_Word
+ (Type_Str : String;
+ Index : in out Natural;
+ Step : Integer := 1)
+ is
+ Initial : constant Natural := Index;
+ begin
+ while Index <= Type_Str'Last
+ and then Index >= Type_Str'First
+ and then (Is_Alphanumeric (Type_Str (Index))
+ or else
+ Type_Str (Index) = '_')
+ loop
+ Index := Index + Step;
+ end loop;
+
+ -- Move at least one character
+
+ if Index = Initial then
+ Index := Index + Step;
+ end if;
+ end Skip_Word;
+
+ --------------------
+ -- Skip_CPP_Token --
+ --------------------
+
+ procedure Skip_CPP_Token
+ (Type_Str : String;
+ Index : in out Natural;
+ Step : Integer := 1)
+ is
+ Initial : constant Natural := Index;
+ begin
+ while Index <= Type_Str'Last
+ and then Index >= Type_Str'First
+ and then (Is_Alphanumeric (Type_Str (Index))
+ or else
+ Type_Str (Index) = '_'
+ or else
+ Type_Str (Index) = '.')
+ loop
+ Index := Index + Step;
+ end loop;
+
+ -- Move at least one character
+
+ if Index = Initial then
+ Index := Index + Step;
+ end if;
+ end Skip_CPP_Token;
+
+ ------------
+ -- Reduce --
+ ------------
+
+ function Reduce
+ (S : String;
+ Max_Length : Positive := Positive'Last;
+ Continuation : String := "...") return String
+ is
+ Result : String (S'Range);
+ Len : Positive := Result'First;
+ Blank : Boolean := False;
+
+ Max : Natural;
+ -- Max if the position of the last character to be returned
+ Cut : Boolean := False;
+ -- Cut set to true if string was cut before the end at Max characters
+ Char : Natural := S'First;
+ Next : Natural := Char;
+ begin
+
+ if Max_Length = Positive'Last then
+ Max := Positive'Last;
+ else
+ Max := S'First + Max_Length - Continuation'Length - 1;
+ end if;
+
+ while Next <= S'Last loop
+ Char := Next;
+ Next := UTF8_Next_Char (S, Char);
+ if Next > S'Last then
+ Next := S'Last + 1;
+ end if;
+
+ if S (Char) = ASCII.LF or else S (Char) = ASCII.CR
+ or else S (Char) = ASCII.HT or else S (Char) = ' '
+ then
+ if not Blank then
+ Result (Len) := ' ';
+ Len := Len + 1;
+ Blank := True;
+ end if;
+
+ else
+ Blank := False;
+
+ Result (Len .. Len + Next - Char - 1) := S (Char .. Next - 1);
+ Len := Len + Next - Char;
+ end if;
+
+ if Len >= Max then
+ Cut := True;
+ exit;
+ end if;
+ end loop;
+
+ if Cut then
+ return Result (Result'First .. Len - 1) & Continuation;
+ else
+ return Result (Result'First .. Len - 1);
+ end if;
+ end Reduce;
+
+ ------------
+ -- Krunch --
+ ------------
+
+ function Krunch
+ (S : String;
+ Max_String_Length : Positive := 20) return String
+ is
+ Ellipsis : constant Wide_Wide_Character :=
+ Wide_Wide_Character'Val (8230);
+ -- UTF8 encoding for the ellipsis character (8230 in Decimal)
+
+ Image : constant Wide_Wide_String := Decode (S);
+
+ begin
+ if Image'Length <= Max_String_Length then
+ return S;
+ end if;
+
+ if Max_String_Length <= 3 then
+ return Encode
+ (Image (Image'First .. Image'First + Max_String_Length - 1));
+ else
+ declare
+ Half : constant Positive := (Max_String_Length - 1) / 2;
+ Result : constant Wide_Wide_String :=
+ Image (Image'First .. Image'First + Half - 1) &
+ Ellipsis &
+ Image (Image'Last - Half + 1 .. Image'Last);
+ begin
+ return Encode (Result);
+ end;
+ end if;
+ end Krunch;
+
+ --------------
+ -- Strip_CR --
+ --------------
+
+ procedure Strip_CR
+ (Text : in out String;
+ Last : out Integer;
+ CR_Found : out Boolean)
+ is
+ pragma Suppress (All_Checks);
+
+ J : Natural := Text'First;
+ begin
+ CR_Found := False;
+
+ if Text'Length = 0 then
+ Last := 0;
+ return;
+ end if;
+
+ loop
+ -- Manual unrolling for efficiency
+
+ exit when Text (J) = ASCII.CR or J = Text'Last;
+ J := J + 1;
+
+ exit when Text (J) = ASCII.CR or J = Text'Last;
+ J := J + 1;
+
+ exit when Text (J) = ASCII.CR or J = Text'Last;
+ J := J + 1;
+ end loop;
+
+ if Text (J) /= ASCII.CR then
+ Last := J;
+ return;
+ end if;
+
+ CR_Found := True;
+ Last := J - 1;
+
+ for Index in J + 1 .. Text'Last loop
+ if Text (Index) /= ASCII.CR then
+ Last := Last + 1;
+ Text (Last) := Text (Index);
+ end if;
+ end loop;
+ end Strip_CR;
+
+ ----------------------
+ -- Strip_CR_And_NUL --
+ ----------------------
+
+ procedure Strip_CR_And_NUL
+ (Text : in out String;
+ Last : out Integer;
+ CR_Found : out Boolean;
+ NUL_Found : out Boolean;
+ Trailing_Space_Found : out Boolean)
+ is
+ pragma Suppress (All_Checks);
+
+ Last_Is_Space : Boolean := False;
+
+ J : Natural := Text'First;
+ begin
+ CR_Found := False;
+ NUL_Found := False;
+ Trailing_Space_Found := False;
+
+ if Text'Length = 0 then
+ Last := 0;
+ return;
+ end if;
+
+ loop
+ if Text (J) = ASCII.CR
+ or else Text (J) = ASCII.NUL
+ or else J = Text'Last
+ then
+ exit;
+ elsif Text (J) = ASCII.LF then
+ if Last_Is_Space then
+ Trailing_Space_Found := True;
+ Last_Is_Space := False;
+ end if;
+ elsif Text (J) = ASCII.HT or else Text (J) = ' ' then
+ Last_Is_Space := True;
+ else
+ Last_Is_Space := False;
+ end if;
+
+ J := J + 1;
+
+ end loop;
+
+ case Text (J) is
+ when ASCII.NUL | ASCII.CR =>
+ Last := J - 1;
+ when others =>
+ Last := J;
+
+ if Last_Is_Space then
+ Trailing_Space_Found := True;
+ end if;
+
+ return;
+ end case;
+
+ for Index in J + 1 .. Text'Last loop
+ case Text (Index) is
+ when ASCII.NUL =>
+ NUL_Found := True;
+ when ASCII.CR =>
+ CR_Found := True;
+ when ASCII.HT | ' ' =>
+ Last_Is_Space := True;
+ Last := Last + 1;
+ Text (Last) := Text (Index);
+ when ASCII.LF =>
+ if Last_Is_Space then
+ Trailing_Space_Found := True;
+ Last_Is_Space := False;
+ end if;
+
+ Last := Last + 1;
+ Text (Last) := Text (Index);
+ when others =>
+ Last_Is_Space := False;
+ Last := Last + 1;
+ Text (Last) := Text (Index);
+ end case;
+ end loop;
+
+ if Last_Is_Space then
+ Trailing_Space_Found := True;
+ end if;
+ end Strip_CR_And_NUL;
+
+ -----------------------------
+ -- Strip_Ending_Linebreaks --
+ -----------------------------
+
+ function Strip_Ending_Linebreaks (Text : String) return String is
+ begin
+ -- Loop to make sure we have removed all of the ending CRs and LFs
+
+ for J in reverse Text'Range loop
+ if Text (J) /= ASCII.CR and then Text (J) /= ASCII.LF then
+ return Text (Text'First .. J);
+ end if;
+ end loop;
+
+ return "";
+ end Strip_Ending_Linebreaks;
+
+ ----------------------
+ -- Do_Tab_Expansion --
+ ----------------------
+
+ function Do_Tab_Expansion
+ (Text : String;
+ Tab_Size : Integer) return String
+ is
+ Num_Tabs : Natural := 0;
+ Col : Integer := 1;
+
+ begin
+ -- Count the number of tabs in the string
+
+ for K in Text'Range loop
+ if Text (K) = ASCII.HT then
+ Num_Tabs := Num_Tabs + 1;
+ end if;
+ end loop;
+
+ if Num_Tabs = 0 then
+ return Text;
+ else
+ declare
+ S : String (1 .. Num_Tabs * Tab_Size + Text'Length);
+ S_Index : Integer := 1;
+ Bound : Integer;
+
+ begin
+ for K in Text'Range loop
+ case Text (K) is
+ when ASCII.LF =>
+ S (S_Index) := Text (K);
+ S_Index := S_Index + 1;
+ Col := 1;
+
+ when ASCII.HT =>
+ if Col mod Tab_Size /= 0 then
+ Bound := (1 + Col / Tab_Size) * Tab_Size - Col + 1;
+ S (S_Index .. S_Index + Bound - 1) := (others => ' ');
+ S_Index := S_Index + Bound;
+ Col := Col + Bound;
+
+ else
+ S (S_Index) := ' ';
+ S_Index := S_Index + 1;
+ Col := Col + 1;
+ end if;
+
+ when others =>
+ S (S_Index) := Text (K);
+ S_Index := S_Index + 1;
+ Col := Col + 1;
+ end case;
+ end loop;
+
+ return S (S'First .. S_Index - 1);
+ end;
+ end if;
+ end Do_Tab_Expansion;
+
+ ------------------
+ -- Strip_Quotes --
+ ------------------
+
+ function Strip_Quotes (S : String) return String is
+ S_First : Integer := S'First;
+ S_Last : Integer := S'Last;
+
+ begin
+ if S = "" then
+ return "";
+ end if;
+
+ while S_First <= S'Last
+ and then (S (S_First) = ' ' or else S (S_First) = '"')
+ loop
+ S_First := S_First + 1;
+ end loop;
+
+ while S_Last >= S'First
+ and then (S (S_Last) = ' ' or else S (S_Last) = '"')
+ loop
+ S_Last := S_Last - 1;
+ end loop;
+
+ return S (S_First .. S_Last);
+ end Strip_Quotes;
+
+ -----------
+ -- Image --
+ -----------
+
+ function Image (N : Integer) return String is
+ begin
+ return GNATCOLL.Utils.Image (N, Min_Width => 1);
+ end Image;
+
+ ----------------------
+ -- Number_Of_Digits --
+ ----------------------
+
+ function Number_Of_Digits (N : Integer) return Natural is
+ begin
+ case N is
+ when 0 .. 9 =>
+ return 1;
+ when 10 .. 99 =>
+ return 2;
+ when 100 .. 999 =>
+ return 3;
+ when 1_000 .. 9_999 =>
+ return 4;
+ when 10_000 .. 99_999 =>
+ return 5;
+ when others =>
+ return Image (N)'Length;
+ end case;
+ end Number_Of_Digits;
+
+ ----------------------
+ -- Is_Entity_Letter --
+ ----------------------
+
+ function Is_Entity_Letter (Char : Wide_Wide_Character) return Boolean is
+ begin
+ return Char = '_' or else Is_Alphanumeric (Char);
+ end Is_Entity_Letter;
+
+ ------------------------
+ -- Is_Operator_Letter --
+ ------------------------
+
+ function Is_Operator_Letter (Char : Wide_Wide_Character) return Boolean is
+ begin
+ case Char is
+ when '<' | '=' | '>' | '+' | '-' | '*' | '/' =>
+ return True;
+
+ when others =>
+ return False;
+ end case;
+ end Is_Operator_Letter;
+
+ function Is_File_Letter (Char : Wide_Wide_Character) return Boolean is
+ begin
+ if Is_Control (Char) then
+ return False;
+ end if;
+
+ case Char is
+ when '<'
+ | '/'
+ | '\'
+ | '>'
+ | '"'
+ | ' ' =>
+ return False;
+
+ when others =>
+ return True;
+ end case;
+ end Is_File_Letter;
+
+ -----------------
+ -- Copy_String --
+ -----------------
+
+ procedure Copy_String
+ (Item : Interfaces.C.Strings.chars_ptr;
+ Str : out String;
+ Len : Natural)
+ is
+ procedure Strncpy
+ (Dest : out String;
+ Src : Interfaces.C.Strings.chars_ptr;
+ Len : Interfaces.C.size_t);
+ pragma Import (C, Strncpy, "strncpy");
+
+ begin
+ Strncpy (Str, Item, Interfaces.C.size_t (Len));
+ end Copy_String;
+
+ -----------
+ -- Clone --
+ -----------
+
+ function Clone
+ (List : GNAT.Strings.String_List) return GNAT.Strings.String_List
+ is
+ L : String_List (List'Range);
+ begin
+ for J in List'Range loop
+ L (J) := new String'(List (J).all);
+ end loop;
+ return L;
+ end Clone;
+
+ ------------
+ -- Append --
+ ------------
+
+ procedure Append
+ (List : in out GNAT.Strings.String_List_Access;
+ Item : String)
+ is
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (String_List, String_List_Access);
+ L : String_List_Access := List;
+ begin
+ if List = null then
+ List := new String_List'(1 .. 1 => new String'(Item));
+ else
+ List := new String_List (L'First .. L'Last + 1);
+ List (L'Range) := L.all;
+ List (List'Last) := new String'(Item);
+ Unchecked_Free (L);
+ end if;
+ end Append;
+
+ ------------
+ -- Append --
+ ------------
+
+ procedure Append
+ (List : in out GNAT.Strings.String_List_Access;
+ List2 : GNAT.Strings.String_List)
+ is
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (String_List, String_List_Access);
+ L : String_List_Access := List;
+ begin
+ if List = null then
+ List := new String_List (1 .. List2'Length);
+ else
+ List := new String_List (L'First .. L'Last + List2'Length);
+ List (L'Range) := L.all;
+ Unchecked_Free (L);
+ end if;
+
+ List (List'Last - List2'Length + 1 .. List'Last) := List2;
+ end Append;
+
+ ----------------
+ -- Safe_Value --
+ ----------------
+
+ function Safe_Value (S : String; Default : Integer := 1) return Integer is
+ begin
+ if S = "" then
+ return Default;
+ else
+ return Integer'Value (S);
+ end if;
+ exception
+ when Constraint_Error =>
+ return Default;
+ end Safe_Value;
+
+ -------------
+ -- Protect --
+ -------------
+
+ function Protect
+ (S : String;
+ Protect_Quotes : Boolean := True;
+ Protect_Spaces : Boolean := False;
+ Protect_Backslashes : Boolean := True) return String
+ is
+ S2 : String (1 .. S'Length * 2);
+ Index : Natural := 1;
+ begin
+ for J in S'Range loop
+ if (Protect_Quotes and then S (J) = '"')
+ or else (Protect_Backslashes and then S (J) = '\')
+ or else (Protect_Spaces and then S (J) = ' ')
+ then
+ S2 (Index .. Index + 1) := '\' & S (J);
+ Index := Index + 2;
+ else
+ S2 (Index) := S (J);
+ Index := Index + 1;
+ end if;
+ end loop;
+
+ return S2 (1 .. Index - 1);
+ end Protect;
+
+ ---------------
+ -- Unprotect --
+ ---------------
+
+ function Unprotect (S : String) return String is
+ begin
+ return GNATCOLL.Scripts.Utils.Unprotect (S);
+ end Unprotect;
+
+ -------------
+ -- Unquote --
+ -------------
+
+ function Unquote (S : String) return String is
+ begin
+ if S'Length > 1
+ and then S (S'First) = '"'
+ and then S (S'Last) = '"'
+ then
+ return S (S'First + 1 .. S'Last - 1);
+ else
+ return S;
+ end if;
+ end Unquote;
+
+ ---------------
+ -- Hex_Value --
+ ---------------
+
+ function Hex_Value (Hex : String) return Natural is
+ begin
+ return Integer'Value ("16#" & Hex & "#");
+ end Hex_Value;
+
+ ------------
+ -- Decode --
+ ------------
+
+ function URL_Decode (URL : String) return String is
+ Res : String (1 .. URL'Length);
+ K : Natural := 0;
+ J : Positive := URL'First;
+
+ begin
+ if URL = "" then
+ return "";
+ end if;
+
+ loop
+ K := K + 1;
+
+ if URL (J) = '%'
+ and then J + 2 <= URL'Last
+ and then Is_Hexadecimal_Digit (URL (J + 1))
+ and then Is_Hexadecimal_Digit (URL (J + 2))
+ then
+ Res (K) := Character'Val (Hex_Value (URL (J + 1 .. J + 2)));
+ J := J + 2;
+ else
+ Res (K) := URL (J);
+ end if;
+
+ J := J + 1;
+ exit when J > URL'Last;
+ end loop;
+
+ return Res (1 .. K);
+ end URL_Decode;
+
+ ------------
+ -- Revert --
+ ------------
+
+ function Revert (S : String; Separator : String := ".") return String is
+ Result : String (S'Range);
+ Index : Natural := S'First;
+ Last : Natural := S'Last;
+ Len, J : Integer;
+ First : constant Natural := S'First + Separator'Length - 1;
+
+ begin
+ J := S'Last;
+
+ loop
+ exit when J < First;
+
+ if S (J - Separator'Length + 1 .. J) = Separator then
+ Len := Last - J;
+ Result (Index .. Index + Len - 1) := S (J + 1 .. Last);
+ J := J - Separator'Length + 1;
+ Last := J - 1;
+ Index := Index + Len;
+ Result (Index .. Index + Separator'Length - 1) := Separator;
+ Index := Index + Separator'Length;
+ end if;
+
+ J := J - 1;
+ end loop;
+
+ if Last >= S'First then
+ Result (Index .. Result'Last) := S (S'First .. Last);
+ end if;
+
+ return Result;
+ end Revert;
+
+ ------------------------------
+ -- Strip_Single_Underscores --
+ ------------------------------
+
+ function Strip_Single_Underscores (S : String) return String is
+ S2 : String := S;
+ J2 : Natural := S'First;
+ begin
+ for J in S'Range loop
+ S2 (J2) := S (J);
+
+ if S (J) /= '_'
+ or else (J > S'First and then S (J - 1) = '_')
+ then
+ J2 := J2 + 1;
+ end if;
+ end loop;
+
+ return S2 (S2'First .. J2 - 1);
+ end Strip_Single_Underscores;
+
+ -------------
+ -- Compare --
+ -------------
+
+ function Compare (A, B : String) return Integer is
+ begin
+ if A < B then
+ return -1;
+ elsif A > B then
+ return 1;
+ else
+ return 0;
+ end if;
+ end Compare;
+
+ function Compare (A, B : Integer) return Integer is
+ begin
+ if A < B then
+ return -1;
+ elsif A > B then
+ return 1;
+ else
+ return 0;
+ end if;
+ end Compare;
+
+ ----------
+ -- Hash --
+ ----------
+
+ function Hash (Key : String) return Header_Num is
+ Tmp : constant Ada.Containers.Hash_Type := Ada.Strings.Hash (Key);
+ begin
+ return Header_Num'First +
+ Header_Num'Base (Tmp mod Header_Num'Range_Length);
+ end Hash;
+
+ ---------------------------
+ -- Case_Insensitive_Hash --
+ ---------------------------
+
+ function Case_Insensitive_Hash (Key : String) return Header_Num is
+ Tmp : constant Ada.Containers.Hash_Type :=
+ Ada.Strings.Hash_Case_Insensitive (Key);
+ begin
+ return Header_Num'First +
+ Header_Num'Base (Tmp mod Header_Num'Range_Length);
+ end Case_Insensitive_Hash;
+
+ ---------------------------
+ -- Has_Include_Directive --
+ ---------------------------
+
+ function Has_Include_Directive (Str : String) return Boolean is
+ begin
+ return Str'Length > 11
+ and then Str (Str'First) = '#'
+ and then Ada.Strings.Fixed.Index
+ (Str (Str'First + 1 .. Str'Last), "include") /= 0;
+ end Has_Include_Directive;
+
+end String_Utils;
diff --git a/packages/ada-mode/gps_source/string_utils.ads
b/packages/ada-mode/gps_source/string_utils.ads
new file mode 100755
index 0000000..aab1d03
--- /dev/null
+++ b/packages/ada-mode/gps_source/string_utils.ads
@@ -0,0 +1,353 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2001-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+-- This package provides a set of subprograms for manipulating and parsing
+-- strings.
+
+with GNAT.Strings;
+with Interfaces.C.Strings;
+with Basic_Types; use Basic_Types;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
+package String_Utils is
+
+ function "+"
+ (S : String) return Unbounded_String renames To_Unbounded_String;
+
+ function "+"
+ (S : Unbounded_String) return String renames To_String;
+ -- Utility conversion operators from String to Unbounded_String
+
+ function Hex_Value (Hex : String) return Natural;
+ -- Return the value for the hexadecimal number Hex. Raises
+ -- Constraint_Error is Hex is not an hexadecimal number.
+
+ procedure Skip_To_Blank
+ (Type_Str : String;
+ Index : in out Natural);
+ -- Skip to the next blank character
+
+ procedure Skip_To_Index
+ (Buffer : String;
+ Columns : out Visible_Column_Type;
+ Index_In_Line : String_Index_Type;
+ Index : in out String_Index_Type;
+ Tab_Width : Positive := 8);
+ procedure Skip_To_Index
+ (Buffer : Unbounded_String;
+ Columns : out Visible_Column_Type;
+ Index_In_Line : String_Index_Type;
+ Index : in out String_Index_Type;
+ Tab_Width : Positive := 8);
+ -- Assuming Index points to the begining of a line, move the index by
+ -- "Index_In_Line" characters, and give the new column value.
+
+ procedure Skip_Hexa_Digit
+ (Type_Str : String;
+ Index : in out Natural);
+ -- Move Index to the first character that can not be part of an hexadecimal
+ -- digit. Note that an hexadecimal digit can optionally start with '0x',
+ -- which is the only case where x is recognized as part of the digit.
+
+ procedure Skip_To_Char
+ (Type_Str : String;
+ Index : in out Natural;
+ Char : Character;
+ Step : Integer := 1);
+ procedure Skip_To_Char
+ (Type_Str : Unbounded_String;
+ Index : in out Natural;
+ Char : Character;
+ Step : Integer := 1);
+ -- Skip every character up to the first occurence of Char in the string.
+ -- If no occurrence found, then Index is set over Type_Str'Last.
+
+ procedure Skip_Word
+ (Type_Str : String;
+ Index : in out Natural;
+ Step : Integer := 1);
+ -- Skip the word starting at Index (at least one character, even if there
+ -- is no word).
+ -- Currently, a word is defined as any string made of alphanumeric
+ -- character or underscore.
+
+ procedure Skip_CPP_Token
+ (Type_Str : String;
+ Index : in out Natural;
+ Step : Integer := 1);
+ -- Skip the cpp token starting at Index (at least one character, even if
+ -- there is no cpp token).
+ -- Currently, a cpp token is defined as any string made of alphanumeric
+ -- character, underscore or period.
+
+ function Tab_Width return Positive;
+ pragma Inline (Tab_Width);
+ -- Default value of tab width in the text editor (current value is 8)
+
+ function Lines_Count (Text : String) return Natural;
+ -- Return the number of lines in Text
+
+ function Blank_Slice
+ (Count : Integer;
+ Use_Tabs : Boolean := False;
+ Tab_Width : Positive := 8) return String;
+ -- Return a string representing count blanks.
+ -- If Use_Tabs is True, use ASCII.HT characters as much as possible,
+ -- otherwise use only spaces.
+ -- Return a null string if Count is negative.
+
+ function Is_Blank (C : Character) return Boolean;
+ -- Return True if C is a blank character: CR, LF, HT or ' '
+
+ procedure Next_Line
+ (Buffer : String;
+ P : Natural;
+ Next : out Natural;
+ Success : out Boolean);
+ -- Return the start of the next line in Next or Buffer'Last if the end of
+ -- the buffer is reached.
+ -- Success is set to True if a new line was found, false otherwise (end of
+ -- buffer reached).
+
+ procedure Parse_Num
+ (Type_Str : String;
+ Index : in out Natural;
+ Result : out Long_Integer);
+ -- Parse the integer found at position Index in Type_Str.
+ -- Index is set to the position of the first character that does not
+ -- belong to the integer.
+
+ function Looking_At
+ (Type_Str : String;
+ Index : Natural;
+ Substring : String) return Boolean;
+ -- Return True if the characters starting at Index in Type_Str are
+ -- equivalent to Substring.
+
+ procedure Parse_Cst_String
+ (Type_Str : String;
+ Index : in out Natural;
+ Str : out String;
+ Str_Last : out Natural;
+ Backslash_Special : Boolean := True);
+ -- Parse the string pointed to by Index, and copy the result in Str.
+ -- Index must point to the opening " character, and will be set to
+ -- point after the closing " character.
+ -- Special characters, as output by gdb (["0a"]) are also interpreted
+ -- and converted to the equivalent Character value.
+ -- Str must be long enough to contain the string, not check is done. As a
+ -- special case, if Str'Length = 0 then no attempt is done to fill up
+ -- the string, and only Length is computed. Str_Last is set to the last
+ -- meaningful character in Str.
+ --
+ -- Index is set to the number of characters parsed in the string.
+
+ procedure Skip_Simple_Value
+ (Type_Str : String;
+ Index : in out Natural;
+ Array_Item_Separator : Character := ',';
+ End_Of_Array : Character := ')';
+ Repeat_Item_Start : Character := '<');
+ -- Skip the value of a simple value ("65 'A'" for instance).
+ -- This stops at the first special character.
+ --
+ -- Array_Item_Separator is the separator in an array value (ie "5, 2, 3").
+ -- End_Of_Array is the array that indicates the end of an array value, as
+ -- in "((1, 2), (3, 4))".
+ -- Repeat_Item_Start if the character that starts a repeat statements, as
+ -- in "<repeats .. times>"
+
+ function Reduce
+ (S : String;
+ Max_Length : Positive := Positive'Last;
+ Continuation : String := "...") return String;
+ -- Replace in string S all ASCII.LF and ASCII.HT characters with a space,
+ -- and replace multiple spaces with a single one. Return the resulting
+ -- string with at most Max_Length character including the continuation
+ -- characters. S should be encoded in UTF-8.
+
+ function Krunch
+ (S : String;
+ Max_String_Length : Positive := 20) return String;
+ -- If String is less than Max_String_Length characters long, return it,
+ -- otherwise return a krunched string no longer than Max_String_Length.
+
+ procedure Strip_CR
+ (Text : in out String;
+ Last : out Integer;
+ CR_Found : out Boolean);
+ -- Same as above, but works on Text, and more efficient
+ -- Text (Text'First .. Last) contains the new result.
+ -- CR_Found is set to True if a CR was found in Text.
+
+ procedure Strip_CR_And_NUL
+ (Text : in out String;
+ Last : out Integer;
+ CR_Found : out Boolean;
+ NUL_Found : out Boolean;
+ Trailing_Space_Found : out Boolean);
+ -- Same as Strip_CR, and strip also ASCII.NUL characters
+ -- Note that CR chars alone are not replaced by LF chars.
+ -- Also check if Text has trailing spaces in a line.
+
+ function Strip_Ending_Linebreaks (Text : String) return String;
+ -- Return a version of Text after stripping all ending CR and LF
+ -- characters.
+
+ function Do_Tab_Expansion
+ (Text : String; Tab_Size : Integer) return String;
+ -- Return a version of Text after all tabs have been correctly expanded
+ -- depending on the value of Tab_Size.
+ -- This function works correctly with multiple-line strings.
+
+ function Strip_Quotes (S : String) return String;
+ -- Remove the quotes and the spaces at the beginning and end of S
+
+ function Strip_Single_Underscores (S : String) return String;
+ -- Return S stripped of single underscores, and with multiple underscores
+ -- concatenated into one.
+ -- This is used to process menu shortcuts, for example
+ -- Strip_Single_Underscores ("/_Project/C_lean") returns "/Project/Clean"
+
+ function Image (N : Integer) return String;
+ -- Create a string image of the given Integer
+
+ function Safe_Value (S : String; Default : Integer := 1) return Integer;
+ -- Convert S to a Natural, making sure there is no exception raised.
+ -- If S doesn't contain a valid number, Default is returned.
+
+ function Number_Of_Digits (N : Integer) return Natural;
+ -- Return the number of digits for the given Integer number;
+
+ function Is_Entity_Letter (Char : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Entity_Letter);
+ -- Return True if the given letter is a valid letter for an entity name
+ -- (ie if the letter is either alphanumeric or an '_').
+
+ function Is_Operator_Letter (Char : Wide_Wide_Character) return Boolean;
+ -- Return True if the given letter is a valid operator
+
+ function Is_File_Letter (Char : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_File_Letter);
+ -- Return True if the given letter is a valid letter for a file name.
+
+ procedure Replace
+ (S : in out GNAT.Strings.String_Access;
+ Value : String);
+ -- Set S to Value, free previous content if any
+
+ procedure Replace
+ (S : in out GNAT.Strings.String_Access;
+ Value : GNAT.Strings.String_Access);
+ -- Idem, but does nothing if Value is null
+
+ function Has_Include_Directive (Str : String) return Boolean;
+ -- Return True is Str contains an #include directive
+
+ -------------------
+ -- Argument_List --
+ -------------------
+
+ function Clone
+ (List : GNAT.Strings.String_List) return GNAT.Strings.String_List;
+ -- Return a deep-copy of List. The returned value must be freed by the
+ -- caller.
+
+ procedure Append
+ (List : in out GNAT.Strings.String_List_Access;
+ List2 : GNAT.Strings.String_List);
+ procedure Append
+ (List : in out GNAT.Strings.String_List_Access;
+ Item : String);
+ -- Append all the strings in List2 to the end of List.
+ -- The strings in List2 are not duplicated.
+ -- List might be null initially.
+
+ ---------------------------
+ -- C String manipulation --
+ ---------------------------
+
+ procedure Copy_String
+ (Item : Interfaces.C.Strings.chars_ptr;
+ Str : out String;
+ Len : Natural);
+ -- Copy Len characters from Item to Str
+
+ ----------------------------
+ -- Arguments manipulation --
+ ----------------------------
+
+ function Protect
+ (S : String;
+ Protect_Quotes : Boolean := True;
+ Protect_Spaces : Boolean := False;
+ Protect_Backslashes : Boolean := True) return String;
+ -- Escape special characters in S.
+ -- Quotes are only escaped when Protect_Quotes is true.
+ -- Spaces are only escaped when Protect_Spaces is true.
+
+ function Unprotect (S : String) return String;
+ -- Unprotect an argument: remove the leading and ending '"',
+ -- and un-escape the "\" when necessary.
+
+ function Unquote (S : String) return String;
+ -- Remove the leading and ending '"' if present
+
+ function Revert (S : String; Separator : String := ".") return String;
+ -- Given a string S composed of names separated with Separator
+ -- (e.g. Put_Line.Text_IO.Ada), return the names reversed
+ -- (e.g. Ada.Text_IO.Put_Line).
+
+ ----------------------
+ -- URL manipulation --
+ ----------------------
+
+ function URL_Decode (URL : String) return String;
+ -- Decode URL into a regular string. Many characters are forbiden into an
+ -- URL and needs to be encoded. A character is encoded by %XY where XY is
+ -- the character's ASCII hexadecimal code. For example a space is encoded
+ -- as %20.
+
+ function Compare (A, B : String) return Integer;
+ function Compare (A, B : Integer) return Integer;
+ -- Return -1 if A<B, 1 if A>B and 0 otherwise. This routine is useful for
+ -- model specific sorting. The second version does the same comparing
+ -- integers. Even if not using string, it is better to keep this routine
+ -- next to the compare based on strings.
+
+ ----------
+ -- Hash --
+ ----------
+
+ generic
+ type Header_Num is range <>;
+ function Hash (Key : String) return Header_Num;
+ -- A generic hashing function working on String keys
+
+ generic
+ type Header_Num is range <>;
+ function Case_Insensitive_Hash (Key : String) return Header_Num;
+ -- A generic hashing function working on case insensitive String keys
+
+private
+ pragma Inline (Is_Blank);
+ pragma Inline (Looking_At);
+ pragma Inline (Skip_To_Char);
+ pragma Inline (Copy_String);
+ pragma Inline (Replace);
+ pragma Inline (Compare);
+end String_Utils;
diff --git a/packages/ada-mode/gps_source/utf8_utils.adb
b/packages/ada-mode/gps_source/utf8_utils.adb
new file mode 100755
index 0000000..b835165
--- /dev/null
+++ b/packages/ada-mode/gps_source/utf8_utils.adb
@@ -0,0 +1,313 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2007-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with GNAT.Decode_UTF8_String;
+with Config;
+
+package body UTF8_Utils is
+
+ Locale_To_UTF_8 : Iconv_T;
+ UTF_8_To_Locale : Iconv_T;
+ Latin1_To_UTF_8 : Iconv_T;
+ UTF_8_To_UTF_32 : Iconv_T;
+ Is_Opened : Boolean := False;
+
+ procedure Open;
+ -- Initialize internal data if not yet initialized
+
+ ----------
+ -- Open --
+ ----------
+
+ procedure Open is
+ begin
+ if not Is_Opened then
+ Locale_To_UTF_8 := Iconv_Open
+ (To_Code => UTF8, From_Code => Config.Default_Charset);
+ UTF_8_To_Locale := Iconv_Open
+ (From_Code => UTF8, To_Code => Config.Default_Charset);
+ Latin1_To_UTF_8 := Iconv_Open
+ (From_Code => ISO_8859_1, To_Code => UTF8);
+ UTF_8_To_UTF_32 := Iconv_Open
+ (From_Code => UTF8, To_Code => UTF32);
+ Is_Opened := True;
+ end if;
+ end Open;
+
+ ---------------------
+ -- Unknown_To_UTF8 --
+ ---------------------
+
+ procedure Unknown_To_UTF8
+ (Input : String;
+ Output : out GNAT.Strings.String_Access;
+ Success : out Boolean) is
+ begin
+ Open;
+ Output := null;
+ Success := True;
+
+ -- First check if the string is already UTF-8
+ if Validate (UTF_8_To_UTF_32, Input) then
+ -- The string is UTF-8, nothing to do
+ return;
+ end if;
+
+ -- The string is not valid UTF-8, assume it is encoded using the locale.
+
+ if Validate (Locale_To_UTF_8, Input) then
+ Output := new String'(Iconv (Locale_To_UTF_8, Input));
+ else
+ Success := False;
+ end if;
+ end Unknown_To_UTF8;
+
+ function Unknown_To_UTF8
+ (Input : String;
+ Success : access Boolean) return UTF8_String
+ is
+ Output : GNAT.Strings.String_Access;
+ begin
+
+ Unknown_To_UTF8 (Input, Output, Success.all);
+
+ if Success.all then
+ if Output = null then
+ return Input;
+ else
+ declare
+ S : constant String := Output.all;
+ begin
+ Free (Output);
+ return S;
+ end;
+ end if;
+
+ else
+ return "";
+ end if;
+ end Unknown_To_UTF8;
+
+ function Unknown_To_UTF8
+ (Input : String) return UTF8_String
+ is
+ Success : aliased Boolean;
+ S : constant String := Unknown_To_UTF8 (Input, Success'Access);
+ begin
+ if Success then
+ return S;
+ else
+ return "<could not convert to UTF8>";
+ end if;
+ end Unknown_To_UTF8;
+
+ --------------------
+ -- UTF8_To_Locale --
+ --------------------
+
+ function UTF8_To_Locale (Input : UTF8_String) return String is
+ begin
+ Open;
+ return Iconv (UTF_8_To_Locale, Input);
+ end UTF8_To_Locale;
+
+ --------------------
+ -- Locale_To_UTF8 --
+ --------------------
+
+ function Locale_To_UTF8 (Input : String) return UTF8_String is
+ begin
+ Open;
+ return Iconv (Locale_To_UTF_8, Input);
+ end Locale_To_UTF8;
+
+ -------------------
+ -- UTF8_Get_Char --
+ -------------------
+
+ function UTF8_Get_Char (Input : UTF8_String) return Wide_Wide_Character is
+ Next : Positive := Input'First;
+ Result : Wide_Wide_Character;
+ begin
+ GNAT.Decode_UTF8_String.Decode_Wide_Wide_Character
+ (Input, Next, Result);
+ return Result;
+ end UTF8_Get_Char;
+
+ --------------------
+ -- UTF8_Next_Char --
+ --------------------
+
+ function UTF8_Next_Char
+ (Str : UTF8_String; Index : Positive) return Positive
+ is
+ Byte : constant Character := Str (Index);
+ begin
+ case Byte is
+ when Character'Val (16#C0#) .. Character'Val (16#DF#) =>
+ return Index + 2;
+ when Character'Val (16#E0#) .. Character'Val (16#EF#) =>
+ return Index + 3;
+ when Character'Val (16#F0#) .. Character'Val (16#F7#) =>
+ return Index + 4;
+ when Character'Val (16#F8#) .. Character'Val (16#FB#) =>
+ return Index + 5;
+ when Character'Val (16#FC#) .. Character'Val (16#FD#) =>
+ return Index + 6;
+ when others =>
+ return Index + 1;
+ end case;
+ end UTF8_Next_Char;
+
+ --------------------
+ -- UTF8_Next_Char --
+ --------------------
+
+ function UTF8_Next_Char
+ (Str : UTF8_Unbounded_String; Index : Positive) return Positive
+ is
+ Byte : constant Character := Element (Str, Index);
+ begin
+ case Byte is
+ when Character'Val (16#C0#) .. Character'Val (16#DF#) =>
+ return Index + 2;
+ when Character'Val (16#E0#) .. Character'Val (16#EF#) =>
+ return Index + 3;
+ when Character'Val (16#F0#) .. Character'Val (16#F7#) =>
+ return Index + 4;
+ when Character'Val (16#F8#) .. Character'Val (16#FB#) =>
+ return Index + 5;
+ when Character'Val (16#FC#) .. Character'Val (16#FD#) =>
+ return Index + 6;
+ when others =>
+ return Index + 1;
+ end case;
+ end UTF8_Next_Char;
+
+ --------------------
+ -- UTF8_Prev_Char --
+ --------------------
+
+ function UTF8_Prev_Char
+ (Str : UTF8_String; Index : Natural) return Natural
+ is
+ Result : Integer := Index - 1;
+ begin
+ if Index not in Str'Range then
+ return Index;
+ end if;
+
+ while Result in Str'Range and then
+ Str (Result) in Character'Val (16#80#) .. Character'Val (16#BF#)
+ loop
+ Result := Result - 1;
+ end loop;
+
+ return Result;
+ end UTF8_Prev_Char;
+
+ ---------------------
+ -- Latin_1_To_UTF8 --
+ ---------------------
+
+ function Latin_1_To_UTF8 (Input : String) return UTF8_String is
+ begin
+ Open;
+ return Iconv (Latin1_To_UTF_8, Input);
+ end Latin_1_To_UTF8;
+
+ --------------
+ -- Validate --
+ --------------
+
+ function Validate
+ (Object : Iconv_T; Input : Byte_Sequence) return Boolean
+ is
+ Output : Byte_Sequence (1 .. 4096);
+ Input_Index : Positive := Input'First;
+ Output_Index : Positive := Output'First;
+ Result : Iconv_Result;
+ begin
+ if Input = "" then
+ return True;
+ end if;
+
+ loop
+ Iconv (Object, Input, Input_Index, Output, Output_Index, Result);
+
+ case Result is
+ when Invalid_Multibyte_Sequence | Incomplete_Multibyte_Sequence =>
+ return False;
+ when Success =>
+ return True;
+ when Full_Buffer =>
+ -- Continue convertion by rewriting output buffer
+ Output_Index := Output'First;
+ end case;
+ end loop;
+ end Validate;
+
+ --------------------
+ -- Validate_UTF_8 --
+ --------------------
+
+ function Validate_UTF_8 (Input : Byte_Sequence) return Boolean is
+ begin
+ Open;
+
+ return Validate (UTF_8_To_UTF_32, Input);
+ end Validate_UTF_8;
+
+ ---------------------
+ -- Column_To_Index --
+ ---------------------
+
+ function Column_To_Index
+ (Buffer : UTF8_String; Column : Character_Offset_Type) return Natural
+ is
+ Result : Positive := Buffer'First;
+ begin
+ if Column <= 0 then
+ return 0;
+ end if;
+
+ for J in 2 .. Column loop
+ Result := UTF8_Next_Char (Buffer, Result);
+ end loop;
+
+ return Result;
+ end Column_To_Index;
+
+ -----------------
+ -- UTF8_Length --
+ -----------------
+
+ function UTF8_Length (Item : UTF8_String) return Natural is
+ Result : Natural := 0;
+ Index : Positive := Item'First;
+
+ begin
+ while Index <= Item'Last loop
+ Result := Result + 1;
+ Index := UTF8_Next_Char (Item, Index);
+ end loop;
+
+ return Result;
+ end UTF8_Length;
+
+end UTF8_Utils;
diff --git a/packages/ada-mode/gps_source/utf8_utils.ads
b/packages/ada-mode/gps_source/utf8_utils.ads
new file mode 100755
index 0000000..e827d98
--- /dev/null
+++ b/packages/ada-mode/gps_source/utf8_utils.ads
@@ -0,0 +1,101 @@
+------------------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2007-2016, AdaCore --
+-- --
+-- This is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. This software is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for more details. You should have received a copy of the GNU --
+-- General Public License distributed with this software; see file --
+-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license. --
+------------------------------------------------------------------------------
+
+-- This package provides a set of high-level subprograms for handling UTF8
+-- encoding
+
+with Basic_Types; use Basic_Types;
+with GNAT.Strings; use GNAT.Strings;
+with GNATCOLL.Iconv; use GNATCOLL.Iconv;
+
+package UTF8_Utils is
+
+ function Unknown_To_UTF8
+ (Input : String;
+ Success : access Boolean) return UTF8_String;
+ -- Transform a string of unknown encoding to UTF-8.
+ -- The heuristics used is the following:
+ -- - if S already contains valid UTF-8, assume it is already encoded
+ -- in UTF8 (the statistical chances for this are very high)
+ -- - if S does not contain valid UTF-8, assume it is encoded using the
+ -- locale, and attempt to convert it from the locale to UTF-8.
+ -- Success is set to False if the conversion failed.
+
+ function Unknown_To_UTF8
+ (Input : String) return UTF8_String;
+ -- Same as above, but return "<could not convert to UTF8>" if the
+ -- conversion could not be done.
+
+ procedure Unknown_To_UTF8
+ (Input : String;
+ Output : out String_Access;
+ Success : out Boolean);
+ -- Same as above, but return Output as Unchecked_String_Access for
+ -- efficiency. Output is still in UTF8 format, and the caller is
+ -- responsible for freeing it.
+ -- In addition, if Input is already a valid UTF8 string, then Output
+ -- will be set to null: you should use Input in this case.
+ -- If Success is set to False, Output will also be set to null.
+ -- Warning: Never reference Output (Output'Range) or Output'Last,
+ -- use Output (1 .. Len) and Len instead.
+
+ function UTF8_To_Locale (Input : UTF8_String) return String;
+ -- Convert Input to the GPS locale (ie, the contents of the environment
+ -- variable CHARSET, defaulting to ISO-8859-1).
+ -- If Input could not be converted, Input is returned as-is.
+
+ function Locale_To_UTF8 (Input : String) return UTF8_String;
+ -- Convert Input from the GPS locale (ie, the contents of the environment
+ -- variable CHARSET, defaulting to ISO-8859-1).
+ -- If Input could not be converted, Input is returned as-is.
+
+ function UTF8_Next_Char
+ (Str : UTF8_String; Index : Positive) return Positive;
+ function UTF8_Next_Char
+ (Str : UTF8_Unbounded_String; Index : Positive) return Positive;
+ -- Find the start of the next UTF8 character after the Index-th byte.
+ -- Index has to be on the start of a character.
+ -- Index is set to a value greater than Str'Last if there is no more
+ -- character.
+
+ function UTF8_Prev_Char
+ (Str : UTF8_String; Index : Natural) return Natural;
+ -- Find the start of the previous UTF8 character before the Index-th byte.
+ -- Index has to be on the start of a character.
+ -- Index is set to 0 if there is no more character.
+
+ function UTF8_Get_Char (Input : UTF8_String) return Wide_Wide_Character;
+ -- Return first character of UTF8_String
+
+ function Latin_1_To_UTF8 (Input : String) return UTF8_String;
+ -- Convert Latin_1 string to UTF-8.
+
+ function Column_To_Index
+ (Buffer : UTF8_String; Column : Character_Offset_Type) return Natural;
+ -- Return index of first byte of UTF8 character in given Column
+ -- Return 0 in Column <= 0. Return Buffer'First when Column = 1
+
+ function UTF8_Length (Item : UTF8_String) return Natural;
+ -- Returns number of user visible characters in UTF8 encoded string.
+
+ function Validate (Object : Iconv_T; Input : Byte_Sequence) return Boolean;
+ -- Check if convertion of Text is possible using given Object
+
+ function Validate_UTF_8 (Input : Byte_Sequence) return Boolean;
+ -- Check whether Input is valid UTF-8
+
+end UTF8_Utils;
diff --git a/packages/ada-ref-man/README b/packages/ada-ref-man/README
index 3aca2be..536b7b1 100644
--- a/packages/ada-ref-man/README
+++ b/packages/ada-ref-man/README
@@ -1,10 +1,3 @@
Emacs info version of Ada Reference Manual 2012 TC1
-The Ada Reference Manual is provided as a Gnu ELPA package; to install
-the package, add to ~./emacs:
-(package-initialize)
-
-then invoke M-x list-packages, install Ada Reference Manual.
-
-(end of file)
diff --git a/packages/wisi/NEWS b/packages/wisi/NEWS
index 06470ae..bd9be26 100644
--- a/packages/wisi/NEWS
+++ b/packages/wisi/NEWS
@@ -7,6 +7,21 @@ Please send wisi bug reports to address@hidden, with
'wisi' in the subject. If possible, use M-x report-emacs-bug.
+* wisi 1.1.5
+9 Jul 2017
+
+** wisi-indent-fallback allows setting the indent engine to use when
+ the wisi engine fails.
+
+** wisi-comment-indent now uses comment-column for comments following
+ code on the same line.
+
+** wisi-forward-statement-keyword tolerates end of buffer, and uses
+ either cache-next or cache-end.
+
+** forward-sexp-function is set to wisi-forward-sexp, which handles
+ parens, strings, and statements.
+
* wisi 1.1.4
31 Oct 2016
diff --git a/packages/wisi/README b/packages/wisi/README
index 82ee858..8e6fa68 100644
--- a/packages/wisi/README
+++ b/packages/wisi/README
@@ -1,14 +1,7 @@
-Emacs wisi package 1.1.4
+Emacs wisi package 1.1.5
The wisi package provides utilities for using generalized LALR parsers
-to do indentation and navigation. See ada-mode for an example of its
-use.
+to do indentation, fontification, and navigation. See ada-mode for an
+example of its use.
-It is provided as a Gnu ELPA package; to install the package, add to
-~./emacs:
-(package-initialize)
-
-then invoke M-x list-packages, install wisi.
-
-(end of file)
diff --git a/packages/wisi/wisi-compile.el b/packages/wisi/wisi-compile.el
index 5c788e7..420621a 100644
--- a/packages/wisi/wisi-compile.el
+++ b/packages/wisi/wisi-compile.el
@@ -1,6 +1,6 @@
;; wisi-compile.el --- Grammar compiler for the wisi parser, integrating Wisi
OpenToken output. -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2012, 2013, 2015, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2013, 2015-2017 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;;
@@ -128,7 +128,8 @@ It returns nil; it is called for the semantic side-effects
only."
(fset action-symbol
`(lambda ($nterm wisi-tokens)
,form
- nil))))
+ nil))
+ (byte-compile action-symbol)))
(defun wisi-compile-grammar (grammar)
"Compile the LALR(1) GRAMMAR; return the automaton for wisi-parse.
@@ -190,16 +191,10 @@ names have the format nonterm:index."
;;
;; FIXME: eliminate use of semantic-lex-* in *-wy.el. Similarly
;; requires decoupling from OpenToken
- ;;
- ;; FIXME: can eliminate obarray? We don't need the obarray to
- ;; avoid garbage collection of the symbols; they are all referenced in the
compiled grammar.
- ;; But each semantic action function has to be defined (and byte-compiled?)
somewhere?
- ;; currently actions are _not_ byte-compiled; wisi-compile-grammar is
run at load time
- ;; need 'eval-when-compile' to byte-compile them?
- ;; can't byte-compile obarray?
(let ((defs (nth 1 grammar))
(symbol-obarray (make-vector 13 0));; for parse actions
+ (byte-compile-warnings '(not free-vars)) ;; for "wisi-test-success" in
test/wisi/*
def nonterm rhs-list rule
semantic-action index)
diff --git a/packages/wisi/wisi-parse.el b/packages/wisi/wisi-parse.el
old mode 100644
new mode 100755
index a16a81d..0076fe5
--- a/packages/wisi/wisi-parse.el
+++ b/packages/wisi/wisi-parse.el
@@ -112,8 +112,6 @@ point at which that max was spawned.")
symbol, `text' is the token string, `start . end' is the range
in the buffer."
- ;; FIXME: (aref automaton 3) is the obarray storing the semantic actions;
- ;; not used here (see related FIXME in wisi-compile)
(let* ((actions (aref automaton 0))
(gotos (aref automaton 1))
(parser-states ;; vector of parallel parser states
diff --git a/packages/wisi/wisi.el b/packages/wisi/wisi.el
old mode 100644
new mode 100755
index 5a3569a..139ff98
--- a/packages/wisi/wisi.el
+++ b/packages/wisi/wisi.el
@@ -1,13 +1,13 @@
;;; wisi.el --- Utilities for implementing an indentation/navigation engine
using a generalized LALR parser -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2012 - 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2012 - 2017 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <address@hidden>
;; Maintainer: Stephen Leake <address@hidden>
;; Keywords: parser
;; indentation
;; navigation
-;; Version: 1.1.4
+;; Version: 1.1.5
;; package-requires: ((cl-lib "0.4") (emacs "24.2"))
;; URL: http://www.nongnu.org/ada-mode/wisi/wisi.html
;;
@@ -742,9 +742,10 @@ If accessing cache at a marker for a token as set by
`wisi-cache-tokens', POS mu
(defun wisi-get-containing-cache (cache)
"Return cache from (wisi-cache-containing CACHE)."
- (let ((containing (wisi-cache-containing cache)))
- (and containing
- (wisi-get-cache (1- containing)))))
+ (when cache
+ (let ((containing (wisi-cache-containing cache)))
+ (and containing
+ (wisi-get-cache (1- containing))))))
(defun wisi-cache-region (cache)
"Return region designated by cache.
@@ -1267,20 +1268,23 @@ If LIMIT (a buffer position) is reached, throw an
error."
(defun wisi-forward-statement-keyword ()
"If not at a cached token, move forward to next
-cache. Otherwise move to cache-next, or next cache if nil.
-Return cache found."
- (wisi-validate-cache (point-max) t) ;; ensure there is a next cache to move
to
- (let ((cache (wisi-get-cache (point))))
- (if cache
- (let ((next (wisi-cache-next cache)))
- (if next
- (goto-char (1- next))
- (wisi-forward-token)
- (wisi-forward-cache)))
- (wisi-forward-cache))
- )
- (wisi-get-cache (point))
- )
+cache. Otherwise move to cache-next, or cache-end, or next cache
+if both nil. Return cache found."
+ (unless (eobp)
+ (wisi-validate-cache (point-max) t) ;; ensure there is a next cache to
move to
+ (let ((cache (wisi-get-cache (point))))
+ (if (and cache
+ (not (eq (wisi-cache-class cache) 'statement-end)))
+ (let ((next (or (wisi-cache-next cache)
+ (wisi-cache-end cache))))
+ (if next
+ (goto-char (1- next))
+ (wisi-forward-token)
+ (wisi-forward-cache)))
+ (wisi-forward-cache))
+ )
+ (wisi-get-cache (point))
+ ))
(defun wisi-backward-statement-keyword ()
"If not at a cached token, move backward to prev
@@ -1295,6 +1299,34 @@ cache. Otherwise move to cache-prev, or prev cache if
nil."
(wisi-backward-cache))
))
+(defun wisi-forward-sexp (&optional arg)
+ "For `forward-sexp-function'."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (cond
+ ((and (> arg 0) (= 4 (syntax-class (syntax-after (point))))) ;; on open
paren
+ (let ((forward-sexp-function nil))
+ (forward-sexp arg)))
+
+ ((and (< arg 0) (= 5 (syntax-class (syntax-after (1- (point)))))) ;; after
close paren
+ (let ((forward-sexp-function nil))
+ (forward-sexp arg)))
+
+ ((and (> arg 0) (= 7 (syntax-class (syntax-after (point))))) ;; on (open)
string quote
+ (let ((forward-sexp-function nil))
+ (forward-sexp arg)))
+
+ ((and (< arg 0) (= 7 (syntax-class (syntax-after (1- (point)))))) ;; after
(close) string quote
+ (let ((forward-sexp-function nil))
+ (forward-sexp arg)))
+
+ (t
+ (dotimes (_i (abs arg))
+ (if (> arg 0)
+ (wisi-forward-statement-keyword)
+ (wisi-backward-statement-keyword))))
+ ))
+
(defun wisi-goto-containing (cache &optional error)
"Move point to containing token for CACHE, return cache at that point.
If ERROR, throw error when CACHE has no container; else return nil."
@@ -1360,7 +1392,7 @@ Return start cache."
(wisi-get-cache (point)))
(defun wisi-prev-statement-cache (cache)
- "Move point to CACHE-next, return cache; error if nil."
+ "Move point to CACHE-prev, return cache; error if nil."
(when (not (markerp (wisi-cache-prev cache)))
(error "no prev statement cache"))
(goto-char (1- (wisi-cache-prev cache)))
@@ -1371,27 +1403,33 @@ Return start cache."
(defun wisi-comment-indent ()
"For `comment-indent-function'. Indent single line comment to
the comment on the previous line."
+ ;; Called from `comment-indent', either to insert a new comment, or
+ ;; to indent the first line of an existing one. In either case, the
+ ;; comment may be after code on the same line. For an existing
+ ;; comment, point is at the start of the starting delimiter.
(or
(save-excursion
- (forward-comment -1)
- (when (looking-at comment-start)
- ;; There is a preceding comment line.
- (current-column)))
-
- ;; Probably called from `comment-indent'; either to insert a new
- ;; comment, or to indent the first line of an existing one. In
- ;; either case, the comment may be after code on the same line.
+ ;; Check for a preceding comment line; fail if comment follows code.
+ (when (forward-comment -1)
+ ;; For the case:
+ ;;
+ ;; code;-- comment
+ ;;
+ ;; point is on '--', and 'forward-comment' does not move point,
+ ;; returns nil.
+ (when (looking-at comment-start)
+ (current-column))))
+
(save-excursion
- (let ((start-col (current-column)))
- (back-to-indentation)
- (if (looking-at comment-start)
- ;; An existing comment alone on a line. Return nil, so
- ;; `comment-indent' will call `indent-according-to-mode'
- nil
-
- ;; A comment after code on the same line; point was at the
- ;; comment start, so assume it is already correct.
- start-col)))
+ (back-to-indentation)
+ (if (looking-at comment-start)
+ ;; An existing comment, no code preceding comment, and
+ ;; no comment on preceding line. Return nil, so
+ ;; `comment-indent' will call `indent-according-to-mode'
+ nil
+
+ ;; A comment after code on the same line.
+ comment-column))
))
(defun wisi-indent-current (offset)
@@ -1446,6 +1484,17 @@ correct. Must leave point at indentation of current
line.")
(defvar-local wisi-indent-failed nil
"Non-nil when wisi-indent-line fails due to parse failing; cleared when
indent succeeds.")
+(defvar-local wisi-indent-fallback 'wisi-indent-fallback-default
+ "Function to compute indent for current line when wisi parse fails.")
+
+(defun wisi-indent-fallback-default ()
+ ;; no indent info at point. Assume user is
+ ;; editing; indent to previous line, fix it
+ ;; after parse succeeds
+ (forward-line -1);; safe at bob
+ (back-to-indentation)
+ (current-column))
+
(defun wisi-indent-line ()
"Indent current line using the wisi indentation engine."
(interactive)
@@ -1460,15 +1509,9 @@ correct. Must leave point at indentation of current
line.")
(wisi-validate-cache (line-end-position))) ;; include at lease the
first token on this line
(if (> (point) wisi-cache-max)
- ;; parse failed
(progn
- ;; no indent info at point. Assume user is
- ;; editing; indent to previous line, fix it
- ;; after parse succeeds
- (setq wisi-indent-failed t)
- (forward-line -1);; safe at bob
- (back-to-indentation)
- (setq indent (current-column)))
+ (setq wisi-indent-failed t)
+ (setq indent (funcall wisi-indent-fallback)))
;; parse succeeded
(when wisi-indent-failed
@@ -1566,8 +1609,10 @@ correct. Must leave point at indentation of current
line.")
(setq wisi-keyword-table keyword-table)
(setq wisi-parse-table parse-table)
- (setq wisi-indent-calculate-functions indent-calculate)
+ ;; file local variables may have added opentoken, gnatprep
+ (setq wisi-indent-calculate-functions (append
wisi-indent-calculate-functions indent-calculate))
(set (make-local-variable 'indent-line-function) 'wisi-indent-line)
+ (set (make-local-variable 'forward-sexp-function) #'wisi-forward-sexp)
(setq wisi-post-parse-fail-hook post-parse-fail)
(setq wisi-indent-failed nil)
@@ -1575,8 +1620,7 @@ correct. Must leave point at indentation of current
line.")
(add-hook 'before-change-functions 'wisi-before-change nil t)
(add-hook 'after-change-functions 'wisi-after-change nil t)
- (when (functionp 'jit-lock-register)
- (jit-lock-register 'wisi-fontify-region))
+ (jit-lock-register 'wisi-fontify-region)
;; see comments on "lexer" above re syntax-propertize
(syntax-propertize (point-max))